/*!
	@brief	このファイルでは、ABのガベージコレクションの実装を行います。
*/


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

Const _System_GC_FLAG_ATOMIC = 1
Const _System_GC_FLAG_NEEDFREE = 2
Const _System_GC_FLAG_INITZERO = 4
Const _System_GC_FLAG_OBJECT = 8

Type _System_GlobalRoot
	ptr As *LONG_PTR
	count As Long
End Type

Type _System_MemoryObject
	ptr As VoidPtr
	size As SIZE_T
	flags As DWord
	generationCount As Long
End Type

Class _System_CGarbageCollection

	hHeap As HANDLE								' GC用のヒープ

	pMemoryObjects As *_System_MemoryObject		' メモリオブジェクト
	countOfMemoryObjects As Long				' 管理するメモリオブジェクトの個数

	iAllSize As SIZE_T

	isSweeping As Boolean	' スウィープ中かどうか

	minPtr As ULONG_PTR
	maxPtr As ULONG_PTR

	' クリティカルセクション
	CriticalSection As CRITICAL_SECTION

	' メモリの上限値（この値を超えるとGCが発動します）
	limitMemorySize As LONG_PTR		' バイト単位
	limitMemoryObjectNum As Long	' メモリオブジェクトの個数単位

	isFinish As Boolean		' GC管理が終了したかどうか


	' Global Root
	pGlobalRoots As *_System_GlobalRoot
	globalRootNum As Long
	Sub AddGlobalRootPtr( ptr As *LONG_PTR, count As Long )
		pGlobalRoots = _System_realloc( pGlobalRoots, (globalRootNum + 1) * SizeOf(_System_GlobalRoot) )
		pGlobalRoots[globalRootNum].ptr = ptr
		pGlobalRoots[globalRootNum].count = count
		globalRootNum++
	End Sub

	Sub RegisterGlobalRoots()
		' このメソッドの実装はコンパイラが自動生成する

		' AddGlobalRootPtr(...)
		' ...
	End Sub

	' 特殊クラスのため、コンストラクタ・デストラクタは呼ばれません
	Sub _System_CGarbageCollection()
	End Sub
	Sub ~_System_CGarbageCollection()
	End Sub

