[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 | '-----------------------
|
---|
| 96 |
|
---|
[237] | 97 |
|
---|
[19] | 98 | 'Priority Property
|
---|
[1] | 99 | Sub Priority(value As ThreadPriority)
|
---|
| 100 | m_Priority=value
|
---|
[19] | 101 | SetThreadPriority(m_hThread,value)
|
---|
[1] | 102 | End Sub
|
---|
| 103 | Function Priority() As ThreadPriority
|
---|
| 104 | Return m_Priority
|
---|
| 105 | End Function
|
---|
| 106 |
|
---|
[19] | 107 | 'ThreadId
|
---|
| 108 | Function ThreadId() As DWord
|
---|
| 109 | Return m_dwThreadId
|
---|
| 110 | End Function
|
---|
[1] | 111 |
|
---|
[330] | 112 | Function Name() As String
|
---|
| 113 | Return name
|
---|
| 114 | End Function
|
---|
| 115 | Sub Name( name As String )
|
---|
| 116 | This.name = name
|
---|
| 117 | End Sub
|
---|
[19] | 118 |
|
---|
[1] | 119 | Sub Start()
|
---|
| 120 | Dim ThreadId As DWord
|
---|
[19] | 121 | m_hThread=_beginthreadex(NULL,0,AddressOf(_run),VarPtr(This),CREATE_SUSPENDED,m_dwThreadId)
|
---|
[1] | 122 | SetThreadPriority(m_hThread,m_Priority)
|
---|
| 123 | Resume()
|
---|
| 124 | End Sub
|
---|
| 125 |
|
---|
| 126 | Private
|
---|
[19] | 127 | Function Cdecl _run() As Long
|
---|
[1] | 128 | '------------
|
---|
| 129 | ' 前処理
|
---|
| 130 | '------------
|
---|
| 131 |
|
---|
[480] | 132 | ' 構造体の一時メモリ退避用領域を作成
|
---|
| 133 | needFreeStructurePointers = _System_malloc( 1 )
|
---|
| 134 | countOfNeedFreeStructurePointers = 0
|
---|
| 135 |
|
---|
[1] | 136 | 'GCにスレッド開始を通知
|
---|
[400] | 137 | _System_pobj_AllThreads->BeginThread(This, _System_GetSp() As *LONG_PTR)
|
---|
[1] | 138 |
|
---|
| 139 |
|
---|
| 140 | '------------
|
---|
| 141 | '実行
|
---|
| 142 | '------------
|
---|
[19] | 143 | _run=Run()
|
---|
[1] | 144 |
|
---|
| 145 |
|
---|
| 146 | '------------
|
---|
| 147 | '後処理
|
---|
| 148 | '------------
|
---|
| 149 |
|
---|
| 150 | 'GCにスレッド終了を通知
|
---|
[400] | 151 | _System_pobj_AllThreads->EndThread(This)
|
---|
[1] | 152 |
|
---|
[480] | 153 | ' 構造体の一時メモリ退避用領域を破棄
|
---|
| 154 | _System_free( needFreeStructurePointers )
|
---|
| 155 |
|
---|
[1] | 156 | '自身のスレッドハンドルを閉じる
|
---|
| 157 | CloseHandle(m_hThread)
|
---|
[19] | 158 | m_hThread=0
|
---|
[1] | 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()
|
---|
[148] | 170 | If SuspendThread(m_hThread) = &HFFFFFFFF Then
|
---|
| 171 | debug
|
---|
| 172 | End If
|
---|
[1] | 173 | End Sub
|
---|
| 174 | Sub Resume()
|
---|
[148] | 175 | If ResumeThread(m_hThread) = &HFFFFFFFF Then
|
---|
| 176 | debug
|
---|
| 177 | End If
|
---|
[1] | 178 | End Sub
|
---|
| 179 |
|
---|
[19] | 180 | Function __GetContext(ByRef Context As CONTEXT) As BOOL
|
---|
| 181 | Return GetThreadContext(m_hThread,Context)
|
---|
| 182 | End Function
|
---|
[58] | 183 | Function __SetContext(ByRef Context As CONTEXT) As BOOL
|
---|
| 184 | Return SetThreadContext(m_hThread,Context)
|
---|
| 185 | End Function
|
---|
[19] | 186 |
|
---|
[374] | 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
|
---|
[19] | 201 |
|
---|
[480] | 202 | Sub __AddNeedFreeTempStructure( structurePointer As VoidPtr )
|
---|
| 203 | needFreeStructurePointers = _System_realloc( needFreeStructurePointers, ( countOfNeedFreeStructurePointers + 1 ) * SizeOf(VoidPtr) )
|
---|
| 204 | needFreeStructurePointers[countOfNeedFreeStructurePointers] = structurePointer
|
---|
| 205 | countOfNeedFreeStructurePointers ++
|
---|
| 206 | End Sub
|
---|
[374] | 207 |
|
---|
[480] | 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 |
|
---|
[19] | 218 | Static Function CurrentThread() As Thread
|
---|
[249] | 219 | Return _System_pobj_AllThreads->CurrentThread()
|
---|
[19] | 220 | End Function
|
---|
| 221 | End Class
|
---|
| 222 |
|
---|
[400] | 223 | Dim _System_pobj_AllThreads As *Detail._System_CThreadCollection
|
---|
[19] | 224 |
|
---|
[400] | 225 | Namespace Detail
|
---|
| 226 |
|
---|
[58] | 227 | '--------------------------------------------------------------------
|
---|
| 228 | ' すべてのスレッドの管理
|
---|
| 229 | '--------------------------------------------------------------------
|
---|
| 230 | ' TODO: このクラスをシングルトンにする
|
---|
[400] | 231 |
|
---|
[19] | 232 | Class _System_CThreadCollection
|
---|
| 233 | Public
|
---|
[400] | 234 | collection As *ThreadInfo
|
---|
[19] | 235 | ThreadNum As Long
|
---|
| 236 |
|
---|
| 237 | CriticalSection As CRITICAL_SECTION
|
---|
| 238 |
|
---|
| 239 | Sub _System_CThreadCollection()
|
---|
[400] | 240 | collection = GC_malloc(1)
|
---|
| 241 | ThreadNum = 0
|
---|
[19] | 242 | InitializeCriticalSection(CriticalSection)
|
---|
[1] | 243 | End Sub
|
---|
[19] | 244 |
|
---|
| 245 | Sub ~_System_CThreadCollection()
|
---|
[234] | 246 | Dim i As Long
|
---|
| 247 | For i=0 To ELM(ThreadNum)
|
---|
[400] | 248 | With collection[i]
|
---|
| 249 | If .thread Then
|
---|
| 250 | .thread = Nothing
|
---|
| 251 | .stackBase = 0
|
---|
| 252 | .exception = Nothing
|
---|
[234] | 253 | End If
|
---|
[400] | 254 | End With
|
---|
[234] | 255 | Next
|
---|
[400] | 256 | collection = 0
|
---|
[19] | 257 | DeleteCriticalSection(CriticalSection)
|
---|
| 258 | End Sub
|
---|
| 259 |
|
---|
| 260 | 'スレッドを生成
|
---|
[400] | 261 | Sub BeginThread(thread As Thread, NowSp As *LONG_PTR)
|
---|
[19] | 262 | EnterCriticalSection(CriticalSection)
|
---|
[400] | 263 | Dim i = FindFreeIndex
|
---|
| 264 | With collection[i]
|
---|
| 265 | .thread = thread
|
---|
| 266 | .stackBase = NowSp
|
---|
| 267 | .exception = New ExceptionService '例外処理管理用オブジェクトを生成
|
---|
| 268 | End With
|
---|
[19] | 269 | LeaveCriticalSection(CriticalSection)
|
---|
| 270 | End Sub
|
---|
[400] | 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
|
---|
[19] | 286 |
|
---|
| 287 | 'スレッドを終了
|
---|
[400] | 288 | Sub EndThread(thread As Thread)
|
---|
[19] | 289 | EnterCriticalSection(CriticalSection)
|
---|
| 290 | Dim i As Long
|
---|
[400] | 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
|
---|
[148] | 298 | End If
|
---|
[400] | 299 | End With
|
---|
[19] | 300 | Next
|
---|
| 301 | LeaveCriticalSection(CriticalSection)
|
---|
| 302 | End Sub
|
---|
| 303 |
|
---|
| 304 | ' すべてのスレッドを中断
|
---|
| 305 | Sub SuspendAllThread()
|
---|
| 306 | Dim i As Long
|
---|
[400] | 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
|
---|
[19] | 313 | Next
|
---|
| 314 | End Sub
|
---|
| 315 |
|
---|
| 316 | ' すべてのスレッドを再開
|
---|
| 317 | Sub ResumeAllThread()
|
---|
| 318 | Dim i As Long
|
---|
[400] | 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
|
---|
[19] | 325 | Next
|
---|
| 326 | End Sub
|
---|
[400] | 327 | /*
|
---|
[148] | 328 | ' 自分以外のスレッドを中断
|
---|
| 329 | Sub SuspendAnotherThread()
|
---|
[400] | 330 | Dim currentThread = CurrentThread()
|
---|
[148] | 331 |
|
---|
| 332 | Dim i As Long
|
---|
| 333 | For i=0 To ELM(ThreadNum)
|
---|
[400] | 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
|
---|
[148] | 341 | Next
|
---|
| 342 | End Sub
|
---|
| 343 |
|
---|
| 344 | ' 自分以外のスレッドを再開
|
---|
| 345 | Sub ResumeAnotherThread()
|
---|
[400] | 346 | Dim currentThread = CurrentThread()
|
---|
[148] | 347 |
|
---|
| 348 | Dim i As Long
|
---|
| 349 | For i=0 To ELM(ThreadNum)
|
---|
[400] | 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
|
---|
[148] | 357 | Next
|
---|
| 358 | End Sub
|
---|
[400] | 359 | */
|
---|
[58] | 360 | 'カレントスレッドを取得
|
---|
[249] | 361 | Function CurrentThread() As Thread
|
---|
[400] | 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
|
---|
[19] | 371 |
|
---|
[400] | 372 | Function CurrentThreadInfo() As *ThreadInfo
|
---|
| 373 | CurrentThreadInfo = FindThreadInfo(GetCurrentThreadId())
|
---|
| 374 | End Function
|
---|
| 375 |
|
---|
| 376 | Function FindThreadInfo(threadID As DWord) As *ThreadInfo
|
---|
[19] | 377 | Dim i As Long
|
---|
[400] | 378 | For i = 0 To ELM(ThreadNum)
|
---|
| 379 | If collection[i].thread.ThreadId = threadID Then
|
---|
| 380 | FindThreadInfo = VarPtr(collection[i])
|
---|
| 381 | Exit Function
|
---|
[19] | 382 | End If
|
---|
| 383 | Next
|
---|
| 384 | End Function
|
---|
[58] | 385 |
|
---|
| 386 | Private
|
---|
| 387 | '------------------------------------------
|
---|
| 388 | ' スレッド固有の例外処理制御
|
---|
| 389 | '------------------------------------------
|
---|
| 390 |
|
---|
| 391 | Public
|
---|
[400] | 392 | Function GetCurrentException() As ExceptionService
|
---|
| 393 | Dim dwNowThreadId = GetCurrentThreadId()
|
---|
[58] | 394 |
|
---|
| 395 | Dim i As Long
|
---|
| 396 | For i=0 To ELM(ThreadNum)
|
---|
[400] | 397 | With collection[i]
|
---|
| 398 | If .thread.ThreadId = dwNowThreadId Then
|
---|
| 399 | Return .exception
|
---|
| 400 | End If
|
---|
| 401 | End With
|
---|
[58] | 402 | Next
|
---|
| 403 |
|
---|
[400] | 404 | OutputDebugString( Ex"カレントスレッドの取得に失敗\r\n" )
|
---|
| 405 | Return Nothing
|
---|
[58] | 406 | End Function
|
---|
[1] | 407 | End Class
|
---|
[400] | 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
|
---|
[480] | 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
|
---|