'threading.sbp


'--------------------------------------------------------------------
' スレッドの優先順位
'--------------------------------------------------------------------
Enum ThreadPriority
	Highest =      2
	AboveNormal =  1
	Normal =       0
	BelowNormal = -1
	Lowest =      -2
End Enum

TypeDef PTHREAD_START_ROUTINE = *Function(args As VoidPtr) As DWord


'--------------------------------------------------------------------
' スレッド クラス
'--------------------------------------------------------------------
Class Thread
	m_hThread As HANDLE
	m_dwThreadId As DWord
	m_Priority As ThreadPriority

	m_fp As PTHREAD_START_ROUTINE
	m_args As VoidPtr

Public
	Sub Thread()
		m_hThread=0
		m_dwThreadId=0
		m_Priority=ThreadPriority.Normal

		m_fp=0
	End Sub
	Sub Thread(fp As PTHREAD_START_ROUTINE, args As VoidPtr)
		m_hThread=0
		m_dwThreadId=0
		m_Priority=ThreadPriority.Normal

		m_fp=fp
		m_args=args
	End Sub

	Sub Thread(ByRef obj As Thread)
		m_hThread=obj.m_hThread
		m_dwThreadId=obj.m_dwThreadId
		m_Priority=obj.m_Priority
		m_fp=obj.m_fp
		m_args=obj.m_args
	End Sub

	Sub Thread(hThread As HANDLE,dwThreadId As DWord,dummy As Long)
		m_hThread=hThread
		m_dwThreadId=dwThreadId
	End Sub

	Sub ~Thread()
	End Sub


	Function Equals( thread As Thread ) As Boolean
		If m_dwThreadId = thread.m_dwThreadId Then
			Return True
		End If
		Return False
	End Function



	'-----------------------
	' Public Properties
	'-----------------------

	'Priority Property
	Sub Priority(value As ThreadPriority)
		m_Priority=value
		SetThreadPriority(m_hThread,value)
	End Sub
	Function Priority() As ThreadPriority
		Return m_Priority
	End Function

	'ThreadId
	Function ThreadId() As DWord
		Return m_dwThreadId
	End Function




	Sub Start()
		Dim ThreadId As DWord
		m_hThread=_beginthreadex(NULL,0,AddressOf(_run),VarPtr(This),CREATE_SUSPENDED,m_dwThreadId)
		SetThreadPriority(m_hThread,m_Priority)
		Resume()
	End Sub

Private
	Function Cdecl _run() As Long
		'------------
		' 前処理
		'------------

		'GCにスレッド開始を通知
		_System_pobj_AllThreads->BeginThread(VarPtr(This),_System_GetSp() As *LONG_PTR)


		'------------
		'実行
		'------------
		_run=Run()


		'------------
		'後処理
		'------------

		'GCにスレッド終了を通知
		_System_pobj_AllThreads->EndThread(VarPtr(This))

		'自身のスレッドハンドルを閉じる
		CloseHandle(m_hThread)
		m_hThread=0

	End Function

Public
	Virtual Function Run() As Long
		If m_fp Then
			Run=m_fp(m_args)
		End If
	End Function

	Sub Suspend()
		If SuspendThread(m_hThread) = &HFFFFFFFF Then
			debug
		End If
	End Sub
	Sub Resume()
		If ResumeThread(m_hThread) = &HFFFFFFFF Then
			debug
		End If
	End Sub

	Function __GetContext(ByRef Context As CONTEXT) As BOOL
		Return GetThreadContext(m_hThread,Context)
	End Function
	Function __SetContext(ByRef Context As CONTEXT) As BOOL
		Return SetThreadContext(m_hThread,Context)
	End Function


	Static Function CurrentThread() As Thread
		Dim obj_Thread As Thread()
		_System_pobj_AllThreads->CurrentThread(obj_Thread)
		Return obj_Thread
	End Function
End Class


