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