Changeset 144 for Include/system/gc.sbp


Ignore:
Timestamp:
Mar 11, 2007, 2:11:05 AM (17 years ago)
Author:
dai
Message:

GCを参照型オブジェクトに適用。
未解放のメモリオブジェクトのダンプ処理をgc.sbpに実装したので、DumpMemoryLeaks.abは破棄した。

File:
1 edited

Legend:

Unmodified
Added
Removed

  • Include/system/gc.sbp

    r109 r144  
    1818Const _System_GC_FLAG_NEEDFREE = 2
    1919Const _System_GC_FLAG_INITZERO = 4
     20Const _System_GC_FLAG_OBJECT = 8
    2021
    2122Const THREAD_GET_CONTEXT  = &H0008
    2223
    2324Class _System_CGarbageCollection
    24     ppPtr As **VoidPtr
     25    ppPtr As *VoidPtr
    2526    pSize As *SIZE_T
    26     pbFlags As *Byte
     27    pdwFlags As *DWord
    2728    n As Long
    2829
    2930    iAllSize As SIZE_T
     31
     32    isSweeping As Boolean
    3033
    3134    CriticalSection As CRITICAL_SECTION
    … …  
    3336    'メモリの上限値（この値を超えるとGCが発動します）
    3437    '※バイト単位
    35     limitMemorySize = 1024*1024*30 As LONG_PTR
     38    limitMemorySize As LONG_PTR
     39
     40    isFinish As Boolean
    3641
    3742Public
     43
     44    ' 特殊クラスのため、コンストラクタ・デストラクタは呼ばれません
    3845    Sub _System_CGarbageCollection()
     46    End Sub
     47    Sub ~_System_CGarbageCollection()
     48    End Sub
     49
     50    Sub Begin()
    3951        If ppPtr Then Exit Sub
    4052
    41         ppPtr=HeapAlloc(_System_hProcessHeap,0,1)
    42         pSize=HeapAlloc(_System_hProcessHeap,0,1)
    43         pbFlags=HeapAlloc(_System_hProcessHeap,0,1)
     53        isFinish = False
     54
     55        'メモリの上限値（この値を超えるとGCが発動します）
     56        '※バイト単位
     57        limitMemorySize = 1024*1024 As LONG_PTR
     58
     59        ppPtr=_System_calloc( 1 )
     60        pSize=_System_calloc( 1 )
     61        pdwFlags=_System_calloc( 1 )
    4462        n=0
    4563
    4664        iAllSize=0
    4765
    48         'スレッド情報管理用オブジェクトを生成
    49         _System_pobj_AllThreads=_System_malloc(SizeOf(_System_CThreadCollection)+SizeOf(LONG_PTR))
    50         _System_pobj_AllThreads->_System_CThreadCollection()
     66        ' スウィープ中かどうか
     67        isSweeping = False
    5168
    5269        'クリティカルセッションを生成
    … …  
    6380            hTargetThread, 0, FALSE, DUPLICATE_SAME_ACCESS)     'カレントスレッドのハンドルを複製
    6481
    65 
    66         '自身のThreadオブジェクトを生成
    67         Dim obj_Thread As Thread(hTargetThread,GetCurrentThreadId(),0)
    68 
    69         _System_pobj_AllThreads->BeginThread(obj_Thread,_System_gc_StackRoot_StartPtr As *LONG_PTR)
    70     End Sub
    71     Sub ~_System_CGarbageCollection()
     82        ' スレッド管理用オブジェクトを生成
     83        _System_pobj_AllThreads = New _System_CThreadCollection()
     84
     85        ' 自身のThreadオブジェクトを生成
     86        Dim thread As Thread(hTargetThread,GetCurrentThreadId(),0)
     87
     88        _System_pobj_AllThreads->BeginThread(VarPtr( thread ),_System_gc_StackRoot_StartPtr As *LONG_PTR)
     89
     90    End Sub
     91    Sub Finish()
    7292        If ppPtr=0 Then Exit Sub
    7393
    74 #ifdef _DLL
    75         _destructor()
    76 #else
    77         '解放スレッドを生成
    78         Dim hThread As HANDLE
    79         Dim ThreadId As DWord
    80         hThread=_beginthreadex(NULL,0,AddressOf(DestructorThread),VarPtr(This),0,ThreadId)
    81         CloseHandle(hThread)
    82         Sleep( INFINITE )
    83 #endif
    84 
    85     End Sub
    86 
    87 Private
    88     Sub _destructor()
    89         Dim i As Long
    90         For i=0 To ELM(n)
    91             If ppPtr[i] Then HeapFree(_System_hProcessHeap,0,ppPtr[i])
    92         Next
     94        isFinish = True
     95
     96        ' スレッド管理用オブジェクトを破棄
     97        Delete _System_pobj_AllThreads
     98
     99        ' 自分以外のスレッドを一時停止
     100        '_System_pobj_AllThreads->SuspendAnotherThread()
     101
     102        OutputDebugString( Ex"garbage colletion sweeping all memory objects!\r\n" )
     103        DeleteAllGarbageMemories()
     104
     105        ' 未解放のメモリオブジェクトをトレース
     106        DumpMemoryLeaks()
     107
     108        ' 自分以外のスレッドを再開
     109        '_System_pobj_AllThreads->ResumeAnotherThread()
     110
    93111        HeapFree(_System_hProcessHeap,0,ppPtr)
    94112        ppPtr=0
    … …  
    96114        HeapFree(_System_hProcessHeap,0,pSize)
    97115        pSize=0
    98         HeapFree(_System_hProcessHeap,0,pbFlags)
    99         pbFlags=0
    100 
    101         'スレッド情報管理用オブジェクトを破棄
    102         _System_pobj_AllThreads->Finalize()
    103         _System_free(_System_pobj_AllThreads)
    104         _System_pobj_AllThreads=0
     116        HeapFree(_System_hProcessHeap,0,pdwFlags)
     117        pdwFlags=0
    105118
    106119        'クリティカルセッションを破棄
    107120        DeleteCriticalSection(CriticalSection)
    108     End Sub
    109     Function Cdecl DestructorThread() As Long
    110         '-------------------------------------
    111         ' すべてのスレッドを一時停止
    112         '-------------------------------------
    113         _System_pobj_AllThreads->SuspendAllThread()
    114 
    115         _destructor()
    116 
    117         'プロセスを終了
    118         ExitProcess(0)
    119     End Function
    120 Public
    121 
    122 
    123 
    124     Sub add(new_ptr As VoidPtr, size As SIZE_T,flags As Byte)
     121
     122    End Sub
     123
     124    Sub add(new_ptr As VoidPtr, size As SIZE_T,flags As DWord)
    125125        iAllSize+=size
    126126
    127         Dim i As Long
    128         For i=0 To ELM(n)
    129             If ppPtr[i]=0 Then
    130                 ppPtr[i]=new_ptr
    131                 pSize[i]=size
    132                 pbFlags[i]=flags
    133                 Exit Sub
    134             End If
    135         Next
    136 
    137         ppPtr=HeapReAlloc(_System_hProcessHeap,0,ppPtr,(n+1)*SizeOf(VoidPtr))
    138         ppPtr[n]=new_ptr
    139 
    140         pSize=HeapReAlloc(_System_hProcessHeap,0,pSize,(n+1)*SizeOf(SIZE_T))
    141         pSize[n]=size
    142 
    143         pbFlags=HeapReAlloc(_System_hProcessHeap,0,pbFlags,(n+1)*SizeOf(Byte))
    144         pbFlags[n]=flags
     127        EnterCriticalSection(CriticalSection)
     128            ppPtr=HeapReAlloc(_System_hProcessHeap,0,ppPtr,(n+1)*SizeOf(VoidPtr))
     129            ppPtr[n]=new_ptr
     130
     131            pSize=HeapReAlloc(_System_hProcessHeap,0,pSize,(n+1)*SizeOf(SIZE_T))
     132            pSize[n]=size
     133
     134            pdwFlags=HeapReAlloc(_System_hProcessHeap,0,pdwFlags,(n+1)*SizeOf(DWord))
     135            pdwFlags[n]=flags
     136        LeaveCriticalSection(CriticalSection)
    145137
    146138        n++
    … …  
    157149            End If
    158150
    159 
    160             Dim pTemp As VoidPtr
    161             pTemp=HeapAlloc(_System_hProcessHeap,dwFlags,size)
    162             add(pTemp,size,flags)
     151            Dim ptr = HeapAlloc(_System_hProcessHeap,dwFlags,size)
     152            add( ptr, size, flags )
    163153        LeaveCriticalSection(CriticalSection)
    164         Return pTemp
     154
     155        Return ptr
    165156    End Function
    166157
    … …  
    183174    End Function
    184175
    185     Sub __free(lpMem As VoidPtr)
     176    Sub __free_ex(lpMem As VoidPtr, isSweeping As Boolean)
    186177        EnterCriticalSection(CriticalSection)
    187178            Dim i As Long
    188179            For i=0 To ELM(n)
    189180                If ppPtr[i]=lpMem Then
    190                     If pbFlags[i] and _System_GC_FLAG_NEEDFREE Then
     181                    If (pdwFlags[i] and _System_GC_FLAG_NEEDFREE)<>0 or isSweeping Then
    191182                        iAllSize-=pSize[i]
    192183
    … …  
    195186                        pSize[i]=0
    196187                    Else
    197                         OutputDebugString(Ex"GCが管理しているメモリ空間を解放しようとしました。\r\n")
     188                        If isFinish = False Then
     189                            OutputDebugString( Ex"heap free missing!\r\n" )
     190                        End If
    198191                    End If
    199192                End If
    … …  
    202195    End Sub
    203196
     197    Sub __free(lpMem As VoidPtr)
     198        __free_ex( lpMem, False )
     199    End Sub
     200
    204201    Sub sweep()
    205202        EnterCriticalSection(CriticalSection)
    206 
    207203            If iAllSize<limitMemorySize Then
    208204                'メモリ使用量が上限値を超えていないとき
    … …  
    210206                Exit Sub
    211207            End If
     208
     209            OutputDebugString( Ex"garbage colletion sweep start!\r\n" )
    212210
    213211            Dim hThread As HANDLE
    … …  
    216214            WaitForSingleObject(hThread,INFINITE)
    217215            CloseHandle(hThread)
    218 
    219216        LeaveCriticalSection(CriticalSection)
    220217    End Sub
    221218
    222     Function Cdecl SweepOnOtherThread() As Long
    223 
    224         '-------------------------------------
    225         ' すべてのスレッドを一時停止
    226         '-------------------------------------
    227         _System_pobj_AllThreads->SuspendAllThread()
    228 
    229 
    230         'マークリストを生成
    231         pbMark=HeapAlloc(_System_hProcessHeap,HEAP_ZERO_MEMORY,n*SizeOf(Byte))
    232 
    233 
    234         '-----------------------------------------------
    235         ' グローバル領域をルートに指定してスキャン
    236         '-----------------------------------------------
    237         scan(_System_gc_GlobalRoot_StartPtr,_System_gc_GlobalRoot_Size)
    238 
    239         '-----------------------------------------------
    240         'ローカル領域をルートに指定してスキャン
    241         '-----------------------------------------------
     219Private
     220
     221    ' 生存検知
     222    Function HitTest(pSample As VoidPtr) As Long
     223        Dim i As Long
     224        For i=0 To ELM(n)
     225            If (ppPtr[i] As LONG_PTR)<=(pSample As LONG_PTR) and (pSample As LONG_PTR)<((ppPtr[i] As LONG_PTR)+pSize[i]) Then
     226                Return i
     227            End If
     228        Next
     229        Return -1
     230    End Function
     231
     232    ' 指定領域のスキャン
     233    Sub Scan(pStartPtr As *LONG_PTR, size As LONG_PTR, pbMark As *Byte)
     234        Dim i As Long, count As Long, index As Long
     235        count=(size\SizeOf(LONG_PTR)) As Long
     236        For i=0 To ELM(count)
     237            index=HitTest(pStartPtr[i] As VoidPtr)
     238            If index<>-1 Then
     239                If pbMark[index]=0 Then
     240                    pbMark[index]=1
     241                   
     242                    If (pdwFlags[index] and _System_GC_FLAG_ATOMIC)=0 Then
     243                        'ヒープ領域がポインタ値を含む可能性があるとき
     244                        If ppPtr[index] = 0 Then
     245                            'エラー
     246                           
     247                        End If
     248                        Scan(ppPtr[index] As *LONG_PTR,pSize[index],pbMark)
     249                    End If
     250                End If
     251            End If
     252        Next
     253    End Sub
     254
     255    ' ローカル領域をルートに指定してスキャン
     256    Sub LocalScan( pbMark As *Byte )
    242257        Dim Context As CONTEXT
    243258        Dim NowSp As *LONG_PTR
    … …  
    260275                size=(_System_pobj_AllThreads->pStackBase[i] As LONG_PTR)-(NowSp As LONG_PTR)
    261276
    262                 scan(NowSp,size)
    263             End If
    264         Next
    265 
    266 
    267         Dim iBackAllSize As SIZE_T
    268         iBackAllSize=iAllSize
    269 
    270         '使われていないメモリを解放する
     277                If NowSp = 0 Then
     278                    debug
     279                    Exit Sub
     280                End If
     281
     282                Scan( NowSp, size, pbMark )
     283            End If
     284        Next
     285    End Sub
     286
     287    Sub DeleteGarbageMemories( pbMark As *Byte )
     288
     289        Dim isAllDelete = False
     290        If pbMark = NULL Then
     291            ' すべてを破棄するとき
     292            isAllDelete = True
     293            pbMark = _System_calloc( n )
     294        End If
     295
     296        Dim i As Long
    271297        For i=0 To ELM(n)
    272             If pbMark[i]=0 and ppPtr[i]<>0 and (pbFlags[i] and _System_GC_FLAG_NEEDFREE)=0 Then
    273                 iAllSize-=pSize[i]
    274 
    275                 HeapFree(_System_hProcessHeap,0,ppPtr[i])
     298            If pbMark[i]=0 and ppPtr[i]<>0 and (pdwFlags[i] and _System_GC_FLAG_NEEDFREE)=0 Then
     299                If ppPtr[i] = 0 Then
     300                    If isAllDelete Then
     301                        Continue
     302                    Else
     303                        debug
     304                    End If
     305                End If
     306
     307                Dim ptr = ppPtr[i]
     308                Dim size = pSize[i]
     309
    276310                ppPtr[i]=0
    277311                pSize[i]=0
    278             End If
    279         Next
     312
     313                If (pdwFlags[i] and _System_GC_FLAG_OBJECT) <> 0 Then
     314                    /*  ・オブジェクトの個数
     315                        ・オブジェクトのサイズ
     316                        ・デストラクタの関数ポインタ
     317                        を考慮 */
     318                    _System_SweepingDelete (ptr + SizeOf( LONG_PTR ) * 3 )
     319                Else
     320                    iAllSize-=size
     321                    HeapFree(_System_hProcessHeap,0,ptr)
     322                End If
     323            End If
     324        Next
     325
     326        If isAllDelete Then
     327            _System_free( pbMark )
     328        End If
     329
     330    End Sub
     331
     332    Sub DeleteAllGarbageMemories()
     333        DeleteGarbageMemories( NULL )
     334    End Sub
     335
     336    Sub Compaction()
     337        Dim i As Long, i2 = 0 As Long
     338        For i=0 To ELM(n)
     339            ppPtr[i2] = ppPtr[i]
     340            pSize[i2] = pSize[i]
     341            pdwFlags[i2] = pdwFlags[i]
     342
     343            If ppPtr[i] Then
     344                i2++
     345            End If
     346        Next
     347        n = i2
     348    End Sub
     349
     350    ' スウィープ（新規スレッドで呼び出し）
     351    Function Cdecl SweepOnOtherThread() As Long
     352
     353        ' すべてのスレッドを一時停止
     354        _System_pobj_AllThreads->SuspendAllThread()
     355
     356        ' マークリストを生成
     357        Dim pbMark = HeapAlloc(_System_hProcessHeap,HEAP_ZERO_MEMORY,n*SizeOf(Byte)) As *Byte
     358
     359        ' グローバル領域をルートに指定してスキャン
     360        Scan( _System_gc_GlobalRoot_StartPtr, _System_gc_GlobalRoot_Size, pbMark )
     361
     362        ' ローカル領域をルートに指定してスキャン
     363        LocalScan( pbMark )
     364
     365        ' スウィープ前のメモリサイズを退避
     366        Dim iBackAllSize = iAllSize
     367
     368        ' スウィープ前のメモリオブジェクトの数
     369        Dim iBeforeN = n
     370
     371        '使われていないメモリを解放する
     372        DeleteGarbageMemories(pbMark)
     373
     374        'コンパクション
     375        Compaction()
    280376
    281377        'マークリストを解放
    … …  
    283379
    284380        If iBackAllSize=iAllSize Then
     381            If iAllSize > limitMemorySize Then
     382                limitMemorySize = iAllSize
     383            End If
     384
    285385            '許容量を拡張する
    286             limitMemorySize*=2
     386            limitMemorySize *= 2
     387
     388            OutputDebugString( Ex"memory size is extended for gc!\r\n" )
    287389        End If
     390
     391        Dim temp[100] As Char
     392        wsprintf(temp,Ex"object items         ... %d -> %d  ( %dMB -> %dMB )\r\n",iBeforeN,n, iBackAllSize\1024\1024, iAllSize\1024\1024)
     393        OutputDebugString( temp )
     394        wsprintf(temp,Ex"limit size of memory ... %d\r\n",limitMemorySize)
     395        OutputDebugString( temp )
     396        OutputDebugString( Ex"garbage colletion sweep finish!\r\n" )
    288397
    289398
    … …  
    294403    End Function
    295404
    296 
    297 Private
    298 
    299     pbMark As *Byte
    300 
    301     Function HitTest(pSample As VoidPtr) As Long
     405    ' 未解放のメモリオブジェクトをトレース
     406    Sub DumpMemoryLeaks()
     407        Dim isLeak = False
    302408        Dim i As Long
    303409        For i=0 To ELM(n)
    304             If (ppPtr[i] As LONG_PTR)<=(pSample As LONG_PTR) and (pSample As LONG_PTR)<((ppPtr[i] As LONG_PTR)+pSize[i]) Then
    305                 Return i
    306             End If
    307         Next
    308         Return -1
    309     End Function
    310 
    311     Sub scan(pStartPtr As *LONG_PTR, size As LONG_PTR)
    312         Dim i As Long, count As Long, index As Long
    313         count=(size\SizeOf(LONG_PTR)) As Long
    314         For i=0 To ELM(count)
    315             index=HitTest(pStartPtr[i] As VoidPtr)
    316             If index<>-1 Then
    317                 If pbMark[index]=0 Then
    318                     pbMark[index]=1
    319 
    320                     If (pbFlags[index] and _System_GC_FLAG_ATOMIC)=0 Then
    321                         'ヒープ領域がポインタ値を含む可能性があるとき
    322                         scan(ppPtr[index] As *LONG_PTR,pSize[index])
     410            If ppPtr[i] Then
     411                If (pdwFlags[i] and _System_GC_FLAG_NEEDFREE)<>0 Then
     412                    If isLeak = False Then
     413                        OutputDebugString( Ex"Detected memory leaks!\r\n" )
     414                        isLeak = True
    323415                    End If
    324                 End If
    325             End If
    326         Next
    327     End Sub
     416
     417                    Dim temp[100] As Char
     418                    OutputDebugString( Ex"heap free missing!\r\n" )
     419                    wsprintf(temp,Ex"{%d} normal block at &H%08X, %d bytes long.\r\n", i, ppPtr[i], pSize[i])
     420                    OutputDebugString( temp )
     421                End If
     422            End If
     423        Next
     424
     425        If isLeak Then
     426            OutputDebugString( Ex"Object dump complete.\r\n" )
     427        End If
     428       
     429    End Sub
     430
    328431End Class
    329432
    330433'GC管理用の特殊なシステムオブジェクト（デストラクタは最終のタイミングで呼び出されます）
    331 Dim _System_GC As _System_CGarbageCollection
     434Dim _System_pGC As *_System_CGarbageCollection
    332435
    333436
    … …  
    335438Function GC_malloc(size As Long) As VoidPtr
    336439    ' sweep
    337     _System_GC.sweep()
     440    _System_pGC->sweep()
    338441
    339442    'allocate
    340     Return _System_GC.__malloc(size,0)
     443    Return _System_pGC->__malloc(size,0)
    341444End Function
    342445
    343446Function GC_malloc_atomic(size As Long) As VoidPtr
    344447    ' sweep
    345     _System_GC.sweep()
     448    _System_pGC->sweep()
    346449
    347450    'allocate
    348     Return _System_GC.__malloc(size,_System_GC_FLAG_ATOMIC)
    349 End Function
     451    Return _System_pGC->__malloc(size,_System_GC_FLAG_ATOMIC)
     452End Function
     453
     454Function _System_GC_malloc_ForObject(size As Long) As VoidPtr
     455    ' sweep
     456    _System_pGC->sweep()
     457
     458    'allocate
     459    Return _System_pGC->__malloc(size,_System_GC_FLAG_OBJECT or _System_GC_FLAG_INITZERO)
     460End Function
     461
     462Function _System_GC_malloc_ForObjectPtr(size As Long) As VoidPtr
     463    ' sweep
     464    _System_pGC->sweep()
     465
     466    'allocate
     467    Return _System_pGC->__malloc(size,_System_GC_FLAG_OBJECT or _System_GC_FLAG_INITZERO or _System_GC_FLAG_NEEDFREE)
     468End Function
     469
     470Function _System_GC_free_for_SweepingDelete( ptr As *Object )
     471    ' free
     472    _System_pGC->__free_ex( ptr, True )
     473End Function
Note: See TracChangeset for help on using the changeset viewer.