早速、GCの実装サンプルをコーディング

abdev

調べ物をするだけではわからないので、早速、動くものを作ってみました（下記コードを参照のこと）。


/*

※これらの変数はコンパイラが自動的に定義します。

Dim _System_gc_GlobalRoot_StartPtr As VoidPtr

Dim _System_gc_GlobalRoot_Size As Long

Dim _System_gc_StackRoot_StartPtr As VoidPtr

 */
Function _System_GetSp() As LONG_PTR                    'dummy

End Function



Class _System_CGarbageCollection

    ppPtr As **VoidPtr

    pSize As *Long

    pbAtomic As *Byte

    n As Long

Public

    Sub _System_CGarbageCollection()

        ppPtr=malloc(1)

        pSize=malloc(1)

        pbAtomic=malloc(1)

        n=0

    End Sub

    Sub ~_System_CGarbageCollection()

        Dim i As Long

        For i=0 To ELM(n)

            If ppPtr[i] Then free(ppPtr[i])

        Next

        free(ppPtr)
        free(pSize)

        free(pbAtomic)

    End Sub
    Sub add(new_ptr As VoidPtr, size As Long,fAtomic As Byte)

        Dim i As Long

        For i=0 To ELM(n)

            If ppPtr[i]=0 Then

                ppPtr[i]=new_ptr

                pSize[i]=size

                pbAtomic[i]=fAtomic

                Exit Sub

            End If

        Next
        ppPtr=realloc(ppPtr,(n+1)*SizeOf(VoidPtr))

        ppPtr[n]=new_ptr
        pSize=realloc(pSize,(n+1)*SizeOf(Long))

        pSize[n]=size
        pbAtomic=realloc(pbAtomic,(n+1)*SizeOf(Byte))

        pbAtomic[n]=fAtomic
        n++

    End Sub
    Function __malloc(size As Long,fAtomic As Byte) As VoidPtr

        Dim pTemp As VoidPtr

        pTemp=malloc(size)

        add(pTemp,size,fAtomic)

        Return pTemp

    End Function
    Sub sweep()

        pbMark=calloc(n*SizeOf(Byte))
        'グローバル領域をルートに指定してスキャン

        scan(_System_gc_GlobalRoot_StartPtr,_System_gc_GlobalRoot_Size)
        'ローカル領域をルートに指定してスキャン

        Dim NowSp As LONG_PTR

        NowSp=_System_GetSp()

        scan(_System_gc_StackRoot_StartPtr,(_System_gc_StackRoot_StartPtr As LONG_PTR)-NowSp)
        '使われていないメモリを解放する

        Dim i As Long

        For i=0 To ELM(n)

            If pbMark[i]=0 and ppPtr[i]<>0 Then

                free(ppPtr[i])

                ppPtr[i]=0

                pSize[i]=0

            End If

        Next
        free(pbMark)

    End Sub



Private
    pbMark As *Byte
    Function HitTest(pSample As VoidPtr) As Long

        Dim i As Long

        For i=0 To ELM(n)

            If (ppPtr[i] As LONG_PTR)<=(pSample As LONG_PTR) and (pSample As LONG_PTR)<((ppPtr[i] As LONG_PTR)+pSize[i]) Then

                Return i

            End If

        Next

        Return -1

    End Function
    Sub scan(pStartPtr As *LONG_PTR, size As Long)

        Dim i As Long, count As Long, index As Long

        count=size/SizeOf(LONG_PTR)

        For i=0 To ELM(count)

            index=HitTest(pStartPtr[i])

            If index<>-1 Then

                If pbMark[index]=0 Then

                    pbMark[index]=1
                    If pbAtomic[index]=0 Then

                        'ヒープ領域がポインタ値を含む可能性があるとき

                        scan(ppPtr[index],pSize[index])

                    End If

                End If

            End If

        Next

    End Sub

End Class

Dim _System_GC As _System_CGarbageCollection





Function GC_malloc(size As Long) As VoidPtr

    ' sweep

    _System_GC.sweep()
    'allocate

    Return _System_GC.__malloc(size,0)

End Function
Function GC_malloc_atomic(size As Long) As VoidPtr

    ' sweep

    _System_GC.sweep()
    'allocate

    Return _System_GC.__malloc(size,1)

End Function


ちなみに、このコードはAB4やAB5CP2では動作しませんので、あしからず。飽くまでもコンパイラを拡張した形での提供になります。


このコードがプログラマに提供する関数は下記の2つです。


まず、GC_mallocはその名のとおり、メモリ確保の関数です。後片付けはシステムが勝手にやってくれるので、freeする必要はありません（う〜ん、ラクチン）。


GC_malloc_atomicは内部にポインタを含まないデータ（文字列など）の確保を行うための関数です。GC_mallocで代用しても差し支えはありませんが、適切な場面でGC_malloc_atomicを利用することでGC発動時のパフォーマンスが向上します。


