source: branch/egtra-gdiplus/system/exception.ab

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

Class TryLayer
Public
    Const AddressOfCatch As VoidPtr
    Const StackPtr As LONG_PTR
    
    Sub TryLayer( AddressOfCatch As VoidPtr, StackPtr As LONG_PTR )
        This.AddressOfCatch = AddressOfCatch
        This.StackPtr = StackPtr
    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
    Sub BeginTryScope( AddressOfCatch As VoidPtr, StackPtr As LONG_PTR )
        ppTryLayers = _System_realloc( ppTryLayers, ( nTryLayers + 1 ) * SizeOf( *TryLayer ) )
        ppTryLayers[nTryLayers] = New TryLayer( AddressOfCatch, StackPtr )
        nTryLayers++
    End Sub

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

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

            'TODO: 適切なエラー処理

            Return
        End If

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



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

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

        'レジスタ情報を取得
        Dim context As CONTEXT
        FillMemory(VarPtr(context),SizeOf(CONTEXT),0)
        context.ContextFlags=CONTEXT_CONTROL
        If thread.__GetContext( context ) = 0 Then
            OutputDebugString(Ex"レジスタ情報の取得に失敗しました。\r\n")
            Return
        End If

        '新しい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
        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