source: trunk/Include/Classes/System/Threading/Thread.ab@ 493

'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
    '-----------------------
    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 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(InterlockedExchangePointer(VarPtr(m_hThread),NULL))
        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