source: trunk/Include/Classes/System/Threading/Thread.ab@ 374

Last change on this file since 374 was 374, checked in by dai, 16 years ago

例外処理機構実装中
・Catchのオーバーロードに対応
・Finallyに対応
・Tryスコープの入れ子に対応
（※注意 … 現時点ではThrow→Catch間でパラメータの引渡しができません）
File size: 8.3 KB
RevLine 
[19]1'threading.sbp
[1]2
[58]3
4'--------------------------------------------------------------------
5' スレッドの優先順位
6'--------------------------------------------------------------------
[1]7Enum ThreadPriority
[19]8 Highest = 2
9 AboveNormal = 1
10 Normal = 0
11 BelowNormal = -1
12 Lowest = -2
[1]13End Enum
14
15TypeDef PTHREAD_START_ROUTINE = *Function(args As VoidPtr) As DWord
16
[58]17
18'--------------------------------------------------------------------
19' スレッド クラス
20'--------------------------------------------------------------------
[1]21Class Thread
22 m_hThread As HANDLE
[19]23 m_dwThreadId As DWord
[1]24 m_Priority As ThreadPriority
25
26 m_fp As PTHREAD_START_ROUTINE
27 m_args As VoidPtr
[330]28 name As String
[58]29
[374]30 isThrowing As Boolean
31 throwingParamObject As Object
32
[1]33Public
34 Sub Thread()
35 m_hThread=0
[19]36 m_dwThreadId=0
[1]37 m_Priority=ThreadPriority.Normal
38
39 m_fp=0
[330]40
41 name = "sub thread"
[374]42
43 isThrowing = False
44 throwingParamObject = Nothing
[1]45 End Sub
46 Sub Thread(fp As PTHREAD_START_ROUTINE, args As VoidPtr)
47 m_hThread=0
[19]48 m_dwThreadId=0
[1]49 m_Priority=ThreadPriority.Normal
50
51 m_fp=fp
52 m_args=args
[330]53
54 name = "sub thread"
[374]55
56 isThrowing = False
57 throwingParamObject = Nothing
[1]58 End Sub
59
[249]60 Sub Thread(obj As Thread)
[19]61 m_hThread=obj.m_hThread
62 m_dwThreadId=obj.m_dwThreadId
63 m_Priority=obj.m_Priority
64 m_fp=obj.m_fp
65 m_args=obj.m_args
[330]66
67 name = "sub thread"
[374]68
69 isThrowing = False
70 throwingParamObject = Nothing
[19]71 End Sub
[1]72
[237]73 Sub Thread(hThread As HANDLE, dwThreadId As DWord, dummy As Long)
[19]74 m_hThread=hThread
75 m_dwThreadId=dwThreadId
[330]76
77 name = "sub thread"
[374]78
79 isThrowing = False
80 throwingParamObject = Nothing
[19]81 End Sub
82
83 Sub ~Thread()
84 End Sub
85
86
[237]87 Function Equals(thread As Thread) As Boolean
88 Return m_dwThreadId = thread.m_dwThreadId
[19]89 End Function
90
91 '-----------------------
92 ' Public Properties
93 '-----------------------
94
[237]95
[19]96 'Priority Property
[1]97 Sub Priority(value As ThreadPriority)
98 m_Priority=value
[19]99 SetThreadPriority(m_hThread,value)
[1]100 End Sub
101 Function Priority() As ThreadPriority
102 Return m_Priority
103 End Function
104
[19]105 'ThreadId
106 Function ThreadId() As DWord
107 Return m_dwThreadId
108 End Function
[1]109
[330]110 Function Name() As String
111 Return name
112 End Function
113 Sub Name( name As String )
114 This.name = name
115 End Sub
[19]116
117
118
[237]119
[330]120
[1]121 Sub Start()
122 Dim ThreadId As DWord
[19]123 m_hThread=_beginthreadex(NULL,0,AddressOf(_run),VarPtr(This),CREATE_SUSPENDED,m_dwThreadId)
[1]124 SetThreadPriority(m_hThread,m_Priority)
125 Resume()
126 End Sub
127
128Private
[19]129 Function Cdecl _run() As Long
[1]130 '------------
131 ' 前処理
132 '------------
133
134 'GCにスレッド開始を通知
[148]135 _System_pobj_AllThreads->BeginThread(VarPtr(This),_System_GetSp() As *LONG_PTR)
[1]136
137
138 '------------
139 '実行
140 '------------
[19]141 _run=Run()
[1]142
143
144 '------------
145 '後処理
146 '------------
147
148 'GCにスレッド終了を通知
[148]149 _System_pobj_AllThreads->EndThread(VarPtr(This))
[1]150
151 '自身のスレッドハンドルを閉じる
152 CloseHandle(m_hThread)
[19]153 m_hThread=0
[1]154
155 End Function
156
157Public
158 Virtual Function Run() As Long
159 If m_fp Then
160 Run=m_fp(m_args)
161 End If
162 End Function
163
164 Sub Suspend()
[148]165 If SuspendThread(m_hThread) = &HFFFFFFFF Then
166 debug
167 End If
[1]168 End Sub
169 Sub Resume()
[148]170 If ResumeThread(m_hThread) = &HFFFFFFFF Then
171 debug
172 End If
[1]173 End Sub
174
[19]175 Function __GetContext(ByRef Context As CONTEXT) As BOOL
176 Return GetThreadContext(m_hThread,Context)
177 End Function
[58]178 Function __SetContext(ByRef Context As CONTEXT) As BOOL
179 Return SetThreadContext(m_hThread,Context)
180 End Function
[19]181
[374]182 Sub __Throw( ex As Object )
183 isThrowing = True
184 throwingParamObject = ex
185 End Sub
186 Sub __Catched()
187 isThrowing = False
188 throwingParamObject = Nothing
189 End Sub
190 Function __IsThrowing() As Boolean
191 Return isThrowing
192 End Function
193 Function __GetThrowintParamObject() As Object
194 Return throwingParamObject
195 End Function
[19]196
[374]197
[19]198 Static Function CurrentThread() As Thread
[249]199 Return _System_pobj_AllThreads->CurrentThread()
[19]200 End Function
201End Class
202
203
[58]204'--------------------------------------------------------------------
205' すべてのスレッドの管理
206'--------------------------------------------------------------------
207' TODO: このクラスをシングルトンにする
[19]208Class _System_CThreadCollection
209Public
210 ppobj_Thread As **Thread
211 pStackBase As **LONG_PTR
212 ThreadNum As Long
213
214 CriticalSection As CRITICAL_SECTION
215
216 Sub _System_CThreadCollection()
[148]217 ppobj_Thread=GC_malloc(1)
[19]218 pStackBase=HeapAlloc(_System_hProcessHeap,0,1)
[58]219 ppException=HeapAlloc(_System_hProcessHeap,0,1)
[19]220 ThreadNum=0
221
222 'クリティカルセッションを生成
223 InitializeCriticalSection(CriticalSection)
[1]224 End Sub
[19]225
226 Sub ~_System_CThreadCollection()
[234]227 Dim i As Long
228 For i=0 To ELM(ThreadNum)
229 If ppobj_Thread[i] Then
230 If i = 0 Then
231 Delete ppobj_Thread[i]
232 End If
233 ppobj_Thread[i]=0
234 pStackBase[i]=0
235 Delete ppException[i]
236 ppException[i]=0
237 Exit For
238 End If
239 Next
240
[19]241 HeapFree(_System_hProcessHeap,0,pStackBase)
242 pStackBase=0
243
[58]244 HeapFree(_System_hProcessHeap,0,ppException)
245 ppException = 0
246
[19]247 ThreadNum=0
248
249 'クリティカルセッションを破棄
250 DeleteCriticalSection(CriticalSection)
251 End Sub
252
253 'スレッドを生成
[148]254 Sub BeginThread(pThread As *Thread,NowSp As *LONG_PTR)
[19]255 EnterCriticalSection(CriticalSection)
256
[58]257 '例外処理管理用オブジェクトを生成
258 Dim pException As *ExceptionService
259 pException = New ExceptionService
260
[19]261 Dim i As Long
262 For i=0 To ELM(ThreadNum)
[58]263 If ppobj_Thread[i] = 0 Then
[148]264 ppobj_Thread[i] = pThread
[58]265 pStackBase[i] = NowSp
266 ppException[i] = pException
[19]267 Exit For
268 End If
269 Next
270
[58]271 If i = ThreadNum Then
[148]272 ppobj_Thread=realloc(ppobj_Thread,(ThreadNum+1)*SizeOf(*Thread))
273 ppobj_Thread[ThreadNum]=pThread
[19]274 pStackBase=HeapReAlloc(_System_hProcessHeap,0,pStackBase,(ThreadNum+1)*SizeOf(LONG_PTR))
275 pStackBase[ThreadNum]=NowSp
[58]276 ppException=HeapReAlloc(_System_hProcessHeap,0,ppException,(ThreadNum+1)*SizeOf(*ExceptionService))
277 ppException[ThreadNum]=pException
[19]278 ThreadNum++
279 End If
280 LeaveCriticalSection(CriticalSection)
281 End Sub
282
283 'スレッドを終了
[148]284 Sub EndThread(pThread As *Thread)
[19]285 EnterCriticalSection(CriticalSection)
286 Dim i As Long
287 For i=0 To ELM(ThreadNum)
[148]288 If ppobj_Thread[i] = pThread Then
289 If i = 0 Then
290 Delete pThread
291 End If
[19]292 ppobj_Thread[i]=0
293 pStackBase[i]=0
[220]294 Delete ppException[i]
295 ppException[i]=0
[19]296 Exit For
297 End If
298 Next
299 LeaveCriticalSection(CriticalSection)
300 End Sub
301
302 ' すべてのスレッドを中断
303 Sub SuspendAllThread()
304 Dim i As Long
305 For i=0 To ELM(ThreadNum)
306 If ppobj_Thread[i] Then
307 ppobj_Thread[i]->Suspend()
308 End If
309 Next
310 End Sub
311
312 ' すべてのスレッドを再開
313 Sub ResumeAllThread()
314 Dim i As Long
315 For i=0 To ELM(ThreadNum)
316 If ppobj_Thread[i] Then
317 ppobj_Thread[i]->Resume()
318 End If
319 Next
320 End Sub
321
[148]322 ' 自分以外のスレッドを中断
323 Sub SuspendAnotherThread()
324 Dim currentThread = Thread.CurrentThread()
325
326 Dim i As Long
327 For i=0 To ELM(ThreadNum)
328
[303]329 If currentThread.Equals( ppobj_Thread[i] As Object ) Then
[148]330 Continue
331 End If
332
333 If ppobj_Thread[i] Then
334 ppobj_Thread[i]->Suspend()
335 End If
336 Next
337 End Sub
338
339 ' 自分以外のスレッドを再開
340 Sub ResumeAnotherThread()
341 Dim currentThread = Thread.CurrentThread()
342
343 Dim i As Long
344 For i=0 To ELM(ThreadNum)
345
[303]346 If currentThread.Equals( ppobj_Thread[i] As Object ) Then
[148]347 Continue
348 End If
349
350 If ppobj_Thread[i] Then
351 ppobj_Thread[i]->Resume()
352 End If
353 Next
354 End Sub
355
[58]356 'カレントスレッドを取得
[249]357 Function CurrentThread() As Thread
[19]358 Dim dwNowThreadId As DWord
359 dwNowThreadId=GetCurrentThreadId()
360
361 Dim i As Long
362 For i=0 To ELM(ThreadNum)
363 If ppobj_Thread[i]->ThreadId=dwNowThreadId Then
[249]364 Return ByVal ppobj_Thread[i]
[19]365 End If
366 Next
367
[249]368 ' TODO: エラー処理
369 OutputDebugString( "カレントスレッドの取得に失敗" )
370 debug
[19]371 End Function
[58]372
373
374Private
375 '------------------------------------------
376 ' スレッド固有の例外処理制御
377 '------------------------------------------
378 ppException As **ExceptionService
379
380Public
381 Function GetCurrentException() As *ExceptionService
382 Dim dwNowThreadId As DWord
383 dwNowThreadId=GetCurrentThreadId()
384
385 Dim i As Long
386 For i=0 To ELM(ThreadNum)
387 If ppobj_Thread[i]->ThreadId=dwNowThreadId Then
388 Return ppException[i]
389 End If
390 Next
391
392 Return NULL
393 End Function
[1]394End Class
[19]395Dim _System_pobj_AllThreads As *_System_CThreadCollection
Note: See TracBrowser for help on using the repository browser.