Changeset 214

Timestamp:

Apr 15, 2007, 1:55:46 AM (17 years ago)

Author:

dai

Message:

GCでのメモリ回収処理を、実行時型情報を元に行うようにした。

Files:

• Include/Classes/System/Object.ab (modified) (1 diff)
• Include/Classes/System/TypeInfo.ab (modified) (7 diffs)
• Include/Classes/index.ab (modified) (1 diff)
• Include/basic.sbp (modified) (1 diff)
• Include/basic/command.sbp (modified) (1 diff)
• Include/basic/function.sbp (modified) (1 diff)
• Include/system/gc.sbp (modified) (17 diffs)
• bin/BasicCompiler32.exe (modified) ( previous)
• bin/BasicCompiler64.exe (modified) ( previous)

Include/Classes/System/Object.ab

@@ -67 +67 @@
     End Sub
 
-    Function GetType() As TypeInfo
+    Virtual Function GetType() As TypeInfo
         Return typeInfo
     End Function

Include/Classes/System/TypeInfo.ab

@@ -13 +13 @@
     Sub ~TypeInfo()
     End Sub
+
+    Override Function GetType() As TypeInfo
+        Return _System_TypeBase.selfTypeInfo
+    End Function
 
 
@@ -162 +166 @@
 Class _System_TypeForClass
     Inherits TypeBaseImpl
-Public
+
+Public
+    referenceOffsets As *Long
+    numOfReference As Long
+
+    Sub _System_TypeForClass( strNamespace As String, name As String, referenceOffsets As *Long, numOfReference As Long )
+        TypeBaseImpl( strNamespace, name )
+
+        This.referenceOffsets = referenceOffsets
+        This.numOfReference = numOfReference
+    End Sub
     Sub _System_TypeForClass( strNamespace As String, name As String )
         TypeBaseImpl( strNamespace, name )
@@ -168 +182 @@
     Sub ~_System_TypeForClass()
     End Sub
+
     Override Function IsClass() As Boolean
         Return True
@@ -225 +240 @@
 
         '例:
-        'Add( New _System_TypeForClass( "System", "String" ) )
+        'Add( New _System_TypeForClass( "System", "String", [__offsets...], __numOfOffsets ) )
         'Search( "String" ).SetBaseType( Search( "Object" ) )
     End Sub
@@ -242 +257 @@
         InitializeUserTypes()
 
+        selfTypeInfo = _System_TypeBase.Search( "System", "TypeInfo" ) As TypeInfo
 
         OutputDebugString( Ex"ready dynamic meta datas!\r\n" )
@@ -251 +267 @@
 
     Static Function Search( strNamespace As LPSTR, typeName As LPSTR ) As TypeBaseImpl
-
         ' TODO: 名前空間に対応する
         Dim i As Long
@@ -267 +282 @@
     End Function
 
+    Static selfTypeInfo = Nothing As TypeInfo
+
 End Class
 

Include/Classes/index.ab

@@ -1 +1 @@
 ' コンパイルに最低限必要なファイル
 
-' System
 #require "System\index.ab"
-
-' System.Thread
+#require "System\Diagnostics\index.ab"
 #require "System\Threading\index.ab"

Include/basic.sbp

@@ -132 +132 @@
         _System_pGC->Begin()
 
+        ' 動的型情報を生成
         _System_TypeBase.Initialize()
 

Include/basic/command.sbp

@@ -266 +266 @@
 
 Dim _System_UsingDblData[_System_MAX_PARMSNUM] As Double
-Dim _System_UsingStrData[_System_MAX_PARMSNUM] As String
+Dim _System_UsingStrData[_System_MAX_PARMSNUM] As *Char     'TODO: 暫定対応（動作未確認）
 Dim _System_UsingDataType[_System_MAX_PARMSNUM] As DWord
 Function _System_GetUsingFormat(UsingStr As String) As String

Include/basic/function.sbp

@@ -779 +779 @@
             i64data=1
             While i>=2
-                Val += i64data * TempPtr[i]
+                Val += ( i64data * TempPtr[i] ) As Double
 
                 i64data *= &O10

Include/system/gc.sbp

@@ -20 +20 @@
 Const _System_GC_FLAG_OBJECT = 8
 
+Type _System_GlobalRoot
+    ptr As *LONG_PTR
+    count As Long
+End Type
+
 Class _System_CGarbageCollection
     ppPtr As *VoidPtr
