1 | 'Thread.ab
|
---|
2 |
|
---|
3 | Namespace System
|
---|
4 |
|
---|
5 | /*タイプ*/
|
---|
6 | TypeDef LocalDataStoreSlot = Long
|
---|
7 |
|
---|
8 |
|
---|
9 | Namespace Threading
|
---|
10 |
|
---|
11 | /*列挙体*/
|
---|
12 | Enum ThreadPriority
|
---|
13 | Highest = 2
|
---|
14 | AboveNormal = 1
|
---|
15 | Normal = 0
|
---|
16 | BelowNormal = -1
|
---|
17 | Lowest = -2
|
---|
18 | End Enum
|
---|
19 |
|
---|
20 | Enum ThreadState
|
---|
21 | 'スレッド状態に AbortRequested が含まれ、そのスレッドは停止していますが、状態はまだ Stopped に変わっていません。
|
---|
22 | Aborted
|
---|
23 | 'スレッド上で Thread.Abort メソッドを呼び出しますが、そのスレッドの終了を試みる保留中の System.Threading.ThreadAbortException をスレッドが受け取っていません。
|
---|
24 | AbortRequested
|
---|
25 | 'スレッドは、フォアグラウンド スレッドではなく、バックグランド スレッドとして実行します。この状態は、Thread.IsBackground プロパティを設定して制御されます。
|
---|
26 | Background
|
---|
27 | 'スレッドをブロックせずに起動します。保留中の ThreadAbortException もありません。
|
---|
28 | Running
|
---|
29 | 'スレッドを停止します。
|
---|
30 | Stopped
|
---|
31 | 'スレッドの停止を要求します。これは、内部でだけ使用します。
|
---|
32 | StopRequested
|
---|
33 | 'スレッドを中断します。
|
---|
34 | Suspended
|
---|
35 | 'スレッドの中断を要求します。
|
---|
36 | SuspendRequested
|
---|
37 | 'スレッド上に Thread.Start メソッドを呼び出しません。
|
---|
38 | Unstarted
|
---|
39 | 'スレッドがブロックされています。これは、Thread.Sleep または Thread.Join の呼び出し、ロックの要求 (たとえば、Monitor.Enter や Monitor.Wait の呼び出しによる)、または ManualResetEvent などのスレッド同期オブジェクトの待機の結果である可能性があります。
|
---|
40 | WaitSleepJoin
|
---|
41 | End Enum
|
---|
42 |
|
---|
43 | /*
|
---|
44 | デリゲート
|
---|
45 | */
|
---|
46 | Delegate Sub ThreadStart()
|
---|
47 |
|
---|
48 | /*
|
---|
49 | 関数ポインタ
|
---|
50 | */
|
---|
51 | TypeDef PTHREAD_START_ROUTINE = *Function(args As VoidPtr) As DWord
|
---|
52 |
|
---|
53 | /*
|
---|
54 | クラス
|
---|
55 | */
|
---|
56 | Class Thread
|
---|
57 | m_hThread As HANDLE
|
---|
58 | m_dwThreadId As DWord
|
---|
59 | m_Priority As ThreadPriority
|
---|
60 |
|
---|
61 | m_fp As PTHREAD_START_ROUTINE
|
---|
62 | m_dg As ThreadStart
|
---|
63 | m_args As VoidPtr
|
---|
64 | name As String
|
---|
65 | state As ThreadState
|
---|
66 |
|
---|
67 | isThrowing As Boolean
|
---|
68 | throwingParamObject As Object
|
---|
69 |
|
---|
70 | needFreeStructurePointers As *VoidPtr
|
---|
71 | countOfNeedFreeStructurePointers As Long
|
---|
72 |
|
---|
73 | Public
|
---|
74 | Sub Thread()
|
---|
75 | m_hThread=0
|
---|
76 | m_dwThreadId=0
|
---|
77 | m_Priority=ThreadPriority.Normal
|
---|
78 |
|
---|
79 | m_fp=0
|
---|
80 |
|
---|
81 | name = "sub thread"
|
---|
82 | state = ThreadState.Unstarted
|
---|
83 |
|
---|
84 | isThrowing = False
|
---|
85 | throwingParamObject = Nothing
|
---|
86 | End Sub
|
---|
87 | Sub Thread(fp As PTHREAD_START_ROUTINE, args As VoidPtr)
|
---|
88 | m_hThread=0
|
---|
89 | m_dwThreadId=0
|
---|
90 | m_Priority=ThreadPriority.Normal
|
---|
91 |
|
---|
92 | m_fp=fp
|
---|
93 | m_args=args
|
---|
94 |
|
---|
95 | name = "sub thread"
|
---|
96 | state = ThreadState.Unstarted
|
---|
97 |
|
---|
98 | isThrowing = False
|
---|
99 | throwingParamObject = Nothing
|
---|
100 | End Sub
|
---|
101 | Sub Thread(threadStart As ThreadStart)
|
---|
102 | m_hThread=0
|
---|
103 | m_dwThreadId=0
|
---|
104 | m_Priority=ThreadPriority.Normal
|
---|
105 |
|
---|
106 | m_fp=AddressOf(threadStartEntry)
|
---|
107 | m_args=ActiveBasic.AllocObjectHandle(threadStart) As VoidPtr
|
---|
108 |
|
---|
109 | name = "sub thread"
|
---|
110 | state = ThreadState.Unstarted
|
---|
111 |
|
---|
112 | isThrowing = False
|
---|
113 | throwingParamObject = Nothing
|
---|
114 | End Sub
|
---|
115 | Sub Thread(obj As Thread)
|
---|
116 | m_hThread=obj.m_hThread
|
---|
117 | m_dwThreadId=obj.m_dwThreadId
|
---|
118 | m_Priority=obj.m_Priority
|
---|
119 | m_fp=obj.m_fp
|
---|
120 | m_args=obj.m_args
|
---|
121 |
|
---|
122 | name = "sub thread"
|
---|
123 | state = ThreadState.Unstarted
|
---|
124 |
|
---|
125 | isThrowing = False
|
---|
126 | throwingParamObject = Nothing
|
---|
127 | End Sub
|
---|
128 |
|
---|
129 | Sub Thread(hThread As HANDLE, dwThreadId As DWord, dummy As Long)
|
---|
130 | m_hThread=hThread
|
---|
131 | m_dwThreadId=dwThreadId
|
---|
132 |
|
---|
133 | name = "sub thread"
|
---|
134 | state = ThreadState.Unstarted
|
---|
135 |
|
---|
136 | isThrowing = False
|
---|
137 | throwingParamObject = Nothing
|
---|
138 | End Sub
|
---|
139 |
|
---|
140 | Sub ~Thread()
|
---|
141 | End Sub
|
---|
142 |
|
---|
143 | Function Equals(thread As Thread) As Boolean
|
---|
144 | Return m_dwThreadId = thread.m_dwThreadId
|
---|
145 | End Function
|
---|
146 |
|
---|
147 | Public 'public property
|
---|
148 | Function IsAlive() As Boolean
|
---|
149 | Dim code As DWord
|
---|
150 | GetExitCodeThread(m_hThread,code)
|
---|
151 | If code=STILL_ACTIVE Then
|
---|
152 | Return True
|
---|
153 | Else
|
---|
154 | Return False
|
---|
155 | End If
|
---|
156 | End Function
|
---|
157 |
|
---|
158 | 'Priority Property
|
---|
159 | Sub Priority(value As ThreadPriority)
|
---|
160 | m_Priority=value
|
---|
161 | SetThreadPriority(m_hThread,value)
|
---|
162 | End Sub
|
---|
163 | Function Priority() As ThreadPriority
|
---|
164 | Return m_Priority
|
---|
165 | End Function
|
---|
166 |
|
---|
167 | 'ThreadId
|
---|
168 | Function ThreadId() As DWord
|
---|
169 | Return m_dwThreadId
|
---|
170 | End Function
|
---|
171 |
|
---|
172 | Function ThreadState() As System.Threading.ThreadState
|
---|
173 | Return This.state
|
---|
174 | End Function
|
---|
175 |
|
---|
176 | Function Name() As String
|
---|
177 | Return name
|
---|
178 | End Function
|
---|
179 | Sub Name( name As String )
|
---|
180 | This.name = name
|
---|
181 | End Sub
|
---|
182 |
|
---|
183 | Public 'public method
|
---|
184 | /* Sub Abort()
|
---|
185 | TODO '実装のためにはかなり検討が必要
|
---|
186 | 'This.__Throw(New ThreadAbortException)
|
---|
187 | End Sub*/
|
---|
188 |
|
---|
189 | Sub Start()
|
---|
190 | Dim pfn = AddressOf(_run) As LONG_PTR
|
---|
191 | m_hThread=CreateThread(NULL,0,pfn As LPTHREAD_START_ROUTINE,ObjPtr(This),CREATE_SUSPENDED,m_dwThreadId)
|
---|
192 | SetThreadPriority(m_hThread,m_Priority)
|
---|
193 | This.Resume()
|
---|
194 | End Sub
|
---|
195 |
|
---|
196 | Virtual Function Run() As Long
|
---|
197 | If m_fp Then
|
---|
198 | Run=m_fp(m_args)
|
---|
199 | End If
|
---|
200 | End Function
|
---|
201 |
|
---|
202 | Sub Suspend()
|
---|
203 | This.state = ThreadState.SuspendRequested
|
---|
204 | If SuspendThread(m_hThread) = &HFFFFFFFF Then
|
---|
205 | This.state = ThreadState.Unstarted
|
---|
206 | Debug 'Throw New ThreadStateException
|
---|
207 | End If
|
---|
208 | This.state = ThreadState.Suspended
|
---|
209 | End Sub
|
---|
210 | Sub Resume()
|
---|
211 | If ResumeThread(m_hThread) = &HFFFFFFFF Then
|
---|
212 | state = ThreadState.Unstarted
|
---|
213 | Debug 'Throw New ThreadStateException
|
---|
214 | End If
|
---|
215 | This.state = ThreadState.Running
|
---|
216 | End Sub
|
---|
217 |
|
---|
218 | /* Function GetData(LocalDataStoreSlot)
|
---|
219 | End Function
|
---|
220 | Sub SetData(LocalDataStoreSlot)
|
---|
221 | End Sub*/
|
---|
222 |
|
---|
223 | Static Function CurrentThread() As Thread
|
---|
224 | Return _System_pobj_AllThreads->CurrentThread()
|
---|
225 | End Function
|
---|
226 |
|
---|
227 | /*------------------------ クラス内部用 --------------------------*/
|
---|
228 | Private
|
---|
229 | Function _run() As Long
|
---|
230 | '------------
|
---|
231 | ' 前処理
|
---|
232 | '------------
|
---|
233 |
|
---|
234 | ' 構造体の一時メモリ退避用領域を作成
|
---|
235 | needFreeStructurePointers = _System_malloc( 1 )
|
---|
236 | countOfNeedFreeStructurePointers = 0
|
---|
237 |
|
---|
238 | 'GCにスレッド開始を通知
|
---|
239 | _System_pobj_AllThreads->BeginThread(This, _System_GetSp() As *LONG_PTR)
|
---|
240 |
|
---|
241 |
|
---|
242 | '------------
|
---|
243 | '実行
|
---|
244 | '------------
|
---|
245 | _run=Run()
|
---|
246 |
|
---|
247 |
|
---|
248 | '------------
|
---|
249 | '後処理
|
---|
250 | '------------
|
---|
251 |
|
---|
252 | 'GCにスレッド終了を通知
|
---|
253 | _System_pobj_AllThreads->EndThread(This)
|
---|
254 |
|
---|
255 | ' 構造体の一時メモリ退避用領域を破棄
|
---|
256 | _System_free( needFreeStructurePointers )
|
---|
257 |
|
---|
258 | '自身のスレッドハンドルを閉じる
|
---|
259 | CloseHandle(InterlockedExchangePointer(VarPtr(m_hThread),NULL))
|
---|
260 | m_hThread=0
|
---|
261 |
|
---|
262 | End Function
|
---|
263 |
|
---|
264 | Static Function threadStartEntry(pThreadStart As VoidPtr) As DWord
|
---|
265 | Dim threadStart = ActiveBasic.ReleaseObjectHandle(pThreadStart As LONG_PTR) As ThreadStart
|
---|
266 | threadStart()
|
---|
267 | End Function
|
---|
268 |
|
---|
269 | /*------------------------ システム用 --------------------------*/
|
---|
270 | Public
|
---|
271 | Function __GetContext(ByRef Context As CONTEXT) As BOOL
|
---|
272 | Return GetThreadContext(m_hThread,Context)
|
---|
273 | End Function
|
---|
274 | Function __SetContext(ByRef Context As CONTEXT) As BOOL
|
---|
275 | Return SetThreadContext(m_hThread,Context)
|
---|
276 | End Function
|
---|
277 |
|
---|
278 | Sub __Throw( ex As Object )
|
---|
279 | isThrowing = True
|
---|
280 | throwingParamObject = ex
|
---|
281 | End Sub
|
---|
282 | Sub __Catched()
|
---|
283 | isThrowing = False
|
---|
284 | throwingParamObject = Nothing
|
---|
285 | End Sub
|
---|
286 | Function __IsThrowing() As Boolean
|
---|
287 | Return isThrowing
|
---|
288 | End Function
|
---|
289 | Function __GetThrowintParamObject() As Object
|
---|
290 | Return throwingParamObject
|
---|
291 | End Function
|
---|
292 |
|
---|
293 | Sub __AddNeedFreeTempStructure( structurePointer As VoidPtr )
|
---|
294 | needFreeStructurePointers = _System_realloc( needFreeStructurePointers, ( countOfNeedFreeStructurePointers + 1 ) * SizeOf(VoidPtr) )
|
---|
295 | needFreeStructurePointers[countOfNeedFreeStructurePointers] = structurePointer
|
---|
296 | countOfNeedFreeStructurePointers ++
|
---|
297 | End Sub
|
---|
298 |
|
---|
299 | Sub __FreeTempStructure()
|
---|
300 | Dim i = 0 As Long
|
---|
301 | While i<countOfNeedFreeStructurePointers
|
---|
302 | free( needFreeStructurePointers[i] )
|
---|
303 | i++
|
---|
304 | Wend
|
---|
305 | countOfNeedFreeStructurePointers = 0
|
---|
306 | End Sub
|
---|
307 | End Class
|
---|
308 |
|
---|
309 |
|
---|
310 | Namespace Detail
|
---|
311 |
|
---|
312 | '--------------------------------------------------------------------
|
---|
313 | ' すべてのスレッドの管理
|
---|
314 | '--------------------------------------------------------------------
|
---|
315 | ' TODO: このクラスをシングルトンにする
|
---|
316 |
|
---|
317 | Class _System_CThreadCollection
|
---|
318 | Public
|
---|
319 | collection As *ThreadInfo
|
---|
320 | ThreadNum As Long
|
---|
321 |
|
---|
322 | CriticalSection As CRITICAL_SECTION
|
---|
323 |
|
---|
324 | Sub _System_CThreadCollection()
|
---|
325 | collection = GC_malloc(1)
|
---|
326 | ThreadNum = 0
|
---|
327 | InitializeCriticalSection(CriticalSection)
|
---|
328 | End Sub
|
---|
329 |
|
---|
330 | Sub ~_System_CThreadCollection()
|
---|
331 | Dim i As Long
|
---|
332 | For i=0 To ELM(ThreadNum)
|
---|
333 | With collection[i]
|
---|
334 | If Not ActiveBasic.IsNothing( .thread ) Then
|
---|
335 | .thread = Nothing
|
---|
336 | .stackBase = 0
|
---|
337 | .exception = Nothing
|
---|
338 | End If
|
---|
339 | End With
|
---|
340 | Next
|
---|
341 | collection = 0
|
---|
342 | DeleteCriticalSection(CriticalSection)
|
---|
343 | End Sub
|
---|
344 |
|
---|
345 | 'スレッドを生成
|
---|
346 | Sub BeginThread(thread As Thread, NowSp As *LONG_PTR)
|
---|
347 | EnterCriticalSection(CriticalSection)
|
---|
348 | Dim i = FindFreeIndex
|
---|
349 | With collection[i]
|
---|
350 | .thread = thread
|
---|
351 | .stackBase = NowSp
|
---|
352 | .exception = New ExceptionService '例外処理管理用オブジェクトを生成
|
---|
353 | End With
|
---|
354 | LeaveCriticalSection(CriticalSection)
|
---|
355 | End Sub
|
---|
356 | Private
|
---|
357 | 'クリティカルセション内で呼ぶこと
|
---|
358 | Function FindFreeIndex() As Long
|
---|
359 | Dim i As Long
|
---|
360 | For i = 0 To ELM(ThreadNum)
|
---|
361 | If ActiveBasic.IsNothing(collection[i].thread) Then
|
---|
362 | FindFreeIndex = i
|
---|
363 | Exit Function
|
---|
364 | End If
|
---|
365 | Next
|
---|
366 | ThreadNum++
|
---|
367 | collection = realloc(collection, ThreadNum * SizeOf(ThreadInfo))
|
---|
368 | FindFreeIndex = i
|
---|
369 | End Function
|
---|
370 | Public
|
---|
371 |
|
---|
372 | 'スレッドを終了
|
---|
373 | Sub EndThread(thread As Thread)
|
---|
374 | EnterCriticalSection(CriticalSection)
|
---|
375 | Dim i As Long
|
---|
376 | For i = 0 To ELM(ThreadNum)
|
---|
377 | With collection[i]
|
---|
378 | If thread.Equals(.thread) Then
|
---|
379 | .thread = Nothing
|
---|
380 | .stackBase = 0
|
---|
381 | .exception = Nothing
|
---|
382 | Exit For
|
---|
383 | End If
|
---|
384 | End With
|
---|
385 | Next
|
---|
386 | LeaveCriticalSection(CriticalSection)
|
---|
387 | End Sub
|
---|
388 |
|
---|
389 | ' すべてのスレッドを中断
|
---|
390 | Sub SuspendAllThread()
|
---|
391 | Dim i As Long
|
---|
392 | For i = 0 To ELM(ThreadNum)
|
---|
393 | With collection[i]
|
---|
394 | If Not ActiveBasic.IsNothing(.thread) Then
|
---|
395 | .thread.Suspend()
|
---|
396 | End If
|
---|
397 | End With
|
---|
398 | Next
|
---|
399 | End Sub
|
---|
400 |
|
---|
401 | ' すべてのスレッドを再開
|
---|
402 | Sub ResumeAllThread()
|
---|
403 | Dim i As Long
|
---|
404 | For i = 0 To ELM(ThreadNum)
|
---|
405 | With collection[i]
|
---|
406 | If Not ActiveBasic.IsNothing(.thread) Then
|
---|
407 | .thread.Resume()
|
---|
408 | End If
|
---|
409 | End With
|
---|
410 | Next
|
---|
411 | End Sub
|
---|
412 | /*
|
---|
413 | ' 自分以外のスレッドを中断
|
---|
414 | Sub SuspendAnotherThread()
|
---|
415 | Dim currentThread = CurrentThread()
|
---|
416 |
|
---|
417 | Dim i As Long
|
---|
418 | For i=0 To ELM(ThreadNum)
|
---|
419 | With collection[i]
|
---|
420 | If currentThread.Equals(.thread) Then
|
---|
421 | Continue
|
---|
422 | ElseIf Not ActiveBasic.IsNothing(.thread) Then
|
---|
423 | .thread.Suspend()
|
---|
424 | End If
|
---|
425 | End With
|
---|
426 | Next
|
---|
427 | End Sub
|
---|
428 |
|
---|
429 | ' 自分以外のスレッドを再開
|
---|
430 | Sub ResumeAnotherThread()
|
---|
431 | Dim currentThread = CurrentThread()
|
---|
432 |
|
---|
433 | Dim i As Long
|
---|
434 | For i=0 To ELM(ThreadNum)
|
---|
435 | With collection[i]
|
---|
436 | If currentThread.Equals(.thread) Then
|
---|
437 | Continue
|
---|
438 | ElseIf Not ActiveBasic.IsNothing(.thread) Then
|
---|
439 | .thread.Resume()
|
---|
440 | End If
|
---|
441 | End With
|
---|
442 | Next
|
---|
443 | End Sub
|
---|
444 | */
|
---|
445 | 'カレントスレッドを取得
|
---|
446 | Function CurrentThread() As Thread
|
---|
447 | Dim p = CurrentThreadInfo()
|
---|
448 | If p = 0 Then
|
---|
449 | ' TODO: エラー処理
|
---|
450 | OutputDebugString( Ex"カレントスレッドの取得に失敗\r\n" )
|
---|
451 | debug
|
---|
452 | Exit Function
|
---|
453 | End If
|
---|
454 | CurrentThread = p->thread
|
---|
455 | End Function
|
---|
456 |
|
---|
457 | Function CurrentThreadInfo() As *ThreadInfo
|
---|
458 | CurrentThreadInfo = FindThreadInfo(GetCurrentThreadId())
|
---|
459 | End Function
|
---|
460 |
|
---|
461 | Function FindThreadInfo(threadID As DWord) As *ThreadInfo
|
---|
462 | EnterCriticalSection(CriticalSection)
|
---|
463 | Dim i As Long
|
---|
464 | For i = 0 To ELM(ThreadNum)
|
---|
465 | If collection[i].thread.ThreadId = threadID Then
|
---|
466 | FindThreadInfo = VarPtr(collection[i])
|
---|
467 | Exit Function
|
---|
468 | End If
|
---|
469 | Next
|
---|
470 | LeaveCriticalSection(CriticalSection)
|
---|
471 | End Function
|
---|
472 |
|
---|
473 | Private
|
---|
474 | '------------------------------------------
|
---|
475 | ' スレッド固有の例外処理制御
|
---|
476 | '------------------------------------------
|
---|
477 |
|
---|
478 | Public
|
---|
479 | Function GetCurrentException() As ExceptionService
|
---|
480 | EnterCriticalSection(CriticalSection)
|
---|
481 | Dim dwNowThreadId = GetCurrentThreadId()
|
---|
482 | Dim i As Long
|
---|
483 | For i=0 To ELM(ThreadNum)
|
---|
484 | With collection[i]
|
---|
485 | If .thread.ThreadId = dwNowThreadId Then
|
---|
486 | GetCurrentException = .exception
|
---|
487 | Exit For
|
---|
488 | End If
|
---|
489 | End With
|
---|
490 | Next
|
---|
491 | LeaveCriticalSection(CriticalSection)
|
---|
492 | If ActiveBasic.IsNothing(GetCurrentException) Then
|
---|
493 | OutputDebugString(Ex"カレントスレッドの取得に失敗\r\n")
|
---|
494 | End If
|
---|
495 | End Function
|
---|
496 | End Class
|
---|
497 |
|
---|
498 | Type ThreadInfo
|
---|
499 | thread As Thread
|
---|
500 | stackBase As *LONG_PTR
|
---|
501 | exception As ExceptionService
|
---|
502 | End Type
|
---|
503 |
|
---|
504 | End Namespace 'Detail
|
---|
505 | End Namespace 'Threading
|
---|
506 | End Namespace 'System
|
---|
507 |
|
---|
508 |
|
---|
509 | /* システムが使う変数 */
|
---|
510 | Dim _System_pobj_AllThreads As *System.Threading.Detail._System_CThreadCollection
|
---|
511 |
|
---|
512 | /* システムが呼び出す関数 */
|
---|
513 | Sub _System_AddNeedFreeTempStructure( structurePointer As VoidPtr )
|
---|
514 | System.Threading.Thread.CurrentThread.__AddNeedFreeTempStructure( structurePointer )
|
---|
515 | End Sub
|
---|
516 | Sub _System_FreeTempStructure()
|
---|
517 | System.Threading.Thread.CurrentThread.__FreeTempStructure()
|
---|
518 | End Sub
|
---|