Changeset 214


Ignore:
Timestamp:
Apr 15, 2007, 1:55:46 AM (18 years ago)
Author:
dai
Message:

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

Files:
9 edited

Legend:

Unmodified
Added
Removed
  • Include/Classes/System/Object.ab

    r212 r214  
    6767    End Sub
    6868
    69     Function GetType() As TypeInfo
     69    Virtual Function GetType() As TypeInfo
    7070        Return typeInfo
    7171    End Function
  • Include/Classes/System/TypeInfo.ab

    r207 r214  
    1313    Sub ~TypeInfo()
    1414    End Sub
     15
     16    Override Function GetType() As TypeInfo
     17        Return _System_TypeBase.selfTypeInfo
     18    End Function
    1519
    1620
     
    162166Class _System_TypeForClass
    163167    Inherits TypeBaseImpl
    164 Public
     168
     169Public
     170    referenceOffsets As *Long
     171    numOfReference As Long
     172
     173    Sub _System_TypeForClass( strNamespace As String, name As String, referenceOffsets As *Long, numOfReference As Long )
     174        TypeBaseImpl( strNamespace, name )
     175
     176        This.referenceOffsets = referenceOffsets
     177        This.numOfReference = numOfReference
     178    End Sub
    165179    Sub _System_TypeForClass( strNamespace As String, name As String )
    166180        TypeBaseImpl( strNamespace, name )
     
    168182    Sub ~_System_TypeForClass()
    169183    End Sub
     184
    170185    Override Function IsClass() As Boolean
    171186        Return True
     
    225240
    226241        '例:
    227         'Add( New _System_TypeForClass( "System", "String" ) )
     242        'Add( New _System_TypeForClass( "System", "String", [__offsets...], __numOfOffsets ) )
    228243        'Search( "String" ).SetBaseType( Search( "Object" ) )
    229244    End Sub
     
    242257        InitializeUserTypes()
    243258
     259        selfTypeInfo = _System_TypeBase.Search( "System", "TypeInfo" ) As TypeInfo
    244260
    245261        OutputDebugString( Ex"ready dynamic meta datas!\r\n" )
     
    251267
    252268    Static Function Search( strNamespace As LPSTR, typeName As LPSTR ) As TypeBaseImpl
    253 
    254269        ' TODO: 名前空間に対応する
    255270        Dim i As Long
     
    267282    End Function
    268283
     284    Static selfTypeInfo = Nothing As TypeInfo
     285
    269286End Class
    270287
  • Include/Classes/index.ab

    r58 r214  
    11' コンパイルに最低限必要なファイル
    22
    3 ' System
    43#require "System\index.ab"
    5 
    6 ' System.Thread
     4#require "System\Diagnostics\index.ab"
    75#require "System\Threading\index.ab"
  • Include/basic.sbp

    r207 r214  
    132132        _System_pGC->Begin()
    133133
     134        ' 動的型情報を生成
    134135        _System_TypeBase.Initialize()
    135136
  • Include/basic/command.sbp

    r179 r214  
    266266
    267267Dim _System_UsingDblData[_System_MAX_PARMSNUM] As Double
    268 Dim _System_UsingStrData[_System_MAX_PARMSNUM] As String
     268Dim _System_UsingStrData[_System_MAX_PARMSNUM] As *Char     'TODO: 暫定対応(動作未確認)
    269269Dim _System_UsingDataType[_System_MAX_PARMSNUM] As DWord
    270270Function _System_GetUsingFormat(UsingStr As String) As String
  • Include/basic/function.sbp

    r208 r214  
    779779            i64data=1
    780780            While i>=2
    781                 Val += i64data * TempPtr[i]
     781                Val += ( i64data * TempPtr[i] ) As Double
    782782
    783783                i64data *= &O10
  • Include/system/gc.sbp

    r203 r214  
    2020Const _System_GC_FLAG_OBJECT = 8
    2121
     22Type _System_GlobalRoot
     23    ptr As *LONG_PTR
     24    count As Long
     25End Type
     26
    2227Class _System_CGarbageCollection
    2328    ppPtr As *VoidPtr
     
    3237    CriticalSection As CRITICAL_SECTION
    3338
    34     'メモリの上限値(この値を超えるとGCが発動します)
    35     '※バイト単位
    36     limitMemorySize As LONG_PTR
     39    ' メモリの上限値(この値を超えるとGCが発動します)
     40    limitMemorySize As LONG_PTR     ' バイト単位
     41    limitMemoryObjectNum As Long    ' メモリオブジェクトの個数単位
    3742
    3843    isFinish As Boolean
    3944
    40 Public
     45
     46    ' Global Root
     47    pGlobalRoots As *_System_GlobalRoot
     48    globalRootNum As Long
     49    Sub AddGlobalRootPtr( ptr As *LONG_PTR, count As Long )
     50        pGlobalRoots = _System_realloc( pGlobalRoots, (globalRootNum + 1) * SizeOf(_System_GlobalRoot) )
     51        pGlobalRoots[globalRootNum].ptr = ptr
     52        pGlobalRoots[globalRootNum].count = count
     53        globalRootNum++
     54    End Sub
     55
     56    Sub RegisterGlobalRoots()
     57        ' このメソッドの実装はコンパイラが自動生成する
     58
     59        ' AddGlobalRootPtr(...)
     60        ' ...
     61    End Sub
    4162
    4263    ' 特殊クラスのため、コンストラクタ・デストラクタは呼ばれません
     
    4667    End Sub
    4768
     69Public
     70
    4871    Sub Begin()
    4972        If ppPtr Then Exit Sub
     
    5275
    5376        'メモリの上限値(この値を超えるとGCが発動します)
    54         '※バイト単位
    55         limitMemorySize = 1024*1024 As LONG_PTR
     77        limitMemorySize = 1024*1024 As LONG_PTR     ' バイト単位
     78        limitMemoryObjectNum = 2000                 ' メモリオブジェクトの個数単位
    5679
    5780        ppPtr=_System_calloc( 1 )
     
    5982        pdwFlags=_System_calloc( 1 )
    6083        n=0
     84
     85        ' Global Root
     86        pGlobalRoots = _System_calloc( 1 )
     87        globalRootNum = 0
     88        RegisterGlobalRoots()
    6189
    6290        iAllSize=0
     
    107135        '_System_pobj_AllThreads->ResumeAnotherThread()
    108136
    109         HeapFree(_System_hProcessHeap,0,ppPtr)
    110         ppPtr=0
    111 
    112         HeapFree(_System_hProcessHeap,0,pSize)
    113         pSize=0
    114         HeapFree(_System_hProcessHeap,0,pdwFlags)
    115         pdwFlags=0
     137        _System_free( ppPtr )
     138        ppPtr = NULL
     139
     140        _System_free( pSize )
     141        pSize = NULL
     142        _System_free( pdwFlags )
     143        pdwFlags = NULL
     144
     145        _System_free( pGlobalRoots )
     146        pGlobalRoots = NULL
    116147
    117148        'クリティカルセッションを破棄
     
    198229
    199230    Sub sweep()
    200         If isSweeping <> False Or iAllSize<limitMemorySize Then
     231        If isSweeping <> False or (iAllSize<limitMemorySize and n<limitMemoryObjectNum) Then
    201232            'メモリ使用量が上限値を超えていないとき
    202233            Exit Sub
    203234        End If
    204         OutputDebugString( Ex"garbage colletion sweep start!\r\n" )
    205235
    206236        Dim hThread As HANDLE
     
    214244Private
    215245
     246    Static Function IsNull( object As Object ) As Boolean
     247        If VarPtr( object ) = NULL Then
     248            Return True
     249        End If
     250        Return False
     251    End Function
     252
    216253    ' 生存検知
    217254    Function HitTest(pSample As VoidPtr) As Long
     
    225262    End Function
    226263
     264    ' オブジェクトのスキャン
     265    Function ScanObject(pObject As *Object, pbMark As *Byte) As Boolean
     266        Dim classTypeInfo = Nothing As _System_TypeForClass
     267        classTypeInfo = pObject->GetType() As _System_TypeForClass
     268
     269        If IsNull( classTypeInfo ) Then
     270            Return False
     271        End If
     272
     273        Dim i As Long
     274        For i = 0 To ELM(classTypeInfo.numOfReference)
     275            Scan( (pObject + classTypeInfo.referenceOffsets[i]) As *LONG_PTR, 1, pbMark )
     276        Next
     277
     278        Return True
     279    End Function
     280
    227281    ' 指定領域のスキャン
    228     Sub Scan(pStartPtr As *LONG_PTR, size As LONG_PTR, pbMark As *Byte)
    229         Dim i As Long, count As Long, index As Long
    230         count=(size\SizeOf(LONG_PTR)) As Long
    231         For i=0 To ELM(count)
     282    Sub Scan(pStartPtr As *LONG_PTR, maxNum As Long, pbMark As *Byte)
     283        Dim i As Long, index As Long
     284
     285        For i=0 To ELM(maxNum)
    232286            index=HitTest(pStartPtr[i] As VoidPtr)
    233287            If index<>-1 Then
     
    235289                    pbMark[index]=1
    236290
    237                     If (pdwFlags[index] and _System_GC_FLAG_ATOMIC)=0 Then
    238                         'ヒープ領域がポインタ値を含む可能性があるとき
     291                    If pdwFlags[index] and _System_GC_FLAG_OBJECT Then
     292                        ' オブジェクトの場合
     293                        If ScanObject( (ppPtr[index] + 3*SizeOf(LONG_PTR)) As *Object, pbMark) = False Then
     294                            Dim maxNum = (pSize[index]\SizeOf(LONG_PTR)) As Long
     295                            Scan(ppPtr[index] As *LONG_PTR, maxNum, pbMark)
     296                        End If
     297
     298                    ElseIf (pdwFlags[index] and _System_GC_FLAG_ATOMIC)=0 Then
     299                        ' ヒープ領域がポインタ値を含む可能性があるとき
    239300                        If ppPtr[index] = 0 Then
    240301                            'エラー
    241302
    242303                        End If
    243                         Scan(ppPtr[index] As *LONG_PTR,pSize[index],pbMark)
     304
     305                        Dim maxNum = (pSize[index]\SizeOf(LONG_PTR)) As Long
     306                        Scan(ppPtr[index] As *LONG_PTR, maxNum, pbMark)
    244307                    End If
    245308                End If
     
    268331#endif
    269332
    270                 size=(_System_pobj_AllThreads->pStackBase[i] As LONG_PTR)-(NowSp As LONG_PTR)
     333                Dim size=(_System_pobj_AllThreads->pStackBase[i] As LONG_PTR)-(NowSp As LONG_PTR)
     334                Dim maxNum = (size\SizeOf(LONG_PTR)) As Long
    271335
    272336                If NowSp = 0 Then
     
    275339                End If
    276340
    277                 Scan( NowSp, size, pbMark )
     341                Scan( NowSp, maxNum, pbMark )
    278342            End If
    279343        Next
     
    313377                    _System_SweepingDelete (ptr + SizeOf( LONG_PTR ) * 3 )
    314378                Else
    315                     iAllSize-=size
    316379                    HeapFree(_System_hProcessHeap,0,ptr)
    317380                End If
     381
     382                iAllSize-=size
    318383            End If
    319384        Next
     
    347412        EnterCriticalSection(CriticalSection)
    348413
    349         If isSweeping <> False Or iAllSize<limitMemorySize Then
     414
     415        Dim startTime = GetTickCount()
     416
     417        OutputDebugString( Ex"garbage colletion sweep start!\r\n" )
     418
     419
     420        If isSweeping <> False or (iAllSize<limitMemorySize and n<limitMemoryObjectNum) Then
    350421            ExitThread(0)
    351422        End If
     
    359430
    360431        ' グローバル領域をルートに指定してスキャン
    361         Scan( _System_gc_GlobalRoot_StartPtr, _System_gc_GlobalRoot_Size, pbMark )
     432        Dim i As Long
     433        For i = 0 To ELM( globalRootNum )
     434            Scan( pGlobalRoots[i].ptr, pGlobalRoots[i].count, pbMark )
     435        Next
    362436
    363437        ' ローカル領域をルートに指定してスキャン
     
    386460            '許容量を拡張する
    387461            limitMemorySize *= 2
     462            limitMemoryObjectNum *= 2
    388463
    389464            OutputDebugString( Ex"memory size is extended for gc!\r\n" )
     
    391466
    392467        Dim temp[100] As Char
    393         wsprintf(temp,Ex"object items         ... %d -> %d  ( %dMB -> %dMB )\r\n",iBeforeN,n, iBackAllSize\1024\1024, iAllSize\1024\1024)
     468        wsprintf(temp,Ex"object items         ... %d -> %d  ( %d MB -> %d MB )\r\n",iBeforeN,n, iBackAllSize\1024\1024, iAllSize\1024\1024)
    394469        OutputDebugString( temp )
    395470        wsprintf(temp,Ex"limit size of memory ... %d\r\n",limitMemorySize)
    396471        OutputDebugString( temp )
    397         OutputDebugString( Ex"garbage colletion sweep finish!\r\n" )
     472        wsprintf(temp,Ex"garbage colletion sweep finish! (%d ms)\r\n\r\n", GetTickCount()-startTime)
     473        OutputDebugString( temp )
    398474
    399475
Note: See TracChangeset for help on using the changeset viewer.