source: Include/Classes/System/Threading/Thread.ab@ 272

Last change on this file since 272 was 249, checked in by dai, 18 years ago

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