'--------------------------------------------------------------------
' すべてのスレッドの管理
'--------------------------------------------------------------------
' TODO: このクラスをシングルトンにする
Class _System_CThreadCollection
Public
	ppobj_Thread As **Thread
	pStackBase As **LONG_PTR
	ThreadNum As Long

	CriticalSection As CRITICAL_SECTION

	Sub _System_CThreadCollection()
		ppobj_Thread=GC_malloc(1)
		pStackBase=HeapAlloc(_System_hProcessHeap,0,1)
		ppException=HeapAlloc(_System_hProcessHeap,0,1)
		ThreadNum=0

		'クリティカルセッションを生成
		InitializeCriticalSection(CriticalSection)
	End Sub

	Sub ~_System_CThreadCollection()
		Dim i As Long
		For i=0 To ELM(ThreadNum)
			If ppobj_Thread[i] Then
				If i = 0 Then
					Delete ppobj_Thread[i]
				End If
				ppobj_Thread[i]=0
				pStackBase[i]=0
				Delete ppException[i]
				ppException[i]=0
				Exit For
			End If
		Next

		HeapFree(_System_hProcessHeap,0,pStackBase)
		pStackBase=0

		HeapFree(_System_hProcessHeap,0,ppException)
		ppException = 0

		ThreadNum=0

		'クリティカルセッションを破棄
		DeleteCriticalSection(CriticalSection)
	End Sub

	'スレッドを生成
	Sub BeginThread(pThread As *Thread,NowSp As *LONG_PTR)
		EnterCriticalSection(CriticalSection)

			'例外処理管理用オブジェクトを生成
			Dim pException As *ExceptionService
			pException = New ExceptionService

			Dim i As Long
			For i=0 To ELM(ThreadNum)
				If ppobj_Thread[i] = 0 Then
					ppobj_Thread[i] = pThread
					pStackBase[i] = NowSp
					ppException[i] = pException
					Exit For
				End If
			Next

			If i = ThreadNum Then
				ppobj_Thread=realloc(ppobj_Thread,(ThreadNum+1)*SizeOf(*Thread))
				ppobj_Thread[ThreadNum]=pThread
				pStackBase=HeapReAlloc(_System_hProcessHeap,0,pStackBase,(ThreadNum+1)*SizeOf(LONG_PTR))
				pStackBase[ThreadNum]=NowSp
				ppException=HeapReAlloc(_System_hProcessHeap,0,ppException,(ThreadNum+1)*SizeOf(*ExceptionService))
				ppException[ThreadNum]=pException
				ThreadNum++
			End If
		LeaveCriticalSection(CriticalSection)
	End Sub

	'スレッドを終了
	Sub EndThread(pThread As *Thread)
		EnterCriticalSection(CriticalSection)
			Dim i As Long
			For i=0 To ELM(ThreadNum)
				If ppobj_Thread[i] = pThread Then
					If i = 0 Then
						Delete pThread
					End If
					ppobj_Thread[i]=0
					pStackBase[i]=0
					Delete ppException[i]
					ppException[i]=0
					Exit For
				End If
			Next
		LeaveCriticalSection(CriticalSection)
	End Sub

	' すべてのスレッドを中断
	Sub SuspendAllThread()
		Dim i As Long
		For i=0 To ELM(ThreadNum)
			If ppobj_Thread[i] Then
				ppobj_Thread[i]->Suspend()
			End If
		Next
	End Sub

	' すべてのスレッドを再開
	Sub ResumeAllThread()
		Dim i As Long
		For i=0 To ELM(ThreadNum)
			If ppobj_Thread[i] Then
				ppobj_Thread[i]->Resume()
			End If
		Next
	End Sub

	' 自分以外のスレッドを中断
	Sub SuspendAnotherThread()
		Dim currentThread = Thread.CurrentThread()

		Dim i As Long
		For i=0 To ELM(ThreadNum)

			If currentThread.Equals( ByVal ppobj_Thread[i] ) Then
				Continue
			End If

			If ppobj_Thread[i] Then
				ppobj_Thread[i]->Suspend()
			End If
		Next
	End Sub

	' 自分以外のスレッドを再開
	Sub ResumeAnotherThread()
		Dim currentThread = Thread.CurrentThread()

		Dim i As Long
		For i=0 To ELM(ThreadNum)

			If currentThread.Equals( ByVal ppobj_Thread[i] ) Then
				Continue
			End If

			If ppobj_Thread[i] Then
				ppobj_Thread[i]->Resume()
			End If
		Next
	End Sub

	'カレントスレッドを取得
	Function CurrentThread(ByRef obj_Thread As Thread) As BOOL
		Dim dwNowThreadId As DWord
		dwNowThreadId=GetCurrentThreadId()

		Dim i As Long
		For i=0 To ELM(ThreadNum)
			If ppobj_Thread[i]->ThreadId=dwNowThreadId Then
				obj_Thread.Thread(ByVal ppobj_Thread[i])
				Return 1
			End If
		Next

		Return 0
	End Function


Private
	'------------------------------------------
	' スレッド固有の例外処理制御
	'------------------------------------------
	ppException As **ExceptionService

Public
	Function GetCurrentException() As *ExceptionService
		Dim dwNowThreadId As DWord
		dwNowThreadId=GetCurrentThreadId()

		Dim i As Long
		For i=0 To ELM(ThreadNum)
			If ppobj_Thread[i]->ThreadId=dwNowThreadId Then
				Return ppException[i]
			End If
		Next

		Return NULL
	End Function
End Class
Dim _System_pobj_AllThreads As *_System_CThreadCollection