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 |
|
---|
29 | Public
|
---|
30 | Sub Thread()
|
---|
31 | m_hThread=0
|
---|
32 | m_dwThreadId=0
|
---|
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
|
---|
39 | m_dwThreadId=0
|
---|
40 | m_Priority=ThreadPriority.Normal
|
---|
41 |
|
---|
42 | m_fp=fp
|
---|
43 | m_args=args
|
---|
44 | End Sub
|
---|
45 |
|
---|
46 | Sub Thread(obj As Thread)
|
---|
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
|
---|
53 |
|
---|
54 | Sub Thread(hThread As HANDLE, dwThreadId As DWord, dummy As Long)
|
---|
55 | m_hThread=hThread
|
---|
56 | m_dwThreadId=dwThreadId
|
---|
57 | End Sub
|
---|
58 |
|
---|
59 | Sub ~Thread()
|
---|
60 | End Sub
|
---|
61 |
|
---|
62 |
|
---|
63 | Function Equals(thread As Thread) As Boolean
|
---|
64 | Return m_dwThreadId = thread.m_dwThreadId
|
---|
65 | End Function
|
---|
66 |
|
---|
67 | '-----------------------
|
---|
68 | ' Public Properties
|
---|
69 | '-----------------------
|
---|
70 |
|
---|
71 |
|
---|
72 | 'Priority Property
|
---|
73 | Sub Priority(value As ThreadPriority)
|
---|
74 | m_Priority=value
|
---|
75 | SetThreadPriority(m_hThread,value)
|
---|
76 | End Sub
|
---|
77 | Function Priority() As ThreadPriority
|
---|
78 | Return m_Priority
|
---|
79 | End Function
|
---|
80 |
|
---|
81 | 'ThreadId
|
---|
82 | Function ThreadId() As DWord
|
---|
83 | Return m_dwThreadId
|
---|
84 | End Function
|
---|
85 |
|
---|
86 |
|
---|
87 |
|
---|
88 |
|
---|
89 |
|
---|
90 | Sub Start()
|
---|
91 | Dim ThreadId As DWord
|
---|
92 | m_hThread=_beginthreadex(NULL,0,AddressOf(_run),VarPtr(This),CREATE_SUSPENDED,m_dwThreadId)
|
---|
93 | SetThreadPriority(m_hThread,m_Priority)
|
---|
94 | Resume()
|
---|
95 | End Sub
|
---|
96 |
|
---|
97 | Private
|
---|
98 | Function Cdecl _run() As Long
|
---|
99 | '------------
|
---|
100 | ' 前処理
|
---|
101 | '------------
|
---|
102 |
|
---|
103 | 'GCにスレッド開始を通知
|
---|
104 | _System_pobj_AllThreads->BeginThread(VarPtr(This),_System_GetSp() As *LONG_PTR)
|
---|
105 |
|
---|
106 |
|
---|
107 | '------------
|
---|
108 | '実行
|
---|
109 | '------------
|
---|
110 | _run=Run()
|
---|
111 |
|
---|
112 |
|
---|
113 | '------------
|
---|
114 | '後処理
|
---|
115 | '------------
|
---|
116 |
|
---|
117 | 'GCにスレッド終了を通知
|
---|
118 | _System_pobj_AllThreads->EndThread(VarPtr(This))
|
---|
119 |
|
---|
120 | '自身のスレッドハンドルを閉じる
|
---|
121 | CloseHandle(m_hThread)
|
---|
122 | m_hThread=0
|
---|
123 |
|
---|
124 | End Function
|
---|
125 |
|
---|
126 | Public
|
---|
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()
|
---|
134 | If SuspendThread(m_hThread) = &HFFFFFFFF Then
|
---|
135 | debug
|
---|
136 | End If
|
---|
137 | End Sub
|
---|
138 | Sub Resume()
|
---|
139 | If ResumeThread(m_hThread) = &HFFFFFFFF Then
|
---|
140 | debug
|
---|
141 | End If
|
---|
142 | End Sub
|
---|
143 |
|
---|
144 | Function __GetContext(ByRef Context As CONTEXT) As BOOL
|
---|
145 | Return GetThreadContext(m_hThread,Context)
|
---|
146 | End Function
|
---|
147 | Function __SetContext(ByRef Context As CONTEXT) As BOOL
|
---|
148 | Return SetThreadContext(m_hThread,Context)
|
---|
149 | End Function
|
---|
150 |
|
---|
151 |
|
---|
152 | Static Function CurrentThread() As Thread
|
---|
153 | Return _System_pobj_AllThreads->CurrentThread()
|
---|
154 | End Function
|
---|
155 | End Class
|
---|
156 |
|
---|
157 |
|
---|
158 | '--------------------------------------------------------------------
|
---|
159 | ' すべてのスレッドの管理
|
---|
160 | '--------------------------------------------------------------------
|
---|
161 | ' TODO: このクラスをシングルトンにする
|
---|
162 | Class _System_CThreadCollection
|
---|
163 | Public
|
---|
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()
|
---|
171 | ppobj_Thread=GC_malloc(1)
|
---|
172 | pStackBase=HeapAlloc(_System_hProcessHeap,0,1)
|
---|
173 | ppException=HeapAlloc(_System_hProcessHeap,0,1)
|
---|
174 | ThreadNum=0
|
---|
175 |
|
---|
176 | 'クリティカルセッションを生成
|
---|
177 | InitializeCriticalSection(CriticalSection)
|
---|
178 | End Sub
|
---|
179 |
|
---|
180 | Sub ~_System_CThreadCollection()
|
---|
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 |
|
---|
195 | HeapFree(_System_hProcessHeap,0,pStackBase)
|
---|
196 | pStackBase=0
|
---|
197 |
|
---|
198 | HeapFree(_System_hProcessHeap,0,ppException)
|
---|
199 | ppException = 0
|
---|
200 |
|
---|
201 | ThreadNum=0
|
---|
202 |
|
---|
203 | 'クリティカルセッションを破棄
|
---|
204 | DeleteCriticalSection(CriticalSection)
|
---|
205 | End Sub
|
---|
206 |
|
---|
207 | 'スレッドを生成
|
---|
208 | Sub BeginThread(pThread As *Thread,NowSp As *LONG_PTR)
|
---|
209 | EnterCriticalSection(CriticalSection)
|
---|
210 |
|
---|
211 | '例外処理管理用オブジェクトを生成
|
---|
212 | Dim pException As *ExceptionService
|
---|
213 | pException = New ExceptionService
|
---|
214 |
|
---|
215 | Dim i As Long
|
---|
216 | For i=0 To ELM(ThreadNum)
|
---|
217 | If ppobj_Thread[i] = 0 Then
|
---|
218 | ppobj_Thread[i] = pThread
|
---|
219 | pStackBase[i] = NowSp
|
---|
220 | ppException[i] = pException
|
---|
221 | Exit For
|
---|
222 | End If
|
---|
223 | Next
|
---|
224 |
|
---|
225 | If i = ThreadNum Then
|
---|
226 | ppobj_Thread=realloc(ppobj_Thread,(ThreadNum+1)*SizeOf(*Thread))
|
---|
227 | ppobj_Thread[ThreadNum]=pThread
|
---|
228 | pStackBase=HeapReAlloc(_System_hProcessHeap,0,pStackBase,(ThreadNum+1)*SizeOf(LONG_PTR))
|
---|
229 | pStackBase[ThreadNum]=NowSp
|
---|
230 | ppException=HeapReAlloc(_System_hProcessHeap,0,ppException,(ThreadNum+1)*SizeOf(*ExceptionService))
|
---|
231 | ppException[ThreadNum]=pException
|
---|
232 | ThreadNum++
|
---|
233 | End If
|
---|
234 | LeaveCriticalSection(CriticalSection)
|
---|
235 | End Sub
|
---|
236 |
|
---|
237 | 'スレッドを終了
|
---|
238 | Sub EndThread(pThread As *Thread)
|
---|
239 | EnterCriticalSection(CriticalSection)
|
---|
240 | Dim i As Long
|
---|
241 | For i=0 To ELM(ThreadNum)
|
---|
242 | If ppobj_Thread[i] = pThread Then
|
---|
243 | If i = 0 Then
|
---|
244 | Delete pThread
|
---|
245 | End If
|
---|
246 | ppobj_Thread[i]=0
|
---|
247 | pStackBase[i]=0
|
---|
248 | Delete ppException[i]
|
---|
249 | ppException[i]=0
|
---|
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 |
|
---|
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( ppobj_Thread[i] As Object ) 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( ppobj_Thread[i] As Object ) 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 |
|
---|
310 | 'カレントスレッドを取得
|
---|
311 | Function CurrentThread() As Thread
|
---|
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
|
---|
318 | Return ByVal ppobj_Thread[i]
|
---|
319 | End If
|
---|
320 | Next
|
---|
321 |
|
---|
322 | ' TODO: エラー処理
|
---|
323 | OutputDebugString( "カレントスレッドの取得に失敗" )
|
---|
324 | debug
|
---|
325 | End Function
|
---|
326 |
|
---|
327 |
|
---|
328 | Private
|
---|
329 | '------------------------------------------
|
---|
330 | ' スレッド固有の例外処理制御
|
---|
331 | '------------------------------------------
|
---|
332 | ppException As **ExceptionService
|
---|
333 |
|
---|
334 | Public
|
---|
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
|
---|
348 | End Class
|
---|
349 | Dim _System_pobj_AllThreads As *_System_CThreadCollection
|
---|