- Timestamp:
- Oct 22, 2007, 1:29:03 AM (17 years ago)
- Location:
- trunk
- Files:
-
- 3 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/Include/system/gc.sbp
r360 r361 23 23 End Type 24 24 25 Type _System_MemoryObject 26 ptr As VoidPtr 27 size As Long 28 flags As DWord 29 generationCount As Long 30 End Type 31 25 32 Class _System_CGarbageCollection 26 33 27 ppPtr As *VoidPtr ' 管理するメモリオブジェクトのポインタリスト 28 pSize As *SIZE_T ' 管理するメモリオブジェクトのサイズリスト 29 pdwFlags As *DWord ' 管理するメモリオブジェクトの属性リスト 30 n As Long ' 管理するメモリオブジェクトの個数 31 32 ppEdenMemoryObjectPtrs As *VoidPtr 33 pEdenMemoryObjectSizes As *SIZE_T 34 pdwEdenMemoryObjectFlags As *DWord 35 numOfEden 34 pMemoryObjects As *_System_MemoryObject ' メモリオブジェクト 35 countOfMemoryObjects As Long ' 管理するメモリオブジェクトの個数 36 36 37 37 iAllSize As SIZE_T … … 113 113 */ 114 114 Sub Begin() 115 If p pPtrThen Exit Sub115 If pMemoryObjects Then Exit Sub 116 116 117 117 isFinish = False … … 121 121 limitMemoryObjectNum = 2000 ' メモリオブジェクトの個数単位 122 122 123 ppPtr=_System_calloc( 1 ) 124 pSize=_System_calloc( 1 ) 125 pdwFlags=_System_calloc( 1 ) 126 n=0 123 pMemoryObjects = _System_calloc( 1 ) 124 countOfMemoryObjects=0 127 125 128 126 ' Global Root … … 166 164 */ 167 165 Sub Finish() 168 If p pPtr=0Then Exit Sub166 If pMemoryObjects = NULL Then Exit Sub 169 167 170 168 isFinish = True … … 185 183 '_System_pobj_AllThreads->ResumeAnotherThread() 186 184 187 _System_free( ppPtr ) 188 ppPtr = NULL 189 190 _System_free( pSize ) 191 pSize = NULL 192 _System_free( pdwFlags ) 193 pdwFlags = NULL 185 _System_free( pMemoryObjects ) 186 pMemoryObjects = NULL 194 187 195 188 _System_free( pGlobalRoots ) … … 200 193 201 194 End Sub 195 196 /*! 197 @brief メモリオブジェクトからインデックスを取得する 198 @param new_ptr メモリオブジェクトへのポインタ 199 @author Daisuke Yamamoto 200 @date 2007/10/21 201 */ 202 Function GetMemoryObjectPtr( ptr As VoidPtr ) As *_System_MemoryObject 203 ' メモリオブジェクトの先頭部分からインデックスを取得する 204 Dim index = Get_LONG_PTR( ptr - SizeOf(LONG_PTR) ) As Long 205 206 If pMemoryObjects[index].ptr <> ptr Then 207 ' メモリイメージが壊れている(先頭に存在するインデックスの整合性が取れない) 208 Dim temporary[1024] As Char 209 wsprintf( temporary, Ex"indexOfMemoryObjects: %d\r\npMemoryObjects[index].ptr: &H%08x\r\nptr: &H%08x\r\n", 210 index, 211 pMemoryObjects[index].ptr, 212 ptr ) 213 _System_DebugOnly_OutputDebugString( temporary ) 214 debug 215 End If 216 217 Return VarPtr( pMemoryObjects[index] ) 218 End Function 202 219 203 220 /*! … … 210 227 */ 211 228 Sub add(new_ptr As VoidPtr, size As SIZE_T, flags As DWord) 212 iAllSize+=size213 214 229 EnterCriticalSection(CriticalSection) 215 ppPtr=HeapReAlloc(_System_hProcessHeap,0,ppPtr,(n+1)*SizeOf(VoidPtr)) 216 ppPtr[n]=new_ptr 217 218 pSize=HeapReAlloc(_System_hProcessHeap,0,pSize,(n+1)*SizeOf(SIZE_T)) 219 pSize[n]=size 220 221 pdwFlags=HeapReAlloc(_System_hProcessHeap,0,pdwFlags,(n+1)*SizeOf(DWord)) 222 pdwFlags[n]=flags 223 224 n++ 230 iAllSize+=size 231 232 ' メモリオブジェクトインスタンスの先頭にインデックスをセットする 233 Set_LONG_PTR( new_ptr - SizeOf( LONG_PTR ), countOfMemoryObjects ) 234 235 pMemoryObjects = _System_realloc( pMemoryObjects, (countOfMemoryObjects+1)*SizeOf(_System_MemoryObject) ) 236 pMemoryObjects[countOfMemoryObjects].ptr = new_ptr 237 pMemoryObjects[countOfMemoryObjects].size = size 238 pMemoryObjects[countOfMemoryObjects].flags = flags 239 pMemoryObjects[countOfMemoryObjects].generationCount = 0 240 241 countOfMemoryObjects++ 225 242 LeaveCriticalSection(CriticalSection) 226 243 227 244 /* 228 245 ' デバッグ用 229 If n= 1996 Then246 If countOfMemoryObjects = 1996 Then 230 247 debug 231 248 End If … … 242 259 */ 243 260 Function __malloc(size As SIZE_T,flags As Byte) As VoidPtr 244 ' EnterCriticalSection(CriticalSection) 245 Dim dwFlags As DWord 246 If flags and _System_GC_FLAG_INITZERO Then 247 dwFlags=HEAP_ZERO_MEMORY 248 Else 249 dwFlags=0 250 End If 251 252 Dim ptr = HeapAlloc(_System_hProcessHeap,dwFlags,size) 253 add( ptr, size, flags ) 254 ' LeaveCriticalSection(CriticalSection) 261 Dim dwFlags As DWord 262 If flags and _System_GC_FLAG_INITZERO Then 263 dwFlags=HEAP_ZERO_MEMORY 264 Else 265 dwFlags=0 266 End If 267 268 ' 実際のメモリバッファはインデックスの分だけ多めに確保する 269 Dim ptr = HeapAlloc( _System_hProcessHeap, dwFlags, size + SizeOf( LONG_PTR ) ) + SizeOf( LONG_PTR ) 270 271 ' 管理対象のメモリオブジェクトとして追加 272 add( ptr, size, flags ) 255 273 256 274 Return ptr … … 267 285 Function __realloc(lpMem As VoidPtr, size As SIZE_T) As VoidPtr 268 286 EnterCriticalSection(CriticalSection) 269 Dim i As Long 270 For i=0 To ELM(n) 271 If ppPtr[i]=lpMem Then 272 iAllSize+=size-pSize[i] 273 274 pSize[i]=size 275 ppPtr[i]=HeapReAlloc(_System_hProcessHeap,HEAP_ZERO_MEMORY,lpMem,size) 276 277 LeaveCriticalSection(CriticalSection) 278 Return ppPtr[i] 279 End If 280 Next 287 288 ' メモリオブジェクトを取得 289 Dim pTempMemoryObject = GetMemoryObjectPtr( lpMem ) 290 291 iAllSize += size - pTempMemoryObject->size 292 293 pTempMemoryObject->size = size 294 pTempMemoryObject->ptr = HeapReAlloc( _System_hProcessHeap, HEAP_ZERO_MEMORY, pTempMemoryObject->ptr - SizeOf(LONG_PTR), size + SizeOf(LONG_PTR) ) + SizeOf(LONG_PTR) 295 281 296 LeaveCriticalSection(CriticalSection) 282 Return 0297 Return pTempMemoryObject->ptr 283 298 End Function 284 299 … … 292 307 Sub __free_ex(lpMem As VoidPtr, isSweeping As Boolean) 293 308 EnterCriticalSection(CriticalSection) 294 Dim i As Long 295 For i=0 To ELM(n) 296 If ppPtr[i]=lpMem Then 297 If (pdwFlags[i] and _System_GC_FLAG_NEEDFREE)<>0 or isSweeping Then 298 iAllSize-=pSize[i] 299 300 HeapFree(_System_hProcessHeap,0,ppPtr[i]) 301 ppPtr[i]=0 302 pSize[i]=0 303 Else 304 If isFinish = False Then 305 _System_DebugOnly_OutputDebugString( Ex"heap free missing!\r\n" ) 306 End If 307 End If 309 310 ' メモリオブジェクトを取得 311 Dim pTempMemoryObject = GetMemoryObjectPtr( lpMem ) 312 313 If (pTempMemoryObject->flags and _System_GC_FLAG_NEEDFREE)<>0 or isSweeping Then 314 iAllSize -= pTempMemoryObject->size 315 316 HeapFree( _System_hProcessHeap, 0, pTempMemoryObject->ptr - SizeOf(LONG_PTR) ) 317 pTempMemoryObject->ptr = NULL 318 pTempMemoryObject->size = 0 319 Else 320 If isFinish = False Then 321 _System_DebugOnly_OutputDebugString( Ex"heap free missing!\r\n" ) 308 322 End If 309 Next323 End If 310 324 LeaveCriticalSection(CriticalSection) 311 325 End Sub … … 327 341 */ 328 342 Sub sweep() 329 If isSweeping <> False or (iAllSize<limitMemorySize and n<limitMemoryObjectNum) Then343 If isSweeping <> False or (iAllSize<limitMemorySize and countOfMemoryObjects<limitMemoryObjectNum) Then 330 344 'メモリ使用量が上限値を超えていないとき 331 345 Exit Sub … … 354 368 Function HitTest(pSample As VoidPtr) As Long 355 369 Dim i As Long 356 For i=0 To ELM( n)357 If (p pPtr[i] As LONG_PTR)<=(pSample As LONG_PTR) and (pSample As LONG_PTR)<((ppPtr[i] As LONG_PTR)+pSize[i]) Then370 For i=0 To ELM(countOfMemoryObjects) 371 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 358 372 Return i 359 373 End If … … 408 422 pbMark[index]=1 409 423 410 If pdwFlags[index] and _System_GC_FLAG_OBJECT Then 424 ' ジェネレーションカウントを増やす 425 pMemoryObjects[index].generationCount ++ 426 427 If pMemoryObjects[index].flags and _System_GC_FLAG_OBJECT Then 411 428 ' オブジェクトの場合 412 If ScanObject( (p pPtr[index]+ 4*SizeOf(LONG_PTR)) As *Object, pbMark) = False Then413 Dim maxNum = (p Size[index]\SizeOf(LONG_PTR)) As Long414 Scan(p pPtr[index]As *LONG_PTR, maxNum, pbMark)429 If ScanObject( (pMemoryObjects[index].ptr + 4*SizeOf(LONG_PTR)) As *Object, pbMark) = False Then 430 Dim maxNum = (pMemoryObjects[index].size\SizeOf(LONG_PTR)) As Long 431 Scan(pMemoryObjects[index].ptr As *LONG_PTR, maxNum, pbMark) 415 432 End If 416 433 417 ElseIf (p dwFlags[index]and _System_GC_FLAG_ATOMIC)=0 Then434 ElseIf (pMemoryObjects[index].flags and _System_GC_FLAG_ATOMIC)=0 Then 418 435 ' ヒープ領域がポインタ値を含む可能性があるとき 419 If p pPtr[index] = 0Then436 If pMemoryObjects[index].ptr = NULL Then 420 437 'エラー 421 438 422 439 End If 423 440 424 Dim maxNum = (p Size[index]\SizeOf(LONG_PTR)) As Long425 Scan(p pPtr[index]As *LONG_PTR, maxNum, pbMark)441 Dim maxNum = (pMemoryObjects[index].size\SizeOf(LONG_PTR)) As Long 442 Scan(pMemoryObjects[index].ptr As *LONG_PTR, maxNum, pbMark) 426 443 End If 427 444 End If … … 500 517 ' すべてを破棄するとき 501 518 isAllDelete = True 502 pbMark = _System_calloc( n)519 pbMark = _System_calloc( countOfMemoryObjects ) 503 520 End If 504 521 505 522 Dim i As Long 506 For i=0 To ELM( n)507 If pbMark[i]=0 and p pPtr[i]<>0 and (pdwFlags[i]and _System_GC_FLAG_NEEDFREE)=0 Then508 If p pPtr[i] = 0Then523 For i=0 To ELM(countOfMemoryObjects) 524 If pbMark[i]=0 and pMemoryObjects[i].ptr<>0 and (pMemoryObjects[i].flags and _System_GC_FLAG_NEEDFREE)=0 Then 525 If pMemoryObjects[i].ptr = NULL Then 509 526 If isAllDelete Then 510 527 Continue … … 514 531 End If 515 532 516 Dim ptr = ppPtr[i] 517 Dim size = pSize[i] 518 519 ppPtr[i]=0 520 pSize[i]=0 521 522 If (pdwFlags[i] and _System_GC_FLAG_OBJECT) <> 0 Then 533 Dim ptr = pMemoryObjects[i].ptr 534 Dim size = pMemoryObjects[i].size 535 536 If (pMemoryObjects[i].flags and _System_GC_FLAG_OBJECT) <> 0 Then 523 537 /* ・オブジェクトの個数 524 538 ・オブジェクトのサイズ … … 528 542 _System_SweepingDelete (ptr + SizeOf( LONG_PTR ) * 4 ) 529 543 Else 530 HeapFree(_System_hProcessHeap,0,ptr)544 __free_ex( ptr, True ) 531 545 End If 532 533 iAllSize-=size534 546 End If 535 547 Next … … 557 569 Sub Compaction() 558 570 Dim i As Long, i2 = 0 As Long 559 For i=0 To ELM(n) 560 ppPtr[i2] = ppPtr[i] 561 pSize[i2] = pSize[i] 562 pdwFlags[i2] = pdwFlags[i] 563 564 If ppPtr[i] Then 571 For i=0 To ELM(countOfMemoryObjects) 572 pMemoryObjects[i2] = pMemoryObjects[i] 573 574 If pMemoryObjects[i2].ptr Then 575 ' メモリオブジェクトの先頭部分にあるインデックスを書き換える 576 Set_LONG_PTR( pMemoryObjects[i2].ptr - SizeOf(LONG_PTR), i2 ) 577 565 578 i2++ 566 579 End If 567 580 Next 568 n= i2581 countOfMemoryObjects = i2 569 582 End Sub 570 583 … … 583 596 584 597 585 If isSweeping <> False or (iAllSize<limitMemorySize and n<limitMemoryObjectNum) Then598 If isSweeping <> False or (iAllSize<limitMemorySize and countOfMemoryObjects<limitMemoryObjectNum) Then 586 599 ExitThread(0) 587 600 End If … … 592 605 593 606 ' マークリストを生成 594 Dim pbMark = HeapAlloc(_System_hProcessHeap,HEAP_ZERO_MEMORY, n*SizeOf(Byte)) As *Byte607 Dim pbMark = HeapAlloc(_System_hProcessHeap,HEAP_ZERO_MEMORY,countOfMemoryObjects*SizeOf(Byte)) As *Byte 595 608 596 609 ' グローバル領域をルートに指定してスキャン … … 604 617 605 618 ' スウィープ前のメモリオブジェクトの数 606 Dim iBeforeN = n619 Dim iBeforeN = countOfMemoryObjects 607 620 608 621 '使われていないメモリを解放する … … 628 641 629 642 Dim temp[100] As Char 630 wsprintf(temp,Ex"object items ... %d -> %d ( %d MB -> %d MB )\r\n",iBeforeN, n, iBackAllSize\1024\1024, iAllSize\1024\1024)643 wsprintf(temp,Ex"object items ... %d -> %d ( %d MB -> %d MB )\r\n",iBeforeN,countOfMemoryObjects, iBackAllSize\1024\1024, iAllSize\1024\1024) 631 644 _System_DebugOnly_OutputDebugString( temp ) 632 645 wsprintf(temp,Ex"limit size of memory ... %d\r\n",limitMemorySize) … … 652 665 Dim isLeak = False 653 666 Dim i As Long 654 For i=0 To ELM( n)655 If p pPtr[i]Then656 If (p dwFlags[i]and _System_GC_FLAG_NEEDFREE)<>0 Then667 For i=0 To ELM(countOfMemoryObjects) 668 If pMemoryObjects[i].ptr Then 669 If (pMemoryObjects[i].flags and _System_GC_FLAG_NEEDFREE)<>0 Then 657 670 If isLeak = False Then 658 671 _System_DebugOnly_OutputDebugString( Ex"Detected memory leaks!\r\n" ) … … 662 675 Dim temp[100] As Char 663 676 _System_DebugOnly_OutputDebugString( Ex"heap free missing!\r\n" ) 664 wsprintf(temp,Ex"{%d} normal block at &H%08X, %d bytes long.\r\n", i, p pPtr[i], pSize[i])677 wsprintf(temp,Ex"{%d} normal block at &H%08X, %d bytes long.\r\n", i, pMemoryObjects[i].ptr, pMemoryObjects[i].size) 665 678 _System_DebugOnly_OutputDebugString( temp ) 666 679 End If
Note:
See TracChangeset
for help on using the changeset viewer.