Changeset 249

Timestamp:

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

Author:

dai

Message:

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

Files:

• Include/Classes/System/Threading/Thread.ab (modified) (4 diffs)
• Include/system/exception.ab (modified) (4 diffs)
• Include/system/gc.sbp (modified) (2 diffs)
• bin/BasicCompiler32.exe (modified) ( previous)
• bin/BasicCompiler64.exe (modified) ( previous)
• bin/abdev.exe (modified) ( previous)

Include/Classes/System/Threading/Thread.ab

@@ -44 +44 @@
     End Sub
 
-    Sub Thread(ByRef obj As Thread)
+    Sub Thread(obj As Thread)
         m_hThread=obj.m_hThread
         m_dwThreadId=obj.m_dwThreadId
@@ -151 +151 @@
 
     Static Function CurrentThread() As Thread
-        Dim obj_Thread As Thread()
-        _System_pobj_AllThreads->CurrentThread(obj_Thread)
-        Return obj_Thread
+        Return _System_pobj_AllThreads->CurrentThread()
     End Function
 End Class
@@ -311 +309 @@
 
     'カレントスレッドを取得
-    Function CurrentThread(ByRef obj_Thread As Thread) As Boolean
+    Function CurrentThread() As Thread
         Dim dwNowThreadId As DWord
         dwNowThreadId=GetCurrentThreadId()
@@ -318 +316 @@
         For i=0 To ELM(ThreadNum)
             If ppobj_Thread[i]->ThreadId=dwNowThreadId Then
-                obj_Thread.Thread(ByVal ppobj_Thread[i])
-                Return True
-            End If
-        Next
-
-        Return False
+                Return ByVal ppobj_Thread[i]
+            End If
+        Next
+
+        ' TODO: エラー処理
+        OutputDebugString( "カレントスレッドの取得に失敗" )
+        debug
     End Function
 

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)