@@ -32 +37 @@
     CriticalSection As CRITICAL_SECTION
 
-    'メモリの上限値（この値を超えるとGCが発動します）
-    '※バイト単位
-    limitMemorySize As LONG_PTR
+    ' メモリの上限値（この値を超えるとGCが発動します）
+    limitMemorySize As LONG_PTR     ' バイト単位
+    limitMemoryObjectNum As Long    ' メモリオブジェクトの個数単位
 
     isFinish As Boolean
 
-Public
+
+    ' Global Root
+    pGlobalRoots As *_System_GlobalRoot
+    globalRootNum As Long
+    Sub AddGlobalRootPtr( ptr As *LONG_PTR, count As Long )
+        pGlobalRoots = _System_realloc( pGlobalRoots, (globalRootNum + 1) * SizeOf(_System_GlobalRoot) )
+        pGlobalRoots[globalRootNum].ptr = ptr
+        pGlobalRoots[globalRootNum].count = count
+        globalRootNum++
+    End Sub
+
+    Sub RegisterGlobalRoots()
+        ' このメソッドの実装はコンパイラが自動生成する
+
+        ' AddGlobalRootPtr(...)
+        ' ...
+    End Sub
 
     ' 特殊クラスのため、コンストラクタ・デストラクタは呼ばれません
@@ -46 +67 @@
     End Sub
 
+Public
+
     Sub Begin()
         If ppPtr Then Exit Sub
@@ -52 +75 @@
 
         'メモリの上限値（この値を超えるとGCが発動します）
-        '※バイト単位
-        limitMemorySize = 1024*1024 As LONG_PTR
+        limitMemorySize = 1024*1024 As LONG_PTR     ' バイト単位
+        limitMemoryObjectNum = 2000                 ' メモリオブジェクトの個数単位
 
         ppPtr=_System_calloc( 1 )
@@ -59 +82 @@
         pdwFlags=_System_calloc( 1 )
         n=0
+
+        ' Global Root
+        pGlobalRoots = _System_calloc( 1 )
+        globalRootNum = 0
+        RegisterGlobalRoots()
 
         iAllSize=0
@@ -107 +135 @@
         '_System_pobj_AllThreads->ResumeAnotherThread()
 
-        HeapFree(_System_hProcessHeap,0,ppPtr)
-        ppPtr=0
-
-        HeapFree(_System_hProcessHeap,0,pSize)
-        pSize=0
-        HeapFree(_System_hProcessHeap,0,pdwFlags)
-        pdwFlags=0
+        _System_free( ppPtr )
+        ppPtr = NULL
+
+        _System_free( pSize )
+        pSize = NULL
+        _System_free( pdwFlags )
+        pdwFlags = NULL
+
+        _System_free( pGlobalRoots )
+        pGlobalRoots = NULL
 
         'クリティカルセッションを破棄
@@ -198 +229 @@
 
     Sub sweep()
-        If isSweeping <> False Or iAllSize<limitMemorySize Then
+        If isSweeping <> False or (iAllSize<limitMemorySize and n<limitMemoryObjectNum) Then
             'メモリ使用量が上限値を超えていないとき
             Exit Sub
         End If
-        OutputDebugString( Ex"garbage colletion sweep start!\r\n" )
 
         Dim hThread As HANDLE
@@ -214 +244 @@
 Private
 
+    Static Function IsNull( object As Object ) As Boolean
+        If VarPtr( object ) = NULL Then
+            Return True
+        End If
+        Return False
+    End Function
+
     ' 生存検知
     Function HitTest(pSample As VoidPtr) As Long
@@ -225 +262 @@
     End Function
 
+    ' オブジェクトのスキャン
+    Function ScanObject(pObject As *Object, pbMark As *Byte) As Boolean
+        Dim classTypeInfo = Nothing As _System_TypeForClass
+        classTypeInfo = pObject->GetType() As _System_TypeForClass
+
+        If IsNull( classTypeInfo ) Then
+            Return False
+        End If
+
+        Dim i As Long
+        For i = 0 To ELM(classTypeInfo.numOfReference)
+            Scan( (pObject + classTypeInfo.referenceOffsets[i]) As *LONG_PTR, 1, pbMark )
+        Next
+
+        Return True
+    End Function
+
     ' 指定領域のスキャン
