Changeset 249 for Include/system

Timestamp:

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

Author:

dai

Message:

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

Location:

Include/system

Files:

• exception.ab (modified) (4 diffs)
• gc.sbp (modified) (2 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")

Include/system/gc.sbp

@@ -288 +288 @@
                     If pdwFlags[index] and _System_GC_FLAG_OBJECT Then
                         ' オブジェクトの場合
-                        If ScanObject( (ppPtr[index] + 3*SizeOf(LONG_PTR)) As *Object, pbMark) = False Then
+                        If ScanObject( (ppPtr[index] + 4*SizeOf(LONG_PTR)) As *Object, pbMark) = False Then
                             Dim maxNum = (pSize[index]\SizeOf(LONG_PTR)) As Long
                             Scan(ppPtr[index] As *LONG_PTR, maxNum, pbMark)
@@ -371 +371 @@
                         ・オブジェクトのサイズ
                         ・デストラクタの関数ポインタ
+                        ・リザーブ領域
                         を考慮 */
-                    _System_SweepingDelete (ptr + SizeOf( LONG_PTR ) * 3 )
+                    _System_SweepingDelete (ptr + SizeOf( LONG_PTR ) * 4 )
                 Else
                     HeapFree(_System_hProcessHeap,0,ptr)