Public

	/*!
	@brief	環境変数にGCを登録する
	@author	Daisuke Yamamoto
	@date	2007/10/21
	*/
	Static Sub Initialize()
		Dim temporary[255] As Char
		If GetEnvironmentVariable( "ActiveBasicGarbageCollection", temporary, 255 ) Then
			' 既にGCがプロセスに存在するとき
			_stscanf( temporary, "%08x", VarPtr( _System_pGC ) )
			MessageBox(0,temporary,"GetEnvironmentVariable",0)
		Else
			_System_pGC = _System_calloc( SizeOf( _System_CGarbageCollection ) )
			_System_pGC->Begin()

			' GCをプロセスに登録する
			_stprintf( temporary, "%08x", _System_pGC )
			SetEnvironmentVariable( "ActiveBasicGarbageCollection", temporary )
		End If
	End Sub

	/*!
	@brief	メモリサイズの上限を指定する
	@param	limitMemorySize メモリサイズの上限（単位はバイト）
			limitMemoryObjectNum メモリ個数の上限
	@author	Daisuke Yamamoto
	@date	2007/10/21
	*/
	Sub SetLimit( limitMemorySize As LONG_PTR, limitMemoryObjectNum As Long )
		This.limitMemorySize = limitMemorySize
		This.limitMemoryObjectNum = limitMemoryObjectNum
	End Sub

	/*!
	@brief	初期化
	@author	Daisuke Yamamoto
	@date	2007/10/21
	*/
	Sub Begin()
		If pMemoryObjects Then Exit Sub

		isFinish = False

		'メモリの上限値（この値を超えるとGCが発動します）
		SetLimit(
			1024*1024,	' バイト単位
			2000		' メモリオブジェクトの個数単位
		)

		hHeap = HeapCreate( 0, 0, 0 )

		pMemoryObjects = _System_calloc( 1 )
		countOfMemoryObjects=0

		' Global Root
		pGlobalRoots = _System_calloc( 1 )
		globalRootNum = 0
		RegisterGlobalRoots()

		iAllSize=0

		' スウィープ中かどうか
		isSweeping = False

		minPtr = &HFFFFFFFFFFFFFFFF As ULONG_PTR
		maxPtr = 0

		'クリティカルセッションを生成
		InitializeCriticalSection(CriticalSection)


		'---------------------------
		' 開始時のスレッドを通知
		'---------------------------
		Dim hTargetThread As HANDLE
		DuplicateHandle(GetCurrentProcess(),
			GetCurrentThread(),
			GetCurrentProcess(),
			hTargetThread, 0, FALSE, DUPLICATE_SAME_ACCESS)		'カレントスレッドのハンドルを複製

		' スレッド管理用オブジェクトを生成
		_System_pobj_AllThreads = New System.Threading.Detail._System_CThreadCollection()

		' 自身のThreadオブジェクトを生成
		Dim thread = New System.Threading.Thread(hTargetThread, GetCurrentThreadId(), 0)
		thread.Name = "main"

		_System_pobj_AllThreads->BeginThread(thread, _System_gc_StackRoot_StartPtr As *LONG_PTR)

	End Sub

	/*!
	@brief	終了処理
	@author	Daisuke Yamamoto
	@date	2007/10/21
	*/
	Sub Finish()
		If pMemoryObjects = NULL Then Exit Sub

		isFinish = True

		' スレッド管理用オブジェクトを破棄
		Delete _System_pobj_AllThreads

		' 自分以外のスレッドを一時停止
		'_System_pobj_AllThreads->SuspendAnotherThread()

		_System_DebugOnly_OutputDebugString( Ex"garbage colletion sweeping all memory objects!\r\n" )
		DeleteAllGarbageMemories()

		' 未解放のメモリオブジェクトをトレース
		DumpMemoryLeaks()

		' 自分以外のスレッドを再開
		'_System_pobj_AllThreads->ResumeAnotherThread()

		_System_free( pMemoryObjects )
		pMemoryObjects = NULL

		_System_free( pGlobalRoots )
		pGlobalRoots = NULL

		'クリティカルセッションを破棄
		DeleteCriticalSection(CriticalSection)

	End Sub

	/*!
	@brief	メモリオブジェクトからインデックスを取得する
	@param	new_ptr メモリオブジェクトへのポインタ
	@author	Daisuke Yamamoto
	@date	2007/10/21
	*/
	Function GetMemoryObjectPtr( ptr As VoidPtr ) As *_System_MemoryObject
		' メモリオブジェクトの先頭部分からインデックスを取得する
		Dim index = Get_LONG_PTR( ptr - SizeOf(LONG_PTR) ) As Long

		If pMemoryObjects[index].ptr <> ptr Then
			' メモリイメージが壊れている（先頭に存在するインデックスの整合性が取れない）
			Dim temporary[1024] As Char
#ifdef _WIN64
			'wsprintfでは、Windows 2000以降でしか%pが使えない。
			wsprintf( temporary, Ex"indexOfMemoryObjects: %d\r\npMemoryObjects[index].ptr: &H%p\r\nptr: &H%p\r\n",
				index,
				pMemoryObjects[index].ptr,
				ptr )
#else
			wsprintf( temporary, Ex"indexOfMemoryObjects: %d\r\npMemoryObjects[index].ptr: &H%08x\r\nptr: &H%08x\r\n",
				index,
				pMemoryObjects[index].ptr,
				ptr )
