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