source: trunk/ab5.0/ablib/src/Classes/System/Threading/Thread.ab@ 599

'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