#endif
			_System_DebugOnly_OutputDebugString( temporary )
			debug
		End If

		Return VarPtr( pMemoryObjects[index] )
	End Function

	/*!
	@brief	メモリオブジェクトを追加する
	@param	new_ptr メモリオブジェクトへのポインタ
			size メモリオブジェクトのサイズ
			flags メモリオブジェクトの属性
	@author	Daisuke Yamamoto
	@date	2007/10/21
	*/
	Sub add(new_ptr As VoidPtr, size As SIZE_T, flags As DWord)
		EnterCriticalSection(CriticalSection)
			iAllSize+=size

			' メモリオブジェクトインスタンスの先頭にインデックスをセットする
			Set_LONG_PTR( new_ptr - SizeOf( LONG_PTR ), countOfMemoryObjects )

			pMemoryObjects = _System_realloc( pMemoryObjects, (countOfMemoryObjects+1)*SizeOf(_System_MemoryObject) )
			pMemoryObjects[countOfMemoryObjects].ptr = new_ptr
			pMemoryObjects[countOfMemoryObjects].size = size
			pMemoryObjects[countOfMemoryObjects].flags = flags
			pMemoryObjects[countOfMemoryObjects].generationCount = 0

			If minPtr > new_ptr As ULONG_PTR Then
				minPtr = new_ptr As ULONG_PTR
			End If
			If maxPtr < ( new_ptr + size ) As ULONG_PTR Then
				maxPtr = ( new_ptr + size ) As ULONG_PTR
			End If

			countOfMemoryObjects++
		LeaveCriticalSection(CriticalSection)

		/*
		' デバッグ用
		If countOfMemoryObjects = 1996 Then
			debug
		End If
		*/
	End Sub


	/*!
	@brief	メモリオブジェクトを確保する
	@param	size メモリオブジェクトのサイズ
			flags メモリオブジェクトの属性
	@author	Daisuke Yamamoto
	@date	2007/10/21
	*/
	Function __malloc(size As SIZE_T,flags As Byte) As VoidPtr
		Dim dwFlags As DWord
		If flags and _System_GC_FLAG_INITZERO Then
			dwFlags=HEAP_ZERO_MEMORY
		Else
			dwFlags=0
		End If

		' 実際のメモリバッファはインデックスの分だけ多めに確保する
		__malloc = HeapAlloc( hHeap, dwFlags, size + SizeOf( LONG_PTR ) )
		throwIfAllocationFailed( __malloc, size )
		__malloc += SizeOf( LONG_PTR )

		' 管理対象のメモリオブジェクトとして追加
		add( __malloc, size, flags )
	End Function

	/*!
	@brief	メモリオブジェクトを再確保する
	@param	lpMem メモリオブジェクトへのポインタ
			size メモリオブジェクトのサイズ
			flags メモリオブジェクトの属性
	@author	Daisuke Yamamoto
	@date	2007/10/21
	*/
	Function __realloc(lpMem As VoidPtr, size As SIZE_T) As VoidPtr
		EnterCriticalSection(CriticalSection)

			' メモリオブジェクトを取得
			Dim pTempMemoryObject = GetMemoryObjectPtr( lpMem )

			iAllSize += size - pTempMemoryObject->size

			pTempMemoryObject->size = size
			__realloc = HeapReAlloc( hHeap, HEAP_ZERO_MEMORY, pTempMemoryObject->ptr - SizeOf(LONG_PTR), size + SizeOf(LONG_PTR) )
			If __realloc = 0 Then
				LeaveCriticalSection(CriticalSection)
				throwIfAllocationFailed(0, size)
			End If
			__realloc += SizeOf(LONG_PTR)
			pTempMemoryObject->ptr = __realloc


			If minPtr > pTempMemoryObject->ptr As ULONG_PTR Then
				minPtr = pTempMemoryObject->ptr As ULONG_PTR
			End If
			If maxPtr < ( pTempMemoryObject->ptr + size ) As ULONG_PTR Then
				maxPtr = ( pTempMemoryObject->ptr + size ) As ULONG_PTR
			End If
		LeaveCriticalSection(CriticalSection)
	End Function

	/*!
	@brief	メモリ確保に失敗したか（NULLかどうか）を調べ、失敗していたら例外を投げる。
	@param[in] p メモリへのポインタ
	@param[in] size 確保しようとした大きさ
	@exception OutOfMemoryException pがNULLだったとき
	@author	Egtra
	@date	2007/12/24
	ただし、sizeがあまりにも小さい場合は、例外を投げず、即座に終了する。
	*/
	Sub throwIfAllocationFailed(p As VoidPtr, size As SIZE_T)
		If p = 0 Then
			If size < 256 Then
				/*
				　これだけのメモリも確保できない状況では、OutOfMemoryException
				のインスタンスすら作成できないかもしれないし、例え作成できても、
				その後、結局メモリ不足でろくなことを行えないはず。そのため、
				ここですぐに終了することにする。
				　なお、この値は特に根拠があって定められた値ではない。
				*/
				HeapDestroy(hHeap)
				OutputDebugString("AB malloc: Out of memory.")
				ExitProcess(-1)
			End If
			Dim s2 = Nothing As Object '#145
			s2 = New System.UInt64(size)
			Throw New System.OutOfMemoryException(ActiveBasic.Strings.SPrintf("malloc: Failed to allocate %zu (%&zx) byte(s) memory.", s2, s2))
		End If
	End Sub

	/*!
	@brief	メモリオブジェクトを解放する
	@param	lpMem メモリオブジェクトへのポインタ
			isSweeping スウィープ中にこのメソッドが呼ばれるときはTrue、それ以外はFalse
	@author	Daisuke Yamamoto
	@date	2007/10/21
	*/
	Sub __free_ex(lpMem As VoidPtr, isSweeping As Boolean)
		EnterCriticalSection(CriticalSection)

			' メモリオブジェクトを取得
			Dim pTempMemoryObject = GetMemoryObjectPtr( lpMem )

			If (pTempMemoryObject->flags and _System_GC_FLAG_NEEDFREE)<>0 or isSweeping Then
				iAllSize -= pTempMemoryObject->size

				HeapFree( hHeap, 0, pTempMemoryObject->ptr - SizeOf(LONG_PTR) )
				pTempMemoryObject->ptr = NULL
				pTempMemoryObject->size = 0
			Else
				If isFinish = False Then
					_System_DebugOnly_OutputDebugString( Ex"heap free missing!\r\n" )
				End If
			End If
		LeaveCriticalSection(CriticalSection)
	End Sub

	/*!
	@brief	メモリオブジェクトを解放する
	@param	lpMem メモリオブジェクトへのポインタ
	@author	Daisuke Yamamoto
	@date	2007/10/21
	*/
	Sub __free(lpMem As VoidPtr)
		__free_ex( lpMem, False )
	End Sub

	/*!
	@brief	必要であればスウィープする
	@author	Daisuke Yamamoto
	@date	2007/10/21
	*/
	Sub TrySweep()
		If isSweeping <> False or (iAllSize<limitMemorySize and countOfMemoryObjects<limitMemoryObjectNum) Then
			'メモリ使用量が上限値を超えていないとき
			Exit Sub
		End If

		Sweep()
	End Sub

	/*!
	@brief	スウィープする
	@author	Daisuke Yamamoto
	@date	2007/10/21
	*/
	Sub Sweep()
		Dim hThread As HANDLE
		Dim ThreadId As DWord
		hThread=_beginthreadex(NULL,0,AddressOf(SweepOnOtherThread),VarPtr(This),0,ThreadId)
		WaitForSingleObject(hThread,INFINITE)
		CloseHandle(hThread)
		isSweeping = False
	End Sub

