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

/*
※これらの変数はコンパイラが自動的に定義します。
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
  • GC_malloc_atomic

まず、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しているのが原因なので、すぐに解消できそうです。

肝心な使用メモリの状況ですが、タスクマネージャで監視を行ったところ、常に平常値を保っておりました(素晴らしい!)。

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