1 |
|
---|
2 | /*
|
---|
3 | ※これらの変数はコンパイラが自動的に定義します。
|
---|
4 | Dim _System_gc_GlobalRoot_StartPtr As VoidPtr
|
---|
5 | Dim _System_gc_GlobalRoot_Size As Long
|
---|
6 | Dim _System_gc_StackRoot_StartPtr As VoidPtr
|
---|
7 | */
|
---|
8 |
|
---|
9 | Function _System_GetSp() As LONG_PTR 'dummy
|
---|
10 | End Function
|
---|
11 |
|
---|
12 |
|
---|
13 | 'メモリの上限値(この値を超えるとGCが発動します)
|
---|
14 | '※バイト単位
|
---|
15 | Dim _System_SWEEP_LIMIT_MEMORY = 1024*1024*30 As LONG_PTR
|
---|
16 |
|
---|
17 | Const _System_GC_FLAG_ATOMIC = 1
|
---|
18 | Const _System_GC_FLAG_NEEDFREE = 2
|
---|
19 | Const _System_GC_FLAG_INITZERO = 4
|
---|
20 |
|
---|
21 | Const THREAD_GET_CONTEXT = &H0008
|
---|
22 |
|
---|
23 | Class _System_CGarbageCollection
|
---|
24 | ppPtr As **VoidPtr
|
---|
25 | pSize As *SIZE_T
|
---|
26 | pbFlags As *Byte
|
---|
27 | n As Long
|
---|
28 |
|
---|
29 | iAllSize As SIZE_T
|
---|
30 |
|
---|
31 | 'スレッド情報
|
---|
32 | phThread As *HANDLE
|
---|
33 | pStackBase As **LONG_PTR
|
---|
34 | ThreadNum As Long
|
---|
35 |
|
---|
36 | CriticalSection As CRITICAL_SECTION
|
---|
37 |
|
---|
38 | Public
|
---|
39 | Sub _System_CGarbageCollection()
|
---|
40 | If ppPtr Then Exit Sub
|
---|
41 |
|
---|
42 | ppPtr=HeapAlloc(_System_hProcessHeap,0,1)
|
---|
43 | pSize=HeapAlloc(_System_hProcessHeap,0,1)
|
---|
44 | pbFlags=HeapAlloc(_System_hProcessHeap,0,1)
|
---|
45 | n=0
|
---|
46 |
|
---|
47 | iAllSize=0
|
---|
48 |
|
---|
49 | 'スレッド情報
|
---|
50 | phThread=HeapAlloc(_System_hProcessHeap,0,1)
|
---|
51 | pStackBase=HeapAlloc(_System_hProcessHeap,0,1)
|
---|
52 | ThreadNum=0
|
---|
53 |
|
---|
54 | 'クリティカルセッションを生成
|
---|
55 | InitializeCriticalSection(CriticalSection)
|
---|
56 |
|
---|
57 | '開始時のスレッドを通知
|
---|
58 | Dim hTargetThread As HANDLE
|
---|
59 | DuplicateHandle(GetCurrentProcess(),
|
---|
60 | GetCurrentThread(),
|
---|
61 | GetCurrentProcess(),
|
---|
62 | hTargetThread, 0, FALSE, DUPLICATE_SAME_ACCESS) 'カレントスレッドのハンドルを複製
|
---|
63 | BeginThread(hTargetThread,_System_gc_StackRoot_StartPtr As *LONG_PTR)
|
---|
64 | End Sub
|
---|
65 | Sub ~_System_CGarbageCollection()
|
---|
66 | If ppPtr=0 Then Exit Sub
|
---|
67 |
|
---|
68 | '解放スレッドを生成
|
---|
69 | Dim hThread As HANDLE
|
---|
70 | Dim ThreadId As DWord
|
---|
71 | hThread=_beginthreadex(NULL,0,AddressOf(DestructorThread),VarPtr(This),0,ThreadId)
|
---|
72 | CloseHandle(hThread)
|
---|
73 | Sleep(INFINITE)
|
---|
74 | End Sub
|
---|
75 |
|
---|
76 | Private
|
---|
77 | Function Cdecl DestructorThread() As Long
|
---|
78 | '-------------------------------------
|
---|
79 | ' すべてのスレッドを一時停止
|
---|
80 | '-------------------------------------
|
---|
81 | Dim i As Long
|
---|
82 | For i=0 To ELM(ThreadNum)
|
---|
83 | If phThread[i] Then
|
---|
84 | SuspendThread(phThread[i])
|
---|
85 | End If
|
---|
86 | Next
|
---|
87 |
|
---|
88 |
|
---|
89 | For i=0 To ELM(n)
|
---|
90 | If ppPtr[i] Then HeapFree(_System_hProcessHeap,0,ppPtr[i])
|
---|
91 | Next
|
---|
92 | HeapFree(_System_hProcessHeap,0,ppPtr)
|
---|
93 | ppPtr=0
|
---|
94 |
|
---|
95 | HeapFree(_System_hProcessHeap,0,pSize)
|
---|
96 | pSize=0
|
---|
97 | HeapFree(_System_hProcessHeap,0,pbFlags)
|
---|
98 | pbFlags=0
|
---|
99 |
|
---|
100 | 'スレッド情報
|
---|
101 | HeapFree(_System_hProcessHeap,0,phThread)
|
---|
102 | phThread=0
|
---|
103 | HeapFree(_System_hProcessHeap,0,pStackBase)
|
---|
104 | pStackBase=0
|
---|
105 |
|
---|
106 | 'クリティカルセッションを破棄
|
---|
107 | DeleteCriticalSection(CriticalSection)
|
---|
108 |
|
---|
109 |
|
---|
110 | 'プロセスを終了
|
---|
111 | ExitProcess(0)
|
---|
112 | End Function
|
---|
113 | Public
|
---|
114 |
|
---|
115 |
|
---|
116 |
|
---|
117 | Sub add(new_ptr As VoidPtr, size As SIZE_T,flags As Byte)
|
---|
118 | iAllSize+=size
|
---|
119 |
|
---|
120 | Dim i As Long
|
---|
121 | For i=0 To ELM(n)
|
---|
122 | If ppPtr[i]=0 Then
|
---|
123 | ppPtr[i]=new_ptr
|
---|
124 | pSize[i]=size
|
---|
125 | pbFlags[i]=flags
|
---|
126 | Exit Sub
|
---|
127 | End If
|
---|
128 | Next
|
---|
129 |
|
---|
130 | ppPtr=HeapReAlloc(_System_hProcessHeap,0,ppPtr,(n+1)*SizeOf(VoidPtr))
|
---|
131 | ppPtr[n]=new_ptr
|
---|
132 |
|
---|
133 | pSize=HeapReAlloc(_System_hProcessHeap,0,pSize,(n+1)*SizeOf(SIZE_T))
|
---|
134 | pSize[n]=size
|
---|
135 |
|
---|
136 | pbFlags=HeapReAlloc(_System_hProcessHeap,0,pbFlags,(n+1)*SizeOf(Byte))
|
---|
137 | pbFlags[n]=flags
|
---|
138 |
|
---|
139 | n++
|
---|
140 | End Sub
|
---|
141 |
|
---|
142 |
|
---|
143 | Function __malloc(size As SIZE_T,flags As Byte) As VoidPtr
|
---|
144 | EnterCriticalSection(CriticalSection)
|
---|
145 | Dim dwFlags As DWord
|
---|
146 | If flags and _System_GC_FLAG_INITZERO Then
|
---|
147 | dwFlags=HEAP_ZERO_MEMORY
|
---|
148 | Else
|
---|
149 | dwFlags=0
|
---|
150 | End If
|
---|
151 |
|
---|
152 |
|
---|
153 | Dim pTemp As VoidPtr
|
---|
154 | pTemp=HeapAlloc(_System_hProcessHeap,dwFlags,size)
|
---|
155 | add(pTemp,size,flags)
|
---|
156 | LeaveCriticalSection(CriticalSection)
|
---|
157 | Return pTemp
|
---|
158 | End Function
|
---|
159 |
|
---|
160 | Function __realloc(lpMem As VoidPtr, size As SIZE_T) As VoidPtr
|
---|
161 | Dim i As Long
|
---|
162 | For i=0 To ELM(n)
|
---|
163 | If ppPtr[i]=lpMem Then
|
---|
164 | iAllSize+=size-pSize[i]
|
---|
165 |
|
---|
166 | pSize[i]=size
|
---|
167 | ppPtr[i]=HeapReAlloc(_System_hProcessHeap,HEAP_ZERO_MEMORY,lpMem,size)
|
---|
168 | Return ppPtr[i]
|
---|
169 | End If
|
---|
170 | Next
|
---|
171 | Return 0
|
---|
172 | End Function
|
---|
173 |
|
---|
174 | Sub __free(lpMem As VoidPtr)
|
---|
175 | Dim i As Long
|
---|
176 | For i=0 To ELM(n)
|
---|
177 | If ppPtr[i]=lpMem Then
|
---|
178 | If pbFlags[i] and _System_GC_FLAG_NEEDFREE Then
|
---|
179 | iAllSize-=pSize[i]
|
---|
180 |
|
---|
181 | HeapFree(_System_hProcessHeap,0,ppPtr[i])
|
---|
182 | ppPtr[i]=0
|
---|
183 | pSize[i]=0
|
---|
184 | Else
|
---|
185 | OutputDebugString(Ex"GCが管理しているメモリ空間を解放しようとしました。\r\n")
|
---|
186 | End If
|
---|
187 | End If
|
---|
188 | Next
|
---|
189 | End Sub
|
---|
190 |
|
---|
191 | Sub sweep()
|
---|
192 | EnterCriticalSection(CriticalSection)
|
---|
193 |
|
---|
194 | If iAllSize<_System_SWEEP_LIMIT_MEMORY Then
|
---|
195 | 'メモリ使用量が上限値を超えていないとき
|
---|
196 | LeaveCriticalSection(CriticalSection)
|
---|
197 | Exit Sub
|
---|
198 | End If
|
---|
199 |
|
---|
200 | Dim hThread As HANDLE
|
---|
201 | Dim ThreadId As DWord
|
---|
202 | hThread=_beginthreadex(NULL,0,AddressOf(SweepOnOtherThread),VarPtr(This),0,ThreadId)
|
---|
203 | WaitForSingleObject(hThread,INFINITE)
|
---|
204 | CloseHandle(hThread)
|
---|
205 |
|
---|
206 | LeaveCriticalSection(CriticalSection)
|
---|
207 | End Sub
|
---|
208 |
|
---|
209 | Function Cdecl SweepOnOtherThread() As Long
|
---|
210 |
|
---|
211 | '-------------------------------------
|
---|
212 | ' すべてのスレッドを一時停止
|
---|
213 | '-------------------------------------
|
---|
214 | Dim i As Long
|
---|
215 | For i=0 To ELM(ThreadNum)
|
---|
216 | If phThread[i] Then
|
---|
217 | SuspendThread(phThread[i])
|
---|
218 | End If
|
---|
219 | Next
|
---|
220 |
|
---|
221 |
|
---|
222 | 'マークリストを生成
|
---|
223 | pbMark=HeapAlloc(_System_hProcessHeap,HEAP_ZERO_MEMORY,n*SizeOf(Byte))
|
---|
224 |
|
---|
225 |
|
---|
226 | '-----------------------------------------------
|
---|
227 | ' グローバル領域をルートに指定してスキャン
|
---|
228 | '-----------------------------------------------
|
---|
229 | scan(_System_gc_GlobalRoot_StartPtr,_System_gc_GlobalRoot_Size)
|
---|
230 |
|
---|
231 | '-----------------------------------------------
|
---|
232 | 'ローカル領域をルートに指定してスキャン
|
---|
233 | '-----------------------------------------------
|
---|
234 | Dim NowSp As *LONG_PTR
|
---|
235 | Dim Context As CONTEXT
|
---|
236 | Dim size As LONG_PTR
|
---|
237 | For i=0 To ELM(ThreadNum)
|
---|
238 | If phThread[i] Then
|
---|
239 | FillMemory(VarPtr(Context),SizeOf(CONTEXT),0)
|
---|
240 | Context.ContextFlags=CONTEXT_CONTROL
|
---|
241 | If GetThreadContext(phThread[i],Context)=0 Then
|
---|
242 | OutputDebugString(Ex"レジスタ情報の取得に失敗しました。\r\n")
|
---|
243 | End If
|
---|
244 |
|
---|
245 | #ifdef _WIN64
|
---|
246 | NowSp=Context.Rsp As *LONG_PTR
|
---|
247 | #else
|
---|
248 | NowSp=Context.Esp As *LONG_PTR
|
---|
249 | #endif
|
---|
250 |
|
---|
251 | size=(pStackBase[i] As LONG_PTR)-(NowSp As LONG_PTR)
|
---|
252 |
|
---|
253 | scan(NowSp,size)
|
---|
254 | End If
|
---|
255 | Next
|
---|
256 |
|
---|
257 |
|
---|
258 | Dim iBackAllSize As SIZE_T
|
---|
259 | iBackAllSize=iAllSize
|
---|
260 |
|
---|
261 | '使われていないメモリを解放する
|
---|
262 | For i=0 To ELM(n)
|
---|
263 | If pbMark[i]=0 and ppPtr[i]<>0 and (pbFlags[i] and _System_GC_FLAG_NEEDFREE)=0 Then
|
---|
264 | iAllSize-=pSize[i]
|
---|
265 |
|
---|
266 | HeapFree(_System_hProcessHeap,0,ppPtr[i])
|
---|
267 | ppPtr[i]=0
|
---|
268 | pSize[i]=0
|
---|
269 | End If
|
---|
270 | Next
|
---|
271 |
|
---|
272 | 'マークリストを解放
|
---|
273 | HeapFree(_System_hProcessHeap,0,pbMark)
|
---|
274 |
|
---|
275 | If iBackAllSize=iAllSize Then
|
---|
276 | '許容量を拡張する
|
---|
277 | _System_SWEEP_LIMIT_MEMORY*=2
|
---|
278 | End If
|
---|
279 |
|
---|
280 |
|
---|
281 | '-------------------------------------
|
---|
282 | ' すべてのスレッドを再開
|
---|
283 | '-------------------------------------
|
---|
284 | For i=0 To ELM(ThreadNum)
|
---|
285 | If phThread[i] Then
|
---|
286 | ResumeThread(phThread[i])
|
---|
287 | End If
|
---|
288 | Next
|
---|
289 | End Function
|
---|
290 |
|
---|
291 |
|
---|
292 |
|
---|
293 | '----------------------------
|
---|
294 | ' スレッド制御のメソッド
|
---|
295 | '----------------------------
|
---|
296 | Sub BeginThread(hThread As HANDLE,NowSp As *LONG_PTR)
|
---|
297 | EnterCriticalSection(CriticalSection)
|
---|
298 | Dim i As Long
|
---|
299 | For i=0 To ELM(ThreadNum)
|
---|
300 | If phThread[i]=0 Then
|
---|
301 | phThread[i]=hThread
|
---|
302 | pStackBase[i]=NowSp
|
---|
303 | Exit For
|
---|
304 | End If
|
---|
305 | Next
|
---|
306 |
|
---|
307 | If i=ThreadNum Then
|
---|
308 | phThread=HeapReAlloc(_System_hProcessHeap,0,phThread,(ThreadNum+1)*SizeOf(HANDLE))
|
---|
309 | phThread[ThreadNum]=hThread
|
---|
310 | pStackBase=HeapReAlloc(_System_hProcessHeap,0,pStackBase,(ThreadNum+1)*SizeOf(LONG_PTR))
|
---|
311 | pStackBase[ThreadNum]=NowSp
|
---|
312 | ThreadNum++
|
---|
313 | End If
|
---|
314 | LeaveCriticalSection(CriticalSection)
|
---|
315 | End Sub
|
---|
316 | Sub EndThread(hThread As HANDLE)
|
---|
317 | EnterCriticalSection(CriticalSection)
|
---|
318 | Dim i As Long
|
---|
319 | For i=0 To ELM(ThreadNum)
|
---|
320 | If phThread[i]=hThread Then
|
---|
321 | phThread[i]=0
|
---|
322 | pStackBase[i]=0
|
---|
323 | Exit For
|
---|
324 | End If
|
---|
325 | Next
|
---|
326 | LeaveCriticalSection(CriticalSection)
|
---|
327 | End Sub
|
---|
328 |
|
---|
329 |
|
---|
330 | Private
|
---|
331 |
|
---|
332 | pbMark As *Byte
|
---|
333 |
|
---|
334 | Function HitTest(pSample As VoidPtr) As Long
|
---|
335 | Dim i As Long
|
---|
336 | For i=0 To ELM(n)
|
---|
337 | If (ppPtr[i] As LONG_PTR)<=(pSample As LONG_PTR) and (pSample As LONG_PTR)<((ppPtr[i] As LONG_PTR)+pSize[i]) Then
|
---|
338 | Return i
|
---|
339 | End If
|
---|
340 | Next
|
---|
341 | Return -1
|
---|
342 | End Function
|
---|
343 |
|
---|
344 | Sub scan(pStartPtr As *LONG_PTR, size As LONG_PTR)
|
---|
345 | Dim i As Long, count As Long, index As Long
|
---|
346 | count=(size\SizeOf(LONG_PTR)) As Long
|
---|
347 | For i=0 To ELM(count)
|
---|
348 | index=HitTest(pStartPtr[i] As VoidPtr)
|
---|
349 | If index<>-1 Then
|
---|
350 | If pbMark[index]=0 Then
|
---|
351 | pbMark[index]=1
|
---|
352 |
|
---|
353 | If (pbFlags[index] and _System_GC_FLAG_ATOMIC)=0 Then
|
---|
354 | 'ヒープ領域がポインタ値を含む可能性があるとき
|
---|
355 | scan(ppPtr[index] As *LONG_PTR,pSize[index])
|
---|
356 | End If
|
---|
357 | End If
|
---|
358 | End If
|
---|
359 | Next
|
---|
360 | End Sub
|
---|
361 | End Class
|
---|
362 |
|
---|
363 | 'GC管理用の特殊なシステムオブジェクト(デストラクタは最終のタイミングで呼び出されます)
|
---|
364 | Dim _System_GC As _System_CGarbageCollection
|
---|
365 |
|
---|
366 |
|
---|
367 |
|
---|
368 | Function GC_malloc(size As Long) As VoidPtr
|
---|
369 | ' sweep
|
---|
370 | _System_GC.sweep()
|
---|
371 |
|
---|
372 | 'allocate
|
---|
373 | Return _System_GC.__malloc(size,0)
|
---|
374 | End Function
|
---|
375 |
|
---|
376 | Function GC_malloc_atomic(size As Long) As VoidPtr
|
---|
377 | ' sweep
|
---|
378 | _System_GC.sweep()
|
---|
379 |
|
---|
380 | 'allocate
|
---|
381 | Return _System_GC.__malloc(size,_System_GC_FLAG_ATOMIC)
|
---|
382 | End Function
|
---|