Changeset 214 for Include/system/gc.sbp

Timestamp:

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

Author:

dai

Message:

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

File:

• Include/system/gc.sbp (modified) (17 diffs)

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 )