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