source: Include/Classes/System/Threading/Thread.ab@ 19

'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
        m_Priority=ThreadPriority.Normal
    End Sub

    Sub ~Thread()
    End Sub


    Function Equals(ByRef obj_Thread As Thread) As BOOL
        If m_dwThreadId=obj_Thread.m_dwThreadId Then
            Return TRUE
        End If
        Return FALSE
    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(This,_System_GetSp() As *LONG_PTR)


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


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

        'GCにスレッド終了を通知
        _System_pobj_AllThreads->EndThread(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()
        SuspendThread(m_hThread)
    End Sub
    Sub Resume()
        ResumeThread(m_hThread)
    End Sub

    Function __GetContext(ByRef Context As CONTEXT) As BOOL
        Return GetThreadContext(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


'すべてのスレッドの管理
Class _System_CThreadCollection
Public
    ppobj_Thread As **Thread
    pStackBase As **LONG_PTR
    ThreadNum As Long

    CriticalSection As CRITICAL_SECTION

    Sub _System_CThreadCollection()
        ppobj_Thread=HeapAlloc(_System_hProcessHeap,0,1)
        pStackBase=HeapAlloc(_System_hProcessHeap,0,1)
        ThreadNum=0

        'クリティカルセッションを生成
        InitializeCriticalSection(CriticalSection)
    End Sub

    Sub ~_System_CThreadCollection()
    End Sub

    Sub Finalize()
        HeapFree(_System_hProcessHeap,0,ppobj_Thread)
        ppobj_Thread=0

        HeapFree(_System_hProcessHeap,0,pStackBase)
        pStackBase=0

        ThreadNum=0

        'クリティカルセッションを破棄
        DeleteCriticalSection(CriticalSection)
    End Sub

    'スレッドを生成
    Sub BeginThread(ByRef obj_Thread As Thread,NowSp As *LONG_PTR)
        EnterCriticalSection(CriticalSection)

            Dim pobj_NewThread As *Thread
            pobj_NewThread=New Thread(obj_Thread)

            Dim i As Long
            For i=0 To ELM(ThreadNum)
                If ppobj_Thread[i]=0 Then
                    ppobj_Thread[i]=pobj_NewThread
                    pStackBase[i]=NowSp
                    Exit For
                End If
            Next

            If i=ThreadNum Then
                ppobj_Thread=HeapReAlloc(_System_hProcessHeap,0,ppobj_Thread,(ThreadNum+1)*SizeOf(*Thread))
                ppobj_Thread[ThreadNum]=pobj_NewThread
                pStackBase=HeapReAlloc(_System_hProcessHeap,0,pStackBase,(ThreadNum+1)*SizeOf(LONG_PTR))
                pStackBase[ThreadNum]=NowSp
                ThreadNum++
            End If
        LeaveCriticalSection(CriticalSection)
    End Sub

    'スレッドを終了
    Sub EndThread(ByRef obj_Thread As Thread)
        EnterCriticalSection(CriticalSection)
            Dim i As Long
            For i=0 To ELM(ThreadNum)
                If ppobj_Thread[i]->Equals(obj_Thread) Then
                    Delete ppobj_Thread[i]
                    ppobj_Thread[i]=0
                    pStackBase[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


    Function CurrentThread(ByRef obj_Thread As Thread) As BOOL
        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 1
            End If
        Next

        Return 0
    End Function
End Class
Dim _System_pobj_AllThreads As *_System_CThreadCollection