source: branch/egtra-gdiplus/Classes/System/Threading/Thread.ab@ 353

'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

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

        m_fp=0
    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
    End Sub

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

    Sub Thread(hThread As HANDLE, dwThreadId As DWord, dummy As Long)
        m_hThread=hThread
        m_dwThreadId=dwThreadId
    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





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

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

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

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

        Return False
    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