'Thread.ab

Namespace System

/*タイプ*/
TypeDef LocalDataStoreSlot = Long


Namespace Threading

/*列挙体*/
Enum ThreadPriority
	Highest =      2
	AboveNormal =  1
	Normal =       0
	BelowNormal = -1
	Lowest =      -2
End Enum

Enum ThreadState
	'スレッド状態に AbortRequested が含まれ、そのスレッドは停止していますが、状態はまだ Stopped に変わっていません。
	Aborted
	'スレッド上で Thread.Abort メソッドを呼び出しますが、そのスレッドの終了を試みる保留中の System.Threading.ThreadAbortException をスレッドが受け取っていません。
	AbortRequested
	'スレッドは、フォアグラウンド スレッドではなく、バックグランド スレッドとして実行します。この状態は、Thread.IsBackground プロパティを設定して制御されます。
	Background
	'スレッドをブロックせずに起動します。保留中の ThreadAbortException もありません。
	Running
	'スレッドを停止します。
	Stopped
	'スレッドの停止を要求します。これは、内部でだけ使用します。
	StopRequested
	'スレッドを中断します。
	Suspended
	'スレッドの中断を要求します。
	SuspendRequested
	'スレッド上に Thread.Start メソッドを呼び出しません。
	Unstarted
	'スレッドがブロックされています。これは、Thread.Sleep または Thread.Join の呼び出し、ロックの要求 (たとえば、Monitor.Enter や Monitor.Wait の呼び出しによる)、または ManualResetEvent などのスレッド同期オブジェクトの待機の結果である可能性があります。
	WaitSleepJoin
End Enum

/*
デリゲート
*/
Delegate Sub ThreadStart()

/*
関数ポインタ
*/
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_dg As ThreadStart
	m_args As VoidPtr
	name As String
	state As ThreadState

	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"
		state = ThreadState.Unstarted

		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"
		state = ThreadState.Unstarted

		isThrowing = False
		throwingParamObject = Nothing
	End Sub
	Sub Thread(threadStart As ThreadStart)
		m_hThread=0
		m_dwThreadId=0
		m_Priority=ThreadPriority.Normal

		m_fp=AddressOf(threadStartEntry)
		m_args=ActiveBasic.AllocObjectHandle(threadStart) As VoidPtr

		name = "sub thread"
		state = ThreadState.Unstarted

		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"
		state = ThreadState.Unstarted

		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"
		state = ThreadState.Unstarted

		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 'public property
	Function IsAlive() As Boolean
		Dim code As DWord
		GetExitCodeThread(m_hThread,code)
		If code=STILL_ACTIVE Then
			Return True
		Else
			Return False
		End If
	End Function

	'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 ThreadState() As System.Threading.ThreadState
		Return This.state
	End Function

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

Public 'public method
/*	Sub Abort()
		TODO '実装のためにはかなり検討が必要
		'This.__Throw(New ThreadAbortException)
	End Sub*/

	Sub Start()
		Dim pfn = AddressOf(_run) As LONG_PTR
		m_hThread=CreateThread(NULL,0,pfn As LPTHREAD_START_ROUTINE,ObjPtr(This),CREATE_SUSPENDED,m_dwThreadId)
		SetThreadPriority(m_hThread,m_Priority)
		This.Resume()
	End Sub

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

	Sub Suspend()
		This.state = ThreadState.SuspendRequested
		If SuspendThread(m_hThread) = &HFFFFFFFF Then
			This.state = ThreadState.Unstarted
			Debug 'Throw New ThreadStateException
		End If
		This.state = ThreadState.Suspended
	End Sub
	Sub Resume()
		If ResumeThread(m_hThread) = &HFFFFFFFF Then
			state = ThreadState.Unstarted
			Debug 'Throw New ThreadStateException
		End If
		This.state = ThreadState.Running
	End Sub

/*	Function GetData(LocalDataStoreSlot)
	End Function
	Sub SetData(LocalDataStoreSlot)
	End Sub*/

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

	/*------------------------ クラス内部用 --------------------------*/
Private
	Function _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(InterlockedExchangePointer(VarPtr(m_hThread),NULL))
		m_hThread=0

	End Function

	Static Function threadStartEntry(pThreadStart As VoidPtr) As DWord
		Dim threadStart = ActiveBasic.ReleaseObjectHandle(pThreadStart As LONG_PTR) As ThreadStart
		threadStart()
	End Function

	/*------------------------ システム用 --------------------------*/
Public
	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
End Class


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 Not ActiveBasic.IsNothing( .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
		EnterCriticalSection(CriticalSection)
		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
		LeaveCriticalSection(CriticalSection)
	End Function

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

Public
	Function GetCurrentException() As ExceptionService
		EnterCriticalSection(CriticalSection)
		Dim dwNowThreadId = GetCurrentThreadId()
		Dim i As Long
		For i=0 To ELM(ThreadNum)
			With collection[i]
				If .thread.ThreadId = dwNowThreadId Then
					GetCurrentException = .exception
					Exit For
				End If
			End With
		Next
		LeaveCriticalSection(CriticalSection)
		If ActiveBasic.IsNothing(GetCurrentException) Then
			OutputDebugString(Ex"カレントスレッドの取得に失敗\r\n")
		End If
	End Function
End Class

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

End Namespace 'Detail
End Namespace 'Threading
End Namespace 'System


/* システムが使う変数 */
Dim _System_pobj_AllThreads As *System.Threading.Detail._System_CThreadCollection

/* システムが呼び出す関数 */
Sub _System_AddNeedFreeTempStructure( structurePointer As VoidPtr )
	System.Threading.Thread.CurrentThread.__AddNeedFreeTempStructure( structurePointer )
End Sub
Sub _System_FreeTempStructure()
	System.Threading.Thread.CurrentThread.__FreeTempStructure()
End Sub