Private

	Static Function IsNull( object As Object ) As Boolean
		Return Object.ReferenceEquals(object, Nothing)
	End Function

	/*!
	@brief	メモリオブジェクトの生存検地
	@param	pSample メモリオブジェクトへのポインタ
	@author	Daisuke Yamamoto
	@date	2007/10/21
	*/
	Function HitTest(pSample As VoidPtr) As Long
		If pSample = NULL Then
			Return -1
		End If
		If not( minPtr <= pSample and pSample <= maxPtr ) Then
			Return -1
		End If

		Dim i As Long
		For i=0 To ELM(countOfMemoryObjects)
			If (pMemoryObjects[i].ptr As LONG_PTR)<=(pSample As LONG_PTR) and (pSample As LONG_PTR)<=((pMemoryObjects[i].ptr As LONG_PTR)+pMemoryObjects[i].size) Then
				Return i
			End If
		Next
		Return -1
	End Function

	/*!
	@brief	オブジェクトのスキャン
	@param	pObject オブジェクトへのポインタ
			pbMark マークリスト
	@author	Daisuke Yamamoto
	@date	2007/10/21
	*/
	Function ScanObject( classTypeInfo As ActiveBasic.Core._System_TypeForClass, pObject As *Object, pbMark As *Byte) As Boolean
		If IsNull( classTypeInfo ) Then
			Return False
		End If

		' 基底クラスをスキャン
		If Not IsNull( classTypeInfo.BaseType ) Then
			Dim baseClassTypeInfo = Nothing As ActiveBasic.Core._System_TypeForClass
			baseClassTypeInfo = classTypeInfo.BaseType As ActiveBasic.Core._System_TypeForClass
			ScanObject( baseClassTypeInfo, pObject, pbMark )
		End If

		/*
		_System_DebugOnly_OutputDebugString( "  (scanning object)" )
		_System_DebugOnly_OutputDebugString( classTypeInfo.Name )
		_System_DebugOnly_OutputDebugString( Ex"\r\n" )
		*/

		Dim i As Long
		For i = 0 To ELM(classTypeInfo.numOfReference)
			Scan( (pObject + classTypeInfo.referenceOffsets[i]) As *LONG_PTR, 1, pbMark )
		Next

		Return True
	End Function
	Function ScanObject(pObject As *Object, pbMark As *Byte) As Boolean
		Dim classTypeInfo = Nothing As ActiveBasic.Core._System_TypeForClass
		classTypeInfo = pObject->GetType() As ActiveBasic.Core._System_TypeForClass

		If Object.ReferenceEquals( classTypeInfo, ActiveBasic.Core._System_TypeBase.selfTypeInfo ) Then
			' TypeInfoクラスの場合はTypeBaseImplクラスとして扱う
			classTypeInfo = _System_TypeBase_Search( "ActiveBasic.Core.TypeBaseImpl" ) As ActiveBasic.Core._System_TypeForClass
		End If

		Return ScanObject( classTypeInfo, pObject, pbMark )
	End Function

	/*!
	@brief	メモリオブジェクトのスキャン
	@param	pStartPtr メモリオブジェクトへのポインタ
			maxNum スキャンするメモリオブジェクトの個数
			pbMark マークリスト
	@author	Daisuke Yamamoto
	@date	2007/10/21
	*/
	Sub Scan(pStartPtr As *LONG_PTR, maxNum As Long, pbMark As *Byte)
		Dim i As Long, index As Long

		For i=0 To ELM(maxNum)
			index=HitTest(pStartPtr[i] As VoidPtr)
			If index<>-1 Then
				If pbMark[index]=0 Then
					pbMark[index]=1

					' ジェネレーションカウントを増やす
					pMemoryObjects[index].generationCount ++

					If pMemoryObjects[index].flags and _System_GC_FLAG_OBJECT Then
						' オブジェクトの場合
						If ScanObject( (pMemoryObjects[index].ptr + 4*SizeOf(LONG_PTR)) As *Object, pbMark) = False Then
							Dim maxNum = (pMemoryObjects[index].size\SizeOf(LONG_PTR)) As Long
							Scan(pMemoryObjects[index].ptr As *LONG_PTR, maxNum, pbMark)
						End If

					ElseIf (pMemoryObjects[index].flags and _System_GC_FLAG_ATOMIC)=0 Then
						' ヒープ領域がポインタ値を含む可能性があるとき
						If pMemoryObjects[index].ptr = NULL Then
							'エラー

						End If

						Dim maxNum = (pMemoryObjects[index].size\SizeOf(LONG_PTR)) As Long
						Scan(pMemoryObjects[index].ptr As *LONG_PTR, maxNum, pbMark)
					End If
				End If
			End If
		Next
	End Sub

	/*!
	@brief	グローバル領域をルートに指定してスキャン
	@param	pbMark マークリスト
	@author	Daisuke Yamamoto
	@date	2007/10/21
	*/
	Sub GlobalScan( pbMark As *Byte )
		Dim i As Long
		For i = 0 To ELM( globalRootNum )
			Scan( pGlobalRoots[i].ptr, pGlobalRoots[i].count, pbMark )
		Next
	End Sub

	/*!
	@brief	ローカル領域をルートに指定してスキャン
	@param	pbMark マークリスト
	@author	Daisuke Yamamoto
	@date	2007/10/21
	*/
	Sub LocalScan( pbMark As *Byte )
		Dim Context As CONTEXT
		Dim NowSp As *LONG_PTR
		Dim size As LONG_PTR
		Dim i As Long
		For i=0 To ELM(_System_pobj_AllThreads->ThreadNum)
			Dim thread = _System_pobj_AllThreads->collection[i].thread
			If Not ActiveBasic.IsNothing(thread) Then
				FillMemory(VarPtr(Context),SizeOf(CONTEXT),0)
				Context.ContextFlags=CONTEXT_CONTROL
				If thread.__GetContext(Context)=0 Then
					_System_DebugOnly_OutputDebugString(Ex"レジスタ情報の取得に失敗しました。\r\n")
				End If