今回のサンプルコードでは、GC_mallocまたはGC_malloc_atomicによりメモリ確保が行われるときに無条件で_System_GC.sweepを呼び出しています（sweep = 掃除。マインスイーパーを連想してしまうf(^^;;;）。これが何を意味するかというと、メモリ確保毎に常にメモリの掃除が行われるのです。一般的には、未解放のメモリが1MBないし10MBたまったときなど、指定条件が出揃った段階で呼び出されるべきものですので、今回のサンプルはちょいと処理速度が遅いです。


．．． ヘ（；・_・）へ


では、ソースコードの見どころを解説していきましょう。


'グローバル領域をルートに指定してスキャン

scan(_System_gc_GlobalRoot_StartPtr,_System_gc_GlobalRoot_Size)
'ローカル領域をルートに指定してスキャン

Dim NowSp As LONG_PTR

NowSp=_System_GetSp()

scan(_System_gc_StackRoot_StartPtr,(_System_gc_StackRoot_StartPtr As LONG_PTR)-NowSp)


これは_System_CGarbageCollection.sweepメソッドにある、メモリ回収時のルート集合を指定している部分です。グローバル変数、ローカル変数をルートにもってきていることがわかります。下記の3つの変数と1つの関数は普通のコードを書いただけでは取得できないので、コンパイラに自動的に定義＆代入してもらうことにします。

  • _System_gc_GlobalRoot_StartPtr … グローバル変数がおかれるメモリの開始位置
  • _System_gc_GlobalRoot_Size … グローバル変数領域の大きさ（バイト単位）
  • _System_gc_StackRoot_StartPtr … スタックフレームの開始位置
  • _System_GetSp関数 … 現在のスタックポインタを取得する


次に、_System_CGarbageCollection.scanメソッドを見てみましょう。指定されたメモリ領域をスキャンし、GC_mallocで確保されたメモリを示すポインタが存在するかどうかをチェックしていきます。
scanメソッドは再帰的に呼び出され、ポインタが含まれる可能性のあるヒープ領域内もスキャンの対象になっている部分に注目しておくとよいでしょう。ポインタが含まれるかどうかはpbAtomic[index]を見分けることで判断できます。pbAtomicはGC_malloc/GC_malloc_atomicの違いをフラグで示しているといったほうが分かりやすいでしょうか。


    Sub scan(pStartPtr As *LONG_PTR, size As Long)

        Dim i As Long, count As Long, index As Long

        count=size/SizeOf(LONG_PTR)

        For i=0 To ELM(count)

            index=HitTest(pStartPtr[i])

            If index<>-1 Then

                If pbMark[index]=0 Then

                    pbMark[index]=1
                    If pbAtomic[index]=0 Then

                        'ヒープ領域がポインタ値を含む可能性があるとき

                        scan(ppPtr[index],pSize[index])

                    End If

                End If

            End If

        Next

    End Sub


あまり長ったらしくないソースコードで実現できたGCサンプル。今後は高速処理の徹底、マルチスレッド状況における動作検証などを行う必要がありそうです。


せっかくなので、ちょっとしたサンプルを作って遊んでみました。


Const MEGABYTE = 1024*1024

Const MAX_LOOP = 1000
Dim lpszBuffer As *Byte

Dim array_pTemp[1024] As LONG_PTR

Dim i As Long
For i=0 To MAX_LOOP

	lpszBuffer=malloc(MEGABYTE)

Next
Dim msg As String

msg=Ex"正常に終了しました。\r\n無駄に確保したメモリの総合サイズは "+Str$(MAX_LOOP/1000)+"GB です。"

MessageBox(0,msg,"GC Test",0)


1MBの無駄メモリを1000回確保するサンプルです。普通にmallocを使うとプロセスメモリはいっきに上がり、私の環境では10000回ループするとヒープ領域の許容範囲を超えてしまいました。


次に、GCを使ってメモリ確保を行ったサンプルを試してみます。


Const MEGABYTE = 1024*1024

Const MAX_LOOP = 1000
Dim lpszBuffer As *Byte

Dim array_pTemp[1024] As LONG_PTR

Dim i As Long
For i=0 To MAX_LOOP

	lpszBuffer=GC_malloc_atomic(MEGABYTE)

Next
Dim msg As String

msg=Ex"正常に終了しました。\r\n無駄に確保したメモリの総合サイズは "+Str$(MAX_LOOP/1000)+"GB です。"

MessageBox(0,msg,"GC Test",0)


無駄メモリの確保ということなので、GC_malloc_atomicを呼び出してみます。正確には計測しませんでしたが、やはりmallocと比べるとちょっと遅いです。まぁ、これは毎回のようにsweepしているのが原因なので、すぐに解消できそうです。
肝心な使用メモリの状況ですが、タスクマネージャで監視を行ったところ、常に平常値を保っておりました（素晴らしい！）。


このサンプルは、開発者向けの次回β版で早速動くようにしたいと思います。