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

Last change on this file since 330 was 330, checked in by dai, 17 years ago

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