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


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


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

Const THREAD_GET_CONTEXT  = &H0008

Class _System_CGarbageCollection
	ppPtr As **VoidPtr
	pSize As *SIZE_T
	pbFlags As *Byte
	n As Long

	iAllSize As SIZE_T

	CriticalSection As CRITICAL_SECTION

	'メモリの上限値（この値を超えるとGCが発動します）
	'※バイト単位
	limitMemorySize = 1024*1024*30 As LONG_PTR

Public
	Sub _System_CGarbageCollection()
		If ppPtr Then Exit Sub

		ppPtr=HeapAlloc(_System_hProcessHeap,0,1)
		pSize=HeapAlloc(_System_hProcessHeap,0,1)
		pbFlags=HeapAlloc(_System_hProcessHeap,0,1)
		n=0

		iAllSize=0

		'スレッド情報管理用オブジェクトを生成
		_System_pobj_AllThreads=_System_malloc(SizeOf(_System_CThreadCollection)+SizeOf(LONG_PTR))
		_System_pobj_AllThreads->_System_CThreadCollection()

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


		'---------------------------
		' 開始時のスレッドを通知
		'---------------------------
		Dim hTargetThread As HANDLE
		DuplicateHandle(GetCurrentProcess(),
			GetCurrentThread(),
			GetCurrentProcess(),
			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()
		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
		HeapFree(_System_hProcessHeap,0,ppPtr)
		ppPtr=0

		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

		'クリティカルセッションを破棄
		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)
		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

		n++
	End Sub


	Function __malloc(size As SIZE_T,flags As Byte) As VoidPtr
		EnterCriticalSection(CriticalSection)
			Dim dwFlags As DWord
			If flags and _System_GC_FLAG_INITZERO Then
				dwFlags=HEAP_ZERO_MEMORY
			Else
				dwFlags=0
			End If


			Dim pTemp As VoidPtr
			pTemp=HeapAlloc(_System_hProcessHeap,dwFlags,size)
			add(pTemp,size,flags)
		LeaveCriticalSection(CriticalSection)
		Return pTemp
	End Function

	Function __realloc(lpMem As VoidPtr, size As SIZE_T) As VoidPtr
		EnterCriticalSection(CriticalSection)
			Dim i As Long
			For i=0 To ELM(n)
				If ppPtr[i]=lpMem Then
					iAllSize+=size-pSize[i]

					pSize[i]=size
					ppPtr[i]=HeapReAlloc(_System_hProcessHeap,HEAP_ZERO_MEMORY,lpMem,size)

					LeaveCriticalSection(CriticalSection)
					Return ppPtr[i]
				End If
			Next
		LeaveCriticalSection(CriticalSection)
		Return 0
	End Function

	Sub __free(lpMem As VoidPtr)
		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
						iAllSize-=pSize[i]

						HeapFree(_System_hProcessHeap,0,ppPtr[i])
						ppPtr[i]=0
						pSize[i]=0
					Else
						OutputDebugString(Ex"GCが管理しているメモリ空間を解放しようとしました。\r\n")
					End If
				End If
			Next
		LeaveCriticalSection(CriticalSection)
	End Sub

	Sub sweep()
		EnterCriticalSection(CriticalSection)

			If iAllSize<limitMemorySize Then
				'メモリ使用量が上限値を超えていないとき
				LeaveCriticalSection(CriticalSection)
				Exit Sub
			End If

			Dim hThread As HANDLE
			Dim ThreadId As DWord
			hThread=_beginthreadex(NULL,0,AddressOf(SweepOnOtherThread),VarPtr(This),0,ThreadId)
			WaitForSingleObject(hThread,INFINITE)
			CloseHandle(hThread)

		LeaveCriticalSection(CriticalSection)
	End Sub

	Function Cdecl SweepOnOtherThread() As Long

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


		'マークリストを生成
		pbMark=HeapAlloc(_System_hProcessHeap,HEAP_ZERO_MEMORY,n*SizeOf(Byte))


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

		'-----------------------------------------------
		'ローカル領域をルートに指定してスキャン
		'-----------------------------------------------
		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)
			If _System_pobj_AllThreads->ppobj_Thread[i] Then
				FillMemory(VarPtr(Context),SizeOf(CONTEXT),0)
				Context.ContextFlags=CONTEXT_CONTROL
				If _System_pobj_AllThreads->ppobj_Thread[i]->__GetContext(Context)=0 Then
					OutputDebugString(Ex"レジスタ情報の取得に失敗しました。\r\n")
				End If

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

				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

		'使われていないメモリを解放する
		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])
				ppPtr[i]=0
				pSize[i]=0
			End If
		Next

		'マークリストを解放
		HeapFree(_System_hProcessHeap,0,pbMark)

		If iBackAllSize=iAllSize Then
			'許容量を拡張する
			limitMemorySize*=2
		End If


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


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_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])
					End If
				End If
			End If
		Next
	End Sub
End Class

'GC管理用の特殊なシステムオブジェクト（デストラクタは最終のタイミングで呼び出されます）
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,_System_GC_FLAG_ATOMIC)
End Function