Changeset 374 for trunk/Include/system

Timestamp:

Nov 10, 2007, 11:20:01 AM (17 years ago)

Author:

dai

Message:

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

File:

• trunk/Include/system/exception.ab (modified) (9 diffs)

trunk/Include/system/exception.ab

@@ -3 +3 @@
 Class TryLayer
 Public
-    Const addressOfCatch As VoidPtr
+    Const catchTable As *LONG_PTR
+    Const addressOfFinally As VoidPtr
     Const basePtr As LONG_PTR
     Const stackPtr As LONG_PTR
+
     Const debugProcNum As DWord
     
-    Sub TryLayer( addressOfCatch As VoidPtr, basePtr As LONG_PTR, stackPtr As LONG_PTR )
-        This.addressOfCatch = addressOfCatch
+    Sub TryLayer( catchTable As *LONG_PTR, addressOfFinally As VoidPtr, basePtr As LONG_PTR, stackPtr As LONG_PTR )
+        This.catchTable = catchTable
+        This.addressOfFinally = addressOfFinally
         This.basePtr = basePtr
         This.stackPtr = stackPtr
@@ -23 +26 @@
     Sub ~TryLayer()
     End Sub
+
+    Sub FinishFinally()
+        If Thread.CurrentThread().__IsThrowing() Then
+            Throw Thread.CurrentThread().__GetThrowintParamObject()
+        End If
+    End Sub
+
+    Function ResolveCatchesOverload( ex As Object ) As LONG_PTR
+        Dim defaultCatchCodePos = 0 As LONG_PTR
+        Dim pos = 0 As Long
+        While catchTable[pos]
+            ' パラメータのクラス名
+            Dim paramName = catchTable[pos] As *Char
+            pos ++
+
+            ' コード位置
+            Dim codePos = catchTable[pos] As LONG_PTR
+            pos ++
+
+            If paramName[0] = 0 Then
+                ' Default Catch
+                defaultCatchCodePos = codePos
+            End If
+
+            If Object.ReferenceEquals( ex, Nothing ) Then
+                ' パラメータなしのとき
+                If paramName[0] = 0 Then
+                    ' マッチしたとき
+                    Return codePos
+                End If
+            Else
+                If lstrcmp( paramName, ex.GetType().FullName ) = 0 Then
+                    ' マッチしたとき
+                    Return codePos
+                End If
+            End If
+        Wend
+        Return defaultCatchCodePos
+    End Function
 End Class
 
@@ -48 +90 @@
 
     'Try
-    Function _BeginTryScope( addressOfCatch As VoidPtr, basePtr As LONG_PTR, stackPtr As LONG_PTR ) As TryLayer
+    Function _BeginTryScope( catchTable As *LONG_PTR, addressOfFinally As VoidPtr, basePtr As LONG_PTR, stackPtr As LONG_PTR ) As TryLayer
         ppTryLayers = _System_realloc( ppTryLayers, ( nTryLayers + 1 ) * SizeOf( *TryLayer ) )
-        ppTryLayers[nTryLayers] = New TryLayer( addressOfCatch, basePtr, stackPtr )
+        ppTryLayers[nTryLayers] = New TryLayer( catchTable, addressOfFinally, basePtr, stackPtr )
         nTryLayers++
 
@@ -56 +98 @@
     End Function
 
-    Static Function BeginTryScope( addressOfCatch As VoidPtr, basePtr As LONG_PTR, stackPtr As LONG_PTR ) As TryLayer
-        Return _System_pobj_AllThreads->GetCurrentException()->_BeginTryScope( addressOfCatch, basePtr, stackPtr )
+    Static Function BeginTryScope( catchTable As *LONG_PTR, addressOfFinally As VoidPtr, basePtr As LONG_PTR, stackPtr As LONG_PTR ) As TryLayer
+        Return _System_pobj_AllThreads->GetCurrentException()->_BeginTryScope( catchTable, addressOfFinally, basePtr, stackPtr )
     End Function
 
@@ -67 +109 @@
 
     'Throw
-    Sub _Throw()
+    Sub _Throw( ex As Object )
         If nTryLayers <= 0 then
             '例外処理スコープ制御が無効なとき
@@ -77 +119 @@
         End If
 
+        ' スレッドへThrow処理を開始したことを通知
+        Thread.CurrentThread().__Throw( ex )
+
         '未解放なローカルオブジェクトを解放する
         FreeLocalObjects()
 
+        Dim pTryLayer = ppTryLayers[nTryLayers - 1] As *TryLayer
+
+        Dim addressOfCatch = pTryLayer->ResolveCatchesOverload( ex ) As LONG_PTR
+        If addressOfCatch Then
+            ' スレッドへThrow処理が終了した（Catchされた）ことを通知
+            Thread.CurrentThread().__Catched()
+        Else
+            ' Catchが定義されていないときはFinallyへ誘導
+            addressOfCatch = pTryLayer->addressOfFinally As LONG_PTR
+        End If
 
 
@@ -95 +150 @@
         '新しいip, sp, bpをセット
 #ifdef _WIN64
-        context.Rip = ppTryLayers[nTryLayers - 1]->addressOfCatch As QWord
-        context.Rbp = ppTryLayers[nTryLayers - 1]->basePtr
-        context.Rsp = ppTryLayers[nTryLayers - 1]->stackPtr
+        context.Rip = addressOfCatch As QWord
+        context.Rbp = pTryLayer->basePtr
+        context.Rsp = pTryLayer->stackPtr
 #else
-        context.Eip = ppTryLayers[nTryLayers - 1]->addressOfCatch As DWord
-        context.Ebp = ppTryLayers[nTryLayers - 1]->basePtr
-        context.Esp = ppTryLayers[nTryLayers - 1]->stackPtr
+        context.Eip = addressOfCatch As DWord
+        context.Ebp = pTryLayer->basePtr
+        context.Esp = pTryLayer->stackPtr
 #endif
 
@@ -108 +163 @@
         ThreadNum=_DebugSys_GetThread()
         If ThreadNum <> -1 Then
-            _DebugSys_ProcNum[ThreadNum] = ppTryLayers[nTryLayers - 1]->debugProcNum-1
+            _DebugSys_ProcNum[ThreadNum] = pTryLayer->debugProcNum-1
         End If
 #endif
@@ -118 +173 @@
     End Sub
 
-    Sub _Throw( msg As String )
-        _Throw()
+    Sub _ThrowWithParam( ex As Object )
+        _Throw( ex )
+    End Sub
+
+    Sub _ThrowNoneParam()
+        _Throw( Nothing )
+    End Sub
+
+    Sub FinishFinally()
+        Dim pTryLayer = ppTryLayers[nTryLayers - 1] As *TryLayer
+        pTryLayer->FinishFinally()
     End Sub
 End Class