source: Include/system/gc.sbp@ 203

Last change on this file since 203 was 203, checked in by イグトランス (egtra), 18 years ago

GCHandleの追加、String.Compareなどの追加、gc.sbpの修正

File size: 11.4 KB
Line 
1/*
2 このファイルでは、ABのガベージコレクションの実装を行います。
3*/
4
5
6/*
7※これらの変数はコンパイラが自動的に定義します。
8Dim _System_gc_GlobalRoot_StartPtr As VoidPtr
9Dim _System_gc_GlobalRoot_Size As Long
10Dim _System_gc_StackRoot_StartPtr As VoidPtr
11*/
12
13Function _System_GetSp() As LONG_PTR 'dummy
14End Function
15
16
17Const _System_GC_FLAG_ATOMIC = 1
18Const _System_GC_FLAG_NEEDFREE = 2
19Const _System_GC_FLAG_INITZERO = 4
20Const _System_GC_FLAG_OBJECT = 8
21
22Class _System_CGarbageCollection
23 ppPtr As *VoidPtr
24 pSize As *SIZE_T
25 pdwFlags As *DWord
26 n As Long
27
28 iAllSize As SIZE_T
29
30 isSweeping As Boolean
31
32 CriticalSection As CRITICAL_SECTION
33
34 'メモリの上限値(この値を超えるとGCが発動します)
35 '※バイト単位
36 limitMemorySize As LONG_PTR
37
38 isFinish As Boolean
39
40Public
41
42 ' 特殊クラスのため、コンストラクタ・デストラクタは呼ばれません
43 Sub _System_CGarbageCollection()
44 End Sub
45 Sub ~_System_CGarbageCollection()
46 End Sub
47
48 Sub Begin()
49 If ppPtr Then Exit Sub
50
51 isFinish = False
52
53 'メモリの上限値(この値を超えるとGCが発動します)
54 '※バイト単位
55 limitMemorySize = 1024*1024 As LONG_PTR
56
57 ppPtr=_System_calloc( 1 )
58 pSize=_System_calloc( 1 )
59 pdwFlags=_System_calloc( 1 )
60 n=0
61
62 iAllSize=0
63
64 ' スウィープ中かどうか
65 isSweeping = False
66
67 'クリティカルセッションを生成
68 InitializeCriticalSection(CriticalSection)
69
70
71 '---------------------------
72 ' 開始時のスレッドを通知
73 '---------------------------
74 Dim hTargetThread As HANDLE
75 DuplicateHandle(GetCurrentProcess(),
76 GetCurrentThread(),
77 GetCurrentProcess(),
78 hTargetThread, 0, FALSE, DUPLICATE_SAME_ACCESS) 'カレントスレッドのハンドルを複製
79
80 ' スレッド管理用オブジェクトを生成
81 _System_pobj_AllThreads = New _System_CThreadCollection()
82
83 ' 自身のThreadオブジェクトを生成
84 Dim thread As Thread(hTargetThread,GetCurrentThreadId(),0)
85
86 _System_pobj_AllThreads->BeginThread(VarPtr( thread ),_System_gc_StackRoot_StartPtr As *LONG_PTR)
87
88 End Sub
89 Sub Finish()
90 If ppPtr=0 Then Exit Sub
91
92 isFinish = True
93
94 ' スレッド管理用オブジェクトを破棄
95 Delete _System_pobj_AllThreads
96
97 ' 自分以外のスレッドを一時停止
98 '_System_pobj_AllThreads->SuspendAnotherThread()
99
100 OutputDebugString( Ex"garbage colletion sweeping all memory objects!\r\n" )
101 DeleteAllGarbageMemories()
102
103 ' 未解放のメモリオブジェクトをトレース
104 DumpMemoryLeaks()
105
106 ' 自分以外のスレッドを再開
107 '_System_pobj_AllThreads->ResumeAnotherThread()
108
109 HeapFree(_System_hProcessHeap,0,ppPtr)
110 ppPtr=0
111
112 HeapFree(_System_hProcessHeap,0,pSize)
113 pSize=0
114 HeapFree(_System_hProcessHeap,0,pdwFlags)
115 pdwFlags=0
116
117 'クリティカルセッションを破棄
118 DeleteCriticalSection(CriticalSection)
119
120 End Sub
121
122 Sub add(new_ptr As VoidPtr, size As SIZE_T, flags As DWord)
123 iAllSize+=size
124
125 EnterCriticalSection(CriticalSection)
126 ppPtr=HeapReAlloc(_System_hProcessHeap,0,ppPtr,(n+1)*SizeOf(VoidPtr))
127 ppPtr[n]=new_ptr
128
129 pSize=HeapReAlloc(_System_hProcessHeap,0,pSize,(n+1)*SizeOf(SIZE_T))
130 pSize[n]=size
131
132 pdwFlags=HeapReAlloc(_System_hProcessHeap,0,pdwFlags,(n+1)*SizeOf(DWord))
133 pdwFlags[n]=flags
134 LeaveCriticalSection(CriticalSection)
135
136 n++
137 End Sub
138
139
140 Function __malloc(size As SIZE_T,flags As Byte) As VoidPtr
141' EnterCriticalSection(CriticalSection)
142 Dim dwFlags As DWord
143 If flags and _System_GC_FLAG_INITZERO Then
144 dwFlags=HEAP_ZERO_MEMORY
145 Else
146 dwFlags=0
147 End If
148
149 Dim ptr = HeapAlloc(_System_hProcessHeap,dwFlags,size)
150 add( ptr, size, flags )
151' LeaveCriticalSection(CriticalSection)
152
153 Return ptr
154 End Function
155
156 Function __realloc(lpMem As VoidPtr, size As SIZE_T) As VoidPtr
157 EnterCriticalSection(CriticalSection)
158 Dim i As Long
159 For i=0 To ELM(n)
160 If ppPtr[i]=lpMem Then
161 iAllSize+=size-pSize[i]
162
163 pSize[i]=size
164 ppPtr[i]=HeapReAlloc(_System_hProcessHeap,HEAP_ZERO_MEMORY,lpMem,size)
165
166 LeaveCriticalSection(CriticalSection)
167 Return ppPtr[i]
168 End If
169 Next
170 LeaveCriticalSection(CriticalSection)
171 Return 0
172 End Function
173
174 Sub __free_ex(lpMem As VoidPtr, isSweeping As Boolean)
175 EnterCriticalSection(CriticalSection)
176 Dim i As Long
177 For i=0 To ELM(n)
178 If ppPtr[i]=lpMem Then
179 If (pdwFlags[i] and _System_GC_FLAG_NEEDFREE)<>0 or isSweeping Then
180 iAllSize-=pSize[i]
181
182 HeapFree(_System_hProcessHeap,0,ppPtr[i])
183 ppPtr[i]=0
184 pSize[i]=0
185 Else
186 If isFinish = False Then
187 OutputDebugString( Ex"heap free missing!\r\n" )
188 End If
189 End If
190 End If
191 Next
192 LeaveCriticalSection(CriticalSection)
193 End Sub
194
195 Sub __free(lpMem As VoidPtr)
196 __free_ex( lpMem, False )
197 End Sub
198
199 Sub sweep()
200 If isSweeping <> False Or iAllSize<limitMemorySize Then
201 'メモリ使用量が上限値を超えていないとき
202 Exit Sub
203 End If
204 OutputDebugString( Ex"garbage colletion sweep start!\r\n" )
205
206 Dim hThread As HANDLE
207 Dim ThreadId As DWord
208 hThread=_beginthreadex(NULL,0,AddressOf(SweepOnOtherThread),VarPtr(This),0,ThreadId)
209 WaitForSingleObject(hThread,INFINITE)
210 CloseHandle(hThread)
211 isSweeping = False
212 End Sub
213
214Private
215
216 ' 生存検知
217 Function HitTest(pSample As VoidPtr) As Long
218 Dim i As Long
219 For i=0 To ELM(n)
220 If (ppPtr[i] As LONG_PTR)<=(pSample As LONG_PTR) and (pSample As LONG_PTR)<((ppPtr[i] As LONG_PTR)+pSize[i]) Then
221 Return i
222 End If
223 Next
224 Return -1
225 End Function
226
227 ' 指定領域のスキャン
228 Sub Scan(pStartPtr As *LONG_PTR, size As LONG_PTR, pbMark As *Byte)
229 Dim i As Long, count As Long, index As Long
230 count=(size\SizeOf(LONG_PTR)) As Long
231 For i=0 To ELM(count)
232 index=HitTest(pStartPtr[i] As VoidPtr)
233 If index<>-1 Then
234 If pbMark[index]=0 Then
235 pbMark[index]=1
236
237 If (pdwFlags[index] and _System_GC_FLAG_ATOMIC)=0 Then
238 'ヒープ領域がポインタ値を含む可能性があるとき
239 If ppPtr[index] = 0 Then
240 'エラー
241
242 End If
243 Scan(ppPtr[index] As *LONG_PTR,pSize[index],pbMark)
244 End If
245 End If
246 End If
247 Next
248 End Sub
249
250 ' ローカル領域をルートに指定してスキャン
251 Sub LocalScan( pbMark As *Byte )
252 Dim Context As CONTEXT
253 Dim NowSp As *LONG_PTR
254 Dim size As LONG_PTR
255 Dim i As Long
256 For i=0 To ELM(_System_pobj_AllThreads->ThreadNum)
257 If _System_pobj_AllThreads->ppobj_Thread[i] Then
258 FillMemory(VarPtr(Context),SizeOf(CONTEXT),0)
259 Context.ContextFlags=CONTEXT_CONTROL
260 If _System_pobj_AllThreads->ppobj_Thread[i]->__GetContext(Context)=0 Then
261 OutputDebugString(Ex"レジスタ情報の取得に失敗しました。\r\n")
262 End If
263
264#ifdef _WIN64
265 NowSp=Context.Rsp As *LONG_PTR
266#else
267 NowSp=Context.Esp As *LONG_PTR
268#endif
269
270 size=(_System_pobj_AllThreads->pStackBase[i] As LONG_PTR)-(NowSp As LONG_PTR)
271
272 If NowSp = 0 Then
273 debug
274 Exit Sub
275 End If
276
277 Scan( NowSp, size, pbMark )
278 End If
279 Next
280 End Sub
281
282 Sub DeleteGarbageMemories( pbMark As *Byte )
283
284 Dim isAllDelete = False
285 If pbMark = NULL Then
286 ' すべてを破棄するとき
287 isAllDelete = True
288 pbMark = _System_calloc( n )
289 End If
290
291 Dim i As Long
292 For i=0 To ELM(n)
293 If pbMark[i]=0 and ppPtr[i]<>0 and (pdwFlags[i] and _System_GC_FLAG_NEEDFREE)=0 Then
294 If ppPtr[i] = 0 Then
295 If isAllDelete Then
296 Continue
297 Else
298 debug
299 End If
300 End If
301
302 Dim ptr = ppPtr[i]
303 Dim size = pSize[i]
304
305 ppPtr[i]=0
306 pSize[i]=0
307
308 If (pdwFlags[i] and _System_GC_FLAG_OBJECT) <> 0 Then
309 /* ・オブジェクトの個数
310 ・オブジェクトのサイズ
311 ・デストラクタの関数ポインタ
312 を考慮 */
313 _System_SweepingDelete (ptr + SizeOf( LONG_PTR ) * 3 )
314 Else
315 iAllSize-=size
316 HeapFree(_System_hProcessHeap,0,ptr)
317 End If
318 End If
319 Next
320
321 If isAllDelete Then
322 _System_free( pbMark )
323 End If
324
325 End Sub
326
327 Sub DeleteAllGarbageMemories()
328 DeleteGarbageMemories( NULL )
329 End Sub
330
331 Sub Compaction()
332 Dim i As Long, i2 = 0 As Long
333 For i=0 To ELM(n)
334 ppPtr[i2] = ppPtr[i]
335 pSize[i2] = pSize[i]
336 pdwFlags[i2] = pdwFlags[i]
337
338 If ppPtr[i] Then
339 i2++
340 End If
341 Next
342 n = i2
343 End Sub
344
345 ' スウィープ(新規スレッドで呼び出し)
346 Function Cdecl SweepOnOtherThread() As Long
347 EnterCriticalSection(CriticalSection)
348
349 If isSweeping <> False Or iAllSize<limitMemorySize Then
350 ExitThread(0)
351 End If
352 isSweeping = True
353
354 ' すべてのスレッドを一時停止
355 _System_pobj_AllThreads->SuspendAllThread()
356
357 ' マークリストを生成
358 Dim pbMark = HeapAlloc(_System_hProcessHeap,HEAP_ZERO_MEMORY,n*SizeOf(Byte)) As *Byte
359
360 ' グローバル領域をルートに指定してスキャン
361 Scan( _System_gc_GlobalRoot_StartPtr, _System_gc_GlobalRoot_Size, pbMark )
362
363 ' ローカル領域をルートに指定してスキャン
364 LocalScan( pbMark )
365
366 ' スウィープ前のメモリサイズを退避
367 Dim iBackAllSize = iAllSize
368
369 ' スウィープ前のメモリオブジェクトの数
370 Dim iBeforeN = n
371
372 '使われていないメモリを解放する
373 DeleteGarbageMemories(pbMark)
374
375 'コンパクション
376 Compaction()
377
378 'マークリストを解放
379 HeapFree(_System_hProcessHeap,0,pbMark)
380
381 If iBackAllSize=iAllSize Then
382 If iAllSize > limitMemorySize Then
383 limitMemorySize = iAllSize
384 End If
385
386 '許容量を拡張する
387 limitMemorySize *= 2
388
389 OutputDebugString( Ex"memory size is extended for gc!\r\n" )
390 End If
391
392 Dim temp[100] As Char
393 wsprintf(temp,Ex"object items ... %d -> %d ( %dMB -> %dMB )\r\n",iBeforeN,n, iBackAllSize\1024\1024, iAllSize\1024\1024)
394 OutputDebugString( temp )
395 wsprintf(temp,Ex"limit size of memory ... %d\r\n",limitMemorySize)
396 OutputDebugString( temp )
397 OutputDebugString( Ex"garbage colletion sweep finish!\r\n" )
398
399
400 '-------------------------------------
401 ' すべてのスレッドを再開
402 '-------------------------------------
403 _System_pobj_AllThreads->ResumeAllThread()
404
405 LeaveCriticalSection(CriticalSection)
406 End Function
407
408 ' 未解放のメモリオブジェクトをトレース
409 Sub DumpMemoryLeaks()
410 Dim isLeak = False
411 Dim i As Long
412 For i=0 To ELM(n)
413 If ppPtr[i] Then
414 If (pdwFlags[i] and _System_GC_FLAG_NEEDFREE)<>0 Then
415 If isLeak = False Then
416 OutputDebugString( Ex"Detected memory leaks!\r\n" )
417 isLeak = True
418 End If
419
420 Dim temp[100] As Char
421 OutputDebugString( Ex"heap free missing!\r\n" )
422 wsprintf(temp,Ex"{%d} normal block at &H%08X, %d bytes long.\r\n", i, ppPtr[i], pSize[i])
423 OutputDebugString( temp )
424 End If
425 End If
426 Next
427
428 If isLeak Then
429 OutputDebugString( Ex"Object dump complete.\r\n" )
430 End If
431
432 End Sub
433
434End Class
435
436'GC管理用の特殊なシステムオブジェクト(デストラクタは最終のタイミングで呼び出されます)
437Dim _System_pGC As *_System_CGarbageCollection
438
439
440
441Function GC_malloc(size As Long) As VoidPtr
442 ' sweep
443 _System_pGC->sweep()
444
445 'allocate
446 Return _System_pGC->__malloc(size,0)
447End Function
448
449Function GC_malloc_atomic(size As Long) As VoidPtr
450 ' sweep
451 _System_pGC->sweep()
452
453 'allocate
454 Return _System_pGC->__malloc(size,_System_GC_FLAG_ATOMIC)
455End Function
456
457Function _System_GC_malloc_ForObject(size As Long) As VoidPtr
458 ' sweep
459 _System_pGC->sweep()
460
461 'allocate
462 Return _System_pGC->__malloc(size,_System_GC_FLAG_OBJECT or _System_GC_FLAG_INITZERO)
463End Function
464
465Function _System_GC_malloc_ForObjectPtr(size As Long) As VoidPtr
466 ' sweep
467 _System_pGC->sweep()
468
469 'allocate
470 Return _System_pGC->__malloc(size,_System_GC_FLAG_OBJECT or _System_GC_FLAG_INITZERO or _System_GC_FLAG_NEEDFREE)
471End Function
472
473Function _System_GC_free_for_SweepingDelete( ptr As *Object )
474 ' free
475 _System_pGC->__free_ex( ptr, True )
476End Function
Note: See TracBrowser for help on using the repository browser.