Index: /trunk/Include/system/gc.sbp
===================================================================
--- /trunk/Include/system/gc.sbp	(revision 360)
+++ /trunk/Include/system/gc.sbp	(revision 361)
@@ -23,15 +23,15 @@
 End Type
 
+Type _System_MemoryObject
+	ptr As VoidPtr
+	size As Long
+	flags As DWord
+	generationCount As Long
+End Type
+
 Class _System_CGarbageCollection
 
-	ppPtr As *VoidPtr		' 管理するメモリオブジェクトのポインタリスト
-	pSize As *SIZE_T		' 管理するメモリオブジェクトのサイズリスト
-	pdwFlags As *DWord		' 管理するメモリオブジェクトの属性リスト
-	n As Long				' 管理するメモリオブジェクトの個数
-
-	ppEdenMemoryObjectPtrs As *VoidPtr
-	pEdenMemoryObjectSizes As *SIZE_T
-	pdwEdenMemoryObjectFlags As *DWord
-	numOfEden
+	pMemoryObjects As *_System_MemoryObject		' メモリオブジェクト
+	countOfMemoryObjects As Long				' 管理するメモリオブジェクトの個数
 
 	iAllSize As SIZE_T
@@ -113,5 +113,5 @@
 	*/
 	Sub Begin()
-		If ppPtr Then Exit Sub
+		If pMemoryObjects Then Exit Sub
 
 		isFinish = False
@@ -121,8 +121,6 @@
 		limitMemoryObjectNum = 2000					' メモリオブジェクトの個数単位
 
-		ppPtr=_System_calloc( 1 )
-		pSize=_System_calloc( 1 )
-		pdwFlags=_System_calloc( 1 )
-		n=0
+		pMemoryObjects = _System_calloc( 1 )
+		countOfMemoryObjects=0
 
 		' Global Root
@@ -166,5 +164,5 @@
 	*/
 	Sub Finish()
-		If ppPtr=0 Then Exit Sub
+		If pMemoryObjects = NULL Then Exit Sub
 
 		isFinish = True
@@ -185,11 +183,6 @@
 		'_System_pobj_AllThreads->ResumeAnotherThread()
 
-		_System_free( ppPtr )
-		ppPtr = NULL
-
-		_System_free( pSize )
-		pSize = NULL
-		_System_free( pdwFlags )
-		pdwFlags = NULL
+		_System_free( pMemoryObjects )
+		pMemoryObjects = NULL
 
 		_System_free( pGlobalRoots )
@@ -200,4 +193,28 @@
 
 	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
+			wsprintf( temporary, Ex"indexOfMemoryObjects: %d\r\npMemoryObjects[index].ptr: &H%08x\r\nptr: &H%08x\r\n",
+				index,
+				pMemoryObjects[index].ptr,
+				ptr )
+			_System_DebugOnly_OutputDebugString( temporary )
+			debug
+		End If
+
+		Return VarPtr( pMemoryObjects[index] )
+	End Function
 
 	/*!
@@ -210,22 +227,22 @@
 	*/
 	Sub add(new_ptr As VoidPtr, size As SIZE_T, flags As DWord)
-		iAllSize+=size
-
 		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
-
-			n++
+			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
+
+			countOfMemoryObjects++
 		LeaveCriticalSection(CriticalSection)
 
 		/*
 		' デバッグ用
-		If n = 1996 Then
+		If countOfMemoryObjects = 1996 Then
 			debug
 		End If
@@ -242,15 +259,16 @@
 	*/
 	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 ptr = HeapAlloc(_System_hProcessHeap,dwFlags,size)
-			add( ptr, size, flags )
-'		LeaveCriticalSection(CriticalSection)
+		Dim dwFlags As DWord
+		If flags and _System_GC_FLAG_INITZERO Then
+			dwFlags=HEAP_ZERO_MEMORY
+		Else
+			dwFlags=0
+		End If
+
+		' 実際のメモリバッファはインデックスの分だけ多めに確保する
+		Dim ptr = HeapAlloc( _System_hProcessHeap, dwFlags, size + SizeOf( LONG_PTR ) ) + SizeOf( LONG_PTR )
+
+		' 管理対象のメモリオブジェクトとして追加
+		add( ptr, size, flags )
 
 		Return ptr
@@ -267,18 +285,15 @@
 	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
+
+			' メモリオブジェクトを取得
+			Dim pTempMemoryObject = GetMemoryObjectPtr( lpMem )
+
+			iAllSize += size - pTempMemoryObject->size
+
+			pTempMemoryObject->size = size
+			pTempMemoryObject->ptr = HeapReAlloc( _System_hProcessHeap, HEAP_ZERO_MEMORY, pTempMemoryObject->ptr - SizeOf(LONG_PTR), size + SizeOf(LONG_PTR) ) + SizeOf(LONG_PTR)
+
 		LeaveCriticalSection(CriticalSection)
-		Return 0
+		Return pTempMemoryObject->ptr
 	End Function
 
@@ -292,20 +307,19 @@
 	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 (pdwFlags[i] and _System_GC_FLAG_NEEDFREE)<>0 or isSweeping Then
