Changeset 374 for trunk


Ignore:
Timestamp:
Nov 10, 2007, 11:20:01 AM (17 years ago)
Author:
dai
Message:

例外処理機構実装中
・Catchのオーバーロードに対応
・Finallyに対応
・Tryスコープの入れ子に対応
（※注意 … 現時点ではThrow→Catch間でパラメータの引渡しができません）

Location:
trunk
Files:
4 edited

Legend:

Unmodified
Added
Removed

  • trunk/Include/Classes/System/Threading/Thread.ab

    r330 r374  
    2828    name As String
    2929
     30    isThrowing As Boolean
     31    throwingParamObject As Object
     32
    3033Public
    3134    Sub Thread()
    … …  
    3740
    3841        name = "sub thread"
     42
     43        isThrowing = False
     44        throwingParamObject = Nothing
    3945    End Sub
    4046    Sub Thread(fp As PTHREAD_START_ROUTINE, args As VoidPtr)
    … …  
    4753
    4854        name = "sub thread"
     55
     56        isThrowing = False
     57        throwingParamObject = Nothing
    4958    End Sub
    5059
    … …  
    5766
    5867        name = "sub thread"
     68
     69        isThrowing = False
     70        throwingParamObject = Nothing
    5971    End Sub
    6072
    … …  
    6476
    6577        name = "sub thread"
     78
     79        isThrowing = False
     80        throwingParamObject = Nothing
    6681    End Sub
    6782
    … …  
    163178    Function __SetContext(ByRef Context As CONTEXT) As BOOL
    164179        Return SetThreadContext(m_hThread,Context)
     180    End Function
     181
     182    Sub __Throw( ex As Object )
     183        isThrowing = True
     184        throwingParamObject = ex
     185    End Sub
     186    Sub __Catched()
     187        isThrowing = False
     188        throwingParamObject = Nothing
     189    End Sub
     190    Function __IsThrowing() As Boolean
     191        Return isThrowing
     192    End Function
     193    Function __GetThrowintParamObject() As Object
     194        Return throwingParamObject
    165195    End Function
    166196

  • trunk/Include/system/exception.ab

    r373 r374  
    33Class TryLayer
    44Public
    5     Const addressOfCatch As VoidPtr
     5    Const catchTable As *LONG_PTR
     6    Const addressOfFinally As VoidPtr
    67    Const basePtr As LONG_PTR
    78    Const stackPtr As LONG_PTR
     9
    810    Const debugProcNum As DWord
    911   
    10     Sub TryLayer( addressOfCatch As VoidPtr, basePtr As LONG_PTR, stackPtr As LONG_PTR )
    11         This.addressOfCatch = addressOfCatch
     12    Sub TryLayer( catchTable As *LONG_PTR, addressOfFinally As VoidPtr, basePtr As LONG_PTR, stackPtr As LONG_PTR )
     13        This.catchTable = catchTable
     14        This.addressOfFinally = addressOfFinally
    1215        This.basePtr = basePtr
    1316        This.stackPtr = stackPtr
    … …  
    2326    Sub ~TryLayer()
    2427    End Sub
     28
     29    Sub FinishFinally()
     30        If Thread.CurrentThread().__IsThrowing() Then
     31            Throw Thread.CurrentThread().__GetThrowintParamObject()
     32        End If
     33    End Sub
     34
     35    Function ResolveCatchesOverload( ex As Object ) As LONG_PTR
     36        Dim defaultCatchCodePos = 0 As LONG_PTR
     37        Dim pos = 0 As Long
     38        While catchTable[pos]
     39            ' パラメータのクラス名
     40            Dim paramName = catchTable[pos] As *Char
     41            pos ++
     42
     43            ' コード位置
     44            Dim codePos = catchTable[pos] As LONG_PTR
     45            pos ++
     46
     47            If paramName[0] = 0 Then
     48                ' Default Catch
     49                defaultCatchCodePos = codePos
     50            End If
     51
     52            If Object.ReferenceEquals( ex, Nothing ) Then
     53                ' パラメータなしのとき
     54                If paramName[0] = 0 Then
     55                    ' マッチしたとき
     56                    Return codePos
     57                End If
     58            Else
     59                If lstrcmp( paramName, ex.GetType().FullName ) = 0 Then
     60                    ' マッチしたとき
     61                    Return codePos
     62                End If
     63            End If
     64        Wend
     65        Return defaultCatchCodePos
     66    End Function
    2567End Class
    2668
    … …  
    4890
    4991    'Try
    50     Function _BeginTryScope( addressOfCatch As VoidPtr, basePtr As LONG_PTR, stackPtr As LONG_PTR ) As TryLayer
     92    Function _BeginTryScope( catchTable As *LONG_PTR, addressOfFinally As VoidPtr, basePtr As LONG_PTR, stackPtr As LONG_PTR ) As TryLayer
    5193        ppTryLayers = _System_realloc( ppTryLayers, ( nTryLayers + 1 ) * SizeOf( *TryLayer ) )
    52         ppTryLayers[nTryLayers] = New TryLayer( addressOfCatch, basePtr, stackPtr )
     94        ppTryLayers[nTryLayers] = New TryLayer( catchTable, addressOfFinally, basePtr, stackPtr )
    5395        nTryLayers++
    5496
    … …  
    5698    End Function
    5799
    58     Static Function BeginTryScope( addressOfCatch As VoidPtr, basePtr As LONG_PTR, stackPtr As LONG_PTR ) As TryLayer
    59         Return _System_pobj_AllThreads->GetCurrentException()->_BeginTryScope( addressOfCatch, basePtr, stackPtr )
     100    Static Function BeginTryScope( catchTable As *LONG_PTR, addressOfFinally As VoidPtr, basePtr As LONG_PTR, stackPtr As LONG_PTR ) As TryLayer
     101        Return _System_pobj_AllThreads->GetCurrentException()->_BeginTryScope( catchTable, addressOfFinally, basePtr, stackPtr )
    60102    End Function
    61103
    … …  
    67109
    68110    'Throw
    69     Sub _Throw()
     111    Sub _Throw( ex As Object )
    70112        If nTryLayers <= 0 then
    71113            '例外処理スコープ制御が無効なとき
    … …  
    77119        End If
    78120
     121        ' スレッドへThrow処理を開始したことを通知
     122        Thread.CurrentThread().__Throw( ex )
     123
    79124        '未解放なローカルオブジェクトを解放する
    80125        FreeLocalObjects()
    81126
     127        Dim pTryLayer = ppTryLayers[nTryLayers - 1] As *TryLayer
     128
     129        Dim addressOfCatch = pTryLayer->ResolveCatchesOverload( ex ) As LONG_PTR
     130        If addressOfCatch Then
     131            ' スレッドへThrow処理が終了した（Catchされた）ことを通知
     132            Thread.CurrentThread().__Catched()
     133        Else
     134            ' Catchが定義されていないときはFinallyへ誘導
     135            addressOfCatch = pTryLayer->addressOfFinally As LONG_PTR
     136        End If
    82137
    83138
    … …  
    95150        '新しいip, sp, bpをセット
    96151#ifdef _WIN64
    97         context.Rip = ppTryLayers[nTryLayers - 1]->addressOfCatch As QWord
    98         context.Rbp = ppTryLayers[nTryLayers - 1]->basePtr
    99         context.Rsp = ppTryLayers[nTryLayers - 1]->stackPtr
     152        context.Rip = addressOfCatch As QWord
     153        context.Rbp = pTryLayer->basePtr
     154        context.Rsp = pTryLayer->stackPtr
    100155#else
    101         context.Eip = ppTryLayers[nTryLayers - 1]->addressOfCatch As DWord
    102         context.Ebp = ppTryLayers[nTryLayers - 1]->basePtr
    103         context.Esp = ppTryLayers[nTryLayers - 1]->stackPtr
     156        context.Eip = addressOfCatch As DWord
     157        context.Ebp = pTryLayer->basePtr
     158        context.Esp = pTryLayer->stackPtr
    104159#endif
    105160
    … …  
    108163        ThreadNum=_DebugSys_GetThread()
    109164        If ThreadNum <> -1 Then
    110             _DebugSys_ProcNum[ThreadNum] = ppTryLayers[nTryLayers - 1]->debugProcNum-1
     165            _DebugSys_ProcNum[ThreadNum] = pTryLayer->debugProcNum-1
    111166        End If
    112167#endif
    … …  
    118173    End Sub
    119174
    120     Sub _Throw( msg As String )
    121         _Throw()
     175    Sub _ThrowWithParam( ex As Object )
     176        _Throw( ex )
     177    End Sub
     178
     179    Sub _ThrowNoneParam()
     180        _Throw( Nothing )
     181    End Sub
     182
     183    Sub FinishFinally()
     184        Dim pTryLayer = ppTryLayers[nTryLayers - 1] As *TryLayer
     185        pTryLayer->FinishFinally()
    122186    End Sub
    123187End Class
Note: See TracChangeset for help on using the changeset viewer.