'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
	name As String

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

		m_fp=0

		name = "sub thread"
	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

		name = "sub thread"
	End Sub

	Sub Thread(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

		name = "sub thread"
	End Sub

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

		name = "sub thread"
	End Sub

	Sub ~Thread()
	End Sub


	Function Equals(thread As Thread) As Boolean
		Return m_dwThreadId = thread.m_dwThreadId
	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

	Function Name() As String
		Return name
	End Function
	Sub Name( name As String )
		This.name = name
	End Sub





	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
		Return _System_pobj_AllThreads->CurrentThread()
	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( ppobj_Thread[i] As Object ) 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( ppobj_Thread[i] As Object ) Then
				Continue
			End If

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

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

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

		' TODO: エラー処理
		OutputDebugString( "カレントスレッドの取得に失敗" )
		debug
	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
