Index: Include/system/DumpMemoryLeaks.ab =================================================================== --- Include/system/DumpMemoryLeaks.ab (revision 143) +++ (revision ) @@ -1,19 +1,0 @@ - -/* -メモリリーク検出を利用するには、下記の定数をソースコードの先頭でdefineする必要がある。 -#define CHECK_MEMORY_LEAKS -*/ - -Class _System_CheckMemoryLeaks -End Class - -'メモリが確保されたときに呼び出される -Sub _System_MemoryAllocate() -End Sub - -'メモリが開放されたときに呼び出される -Sub _System_MemoryDeallocate() -End Sub - -Sub DumpMemoryLeaks() -End Sub Index: Include/system/gc.sbp =================================================================== --- Include/system/gc.sbp (revision 143) +++ Include/system/gc.sbp (revision 144) @@ -18,14 +18,17 @@ Const _System_GC_FLAG_NEEDFREE = 2 Const _System_GC_FLAG_INITZERO = 4 +Const _System_GC_FLAG_OBJECT = 8 Const THREAD_GET_CONTEXT = &H0008 Class _System_CGarbageCollection - ppPtr As **VoidPtr + ppPtr As *VoidPtr pSize As *SIZE_T - pbFlags As *Byte + pdwFlags As *DWord n As Long iAllSize As SIZE_T + + isSweeping As Boolean CriticalSection As CRITICAL_SECTION @@ -33,20 +36,34 @@ 'メモリの上限値（この値を超えるとGCが発動します） '※バイト単位 - limitMemorySize = 1024*1024*30 As LONG_PTR + limitMemorySize As LONG_PTR + + isFinish As Boolean Public + + ' 特殊クラスのため、コンストラクタ・デストラクタは呼ばれません Sub _System_CGarbageCollection() + End Sub + Sub ~_System_CGarbageCollection() + End Sub + + Sub Begin() If ppPtr Then Exit Sub - ppPtr=HeapAlloc(_System_hProcessHeap,0,1) - pSize=HeapAlloc(_System_hProcessHeap,0,1) - pbFlags=HeapAlloc(_System_hProcessHeap,0,1) + isFinish = False + + 'メモリの上限値（この値を超えるとGCが発動します） + '※バイト単位 + limitMemorySize = 1024*1024 As LONG_PTR + + ppPtr=_System_calloc( 1 ) + pSize=_System_calloc( 1 ) + pdwFlags=_System_calloc( 1 ) n=0 iAllSize=0 - 'スレッド情報管理用オブジェクトを生成 - _System_pobj_AllThreads=_System_malloc(SizeOf(_System_CThreadCollection)+SizeOf(LONG_PTR)) - _System_pobj_AllThreads->_System_CThreadCollection() + ' スウィープ中かどうか + isSweeping = False 'クリティカルセッションを生成 @@ -63,32 +80,33 @@ hTargetThread, 0, FALSE, DUPLICATE_SAME_ACCESS) 'カレントスレッドのハンドルを複製 - - '自身のThreadオブジェクトを生成 - Dim obj_Thread As Thread(hTargetThread,GetCurrentThreadId(),0) - - _System_pobj_AllThreads->BeginThread(obj_Thread,_System_gc_StackRoot_StartPtr As *LONG_PTR) - End Sub - Sub ~_System_CGarbageCollection() + ' スレッド管理用オブジェクトを生成 + _System_pobj_AllThreads = New _System_CThreadCollection() + + ' 自身のThreadオブジェクトを生成 + Dim thread As Thread(hTargetThread,GetCurrentThreadId(),0) + + _System_pobj_AllThreads->BeginThread(VarPtr( thread ),_System_gc_StackRoot_StartPtr As *LONG_PTR) + + End Sub + Sub Finish() If ppPtr=0 Then Exit Sub -#ifdef _DLL - _destructor() -#else - '解放スレッドを生成 - Dim hThread As HANDLE - Dim ThreadId As DWord - hThread=_beginthreadex(NULL,0,AddressOf(DestructorThread),VarPtr(This),0,ThreadId) - CloseHandle(hThread) - Sleep( INFINITE ) -#endif - - End Sub - -Private - Sub _destructor() - Dim i As Long - For i=0 To ELM(n) - If ppPtr[i] Then HeapFree(_System_hProcessHeap,0,ppPtr[i]) - Next + isFinish = True + + ' スレッド管理用オブジェクトを破棄 + Delete _System_pobj_AllThreads + + ' 自分以外のスレッドを一時停止 + '_System_pobj_AllThreads->SuspendAnotherThread() + + OutputDebugString( Ex"garbage colletion sweeping all memory objects!\r\n" ) + DeleteAllGarbageMemories() + + ' 未解放のメモリオブジェクトをトレース + DumpMemoryLeaks() + + ' 自分以外のスレッドを再開 + '_System_pobj_AllThreads->ResumeAnotherThread() + HeapFree(_System_hProcessHeap,0,ppPtr) ppPtr=0 @@ -96,51 +114,25 @@ HeapFree(_System_hProcessHeap,0,pSize) pSize=0 - HeapFree(_System_hProcessHeap,0,pbFlags) - pbFlags=0 - - 'スレッド情報管理用オブジェクトを破棄 - _System_pobj_AllThreads->Finalize() - _System_free(_System_pobj_AllThreads) - _System_pobj_AllThreads=0 + HeapFree(_System_hProcessHeap,0,pdwFlags) + pdwFlags=0 'クリティカルセッションを破棄 DeleteCriticalSection(CriticalSection) - End Sub - Function Cdecl DestructorThread() As Long - '------------------------------------- - ' すべてのスレッドを一時停止 - '------------------------------------- - _System_pobj_AllThreads->SuspendAllThread() - - _destructor() - - 'プロセスを終了 - ExitProcess(0) - End Function -Public - - - - Sub add(new_ptr As VoidPtr, size As SIZE_T,flags As Byte) + + End Sub + + Sub add(new_ptr As VoidPtr, size As SIZE_T,flags As DWord) iAllSize+=size - Dim i As Long - For i=0 To ELM(n) - If ppPtr[i]=0 Then - ppPtr[i]=new_ptr - pSize[i]=size - pbFlags[i]=flags - Exit Sub - End If - Next - - ppPtr=HeapReAlloc(_System_hProcessHeap,0,ppPtr,(n+1)*SizeOf(VoidPtr)) - ppPtr[n]=new_ptr - - pSize=HeapReAlloc(_System_hProcessHeap,0,pSize,(n+1)*SizeOf(SIZE_T)) - pSize[n]=size - - pbFlags=HeapReAlloc(_System_hProcessHeap,0,pbFlags,(n+1)*SizeOf(Byte)) - pbFlags[n]=flags + EnterCriticalSection(CriticalSection) + ppPtr=HeapReAlloc(_System_hProcessHeap,0,ppPtr,(n+1)*SizeOf(VoidPtr)) + ppPtr[n]=new_ptr + + pSize=HeapReAlloc(_System_hProcessHeap,0,pSize,(n+1)*SizeOf(SIZE_T)) + pSize[n]=size + + pdwFlags=HeapReAlloc(_System_hProcessHeap,0,pdwFlags,(n+1)*SizeOf(DWord)) + pdwFlags[n]=flags + LeaveCriticalSection(CriticalSection) n++ @@ -157,10 +149,9 @@ End If - - Dim pTemp As VoidPtr - pTemp=HeapAlloc(_System_hProcessHeap,dwFlags,size) - add(pTemp,size,flags) + Dim ptr = HeapAlloc(_System_hProcessHeap,dwFlags,size) + add( ptr, size, flags ) LeaveCriticalSection(CriticalSection) - Return pTemp + + Return ptr End Function @@ -183,10 +174,10 @@ End Function - Sub __free(lpMem As VoidPtr) + Sub __free_ex(lpMem As VoidPtr, isSweeping As Boolean) EnterCriticalSection(CriticalSection) Dim i As Long For i=0 To ELM(n) If ppPtr[i]=lpMem Then - If pbFlags[i] and _System_GC_FLAG_NEEDFREE Then + If (pdwFlags[i] and _System_GC_FLAG_NEEDFREE)<>0 or isSweeping Then iAllSize-=pSize[i] @@ -195,5 +186,7 @@ pSize[i]=0 Else - OutputDebugString(Ex"GCが管理しているメモリ空間を解放しようとしました。\r\n") + If isFinish = False Then + OutputDebugString( Ex"heap free missing!\r\n" ) + End If End If End If @@ -202,7 +195,10 @@ End Sub + Sub __free(lpMem As VoidPtr) + __free_ex( lpMem, False ) + End Sub + Sub sweep() EnterCriticalSection(CriticalSection) - If iAllSizeSuspendAllThread() - - - 'マークリストを生成 - pbMark=HeapAlloc(_System_hProcessHeap,HEAP_ZERO_MEMORY,n*SizeOf(Byte)) - - - '----------------------------------------------- - ' グローバル領域をルートに指定してスキャン - '----------------------------------------------- - scan(_System_gc_GlobalRoot_StartPtr,_System_gc_GlobalRoot_Size) - - '----------------------------------------------- - 'ローカル領域をルートに指定してスキャン - '----------------------------------------------- +Private + + ' 生存検知 + 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_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) + index=HitTest(pStartPtr[i] As VoidPtr) + If index<>-1 Then + If pbMark[index]=0 Then + pbMark[index]=1 + + If (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) + End If + End If + End If + Next + End Sub + + ' ローカル領域をルートに指定してスキャン + Sub LocalScan( pbMark As *Byte ) Dim Context As CONTEXT Dim NowSp As *LONG_PTR @@ -260,22 +275,103 @@ size=(_System_pobj_AllThreads->pStackBase[i] As LONG_PTR)-(NowSp As LONG_PTR) - scan(NowSp,size) - End If - Next - - - Dim iBackAllSize As SIZE_T - iBackAllSize=iAllSize - - '使われていないメモリを解放する + If NowSp = 0 Then + debug + Exit Sub + End If + + Scan( NowSp, size, pbMark ) + End If + Next + End Sub + + Sub DeleteGarbageMemories( pbMark As *Byte ) + + Dim isAllDelete = False + If pbMark = NULL Then + ' すべてを破棄するとき + isAllDelete = True + pbMark = _System_calloc( n ) + End If + + Dim i As Long For i=0 To ELM(n) - If pbMark[i]=0 and ppPtr[i]<>0 and (pbFlags[i] and _System_GC_FLAG_NEEDFREE)=0 Then - iAllSize-=pSize[i] - - HeapFree(_System_hProcessHeap,0,ppPtr[i]) + If pbMark[i]=0 and ppPtr[i]<>0 and (pdwFlags[i] and _System_GC_FLAG_NEEDFREE)=0 Then + If ppPtr[i] = 0 Then + If isAllDelete Then + Continue + Else + debug + End If + End If + + Dim ptr = ppPtr[i] + Dim size = pSize[i] + ppPtr[i]=0 pSize[i]=0 - End If - Next + + If (pdwFlags[i] and _System_GC_FLAG_OBJECT) <> 0 Then + /* ・オブジェクトの個数 + ・オブジェクトのサイズ + ・デストラクタの関数ポインタ + を考慮 */ + _System_SweepingDelete (ptr + SizeOf( LONG_PTR ) * 3 ) + Else + iAllSize-=size + HeapFree(_System_hProcessHeap,0,ptr) + End If + End If + Next + + If isAllDelete Then + _System_free( pbMark ) + End If + + End Sub + + Sub DeleteAllGarbageMemories() + DeleteGarbageMemories( NULL ) + End Sub + + Sub Compaction() + Dim i As Long, i2 = 0 As Long + For i=0 To ELM(n) + ppPtr[i2] = ppPtr[i] + pSize[i2] = pSize[i] + pdwFlags[i2] = pdwFlags[i] + + If ppPtr[i] Then + i2++ + End If + Next + n = i2 + End Sub + + ' スウィープ（新規スレッドで呼び出し） + Function Cdecl SweepOnOtherThread() As Long + + ' すべてのスレッドを一時停止 + _System_pobj_AllThreads->SuspendAllThread() + + ' マークリストを生成 + Dim pbMark = HeapAlloc(_System_hProcessHeap,HEAP_ZERO_MEMORY,n*SizeOf(Byte)) As *Byte + + ' グローバル領域をルートに指定してスキャン + Scan( _System_gc_GlobalRoot_StartPtr, _System_gc_GlobalRoot_Size, pbMark ) + + ' ローカル領域をルートに指定してスキャン + LocalScan( pbMark ) + + ' スウィープ前のメモリサイズを退避 + Dim iBackAllSize = iAllSize + + ' スウィープ前のメモリオブジェクトの数 + Dim iBeforeN = n + + '使われていないメモリを解放する + DeleteGarbageMemories(pbMark) + + 'コンパクション + Compaction() 'マークリストを解放 @@ -283,7 +379,20 @@ If iBackAllSize=iAllSize Then + If iAllSize > limitMemorySize Then + limitMemorySize = iAllSize + End If + '許容量を拡張する - limitMemorySize*=2 + limitMemorySize *= 2 + + OutputDebugString( Ex"memory size is extended for gc!\r\n" ) End If + + Dim temp[100] As Char + wsprintf(temp,Ex"object items ... %d -> %d ( %dMB -> %dMB )\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" ) @@ -294,40 +403,34 @@ End Function - -Private - - pbMark As *Byte - - Function HitTest(pSample As VoidPtr) As Long + ' 未解放のメモリオブジェクトをトレース + Sub DumpMemoryLeaks() + Dim isLeak = False 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_PTR) - Dim i As Long, count As Long, index As Long - count=(size\SizeOf(LONG_PTR)) As Long - For i=0 To ELM(count) - index=HitTest(pStartPtr[i] As VoidPtr) - If index<>-1 Then - If pbMark[index]=0 Then - pbMark[index]=1 - - If (pbFlags[index] and _System_GC_FLAG_ATOMIC)=0 Then - 'ヒープ領域がポインタ値を含む可能性があるとき - scan(ppPtr[index] As *LONG_PTR,pSize[index]) + If ppPtr[i] Then + If (pdwFlags[i] and _System_GC_FLAG_NEEDFREE)<>0 Then + If isLeak = False Then + OutputDebugString( Ex"Detected memory leaks!\r\n" ) + isLeak = True End If - End If - End If - Next - End Sub + + Dim temp[100] As Char + OutputDebugString( Ex"heap free missing!\r\n" ) + wsprintf(temp,Ex"{%d} normal block at &H%08X, %d bytes long.\r\n", i, ppPtr[i], pSize[i]) + OutputDebugString( temp ) + End If + End If + Next + + If isLeak Then + OutputDebugString( Ex"Object dump complete.\r\n" ) + End If + + End Sub + End Class 'GC管理用の特殊なシステムオブジェクト（デストラクタは最終のタイミングで呼び出されます） -Dim _System_GC As _System_CGarbageCollection +Dim _System_pGC As *_System_CGarbageCollection @@ -335,15 +438,36 @@ Function GC_malloc(size As Long) As VoidPtr ' sweep - _System_GC.sweep() + _System_pGC->sweep() 'allocate - Return _System_GC.__malloc(size,0) + Return _System_pGC->__malloc(size,0) End Function Function GC_malloc_atomic(size As Long) As VoidPtr ' sweep - _System_GC.sweep() + _System_pGC->sweep() 'allocate - Return _System_GC.__malloc(size,_System_GC_FLAG_ATOMIC) -End Function + Return _System_pGC->__malloc(size,_System_GC_FLAG_ATOMIC) +End Function + +Function _System_GC_malloc_ForObject(size As Long) As VoidPtr + ' sweep + _System_pGC->sweep() + + 'allocate + Return _System_pGC->__malloc(size,_System_GC_FLAG_OBJECT or _System_GC_FLAG_INITZERO) +End Function + +Function _System_GC_malloc_ForObjectPtr(size As Long) As VoidPtr + ' sweep + _System_pGC->sweep() + + 'allocate + Return _System_pGC->__malloc(size,_System_GC_FLAG_OBJECT or _System_GC_FLAG_INITZERO or _System_GC_FLAG_NEEDFREE) +End Function + +Function _System_GC_free_for_SweepingDelete( ptr As *Object ) + ' free + _System_pGC->__free_ex( ptr, True ) +End Function