1 /* voc 2.1.0 [2019/11/01]. Bootstrapping compiler for address size 8, alignment 8. rtsSF */
2 
3 #define SHORTINT INT8
4 #define INTEGER  INT16
5 #define LONGINT  INT32
6 #define SET      UINT32
7 
8 #include "SYSTEM.h"
9 
10 struct Heap__1 {
11 	CHAR ch;
12 	SYSTEM_PTR p;
13 };
14 
15 typedef
16 	struct Heap_CmdDesc *Heap_Cmd;
17 
18 typedef
19 	CHAR Heap_CmdName[24];
20 
21 typedef
22 	void (*Heap_Command)(void);
23 
24 typedef
25 	struct Heap_CmdDesc {
26 		Heap_Cmd next;
27 		Heap_CmdName name;
28 		Heap_Command cmd;
29 	} Heap_CmdDesc;
30 
31 typedef
32 	void (*Heap_EnumProc)(void(*)(SYSTEM_PTR));
33 
34 typedef
35 	struct Heap_FinDesc *Heap_FinNode;
36 
37 typedef
38 	void (*Heap_Finalizer)(SYSTEM_PTR);
39 
40 typedef
41 	struct Heap_FinDesc {
42 		Heap_FinNode next;
43 		INT64 obj;
44 		BOOLEAN marked;
45 		Heap_Finalizer finalize;
46 	} Heap_FinDesc;
47 
48 typedef
49 	struct Heap_ModuleDesc *Heap_Module;
50 
51 typedef
52 	CHAR Heap_ModuleName[20];
53 
54 typedef
55 	struct Heap_ModuleDesc {
56 		Heap_Module next;
57 		Heap_ModuleName name;
58 		INT32 refcnt;
59 		Heap_Cmd cmds;
60 		INT64 types;
61 		Heap_EnumProc enumPtrs;
62 		INT32 reserved1, reserved2;
63 	} Heap_ModuleDesc;
64 
65 
66 export SYSTEM_PTR Heap_modules;
67 static INT64 Heap_freeList[10];
68 static INT64 Heap_bigBlocks;
69 export INT64 Heap_allocated;
70 static BOOLEAN Heap_firstTry;
71 static INT16 Heap_ldUnit;
72 export INT64 Heap_heap;
73 static INT64 Heap_heapMin, Heap_heapMax;
74 export INT64 Heap_heapsize, Heap_heapMinExpand;
75 static Heap_FinNode Heap_fin;
76 static INT16 Heap_lockdepth;
77 static BOOLEAN Heap_interrupted;
78 export INT16 Heap_FileCount;
79 
80 export ADDRESS *Heap_ModuleDesc__typ;
81 export ADDRESS *Heap_CmdDesc__typ;
82 export ADDRESS *Heap_FinDesc__typ;
83 export ADDRESS *Heap__1__typ;
84 
85 static void Heap_CheckFin (void);
86 static void Heap_ExtendHeap (INT64 blksz);
87 export void Heap_FINALL (void);
88 static void Heap_Finalize (void);
89 export INT32 Heap_FreeModule (CHAR *name, ADDRESS name__len);
90 export void Heap_GC (BOOLEAN markStack);
91 static void Heap_HeapSort (INT32 n, INT64 *a, ADDRESS a__len);
92 export void Heap_INCREF (Heap_Module m);
93 export void Heap_InitHeap (void);
94 export void Heap_Lock (void);
95 static void Heap_Mark (INT64 q);
96 static void Heap_MarkCandidates (INT32 n, INT64 *cand, ADDRESS cand__len);
97 static void Heap_MarkP (SYSTEM_PTR p);
98 static void Heap_MarkStack (INT64 n, INT64 *cand, ADDRESS cand__len);
99 export SYSTEM_PTR Heap_NEWBLK (INT64 size);
100 export SYSTEM_PTR Heap_NEWREC (INT64 tag);
101 static INT64 Heap_NewChunk (INT64 blksz);
102 export void Heap_REGCMD (Heap_Module m, Heap_CmdName name, Heap_Command cmd);
103 export SYSTEM_PTR Heap_REGMOD (Heap_ModuleName name, Heap_EnumProc enumPtrs);
104 export void Heap_REGTYP (Heap_Module m, INT64 typ);
105 export void Heap_RegisterFinalizer (SYSTEM_PTR obj, Heap_Finalizer finalize);
106 static void Heap_Scan (void);
107 static void Heap_Sift (INT32 l, INT32 r, INT64 *a, ADDRESS a__len);
108 export void Heap_Unlock (void);
109 
110 extern void *Heap__init();
111 extern ADDRESS Modules_MainStackFrame;
112 extern ADDRESS Platform_OSAllocate(ADDRESS size);
113 #define Heap_HeapModuleInit()	Heap__init()
114 #define Heap_ModulesHalt(code)	Modules_Halt(code)
115 #define Heap_ModulesMainStackFrame()	Modules_MainStackFrame
116 #define Heap_OSAllocate(size)	Platform_OSAllocate(size)
117 #define Heap_uLE(x, y)	((size_t)x <= (size_t)y)
118 #define Heap_uLT(x, y)	((size_t)x <  (size_t)y)
119 
Heap_Lock(void)120 void Heap_Lock (void)
121 {
122 	Heap_lockdepth += 1;
123 }
124 
Heap_Unlock(void)125 void Heap_Unlock (void)
126 {
127 	Heap_lockdepth -= 1;
128 	if ((Heap_interrupted && Heap_lockdepth == 0)) {
129 		Heap_ModulesHalt(-9);
130 	}
131 }
132 
Heap_REGMOD(Heap_ModuleName name,Heap_EnumProc enumPtrs)133 SYSTEM_PTR Heap_REGMOD (Heap_ModuleName name, Heap_EnumProc enumPtrs)
134 {
135 	Heap_Module m;
136 	if (__STRCMP(name, "Heap") == 0) {
137 		__SYSNEW(m, 64);
138 	} else {
139 		__NEW(m, Heap_ModuleDesc);
140 	}
141 	m->types = 0;
142 	m->cmds = NIL;
143 	__COPY(name, m->name, 20);
144 	m->refcnt = 0;
145 	m->enumPtrs = enumPtrs;
146 	m->next = (Heap_Module)(ADDRESS)Heap_modules;
147 	Heap_modules = (SYSTEM_PTR)m;
148 	return (void*)m;
149 }
150 
Heap_FreeModule(CHAR * name,ADDRESS name__len)151 INT32 Heap_FreeModule (CHAR *name, ADDRESS name__len)
152 {
153 	Heap_Module m, p;
154 	__DUP(name, name__len, CHAR);
155 	m = (Heap_Module)(ADDRESS)Heap_modules;
156 	while ((m != NIL && __STRCMP(m->name, name) != 0)) {
157 		p = m;
158 		m = m->next;
159 	}
160 	if ((m != NIL && m->refcnt == 0)) {
161 		if (m == (Heap_Module)(ADDRESS)Heap_modules) {
162 			Heap_modules = (SYSTEM_PTR)m->next;
163 		} else {
164 			p->next = m->next;
165 		}
166 		__DEL(name);
167 		return 0;
168 	} else {
169 		if (m == NIL) {
170 			__DEL(name);
171 			return -1;
172 		} else {
173 			__DEL(name);
174 			return m->refcnt;
175 		}
176 	}
177 	__RETCHK;
178 }
179 
Heap_REGCMD(Heap_Module m,Heap_CmdName name,Heap_Command cmd)180 void Heap_REGCMD (Heap_Module m, Heap_CmdName name, Heap_Command cmd)
181 {
182 	Heap_Cmd c;
183 	if (__STRCMP(m->name, "Heap") == 0) {
184 		__SYSNEW(c, 40);
185 	} else {
186 		__NEW(c, Heap_CmdDesc);
187 	}
188 	__COPY(name, c->name, 24);
189 	c->cmd = cmd;
190 	c->next = m->cmds;
191 	m->cmds = c;
192 }
193 
Heap_REGTYP(Heap_Module m,INT64 typ)194 void Heap_REGTYP (Heap_Module m, INT64 typ)
195 {
196 	__PUT(typ, m->types, INT64);
197 	m->types = typ;
198 }
199 
Heap_INCREF(Heap_Module m)200 void Heap_INCREF (Heap_Module m)
201 {
202 	m->refcnt += 1;
203 }
204 
Heap_NewChunk(INT64 blksz)205 static INT64 Heap_NewChunk (INT64 blksz)
206 {
207 	INT64 chnk, blk, end;
208 	chnk = Heap_OSAllocate(blksz + 24);
209 	if (chnk != 0) {
210 		blk = chnk + 24;
211 		end = blk + blksz;
212 		__PUT(chnk + 8, end, INT64);
213 		__PUT(blk, blk + 8, INT64);
214 		__PUT(blk + 8, blksz, INT64);
215 		__PUT(blk + 16, -8, INT64);
216 		__PUT(blk + 24, Heap_bigBlocks, INT64);
217 		Heap_bigBlocks = blk;
218 		Heap_heapsize += blksz;
219 		if (Heap_uLT(blk + 8, Heap_heapMin)) {
220 			Heap_heapMin = blk + 8;
221 		}
222 		if (Heap_uLT(Heap_heapMax, end)) {
223 			Heap_heapMax = end;
224 		}
225 	}
226 	return chnk;
227 }
228 
Heap_ExtendHeap(INT64 blksz)229 static void Heap_ExtendHeap (INT64 blksz)
230 {
231 	INT64 size, chnk, j, next;
232 		if (Heap_uLT(Heap_heapMinExpand, blksz)) {
233 		size = blksz;
234 	} else {
235 		size = Heap_heapMinExpand;
236 	}
237 	chnk = Heap_NewChunk(size);
238 	if (chnk != 0) {
239 		if (Heap_uLT(chnk, Heap_heap)) {
240 			__PUT(chnk, Heap_heap, INT64);
241 			Heap_heap = chnk;
242 		} else {
243 			j = Heap_heap;
244 			__GET(j, next, INT64);
245 			while ((next != 0 && Heap_uLT(next, chnk))) {
246 				j = next;
247 				__GET(j, next, INT64);
248 			}
249 			__PUT(chnk, next, INT64);
250 			__PUT(j, chnk, INT64);
251 		}
252 	} else if (!Heap_firstTry) {
253 		Heap_heapMinExpand = 32;
254 	}
255 }
256 
Heap_NEWREC(INT64 tag)257 SYSTEM_PTR Heap_NEWREC (INT64 tag)
258 {
259 	INT64 i, i0, di, blksz, restsize, t, adr, end, next, prev;
260 	SYSTEM_PTR new;
261 	Heap_Lock();
262 	__GET(tag, blksz, INT64);
263 		i0 = __LSH(blksz, -Heap_ldUnit, 64);
264 	i = i0;
265 	if (i < 9) {
266 		adr = Heap_freeList[i];
267 		while (adr == 0) {
268 			i += 1;
269 			adr = Heap_freeList[i];
270 		}
271 	}
272 	if (i < 9) {
273 		__GET(adr + 24, next, INT64);
274 		Heap_freeList[i] = next;
275 		if (i != i0) {
276 			di = i - i0;
277 			restsize = __ASHL(di, 5);
278 			end = adr + restsize;
279 			__PUT(end + 8, blksz, INT64);
280 			__PUT(end + 16, -8, INT64);
281 			__PUT(end, end + 8, INT64);
282 			__PUT(adr + 8, restsize, INT64);
283 			__PUT(adr + 24, Heap_freeList[di], INT64);
284 			Heap_freeList[di] = adr;
285 			adr += restsize;
286 		}
287 	} else {
288 		adr = Heap_bigBlocks;
289 		prev = 0;
290 		for (;;) {
291 			if (adr == 0) {
292 				if (Heap_firstTry) {
293 					Heap_GC(1);
294 					blksz += 32;
295 					t = __LSH(Heap_allocated + blksz, -(2 + Heap_ldUnit), 64) * 160;
296 					if (Heap_uLT(Heap_heapsize, t)) {
297 						Heap_ExtendHeap(t - Heap_heapsize);
298 					}
299 					Heap_firstTry = 0;
300 					new = Heap_NEWREC(tag);
301 					if (new == NIL) {
302 						Heap_ExtendHeap(blksz);
303 						new = Heap_NEWREC(tag);
304 					}
305 					Heap_firstTry = 1;
306 					Heap_Unlock();
307 					return new;
308 				} else {
309 					Heap_Unlock();
310 					return NIL;
311 				}
312 			}
313 			__GET(adr + 8, t, INT64);
314 			if (Heap_uLE(blksz, t)) {
315 				break;
316 			}
317 			prev = adr;
318 			__GET(adr + 24, adr, INT64);
319 		}
320 		restsize = t - blksz;
321 		end = adr + restsize;
322 		__PUT(end + 8, blksz, INT64);
323 		__PUT(end + 16, -8, INT64);
324 		__PUT(end, end + 8, INT64);
325 		if (Heap_uLT(288, restsize)) {
326 			__PUT(adr + 8, restsize, INT64);
327 		} else {
328 			__GET(adr + 24, next, INT64);
329 			if (prev == 0) {
330 				Heap_bigBlocks = next;
331 			} else {
332 				__PUT(prev + 24, next, INT64);
333 			}
334 			if (restsize != 0) {
335 				di = __ASHR(restsize, 5);
336 				__PUT(adr + 8, restsize, INT64);
337 				__PUT(adr + 24, Heap_freeList[di], INT64);
338 				Heap_freeList[di] = adr;
339 			}
340 		}
341 		adr += restsize;
342 	}
343 	i = adr + 32;
344 	end = adr + blksz;
345 	while (Heap_uLT(i, end)) {
346 		__PUT(i, 0, INT64);
347 		__PUT(i + 8, 0, INT64);
348 		__PUT(i + 16, 0, INT64);
349 		__PUT(i + 24, 0, INT64);
350 		i += 32;
351 	}
352 	__PUT(adr + 24, 0, INT64);
353 	__PUT(adr, tag, INT64);
354 	__PUT(adr + 8, 0, INT64);
355 	__PUT(adr + 16, 0, INT64);
356 	Heap_allocated += blksz;
357 	Heap_Unlock();
358 	return (SYSTEM_PTR)(ADDRESS)(adr + 8);
359 }
360 
Heap_NEWBLK(INT64 size)361 SYSTEM_PTR Heap_NEWBLK (INT64 size)
362 {
363 	INT64 blksz, tag;
364 	SYSTEM_PTR new;
365 	Heap_Lock();
366 	blksz = __ASHL(__ASHR(size + 63, 5), 5);
367 	new = Heap_NEWREC((ADDRESS)&blksz);
368 	tag = ((INT64)(ADDRESS)new + blksz) - 24;
369 	__PUT(tag - 8, 0, INT64);
370 	__PUT(tag, blksz, INT64);
371 	__PUT(tag + 8, -8, INT64);
372 	__PUT((INT64)(ADDRESS)new - 8, tag, INT64);
373 	Heap_Unlock();
374 	return new;
375 }
376 
Heap_Mark(INT64 q)377 static void Heap_Mark (INT64 q)
378 {
379 	INT64 p, tag, offset, fld, n, tagbits;
380 	if (q != 0) {
381 		__GET(q - 8, tagbits, INT64);
382 		if (!__ODD(tagbits)) {
383 			__PUT(q - 8, tagbits + 1, INT64);
384 			p = 0;
385 			tag = tagbits + 8;
386 			for (;;) {
387 				__GET(tag, offset, INT64);
388 				if (offset < 0) {
389 					__PUT(q - 8, (tag + offset) + 1, INT64);
390 					if (p == 0) {
391 						break;
392 					}
393 					n = q;
394 					q = p;
395 					__GET(q - 8, tag, INT64);
396 					tag -= 1;
397 					__GET(tag, offset, INT64);
398 					fld = q + offset;
399 					__GET(fld, p, INT64);
400 					__PUT(fld, (SYSTEM_PTR)(ADDRESS)n, SYSTEM_PTR);
401 				} else {
402 					fld = q + offset;
403 					__GET(fld, n, INT64);
404 					if (n != 0) {
405 						__GET(n - 8, tagbits, INT64);
406 						if (!__ODD(tagbits)) {
407 							__PUT(n - 8, tagbits + 1, INT64);
408 							__PUT(q - 8, tag + 1, INT64);
409 							__PUT(fld, (SYSTEM_PTR)(ADDRESS)p, SYSTEM_PTR);
410 							p = q;
411 							q = n;
412 							tag = tagbits;
413 						}
414 					}
415 				}
416 				tag += 8;
417 			}
418 		}
419 	}
420 }
421 
Heap_MarkP(SYSTEM_PTR p)422 static void Heap_MarkP (SYSTEM_PTR p)
423 {
424 	Heap_Mark((INT64)(ADDRESS)p);
425 }
426 
Heap_Scan(void)427 static void Heap_Scan (void)
428 {
429 	INT64 chnk, adr, end, start, tag, i, size, freesize;
430 	Heap_bigBlocks = 0;
431 	i = 1;
432 	while (i < 9) {
433 		Heap_freeList[i] = 0;
434 		i += 1;
435 	}
436 	freesize = 0;
437 	Heap_allocated = 0;
438 	chnk = Heap_heap;
439 	while (chnk != 0) {
440 		adr = chnk + 24;
441 		__GET(chnk + 8, end, INT64);
442 		while (Heap_uLT(adr, end)) {
443 			__GET(adr, tag, INT64);
444 			if (__ODD(tag)) {
445 				if (freesize != 0) {
446 					start = adr - freesize;
447 					__PUT(start, start + 8, INT64);
448 					__PUT(start + 8, freesize, INT64);
449 					__PUT(start + 16, -8, INT64);
450 					i = __LSH(freesize, -Heap_ldUnit, 64);
451 					freesize = 0;
452 					if (Heap_uLT(i, 9)) {
453 						__PUT(start + 24, Heap_freeList[i], INT64);
454 						Heap_freeList[i] = start;
455 					} else {
456 						__PUT(start + 24, Heap_bigBlocks, INT64);
457 						Heap_bigBlocks = start;
458 					}
459 				}
460 				tag -= 1;
461 				__PUT(adr, tag, INT64);
462 				__GET(tag, size, INT64);
463 				Heap_allocated += size;
464 				adr += size;
465 			} else {
466 				__GET(tag, size, INT64);
467 				freesize += size;
468 				adr += size;
469 			}
470 		}
471 		if (freesize != 0) {
472 			start = adr - freesize;
473 			__PUT(start, start + 8, INT64);
474 			__PUT(start + 8, freesize, INT64);
475 			__PUT(start + 16, -8, INT64);
476 			i = __LSH(freesize, -Heap_ldUnit, 64);
477 			freesize = 0;
478 			if (Heap_uLT(i, 9)) {
479 				__PUT(start + 24, Heap_freeList[i], INT64);
480 				Heap_freeList[i] = start;
481 			} else {
482 				__PUT(start + 24, Heap_bigBlocks, INT64);
483 				Heap_bigBlocks = start;
484 			}
485 		}
486 		__GET(chnk, chnk, INT64);
487 	}
488 }
489 
Heap_Sift(INT32 l,INT32 r,INT64 * a,ADDRESS a__len)490 static void Heap_Sift (INT32 l, INT32 r, INT64 *a, ADDRESS a__len)
491 {
492 	INT32 i, j;
493 	INT64 x;
494 	j = l;
495 	x = a[j];
496 	for (;;) {
497 		i = j;
498 		j = __ASHL(j, 1) + 1;
499 		if ((j < r && Heap_uLT(a[j], a[j + 1]))) {
500 			j += 1;
501 		}
502 		if (j > r || Heap_uLE(a[j], x)) {
503 			break;
504 		}
505 		a[i] = a[j];
506 	}
507 	a[i] = x;
508 }
509 
Heap_HeapSort(INT32 n,INT64 * a,ADDRESS a__len)510 static void Heap_HeapSort (INT32 n, INT64 *a, ADDRESS a__len)
511 {
512 	INT32 l, r;
513 	INT64 x;
514 	l = __ASHR(n, 1);
515 	r = n - 1;
516 	while (l > 0) {
517 		l -= 1;
518 		Heap_Sift(l, r, (void*)a, a__len);
519 	}
520 	while (r > 0) {
521 		x = a[0];
522 		a[0] = a[r];
523 		a[r] = x;
524 		r -= 1;
525 		Heap_Sift(l, r, (void*)a, a__len);
526 	}
527 }
528 
Heap_MarkCandidates(INT32 n,INT64 * cand,ADDRESS cand__len)529 static void Heap_MarkCandidates (INT32 n, INT64 *cand, ADDRESS cand__len)
530 {
531 	INT64 chnk, end, adr, tag, next, i, ptr, size;
532 		chnk = Heap_heap;
533 	i = 0;
534 	while (chnk != 0) {
535 		__GET(chnk + 8, end, INT64);
536 		adr = chnk + 24;
537 		while (Heap_uLT(adr, end)) {
538 			__GET(adr, tag, INT64);
539 			if (__ODD(tag)) {
540 				__GET(tag - 1, size, INT64);
541 				adr += size;
542 				ptr = adr + 8;
543 				while (Heap_uLT(cand[i], ptr)) {
544 					i += 1;
545 					if (i == (INT64)n) {
546 						return;
547 					}
548 				}
549 			} else {
550 				__GET(tag, size, INT64);
551 				ptr = adr + 8;
552 				adr += size;
553 				while (Heap_uLT(cand[i], ptr)) {
554 					i += 1;
555 					if (i == (INT64)n) {
556 						return;
557 					}
558 				}
559 				if (Heap_uLT(cand[i], adr)) {
560 					Heap_Mark(ptr);
561 				}
562 			}
563 			if (Heap_uLE(end, cand[i])) {
564 				adr = end;
565 			}
566 		}
567 		__GET(chnk, chnk, INT64);
568 	}
569 }
570 
Heap_CheckFin(void)571 static void Heap_CheckFin (void)
572 {
573 	Heap_FinNode n;
574 	INT64 tag;
575 	n = Heap_fin;
576 	while (n != NIL) {
577 		__GET(n->obj - 8, tag, INT64);
578 		if (!__ODD(tag)) {
579 			n->marked = 0;
580 			Heap_Mark(n->obj);
581 		} else {
582 			n->marked = 1;
583 		}
584 		n = n->next;
585 	}
586 }
587 
Heap_Finalize(void)588 static void Heap_Finalize (void)
589 {
590 	Heap_FinNode n, prev;
591 	n = Heap_fin;
592 	prev = NIL;
593 	while (n != NIL) {
594 		if (!n->marked) {
595 			if (n == Heap_fin) {
596 				Heap_fin = Heap_fin->next;
597 			} else {
598 				prev->next = n->next;
599 			}
600 			(*n->finalize)((SYSTEM_PTR)(ADDRESS)n->obj);
601 			if (prev == NIL) {
602 				n = Heap_fin;
603 			} else {
604 				n = n->next;
605 			}
606 		} else {
607 			prev = n;
608 			n = n->next;
609 		}
610 	}
611 }
612 
Heap_FINALL(void)613 void Heap_FINALL (void)
614 {
615 	Heap_FinNode n;
616 	while (Heap_fin != NIL) {
617 		n = Heap_fin;
618 		Heap_fin = Heap_fin->next;
619 		(*n->finalize)((SYSTEM_PTR)(ADDRESS)n->obj);
620 	}
621 }
622 
Heap_MarkStack(INT64 n,INT64 * cand,ADDRESS cand__len)623 static void Heap_MarkStack (INT64 n, INT64 *cand, ADDRESS cand__len)
624 {
625 	SYSTEM_PTR frame;
626 	INT32 nofcand;
627 	INT64 inc, sp, p, stack0;
628 	struct Heap__1 align;
629 	if (n > 0) {
630 		Heap_MarkStack(n - 1, cand, cand__len);
631 		if (n > 100) {
632 			return;
633 		}
634 	}
635 	if (n == 0) {
636 		nofcand = 0;
637 		sp = (ADDRESS)&frame;
638 		stack0 = Heap_ModulesMainStackFrame();
639 		inc = (ADDRESS)&align.p - (ADDRESS)&align;
640 		if (Heap_uLT(stack0, sp)) {
641 			inc = -inc;
642 		}
643 		while (sp != stack0) {
644 			__GET(sp, p, INT64);
645 			if ((Heap_uLE(Heap_heapMin, p) && Heap_uLT(p, Heap_heapMax))) {
646 				if (nofcand == cand__len) {
647 					Heap_HeapSort(nofcand, (void*)cand, cand__len);
648 					Heap_MarkCandidates(nofcand, (void*)cand, cand__len);
649 					nofcand = 0;
650 				}
651 				cand[nofcand] = p;
652 				nofcand += 1;
653 			}
654 			sp += inc;
655 		}
656 		if (nofcand > 0) {
657 			Heap_HeapSort(nofcand, (void*)cand, cand__len);
658 			Heap_MarkCandidates(nofcand, (void*)cand, cand__len);
659 		}
660 	}
661 }
662 
Heap_GC(BOOLEAN markStack)663 void Heap_GC (BOOLEAN markStack)
664 {
665 	Heap_Module m;
666 	INT64 i0, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, i21, i22, i23;
667 	INT64 cand[10000];
668 	if (Heap_lockdepth == 0 || (Heap_lockdepth == 1 && !markStack)) {
669 		Heap_Lock();
670 		m = (Heap_Module)(ADDRESS)Heap_modules;
671 		while (m != NIL) {
672 			if (m->enumPtrs != NIL) {
673 				(*m->enumPtrs)(Heap_MarkP);
674 			}
675 			m = m->next;
676 		}
677 		if (markStack) {
678 			i0 = -100;
679 			i1 = -101;
680 			i2 = -102;
681 			i3 = -103;
682 			i4 = -104;
683 			i5 = -105;
684 			i6 = -106;
685 			i7 = -107;
686 			i8 = 1;
687 			i9 = 2;
688 			i10 = 3;
689 			i11 = 4;
690 			i12 = 5;
691 			i13 = 6;
692 			i14 = 7;
693 			i15 = 8;
694 			i16 = 9;
695 			i17 = 10;
696 			i18 = 11;
697 			i19 = 12;
698 			i20 = 13;
699 			i21 = 14;
700 			i22 = 15;
701 			i23 = 16;
702 			for (;;) {
703 				i0 += 1;
704 				i1 += 2;
705 				i2 += 3;
706 				i3 += 4;
707 				i4 += 5;
708 				i5 += 6;
709 				i6 += 7;
710 				i7 += 8;
711 				i8 += 9;
712 				i9 += 10;
713 				i10 += 11;
714 				i11 += 12;
715 				i12 += 13;
716 				i13 += 14;
717 				i14 += 15;
718 				i15 += 16;
719 				i16 += 17;
720 				i17 += 18;
721 				i18 += 19;
722 				i19 += 20;
723 				i20 += 21;
724 				i21 += 22;
725 				i22 += 23;
726 				i23 += 24;
727 				if ((i0 == -99 && i15 == 24)) {
728 					Heap_MarkStack(32, (void*)cand, 10000);
729 					break;
730 				}
731 			}
732 			if (((((((((((((((((((((((i0 + i1) + i2) + i3) + i4) + i5) + i6) + i7) + i8) + i9) + i10) + i11) + i12) + i13) + i14) + i15) + i16) + i17) + i18) + i19) + i20) + i21) + i22) + i23 > 10000) {
733 				return;
734 			}
735 		}
736 		Heap_CheckFin();
737 		Heap_Scan();
738 		Heap_Finalize();
739 		Heap_Unlock();
740 	}
741 }
742 
Heap_RegisterFinalizer(SYSTEM_PTR obj,Heap_Finalizer finalize)743 void Heap_RegisterFinalizer (SYSTEM_PTR obj, Heap_Finalizer finalize)
744 {
745 	Heap_FinNode f;
746 	__NEW(f, Heap_FinDesc);
747 	f->obj = (INT64)(ADDRESS)obj;
748 	f->finalize = finalize;
749 	f->marked = 1;
750 	f->next = Heap_fin;
751 	Heap_fin = f;
752 }
753 
Heap_InitHeap(void)754 void Heap_InitHeap (void)
755 {
756 	Heap_heap = 0;
757 	Heap_heapsize = 0;
758 	Heap_allocated = 0;
759 	Heap_lockdepth = 0;
760 	Heap_heapMin = -1;
761 	Heap_heapMax = 0;
762 	Heap_bigBlocks = 0;
763 	Heap_heapMinExpand = 256000;
764 	Heap_ldUnit = 5;
765 	Heap_heap = Heap_NewChunk(256000);
766 	__PUT(Heap_heap, 0, INT64);
767 	Heap_firstTry = 1;
768 	Heap_freeList[9] = 1;
769 	Heap_FileCount = 0;
770 	Heap_modules = NIL;
771 	Heap_fin = NIL;
772 	Heap_interrupted = 0;
773 	Heap_HeapModuleInit();
774 }
775 
EnumPtrs(void (* P)(void *))776 static void EnumPtrs(void (*P)(void*))
777 {
778 	P(Heap_modules);
779 	P(Heap_fin);
780 }
781 
782 __TDESC(Heap_ModuleDesc, 1, 2) = {__TDFLDS("ModuleDesc", 64), {0, 32, -24}};
783 __TDESC(Heap_CmdDesc, 1, 1) = {__TDFLDS("CmdDesc", 40), {0, -16}};
784 __TDESC(Heap_FinDesc, 1, 1) = {__TDFLDS("FinDesc", 32), {0, -16}};
785 __TDESC(Heap__1, 1, 1) = {__TDFLDS("", 16), {8, -16}};
786 
Heap__init(void)787 export void *Heap__init(void)
788 {
789 	__DEFMOD;
790 	__REGMOD("Heap", EnumPtrs);
791 	__REGCMD("FINALL", Heap_FINALL);
792 	__REGCMD("InitHeap", Heap_InitHeap);
793 	__REGCMD("Lock", Heap_Lock);
794 	__REGCMD("Unlock", Heap_Unlock);
795 	__INITYP(Heap_ModuleDesc, Heap_ModuleDesc, 0);
796 	__INITYP(Heap_CmdDesc, Heap_CmdDesc, 0);
797 	__INITYP(Heap_FinDesc, Heap_FinDesc, 0);
798 	__INITYP(Heap__1, Heap__1, 0);
799 /* BEGIN */
800 	__ENDMOD;
801 }
802