source: trunk/Include/system/exception.ab@ 364

'TODO: ローカルオブジェクト確保及び解放時にTryServiceに通知する必要がある。

Class TryLayer
Public
    Const AddressOfCatch As VoidPtr
    Const StackPtr As LONG_PTR
    context As CONTEXT
    Const debugProcNum As DWord
    
    Sub TryLayer( AddressOfCatch As VoidPtr, StackPtr As LONG_PTR )
        This.AddressOfCatch = AddressOfCatch
        This.StackPtr = StackPtr

        context.ContextFlags=CONTEXT_ALL
        If Thread.CurrentThread().__GetContext(context) = 0 Then
            ' TODO: エラー処理
            debug
        End If

#ifdef _DEBUG
        Dim ThreadNum As Long
        ThreadNum=_DebugSys_GetThread()
        If ThreadNum <> -1 Then
            debugProcNum = _DebugSys_ProcNum[ThreadNum]
        End If
#endif
    End Sub
    Sub ~TryLayer()
    End Sub
End Class

Class ExceptionService
    ppTryLayers As **TryLayer
    nTryLayers As Long

    Sub FreeLocalObjects()
        'TODO: 破棄されていないローカルオブジェクトを破棄
    End Sub
Public

    Sub ExceptionService()
        ppTryLayers = _System_malloc( 1 )
        nTryLayers = 0
    End Sub
    Sub ~ExceptionService()
        Dim i As Long
        For i = 0 To ELM( nTryLayers )
            Delete ppTryLayers[i]
        Next
        _System_free( ppTryLayers )
        ppTryLayers = 0
    End Sub

    'Try
    Function BeginTryScope( AddressOfCatch As VoidPtr, StackPtr As LONG_PTR ) As TryLayer
        ppTryLayers = _System_realloc( ppTryLayers, ( nTryLayers + 1 ) * SizeOf( *TryLayer ) )
        ppTryLayers[nTryLayers] = New TryLayer( AddressOfCatch, StackPtr )
        nTryLayers++

        Return ByVal ppTryLayers[nTryLayers-1]
    End Function

    'End Try
    Sub EndTryScope()
        nTryLayers--
        Delete ppTryLayers[nTryLayers]
    End Sub

    'Throw
    Sub _Throw()
        If nTryLayers <= 0 then
            '例外処理スコープ制御が無効なとき

            'TODO: 適切なエラー処理
            MessageBox( NULL, "例外", "", MB_OK or MB_ICONEXCLAMATION )

            Return
        End If

        '未解放なローカルオブジェクトを解放する
        FreeLocalObjects()



        '--------------------------------------------------
        ' スレッドのコンテキストを設定（Catchへ遷移する）
        '--------------------------------------------------

        'カレント スレッドを取得
        Dim thread = Thread.CurrentThread

        'レジスタ情報を取得
        Dim context = ppTryLayers[nTryLayers - 1]->context
debug
        '新しいip, spをセット
#ifdef _WIN64
        context.Rip = ppTryLayers[nTryLayers - 1]->AddressOfCatch As QWord
        'context.Rsp = ppTryLayers[nTryLayers - 1]->StackPtr
#else
        context.Eip = ppTryLayers[nTryLayers - 1]->AddressOfCatch As DWord
        context.Esp = ppTryLayers[nTryLayers - 1]->StackPtr
#endif

#ifdef _DEBUG
        Dim ThreadNum As Long
        ThreadNum=_DebugSys_GetThread()
        If ThreadNum <> -1 Then
            _DebugSys_ProcNum[ThreadNum] = ppTryLayers[nTryLayers - 1]->debugProcNum-1
        End If
#endif

        If thread.__SetContext( context ) = 0 Then
            OutputDebugString(Ex"レジスタ情報の設定に失敗しました。\r\n")
            Return
        End If
    End Sub

    Sub _Throw( msg As String )
        _Throw()
    End Sub

    Static Sub AllocateObject( pObj As VoidPtr )
        Dim thread = Thread.CurrentThread
        'TODO: ローカルオブジェクトを登録
    End Sub

    Static Sub DeallocateObject( pObj As VoidPtr )
        'TODO: ローカルオブジェクトを破棄
    End Sub
End Class