[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
|
---|
| 24 |
|
---|
[1] | 25 | m_Priority As ThreadPriority
|
---|
| 26 |
|
---|
| 27 | m_fp As PTHREAD_START_ROUTINE
|
---|
| 28 | m_args As VoidPtr
|
---|
[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
|
---|
| 37 | End Sub
|
---|
| 38 | Sub Thread(fp As PTHREAD_START_ROUTINE, args As VoidPtr)
|
---|
| 39 | m_hThread=0
|
---|
[19] | 40 | m_dwThreadId=0
|
---|
[1] | 41 | m_Priority=ThreadPriority.Normal
|
---|
| 42 |
|
---|
| 43 | m_fp=fp
|
---|
| 44 | m_args=args
|
---|
| 45 | End Sub
|
---|
| 46 |
|
---|
[19] | 47 | Sub Thread(ByRef obj As Thread)
|
---|
| 48 | m_hThread=obj.m_hThread
|
---|
| 49 | m_dwThreadId=obj.m_dwThreadId
|
---|
| 50 | m_Priority=obj.m_Priority
|
---|
| 51 | m_fp=obj.m_fp
|
---|
| 52 | m_args=obj.m_args
|
---|
| 53 | End Sub
|
---|
[1] | 54 |
|
---|
[19] | 55 | Sub Thread(hThread As HANDLE,dwThreadId As DWord,dummy As Long)
|
---|
| 56 | m_hThread=hThread
|
---|
| 57 | m_dwThreadId=dwThreadId
|
---|
| 58 | m_Priority=ThreadPriority.Normal
|
---|
| 59 | End Sub
|
---|
| 60 |
|
---|
| 61 | Sub ~Thread()
|
---|
| 62 | End Sub
|
---|
| 63 |
|
---|
| 64 |
|
---|
| 65 | Function Equals(ByRef obj_Thread As Thread) As BOOL
|
---|
| 66 | If m_dwThreadId=obj_Thread.m_dwThreadId Then
|
---|
[42] | 67 | Return _System_TRUE
|
---|
[19] | 68 | End If
|
---|
[42] | 69 | Return _System_FALSE
|
---|
[19] | 70 | End Function
|
---|
| 71 |
|
---|
| 72 |
|
---|
| 73 |
|
---|
| 74 | '-----------------------
|
---|
| 75 | ' Public Properties
|
---|
| 76 | '-----------------------
|
---|
| 77 |
|
---|
| 78 | 'Priority Property
|
---|
[1] | 79 | Sub Priority(value As ThreadPriority)
|
---|
| 80 | m_Priority=value
|
---|
[19] | 81 | SetThreadPriority(m_hThread,value)
|
---|
[1] | 82 | End Sub
|
---|
| 83 | Function Priority() As ThreadPriority
|
---|
| 84 | Return m_Priority
|
---|
| 85 | End Function
|
---|
| 86 |
|
---|
[19] | 87 | 'ThreadId
|
---|
| 88 | Function ThreadId() As DWord
|
---|
| 89 | Return m_dwThreadId
|
---|
| 90 | End Function
|
---|
[1] | 91 |
|
---|
[19] | 92 |
|
---|
| 93 |
|
---|
| 94 |
|
---|
[1] | 95 | Sub Start()
|
---|
| 96 | Dim ThreadId As DWord
|
---|
[19] | 97 | m_hThread=_beginthreadex(NULL,0,AddressOf(_run),VarPtr(This),CREATE_SUSPENDED,m_dwThreadId)
|
---|
[1] | 98 | SetThreadPriority(m_hThread,m_Priority)
|
---|
| 99 | Resume()
|
---|
| 100 | End Sub
|
---|
| 101 |
|
---|
| 102 | Private
|
---|
[19] | 103 | Function Cdecl _run() As Long
|
---|
[1] | 104 | '------------
|
---|
| 105 | ' 前処理
|
---|
| 106 | '------------
|
---|
| 107 |
|
---|
| 108 | 'GCにスレッド開始を通知
|
---|
[19] | 109 | _System_pobj_AllThreads->BeginThread(This,_System_GetSp() As *LONG_PTR)
|
---|
[1] | 110 |
|
---|
| 111 |
|
---|
| 112 | '------------
|
---|
| 113 | '実行
|
---|
| 114 | '------------
|
---|
[19] | 115 | _run=Run()
|
---|
[1] | 116 |
|
---|
| 117 |
|
---|
| 118 | '------------
|
---|
| 119 | '後処理
|
---|
| 120 | '------------
|
---|
| 121 |
|
---|
| 122 | 'GCにスレッド終了を通知
|
---|
[19] | 123 | _System_pobj_AllThreads->EndThread(This)
|
---|
[1] | 124 |
|
---|
| 125 | '自身のスレッドハンドルを閉じる
|
---|
| 126 | CloseHandle(m_hThread)
|
---|
[19] | 127 | m_hThread=0
|
---|
[1] | 128 |
|
---|
| 129 | End Function
|
---|
| 130 |
|
---|
| 131 | Public
|
---|
| 132 | Virtual Function Run() As Long
|
---|
| 133 | If m_fp Then
|
---|
| 134 | Run=m_fp(m_args)
|
---|
| 135 | End If
|
---|
| 136 | End Function
|
---|
| 137 |
|
---|
| 138 | Sub Suspend()
|
---|
| 139 | SuspendThread(m_hThread)
|
---|
| 140 | End Sub
|
---|
| 141 | Sub Resume()
|
---|
| 142 | ResumeThread(m_hThread)
|
---|
| 143 | End Sub
|
---|
| 144 |
|
---|
[19] | 145 | Function __GetContext(ByRef Context As CONTEXT) As BOOL
|
---|
| 146 | Return GetThreadContext(m_hThread,Context)
|
---|
| 147 | End Function
|
---|
[58] | 148 | Function __SetContext(ByRef Context As CONTEXT) As BOOL
|
---|
| 149 | Return SetThreadContext(m_hThread,Context)
|
---|
| 150 | End Function
|
---|
[19] | 151 |
|
---|
| 152 |
|
---|
| 153 | Static Function CurrentThread() As Thread
|
---|
| 154 | Dim obj_Thread As Thread()
|
---|
| 155 | _System_pobj_AllThreads->CurrentThread(obj_Thread)
|
---|
| 156 | Return obj_Thread
|
---|
| 157 | End Function
|
---|
| 158 | End Class
|
---|
| 159 |
|
---|
| 160 |
|
---|
[58] | 161 | '--------------------------------------------------------------------
|
---|
| 162 | ' すべてのスレッドの管理
|
---|
| 163 | '--------------------------------------------------------------------
|
---|
| 164 | ' TODO: このクラスをシングルトンにする
|
---|
[19] | 165 | Class _System_CThreadCollection
|
---|
| 166 | Public
|
---|
| 167 | ppobj_Thread As **Thread
|
---|
| 168 | pStackBase As **LONG_PTR
|
---|
| 169 | ThreadNum As Long
|
---|
| 170 |
|
---|
| 171 | CriticalSection As CRITICAL_SECTION
|
---|
| 172 |
|
---|
| 173 | Sub _System_CThreadCollection()
|
---|
| 174 | ppobj_Thread=HeapAlloc(_System_hProcessHeap,0,1)
|
---|
| 175 | pStackBase=HeapAlloc(_System_hProcessHeap,0,1)
|
---|
[58] | 176 | ppException=HeapAlloc(_System_hProcessHeap,0,1)
|
---|
[19] | 177 | ThreadNum=0
|
---|
| 178 |
|
---|
| 179 | 'クリティカルセッションを生成
|
---|
| 180 | InitializeCriticalSection(CriticalSection)
|
---|
[1] | 181 | End Sub
|
---|
[19] | 182 |
|
---|
| 183 | Sub ~_System_CThreadCollection()
|
---|
| 184 | End Sub
|
---|
| 185 |
|
---|
| 186 | Sub Finalize()
|
---|
| 187 | HeapFree(_System_hProcessHeap,0,ppobj_Thread)
|
---|
| 188 | ppobj_Thread=0
|
---|
| 189 |
|
---|
| 190 | HeapFree(_System_hProcessHeap,0,pStackBase)
|
---|
| 191 | pStackBase=0
|
---|
| 192 |
|
---|
[58] | 193 | HeapFree(_System_hProcessHeap,0,ppException)
|
---|
| 194 | ppException = 0
|
---|
| 195 |
|
---|
[19] | 196 | ThreadNum=0
|
---|
| 197 |
|
---|
| 198 | 'クリティカルセッションを破棄
|
---|
| 199 | DeleteCriticalSection(CriticalSection)
|
---|
| 200 | End Sub
|
---|
| 201 |
|
---|
| 202 | 'スレッドを生成
|
---|
| 203 | Sub BeginThread(ByRef obj_Thread As Thread,NowSp As *LONG_PTR)
|
---|
| 204 | EnterCriticalSection(CriticalSection)
|
---|
| 205 |
|
---|
[58] | 206 | 'スレッドオブジェクトを生成
|
---|
[19] | 207 | Dim pobj_NewThread As *Thread
|
---|
| 208 | pobj_NewThread=New Thread(obj_Thread)
|
---|
| 209 |
|
---|
[58] | 210 | '例外処理管理用オブジェクトを生成
|
---|
| 211 | Dim pException As *ExceptionService
|
---|
| 212 | pException = New ExceptionService
|
---|
| 213 |
|
---|
[19] | 214 | Dim i As Long
|
---|
| 215 | For i=0 To ELM(ThreadNum)
|
---|
[58] | 216 | If ppobj_Thread[i] = 0 Then
|
---|
| 217 | ppobj_Thread[i] = pobj_NewThread
|
---|
| 218 | pStackBase[i] = NowSp
|
---|
| 219 | ppException[i] = pException
|
---|
[19] | 220 | Exit For
|
---|
| 221 | End If
|
---|
| 222 | Next
|
---|
| 223 |
|
---|
[58] | 224 | If i = ThreadNum Then
|
---|
[19] | 225 | ppobj_Thread=HeapReAlloc(_System_hProcessHeap,0,ppobj_Thread,(ThreadNum+1)*SizeOf(*Thread))
|
---|
| 226 | ppobj_Thread[ThreadNum]=pobj_NewThread
|
---|
| 227 | pStackBase=HeapReAlloc(_System_hProcessHeap,0,pStackBase,(ThreadNum+1)*SizeOf(LONG_PTR))
|
---|
| 228 | pStackBase[ThreadNum]=NowSp
|
---|
[58] | 229 | ppException=HeapReAlloc(_System_hProcessHeap,0,ppException,(ThreadNum+1)*SizeOf(*ExceptionService))
|
---|
| 230 | ppException[ThreadNum]=pException
|
---|
[19] | 231 | ThreadNum++
|
---|
| 232 | End If
|
---|
| 233 | LeaveCriticalSection(CriticalSection)
|
---|
| 234 | End Sub
|
---|
| 235 |
|
---|
| 236 | 'スレッドを終了
|
---|
| 237 | Sub EndThread(ByRef obj_Thread As Thread)
|
---|
| 238 | EnterCriticalSection(CriticalSection)
|
---|
| 239 | Dim i As Long
|
---|
| 240 | For i=0 To ELM(ThreadNum)
|
---|
| 241 | If ppobj_Thread[i]->Equals(obj_Thread) Then
|
---|
| 242 | Delete ppobj_Thread[i]
|
---|
| 243 | ppobj_Thread[i]=0
|
---|
| 244 | pStackBase[i]=0
|
---|
| 245 | Exit For
|
---|
| 246 | End If
|
---|
| 247 | Next
|
---|
| 248 | LeaveCriticalSection(CriticalSection)
|
---|
| 249 | End Sub
|
---|
| 250 |
|
---|
| 251 | ' すべてのスレッドを中断
|
---|
| 252 | Sub SuspendAllThread()
|
---|
| 253 | Dim i As Long
|
---|
| 254 | For i=0 To ELM(ThreadNum)
|
---|
| 255 | If ppobj_Thread[i] Then
|
---|
| 256 | ppobj_Thread[i]->Suspend()
|
---|
| 257 | End If
|
---|
| 258 | Next
|
---|
| 259 | End Sub
|
---|
| 260 |
|
---|
| 261 | ' すべてのスレッドを再開
|
---|
| 262 | Sub ResumeAllThread()
|
---|
| 263 | Dim i As Long
|
---|
| 264 | For i=0 To ELM(ThreadNum)
|
---|
| 265 | If ppobj_Thread[i] Then
|
---|
| 266 | ppobj_Thread[i]->Resume()
|
---|
| 267 | End If
|
---|
| 268 | Next
|
---|
| 269 | End Sub
|
---|
| 270 |
|
---|
[58] | 271 | 'カレントスレッドを取得
|
---|
[19] | 272 | Function CurrentThread(ByRef obj_Thread As Thread) As BOOL
|
---|
| 273 | Dim dwNowThreadId As DWord
|
---|
| 274 | dwNowThreadId=GetCurrentThreadId()
|
---|
| 275 |
|
---|
| 276 | Dim i As Long
|
---|
| 277 | For i=0 To ELM(ThreadNum)
|
---|
| 278 | If ppobj_Thread[i]->ThreadId=dwNowThreadId Then
|
---|
| 279 | obj_Thread.Thread(ByVal ppobj_Thread[i])
|
---|
| 280 | Return 1
|
---|
| 281 | End If
|
---|
| 282 | Next
|
---|
| 283 |
|
---|
| 284 | Return 0
|
---|
| 285 | End Function
|
---|
[58] | 286 |
|
---|
| 287 |
|
---|
| 288 | Private
|
---|
| 289 | '------------------------------------------
|
---|
| 290 | ' スレッド固有の例外処理制御
|
---|
| 291 | '------------------------------------------
|
---|
| 292 | ppException As **ExceptionService
|
---|
| 293 |
|
---|
| 294 | Public
|
---|
| 295 | Function GetCurrentException() As *ExceptionService
|
---|
| 296 | Dim dwNowThreadId As DWord
|
---|
| 297 | dwNowThreadId=GetCurrentThreadId()
|
---|
| 298 |
|
---|
| 299 | Dim i As Long
|
---|
| 300 | For i=0 To ELM(ThreadNum)
|
---|
| 301 | If ppobj_Thread[i]->ThreadId=dwNowThreadId Then
|
---|
| 302 | Return ppException[i]
|
---|
| 303 | End If
|
---|
| 304 | Next
|
---|
| 305 |
|
---|
| 306 | Return NULL
|
---|
| 307 | End Function
|
---|
[1] | 308 | End Class
|
---|
[19] | 309 | Dim _System_pobj_AllThreads As *_System_CThreadCollection
|
---|