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