-						iAllSize-=pSize[i]
-
-						HeapFree(_System_hProcessHeap,0,ppPtr[i])
-						ppPtr[i]=0
-						pSize[i]=0
-					Else
-						If isFinish = False Then
-							_System_DebugOnly_OutputDebugString( Ex"heap free missing!\r\n" )
-						End If
-					End If
+
+			' メモリオブジェクトを取得
+			Dim pTempMemoryObject = GetMemoryObjectPtr( lpMem )
+
+			If (pTempMemoryObject->flags and _System_GC_FLAG_NEEDFREE)<>0 or isSweeping Then
+				iAllSize -= pTempMemoryObject->size
+
+				HeapFree( _System_hProcessHeap, 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
-			Next
+			End If
 		LeaveCriticalSection(CriticalSection)
 	End Sub
@@ -327,5 +341,5 @@
 	*/
 	Sub sweep()
-		If isSweeping <> False or (iAllSize<limitMemorySize and n<limitMemoryObjectNum) Then
+		If isSweeping <> False or (iAllSize<limitMemorySize and countOfMemoryObjects<limitMemoryObjectNum) Then
 			'メモリ使用量が上限値を超えていないとき
 			Exit Sub
@@ -354,6 +368,6 @@
 	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
+		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
@@ -408,20 +422,23 @@
 					pbMark[index]=1
 
-					If pdwFlags[index] and _System_GC_FLAG_OBJECT Then
+					' ジェネレーションカウントを増やす
+					pMemoryObjects[index].generationCount ++
+
+					If pMemoryObjects[index].flags and _System_GC_FLAG_OBJECT Then
 						' オブジェクトの場合
-						If ScanObject( (ppPtr[index] + 4*SizeOf(LONG_PTR)) As *Object, pbMark) = False Then
-							Dim maxNum = (pSize[index]\SizeOf(LONG_PTR)) As Long
-							Scan(ppPtr[index] As *LONG_PTR, maxNum, pbMark)
+						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 (pdwFlags[index] and _System_GC_FLAG_ATOMIC)=0 Then
+					ElseIf (pMemoryObjects[index].flags and _System_GC_FLAG_ATOMIC)=0 Then
 						' ヒープ領域がポインタ値を含む可能性があるとき
-						If ppPtr[index] = 0 Then
+						If pMemoryObjects[index].ptr = NULL Then
 							'エラー
 
 						End If
 
-						Dim maxNum = (pSize[index]\SizeOf(LONG_PTR)) As Long
-						Scan(ppPtr[index] As *LONG_PTR, maxNum, pbMark)
+						Dim maxNum = (pMemoryObjects[index].size\SizeOf(LONG_PTR)) As Long
+						Scan(pMemoryObjects[index].ptr As *LONG_PTR, maxNum, pbMark)
 					End If
 				End If
@@ -500,11 +517,11 @@
 			' すべてを破棄するとき
 			isAllDelete = True
-			pbMark = _System_calloc( n )
+			pbMark = _System_calloc( countOfMemoryObjects )
 		End If
 
 		Dim i As Long
-		For i=0 To ELM(n)
-			If pbMark[i]=0 and ppPtr[i]<>0 and (pdwFlags[i] and _System_GC_FLAG_NEEDFREE)=0 Then
-				If ppPtr[i] = 0 Then
+		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
@@ -514,11 +531,8 @@
 				End If
 
-				Dim ptr = ppPtr[i]
-				Dim size = pSize[i]
-
-				ppPtr[i]=0
-				pSize[i]=0
-
-				If (pdwFlags[i] and _System_GC_FLAG_OBJECT) <> 0 Then
+				Dim ptr = pMemoryObjects[i].ptr
+				Dim size = pMemoryObjects[i].size
+
+				If (pMemoryObjects[i].flags and _System_GC_FLAG_OBJECT) <> 0 Then
 					/*	・オブジェクトの個数
 						・オブジェクトのサイズ
@@ -528,8 +542,6 @@
 					_System_SweepingDelete (ptr + SizeOf( LONG_PTR ) * 4 )
 				Else
-					HeapFree(_System_hProcessHeap,0,ptr)
+					__free_ex( ptr, True )
 				End If
-
-				iAllSize-=size
 			End If
 		Next
@@ -557,14 +569,15 @@
 	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
+		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
-		n = i2
+		countOfMemoryObjects = i2
 	End Sub
 
@@ -583,5 +596,5 @@
 
 
-		If isSweeping <> False or (iAllSize<limitMemorySize and n<limitMemoryObjectNum) Then
+		If isSweeping <> False or (iAllSize<limitMemorySize and countOfMemoryObjects<limitMemoryObjectNum) Then
 			ExitThread(0)
 		End If
@@ -592,5 +605,5 @@
 
 		' マークリストを生成
-		Dim pbMark = HeapAlloc(_System_hProcessHeap,HEAP_ZERO_MEMORY,n*SizeOf(Byte)) As *Byte
+		Dim pbMark = HeapAlloc(_System_hProcessHeap,HEAP_ZERO_MEMORY,countOfMemoryObjects*SizeOf(Byte)) As *Byte
 
 		' グローバル領域をルートに指定してスキャン
@@ -604,5 +617,5 @@
 
 		' スウィープ前のメモリオブジェクトの数
-		Dim iBeforeN = n
+		Dim iBeforeN = countOfMemoryObjects
 
 		'使われていないメモリを解放する
@@ -628,5 +641,5 @@
 
 		Dim temp[100] As Char
-		wsprintf(temp,Ex"object items         ... %d -> %d  ( %d MB -> %d MB )\r\n",iBeforeN,n, iBackAllSize\1024\1024, iAllSize\1024\1024)
+		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)
@@ -652,7 +665,7 @@
 		Dim isLeak = False
 		Dim i As Long
-		For i=0 To ELM(n)
-			If ppPtr[i] Then
-				If (pdwFlags[i] and _System_GC_FLAG_NEEDFREE)<>0 Then
+		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" )
@@ -662,5 +675,5 @@
 					Dim temp[100] As Char
 					_System_DebugOnly_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])
+					wsprintf(temp,Ex"{%d} normal block at &H%08X, %d bytes long.\r\n", i, pMemoryObjects[i].ptr, pMemoryObjects[i].size)
 					_System_DebugOnly_OutputDebugString( temp )
 				End If
