Changeset 249 for Include/system/exception.ab

Timestamp:

May 15, 2007, 2:44:41 AM (17 years ago)

Author:

dai

Message:

[32bitコンパイラ]ByRef指定のInteger/Byte型のローカル変数に値を代入すると強制終了してしまうバグを修正。
（呼び出し単体コードも対応→）関数の戻り値オブジェクトのメンバ・メソッドを一時オブジェクトを介さずに参照できるようにした。
オブジェクトの先頭バッファのサイズを4ポインタ分に拡張した。

File:

• Include/system/exception.ab (modified) (4 diffs)

Include/system/exception.ab

@@ -5 +5 @@
     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()
@@ -37 +53 @@
 
     'Try
-    Sub BeginTryScope( AddressOfCatch As VoidPtr, StackPtr As LONG_PTR )
+    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++
-    End Sub
+
+        Return ByVal ppTryLayers[nTryLayers-1]
+    End Function
 
     'End Try
@@ -55 +73 @@
 
             'TODO: 適切なエラー処理
+            MessageBox( NULL, "例外", "", MB_OK or MB_ICONEXCLAMATION )
 
             Return
@@ -72 +91 @@
 
         'レジスタ情報を取得
-        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
-
+        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
+        '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")