#ifdef _WIN64
				NowSp=Context.Rsp As *LONG_PTR
#else
				NowSp=Context.Esp As *LONG_PTR
#endif

				Dim size=(_System_pobj_AllThreads->collection[i].stackBase As LONG_PTR)-(NowSp As LONG_PTR)
				Dim maxNum = (size\SizeOf(LONG_PTR)) As Long

				If NowSp = 0 Then
					debug
					Exit Sub
				End If

				/*
				_System_DebugOnly_OutputDebugString( "(scanning thread local)" )
				_System_DebugOnly_OutputDebugString( thread.Name )
				_System_DebugOnly_OutputDebugString( Ex"\r\n" )
				*/

				Scan( NowSp, maxNum, pbMark )
			End If
		Next
	End Sub

	/*!
	@brief	生存していないメモリオブジェクトを解放する
	@param	pbMark マークリスト
	@author	Daisuke Yamamoto
	@date	2007/10/21
	*/
	Sub DeleteGarbageMemories( pbMark As *Byte )

		Dim isAllDelete = False
		If pbMark = NULL Then
			' すべてを破棄するとき
			isAllDelete = True
			pbMark = _System_calloc( countOfMemoryObjects )
		End If

		Dim i As Long
		For i=0 To ELM(countOfMemoryObjects)
			If pbMark[i]=0 and pMemoryObjects[i].ptr<>0 and (pMemoryObjects[i].flags and _System_GC_FLAG_NEEDFREE)=0 Then
				If pMemoryObjects[i].ptr = NULL Then
					If isAllDelete Then
						Continue
					Else
						debug
					End If
				End If

				Dim ptr = pMemoryObjects[i].ptr
				Dim size = pMemoryObjects[i].size

				If (pMemoryObjects[i].flags and _System_GC_FLAG_OBJECT) <> 0 Then
					/*	・オブジェクトの個数
						・オブジェクトのサイズ
						・デストラクタの関数ポインタ
						・リザーブ領域
						を考慮	*/
					_System_SweepingDelete (ptr + SizeOf( LONG_PTR ) * 4 )
				Else
					__free_ex( ptr, True )
				End If
			End If
		Next

		If isAllDelete Then
			_System_free( pbMark )
		End If

	End Sub

	/*!
	@brief	GCが管理するすべてのメモリオブジェクトを解放する
	@author	Daisuke Yamamoto
	@date	2007/10/21
	*/
	Sub DeleteAllGarbageMemories()
		DeleteGarbageMemories( NULL )
	End Sub

	/*!
	@brief	コンパクション
	@author	Daisuke Yamamoto
	@date	2007/10/21
	*/
	Sub Compaction()
		Dim i As Long, i2 = 0 As Long
		For i=0 To ELM(countOfMemoryObjects)
			pMemoryObjects[i2] = pMemoryObjects[i]

			If pMemoryObjects[i2].ptr Then
				' メモリオブジェクトの先頭部分にあるインデックスを書き換える
				Set_LONG_PTR( pMemoryObjects[i2].ptr - SizeOf(LONG_PTR), i2 )

				i2++
			End If
		Next
		countOfMemoryObjects = i2
	End Sub

	/*!
	@brief	スウィープ（新規スレッドで呼び出す必要あり）
	@author	Daisuke Yamamoto
	@date	2007/10/21
	*/
	Function SweepOnOtherThread() As Long
		Imports System.Threading.Detail
		EnterCriticalSection(CriticalSection)

		Dim startTime = GetTickCount()

		_System_DebugOnly_OutputDebugString( Ex"garbage colletion sweep start!\r\n" )


		'If isSweeping <> False or (iAllSize<limitMemorySize and countOfMemoryObjects<limitMemoryObjectNum) Then
		'	ExitThread(0)
		'End If
		isSweeping = True

		' すべてのスレッドを一時停止
		_System_pobj_AllThreads->SuspendAllThread()

		' マークリストを生成
		Dim pbMark = _System_calloc(countOfMemoryObjects*SizeOf(Byte)) As *Byte

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

		' ローカル領域をルートに指定してスキャン
		LocalScan( pbMark )

		' スウィープ前のメモリサイズを退避
		Dim iBackAllSize = iAllSize

		' スウィープ前のメモリオブジェクトの数
		Dim iBeforeN = countOfMemoryObjects

		'使われていないメモリを解放する
		DeleteGarbageMemories(pbMark)

		'コンパクション
		Compaction()

		'マークリストを解放
		_System_free(pbMark)

		If iBackAllSize <= iAllSize * 2 Then
			If iAllSize > limitMemorySize Then
				limitMemorySize = iAllSize
			End If

			'許容量を拡張する
			limitMemorySize *= 2
			limitMemoryObjectNum *= 2

			_System_DebugOnly_OutputDebugString( Ex"memory size is extended for gc!\r\n" )
		End If

		Dim temp[100] As Char
		wsprintf(temp,Ex"object items         ... %d -> %d  ( %d MB -> %d MB )\r\n",iBeforeN,countOfMemoryObjects, iBackAllSize\1024\1024, iAllSize\1024\1024)
		_System_DebugOnly_OutputDebugString( temp )
		wsprintf(temp,Ex"limit size of memory ... %d\r\n",limitMemorySize)
		_System_DebugOnly_OutputDebugString( temp )
		wsprintf(temp,Ex"garbage colletion sweep finish! (%d ms)\r\n\r\n", GetTickCount()-startTime)
		_System_DebugOnly_OutputDebugString( temp )


		'-------------------------------------
		' すべてのスレッドを再開
		'-------------------------------------
		_System_pobj_AllThreads->ResumeAllThread()

		LeaveCriticalSection(CriticalSection)
	End Function

	/*!
	@brief	未解放のメモリオブジェクトをデバッグ出力する
	@author	Daisuke Yamamoto
	@date	2007/10/21
	*/
	Sub DumpMemoryLeaks()
		Dim isLeak = False
		Dim i As Long
		For i=0 To ELM(countOfMemoryObjects)
			If pMemoryObjects[i].ptr Then
				If (pMemoryObjects[i].flags and _System_GC_FLAG_NEEDFREE)<>0 Then
					If isLeak = False Then
						_System_DebugOnly_OutputDebugString( Ex"Detected memory leaks!\r\n" )
						isLeak = True
					End If

					Dim temp[100] As Char
					_System_DebugOnly_OutputDebugString( Ex"heap free missing!\r\n" )