-    Sub Scan(pStartPtr As *LONG_PTR, size As LONG_PTR, pbMark As *Byte)
-        Dim i As Long, count As Long, index As Long
-        count=(size\SizeOf(LONG_PTR)) As Long
-        For i=0 To ELM(count)
+    Sub Scan(pStartPtr As *LONG_PTR, maxNum As Long, pbMark As *Byte)
+        Dim i As Long, index As Long
+
+        For i=0 To ELM(maxNum)
             index=HitTest(pStartPtr[i] As VoidPtr)
             If index<>-1 Then
@@ -235 +289 @@
                     pbMark[index]=1
 
-                    If (pdwFlags[index] and _System_GC_FLAG_ATOMIC)=0 Then
-                        'ヒープ領域がポインタ値を含む可能性があるとき
+                    If pdwFlags[index] and _System_GC_FLAG_OBJECT Then
+                        ' オブジェクトの場合
+                        If ScanObject( (ppPtr[index] + 3*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)
+                        End If
+
+                    ElseIf (pdwFlags[index] and _System_GC_FLAG_ATOMIC)=0 Then
+                        ' ヒープ領域がポインタ値を含む可能性があるとき
                         If ppPtr[index] = 0 Then
                             'エラー
 
                         End If
-                        Scan(ppPtr[index] As *LONG_PTR,pSize[index],pbMark)
+
+                        Dim maxNum = (pSize[index]\SizeOf(LONG_PTR)) As Long
+                        Scan(ppPtr[index] As *LONG_PTR, maxNum, pbMark)
                     End If
                 End If
@@ -268 +331 @@
 #endif
 
-                size=(_System_pobj_AllThreads->pStackBase[i] As LONG_PTR)-(NowSp As LONG_PTR)
+                Dim size=(_System_pobj_AllThreads->pStackBase[i] As LONG_PTR)-(NowSp As LONG_PTR)
+                Dim maxNum = (size\SizeOf(LONG_PTR)) As Long
 
                 If NowSp = 0 Then
@@ -275 +339 @@
                 End If
 
-                Scan( NowSp, size, pbMark )
+                Scan( NowSp, maxNum, pbMark )
             End If
         Next
@@ -313 +377 @@
                     _System_SweepingDelete (ptr + SizeOf( LONG_PTR ) * 3 )
                 Else
-                    iAllSize-=size
                     HeapFree(_System_hProcessHeap,0,ptr)
                 End If
+
+                iAllSize-=size
             End If
         Next
@@ -347 +412 @@
         EnterCriticalSection(CriticalSection)
 
-        If isSweeping <> False Or iAllSize<limitMemorySize Then
+
+        Dim startTime = GetTickCount()
+
+        OutputDebugString( Ex"garbage colletion sweep start!\r\n" )
+
+
+        If isSweeping <> False or (iAllSize<limitMemorySize and n<limitMemoryObjectNum) Then
             ExitThread(0)
         End If
@@ -359 +430 @@
 
         ' グローバル領域をルートに指定してスキャン
-        Scan( _System_gc_GlobalRoot_StartPtr, _System_gc_GlobalRoot_Size, pbMark )
+        Dim i As Long
+        For i = 0 To ELM( globalRootNum )
+            Scan( pGlobalRoots[i].ptr, pGlobalRoots[i].count, pbMark )
+        Next
 
         ' ローカル領域をルートに指定してスキャン
@@ -386 +460 @@
             '許容量を拡張する
             limitMemorySize *= 2
+            limitMemoryObjectNum *= 2
 
             OutputDebugString( Ex"memory size is extended for gc!\r\n" )
@@ -391 +466 @@
 
         Dim temp[100] As Char
-        wsprintf(temp,Ex"object items         ... %d -> %d  ( %dMB -> %dMB )\r\n",iBeforeN,n, iBackAllSize\1024\1024, iAllSize\1024\1024)
+        wsprintf(temp,Ex"object items         ... %d -> %d  ( %d MB -> %d MB )\r\n",iBeforeN,n, iBackAllSize\1024\1024, iAllSize\1024\1024)
         OutputDebugString( temp )
         wsprintf(temp,Ex"limit size of memory ... %d\r\n",limitMemorySize)
         OutputDebugString( temp )
-        OutputDebugString( Ex"garbage colletion sweep finish!\r\n" )
+        wsprintf(temp,Ex"garbage colletion sweep finish! (%d ms)\r\n\r\n", GetTickCount()-startTime)
+        OutputDebugString( temp )