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

Last change on this file since 412 was 400, checked in by イグトランス (egtra), 17 years ago

_System_CThreadCollectionでのクラスインスタンスへのポインタの使用を除去、参照変数構文へ。

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