#ifdef _WIN64
					wsprintf(temp,Ex"{%d} normal block at &H%p, %d bytes long.\r\n", i, pMemoryObjects[i].ptr, pMemoryObjects[i].size)
#else
					wsprintf(temp,Ex"{%d} normal block at &H%08X, %d bytes long.\r\n", i, pMemoryObjects[i].ptr, pMemoryObjects[i].size)
#endif
					_System_DebugOnly_OutputDebugString( temp )
				End If
			End If
		Next

		If isLeak Then
			_System_DebugOnly_OutputDebugString( Ex"Object dump complete.\r\n" )
		End If

	End Sub

End Class

'GC管理用の特殊なシステムオブジェクト（デストラクタは最終のタイミングで呼び出されます）
Dim _System_pGC As *_System_CGarbageCollection



Function GC_malloc(size As SIZE_T) As VoidPtr
	' sweep
	_System_pGC->TrySweep()

	'allocate
	Return _System_pGC->__malloc(size,0)
End Function

Function GC_malloc_atomic(size As SIZE_T) As VoidPtr
	' sweep
	_System_pGC->TrySweep()

	'allocate
	Return _System_pGC->__malloc(size,_System_GC_FLAG_ATOMIC)
End Function

Function _System_GC_malloc_ForObject(size As SIZE_T) As VoidPtr
	' sweep
	_System_pGC->TrySweep()

	'allocate
	Return _System_pGC->__malloc(size,_System_GC_FLAG_OBJECT or _System_GC_FLAG_INITZERO)
End Function

Function _System_GC_malloc_ForObjectPtr(size As SIZE_T) As VoidPtr
	' sweep
	_System_pGC->TrySweep()

	'allocate
	Return _System_pGC->__malloc(size,_System_GC_FLAG_OBJECT or _System_GC_FLAG_INITZERO or _System_GC_FLAG_NEEDFREE)
End Function

Sub _System_GC_free_for_SweepingDelete( ptr As *Object )
	' free
	_System_pGC->__free_ex( ptr, True )
End Sub
