'Thread.ab

'--------------------------------------------------------------------
' スレッドの優先順位
'--------------------------------------------------------------------
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

	isThrowing As Boolean
	throwingParamObject As Object

	needFreeStructurePointers As *VoidPtr
	countOfNeedFreeStructurePointers As Long

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

		m_fp=0

		name = "sub thread"

		isThrowing = False
		throwingParamObject = Nothing
	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"

		isThrowing = False
		throwingParamObject = Nothing
	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"

		isThrowing = False
		throwingParamObject = Nothing
	End Sub

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

		name = "sub thread"

		isThrowing = False
		throwingParamObject = Nothing
	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
		'------------
		' 前処理
		'------------

		' 構造体の一時メモリ退避用領域を作成
		needFreeStructurePointers = _System_malloc( 1 )
		countOfNeedFreeStructurePointers = 0

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


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


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

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

		' 構造体の一時メモリ退避用領域を破棄
		_System_free( needFreeStructurePointers )

		'自身のスレッドハンドルを閉じる
		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

	Sub __Throw( ex As Object )
		isThrowing = True
		throwingParamObject = ex
	End Sub
	Sub __Catched()
		isThrowing = False
		throwingParamObject = Nothing
	End Sub
	Function __IsThrowing() As Boolean
		Return isThrowing
	End Function
	Function __GetThrowintParamObject() As Object
		Return throwingParamObject
	End Function

	Sub __AddNeedFreeTempStructure( structurePointer As VoidPtr )
		needFreeStructurePointers = _System_realloc( needFreeStructurePointers, ( countOfNeedFreeStructurePointers + 1 ) * SizeOf(VoidPtr) )
		needFreeStructurePointers[countOfNeedFreeStructurePointers] = structurePointer
		countOfNeedFreeStructurePointers ++
	End Sub

	Sub __FreeTempStructure()
		Dim i = 0 As Long
		While i<countOfNeedFreeStructurePointers
			free( needFreeStructurePointers[i] )
			i++
		Wend
		countOfNeedFreeStructurePointers = 0
	End Sub


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

Dim _System_pobj_AllThreads As *Detail._System_CThreadCollection

Namespace Detail

'--------------------------------------------------------------------
' すべてのスレッドの管理
'--------------------------------------------------------------------
' TODO: このクラスをシングルトンにする

Class _System_CThreadCollection
Public
	collection As *ThreadInfo
	ThreadNum As Long

	CriticalSection As CRITICAL_SECTION

	Sub _System_CThreadCollection()
		collection = GC_malloc(1)
		ThreadNum = 0
		InitializeCriticalSection(CriticalSection)
	End Sub

	Sub ~_System_CThreadCollection()
		Dim i As Long
		For i=0 To ELM(ThreadNum)
			With collection[i]
				If .thread Then
					.thread = Nothing
					.stackBase = 0
					.exception = Nothing
				End If
			End With
		Next
		collection = 0
		DeleteCriticalSection(CriticalSection)
	End Sub

	'スレッドを生成
	Sub BeginThread(thread As Thread, NowSp As *LONG_PTR)
		EnterCriticalSection(CriticalSection)
		Dim i = FindFreeIndex
		With collection[i]
			.thread = thread
			.stackBase = NowSp
			.exception = New ExceptionService '例外処理管理用オブジェクトを生成
		End With
		LeaveCriticalSection(CriticalSection)
	End Sub
Private
	'クリティカルセション内で呼ぶこと
	Function FindFreeIndex() As Long
		Dim i As Long
		For i = 0 To ELM(ThreadNum)
			If ActiveBasic.IsNothing(collection[i].thread) Then
				FindFreeIndex = i
				Exit Function
			End If
		Next
		ThreadNum++
		collection = realloc(collection, ThreadNum * SizeOf(ThreadInfo))
		FindFreeIndex = i
	End Function
Public

	'スレッドを終了
	Sub EndThread(thread As Thread)
		EnterCriticalSection(CriticalSection)
			Dim i As Long
			For i = 0 To ELM(ThreadNum)
				With collection[i]
					If thread.Equals(.thread) Then
						.thread = Nothing
						.stackBase = 0
						.exception = Nothing
						Exit For
					End If
				End With
			Next
		LeaveCriticalSection(CriticalSection)
	End Sub

	' すべてのスレッドを中断
	Sub SuspendAllThread()
		Dim i As Long
		For i = 0 To ELM(ThreadNum)
			With collection[i]
				If Not ActiveBasic.IsNothing(.thread) Then
					.thread.Suspend()
				End If
			End With
		Next
	End Sub

	' すべてのスレッドを再開
	Sub ResumeAllThread()
		Dim i As Long
		For i = 0 To ELM(ThreadNum)
			With collection[i]
				If Not ActiveBasic.IsNothing(.thread) Then
					.thread.Resume()
				End If
			End With
		Next
	End Sub
/*
	' 自分以外のスレッドを中断
	Sub SuspendAnotherThread()
		Dim currentThread = CurrentThread()

		Dim i As Long
		For i=0 To ELM(ThreadNum)
			With collection[i]
				If currentThread.Equals(.thread) Then
					Continue
				ElseIf Not ActiveBasic.IsNothing(.thread) Then
					.thread.Suspend()
				End If
			End With
		Next
	End Sub

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

		Dim i As Long
		For i=0 To ELM(ThreadNum)
			With collection[i]
				If currentThread.Equals(.thread) Then
					Continue
				ElseIf Not ActiveBasic.IsNothing(.thread) Then
					.thread.Resume()
				End If
			End With
		Next
	End Sub
*/
	'カレントスレッドを取得
	Function CurrentThread() As Thread
		Dim p = CurrentThreadInfo()
		If p = 0 Then
			' TODO: エラー処理
			OutputDebugString( Ex"カレントスレッドの取得に失敗\r\n" )
			debug
			Exit Function
		End If
		CurrentThread = p->thread
	End Function

	Function CurrentThreadInfo() As *ThreadInfo
		CurrentThreadInfo = FindThreadInfo(GetCurrentThreadId())
	End Function

	Function FindThreadInfo(threadID As DWord) As *ThreadInfo
		Dim i As Long
		For i = 0 To ELM(ThreadNum)
			If collection[i].thread.ThreadId = threadID Then
				FindThreadInfo = VarPtr(collection[i])
				Exit Function
			End If
		Next
	End Function

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

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

		Dim i As Long
		For i=0 To ELM(ThreadNum)
			With collection[i]
				If .thread.ThreadId = dwNowThreadId Then
					Return .exception
				End If
			End With
		Next

		OutputDebugString( Ex"カレントスレッドの取得に失敗\r\n" )
		Return Nothing
	End Function
End Class

Type ThreadInfo
	thread As Thread
	stackBase As *LONG_PTR
	exception As ExceptionService
End Type

End Namespace 'Detail

Sub _System_AddNeedFreeTempStructure( structurePointer As VoidPtr )
	Thread.CurrentThread.__AddNeedFreeTempStructure( structurePointer )
End Sub
Sub _System_FreeTempStructure()
	Thread.CurrentThread.__FreeTempStructure()
End Sub