1 /****************************************************************/
2 /* file alloc.c
3
4 ARIBAS interpreter for Arithmetic
5 Copyright (C) 1996-2002 O.Forster
6
7 This program is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2 of the License, or
10 (at your option) any later version.
11
12 This program is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
16
17 You should have received a copy of the GNU General Public License
18 along with this program; if not, write to the Free Software
19 Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
20
21 Address of the author
22
23 Otto Forster
24 Math. Institut der LMU
25 Theresienstr. 39
26 D-80333 Muenchen, Germany
27
28 Email forster@mathematik.uni-muenchen.de
29 */
30 /****************************************************************/
31
32 /*
33 ** alloc.c
34 ** memory allocation and garbage collection functions
35 **
36 ** date of last change
37 ** 1995-03-29
38 ** 1996-10-04 changed iniconfig
39 ** 1997-04-18 various SIZE defines, changed mvsymtab, tempfree
40 ** 1997-09-06 memory allocation #ifdef M_LARGE
41 ** 1997-12-26 small changes in iniconfig
42 ** 1998-01-06 fixed small bug in moveobj
43 ** 2002-04-05 changed some configuration constants
44 */
45
46 #include "common.h"
47
48 /*-------------------------------------------------------------*/
49 /* configuration constants */
50
51 #define SMALL_BLOCK0SIZE 4000 /* unit is sizeof(truc) = 4 */
52 #define MED_BLOCK0SIZE 8000
53 #define BIG_BLOCK0SIZE 16000
54 #define SMALL_BLOCKSIZE 12240 /* multiple of 255 */
55 #define MED_BLOCKSIZE 16320 /* multiple of 255, < 2**14 */
56 #define BIG_BLOCKSIZE 65280 /* multiple of 255, < 2**16 */
57
58 #ifdef M_SMALL
59
60 #define HASHTABSIZE 509 /* size of hash table (prime) */
61 #define BLOCKMAX 16
62 #define ARIBUFSIZE 5000 /* size of bignum buffer (word2's) */
63 #define BLOCK0SIZE SMALL_BLOCK0SIZE
64 #define BLOCKSIZE SMALL_BLOCKSIZE
65 #define RESERVE 6000 /* soviel Bytes sollen freibleiben */
66 #define WORKSTKSIZE 6000 /* size of evaluation+work stack (word4's) */
67 #define ARGSTKSIZE 7000 /* size of argument+save stack (word4's) */
68
69 #endif
70
71 #ifdef M_LARGE
72 #include <assert.h>
73
74 #define HASHTABSIZE 1009 /* size of hash table (prime) */
75 #define BLOCKMAX 192 /* must be < 255 */
76 #define BLOCK0SIZE BIG_BLOCK0SIZE
77 #define BLOCKSIZE BIG_BLOCKSIZE
78 #define RESERVE 16000
79 #define WORKSTKSIZE BIG_BLOCKSIZE
80 #define ARGSTKSIZE 16000
81
82 #ifdef MEM
83 #if (MEM >= 1) && (MEM <= 32)
84 #define MEM_DEFAULT (MEM*1024)
85 #endif
86 #endif /* MEM */
87 #ifdef INTSIZE
88 #if (INTSIZE >= 20) && (INTSIZE <= 300)
89 #define ARIBUFSIZE (INTSIZE * 209)
90 #endif
91 #else
92 #define ARIBUFSIZE 10000 /* size of bignum buffer (word2's) */
93 #endif /* INTSIZE */
94 #endif /* M_LARGE */
95
96
97 #ifndef MEM_DEFAULT
98
99 #ifdef ATARIST
100 #define MEM_DEFAULT 512
101 #endif
102 #ifdef MsDOS
103 #define MEM_DEFAULT 300
104 #endif
105 #ifdef DjGPP
106 #define MEM_DEFAULT 2048
107 #endif
108 #ifdef MsWIN32
109 #define MEM_DEFAULT 2048
110 #endif
111 #ifdef genUNiX
112 #define MEM_DEFAULT 2048
113 #endif
114
115 #endif /* MEM_DEFAULT */
116
117 /*-------------------------------------------------------------*/
118
119 PUBLIC truc *Symbol;
120 PUBLIC truc *Memory[BLOCKMAX+1];
121 PUBLIC trucptr *Symtab; /* symbol table */
122 PUBLIC size_t hashtabSize;
123 PUBLIC truc *WorkStack; /* evaluation stack (also work stack) */
124 PUBLIC truc *evalStkPtr, *workStkPtr;
125 PUBLIC truc *ArgStack; /* argument stack (also save stack) */
126 PUBLIC truc *argStkPtr, *saveStkPtr;
127 PUBLIC truc *basePtr;
128
129 PUBLIC word2 *AriBuf, *PrimTab;
130 PUBLIC word2 *AriScratch, *AuxBuf;
131 PUBLIC size_t aribufSize, auxbufSize, scrbufSize;
132 /* unit is sizeof(word2) */
133
134 PUBLIC void inialloc _((void));
135 PUBLIC int memalloc _((int mem));
136 PUBLIC void dealloc _((void));
137 PUBLIC void resetarr _((void));
138 PUBLIC int initend _((void));
139 PUBLIC int tempfree _((int flg));
140 PUBLIC int inpack _((truc obj, truc pack));
141 PUBLIC char *stringalloc _((unsigned int size));
142 PUBLIC unsigned getblocksize _((void));
143 PUBLIC size_t new0 _((unsigned int size));
144 PUBLIC truc newobj _((int flg, unsigned int size, trucptr *ptraddr));
145 PUBLIC truc new0obj _((int flg, unsigned int size, trucptr *ptraddr));
146 PUBLIC unsigned obj4size _((int type, truc *ptr));
147 PUBLIC void cpy4arr _((truc *ptr1, unsigned len, truc *ptr2));
148
149 /*--------------------------------------------------------*/
150
151 typedef struct {
152 byte flag;
153 byte flg2;
154 word2 curbot;
155 word2 blkceil;
156 word2 blkbot;
157 } blkdesc;
158
159 PRIVATE char *Stringpool;
160 PRIVATE char *Stringsys;
161
162 PRIVATE size_t symBot, userBot;
163 PRIVATE size_t memBot, memCeil;
164 PRIVATE size_t argstkSize, workstkSize, blockSize, block0Size;
165 PRIVATE int curblock, noofblocks, auxindex0, maxblocks;
166 PRIVATE blkdesc blockinfo[BLOCKMAX+1];
167
168 PRIVATE word4 gccount = 0;
169
170 PRIVATE truc gcsym, memavsym;
171
172 PRIVATE void iniconfig _((int mem));
173 PRIVATE void inisymtab _((void));
174 PRIVATE void iniblock _((void));
175 PRIVATE void memstatistics _((long slot[4]));
176 PRIVATE void displaymem _((long s[]));
177 PRIVATE void gcstatistics _((void));
178 PRIVATE int memshrink _((int nnew, int nold));
179 PRIVATE truc Fmemavail _((int argn));
180 PRIVATE void nextblock _((unsigned int size));
181 PRIVATE void clearbufs _((void));
182 PRIVATE truc Fgc _((int argn));
183 PRIVATE int garbcollect _((int mode));
184 PRIVATE void prepgc _((void));
185 PRIVATE void endgc _((void));
186 PRIVATE void mvsymtab _((void));
187 PRIVATE void mvargstk _((void));
188 PRIVATE void mvevalstk _((void));
189 PRIVATE void moveobj _((truc *x));
190 PRIVATE int toupdate _((truc *x));
191 PRIVATE int datupdate _((int flg));
192
193 #define FREE 0
194 #define HALFFULL 1
195 #define FULL 2
196 #define RESERVED 4
197 #define NOAGERL 8
198
199 /*------------------------------------------------------------*/
inialloc()200 PUBLIC void inialloc()
201 {
202 gcsym = newsymsig("gc", sFBINARY, (wtruc)Fgc, s_01);
203 memavsym= newsymsig("memavail", sFBINARY, (wtruc)Fmemavail, s_01);
204 }
205 /*--------------------------------------------------------------*/
iniconfig(mem)206 PRIVATE void iniconfig(mem)
207 int mem;
208 {
209 int k;
210 long memmax;
211
212 #ifdef M_LARGE
213 assert(sizeof(word4) == 4);
214 assert(sizeof(word2) == 2);
215 #endif
216 argstkSize = ARGSTKSIZE;
217 workstkSize = WORKSTKSIZE;
218 hashtabSize = HASHTABSIZE;
219 aribufSize = ARIBUFSIZE;
220 blockSize = BLOCKSIZE;
221 block0Size = BLOCK0SIZE;
222
223 if(mem <= 0) {
224 mem = MEM_DEFAULT;
225 }
226 #ifdef M_LARGE
227 else if(mem < 1000) {
228 block0Size = MED_BLOCK0SIZE;
229 if(mem < 512)
230 mem = 512;
231 }
232 #else
233 else if(mem < 64)
234 mem = 64;
235 #endif
236 #ifdef ATARIST
237 else if(mem >= 1000) {
238 blockSize = BIG_BLOCKSIZE;
239 block0Size = MED_BLOCK0SIZE;
240 }
241 #endif
242 #ifdef DOSorTOS
243 else if(mem >= 200)
244 blockSize = MED_BLOCKSIZE;
245 #endif
246 memmax = blockSize;
247 memmax *= BLOCKMAX;
248 memmax /= 255;
249 if(mem > memmax)
250 mem = memmax;
251 if(mem < 2000) {
252 if(mem < 96) {
253 maxblocks = 2;
254 }
255 else {
256 for(k=3; k<BLOCKMAX; k++)
257 if(mem/k <= blockSize/255)
258 break;
259 maxblocks = k;
260 }
261 blockSize = mem/maxblocks;
262 blockSize *= 255;
263 blockSize &= 0xFFFE; /* make even */
264 }
265 else { /* mem >= 2000 */
266 maxblocks = (mem + blockSize/510)/(blockSize/255);
267 if(maxblocks > BLOCKMAX)
268 maxblocks = BLOCKMAX;
269 }
270 }
271 /*--------------------------------------------------------------*/
272 /*
273 ** allocate memory for Symtab,
274 ** ArgStack, WorkStack, EvalStack,
275 ** Symbol and Memory
276 ** returns total amount of allocated memory (in kilobytes)
277 */
memalloc(mem)278 PUBLIC int memalloc(mem)
279 int mem;
280 {
281 int k;
282 unsigned long memallsize;
283 size_t size;
284 void *ptr;
285
286 stacklimit();
287
288 iniconfig(mem);
289 size = sizeof(trucptr) * hashtabSize;
290 memallsize = size;
291 ptr = malloc(size);
292 if(ptr) {
293 Symtab = (trucptr *)ptr;
294 size = sizeof(truc) * argstkSize;
295 memallsize += size;
296 ptr = malloc(size);
297 }
298 if(ptr) {
299 ArgStack = (truc *)ptr;
300 size = sizeof(truc) * workstkSize;
301 memallsize += size;
302 ptr = malloc(size);
303 }
304 if(ptr) {
305 WorkStack = (truc *)ptr;
306 size = sizeof(word2)*(aribufSize + PRIMTABSIZE + 16);
307 memallsize += size;
308 ptr = malloc(size);
309 }
310 if(ptr) {
311 AriBuf = (word2 *)ptr;
312 PrimTab = AriBuf + aribufSize + 16;
313 inisymtab();
314 resetarr();
315 }
316 else
317 faterr(err_memory);
318
319 size = sizeof(truc) * block0Size;
320 ptr = malloc(size);
321 #ifdef M_LARGE
322 noofblocks = maxblocks;
323 if(ptr) {
324 memallsize += size;
325 Memory[0] = (truc *)ptr;
326 }
327 else {
328 goto errmem;
329 }
330 size = sizeof(truc)*blockSize*noofblocks;
331 ptr = malloc(size);
332 if(ptr) {
333 memallsize += size;
334 Memory[1] = (truc *)ptr;
335 for(k=2; k<=noofblocks; k++)
336 Memory[k] = Memory[k-1] + blockSize;
337 }
338 else {
339 goto errmem;
340 }
341 #else /* !M_LARGE */
342 k = 0;
343 while(ptr != NULL) {
344 memallsize += size;
345 Memory[k] = (truc *)ptr;
346 if(++k > maxblocks)
347 break;
348 size = sizeof(truc) * blockSize;
349 ptr = malloc(size);
350 }
351 noofblocks = k-1;
352 #endif /* ?M_LARGE */
353 ptr = malloc(RESERVE); /* test free memory */
354 if(ptr != NULL)
355 free(ptr);
356 else {
357 free(Memory[noofblocks]);
358 noofblocks--;
359 memallsize -= size;
360 }
361 if(noofblocks < 2)
362 goto errmem;
363 Symbol = Memory[0];
364 symBot = 0;
365 Stringpool = (char *)(Symbol + block0Size);
366 iniblock();
367 return((int)(memallsize >> 10));
368 errmem:
369 faterr(err_memory);
370 return(0);
371 }
372 /*-------------------------------------------------------------*/
dealloc()373 PUBLIC void dealloc()
374 {
375
376 #ifdef M_LARGE
377 free(Memory[1]);
378 #else
379 int i;
380 for(i=noofblocks; i>=1; i--)
381 if(blockinfo[i].blkbot == 0)
382 free(Memory[i]);
383 #endif
384 free(Symbol);
385 free(AriBuf);
386 free(WorkStack);
387 free(ArgStack);
388 free(Symtab);
389 }
390 /*-------------------------------------------------------------*/
resetarr()391 PUBLIC void resetarr()
392 {
393 workStkPtr = WorkStack - 1;
394 evalStkPtr = WorkStack + workstkSize;
395 argStkPtr = ArgStack - 1;
396 saveStkPtr = ArgStack + argstkSize;
397 basePtr = ArgStack;
398 }
399 /* ------------------------------------------------------- */
inisymtab()400 PRIVATE void inisymtab()
401 {
402 trucptr *sympt;
403 int i;
404
405 sympt = Symtab;
406 i = hashtabSize;
407 while(--i >= 0)
408 *sympt++ = NULL;
409 }
410 /*---------------------------------------------------------*/
iniblock()411 PRIVATE void iniblock()
412 {
413 int split, m;
414 int i;
415
416 scrbufSize =
417 (blockSize / sizeof(word2)) * sizeof(truc);
418 #ifdef M_LARGE
419 auxbufSize =
420 (noofblocks*blockSize/2)/sizeof(word2)*sizeof(truc) - scrbufSize;
421 #else /* !M_LARGE */
422 auxbufSize = scrbufSize;
423 if(noofblocks == 3)
424 auxbufSize /= 2;
425 else if(noofblocks < 3)
426 auxbufSize = 0;
427 #endif /* ?M_LARGE */
428
429 m = (noofblocks+1)/2 + 1;
430 split = (noofblocks & 1) && (noofblocks < BLOCKMAX);
431 if(split) {
432 noofblocks++;
433 for(i=noofblocks; i>=m; i--)
434 Memory[i] = Memory[i-1];
435 }
436 blockinfo[0].flag = noofblocks;
437 for(i=1; i<=noofblocks; i++) {
438 blockinfo[i].flag = (i<m ? FREE : RESERVED);
439 blockinfo[i].blkbot = 0;
440 blockinfo[i].curbot = 0;
441 blockinfo[i].blkceil = blockSize;
442 }
443 if(split) {
444 blockinfo[m-1].blkceil = blockSize/2;
445 blockinfo[m].blkbot = blockSize/2;
446 blockinfo[m].curbot = blockSize/2;
447 }
448 curblock = 1;
449 memBot = blockinfo[curblock].blkbot;
450 memCeil = blockinfo[curblock].blkceil;
451 AriScratch = (word2 *)Memory[noofblocks];
452
453 #ifdef M_LARGE
454 auxindex0 = noofblocks/2+1;
455 #else /* !M_LARGE */
456 auxindex0 = noofblocks-1;
457 #endif /* ?M_LARGE */
458 AuxBuf = (word2 *)Memory[auxindex0];
459 }
460 /*---------------------------------------------------------*/
461 /*
462 ** must be called at the end of initializations
463 ** sets global variables userBot and Stringsys
464 ** returns number of bytes used by system for symbols and symbol names
465 */
initend()466 PUBLIC int initend()
467 {
468 size_t n;
469
470 userBot = symBot;
471 Stringsys = Stringpool;
472
473 n = (char *)(Symbol + block0Size) - Stringsys;
474 n += sizeof(truc)*userBot;
475 return(n);
476 }
477 /*---------------------------------------------------------*/
478 /*
479 ** Mit Argument flg > 0: Gibt die zweite Haelfte der Memory-Bloecke frei
480 ** Mit Argument flg == 0: Allokiert von neuem die freigegebenen
481 ** Memorybloecke
482 ** Rueckgabewert: 1 bei Erfolg, 0 bei Fehler
483 */
tempfree(flg)484 PUBLIC int tempfree(flg)
485 int flg;
486 {
487 #ifdef M_SMALL
488 int i, m, res;
489 size_t size;
490 void *ptr;
491
492 m = (noofblocks/2) + 1;
493 if(blockinfo[m].blkbot > 0)
494 m++;
495 if(flg > 0) {
496 garbcollect(1);
497 if(blockinfo[1].flag == RESERVED)
498 garbcollect(1);
499 /* nun ist zweite Haelfte frei */
500 for(i=noofblocks; i>=m; i--)
501 free(Memory[i]);
502 }
503 else {
504 size = blockSize * sizeof(truc);
505 for(i=m; i<=noofblocks; i++) {
506 ptr = malloc(size);
507 if(ptr == NULL) {
508 res = memshrink(i-1,noofblocks);
509 if(res == 0) {
510 noofblocks = i-1;
511 return(0);
512 }
513 else
514 break;
515 }
516 Memory[i] = (truc *)ptr;
517 }
518 AriScratch = (word2 *)Memory[noofblocks];
519 AuxBuf = (word2 *)Memory[noofblocks-1];
520 }
521 #endif /* M_SMALL */
522 return(1);
523 }
524 /*---------------------------------------------------------*/
525 /*
526 ** Reduziert die Anzahl der Memory-Bloecke von nold auf nnew
527 ** Es wird vorausgesetzt, dass die derzeit aktiven Bloecke
528 ** zur ersten Haelfte gehoeren und dass nnew < nold
529 ** Rueckgabewert: 1 bei Erfolg, 0 bei Misserfolg
530 */
memshrink(nnew,nold)531 PRIVATE int memshrink(nnew,nold)
532 int nnew, nold;
533 {
534 #ifdef M_SMALL
535 int i,m,m1,split;
536
537 m = (nold/2) + 1;
538 split = (blockinfo[m].blkbot > 0);
539 if(split)
540 nnew--;
541 if(nnew < 2)
542 return(0);
543 else if(nnew == 2)
544 auxbufSize = 0;
545 else if(nnew == 3)
546 auxbufSize /= 2;
547 m1 = nnew/2;
548 for(i=m1; i<m; i++) {
549 if(blockinfo[m].blkbot < blockinfo[m].curbot)
550 return(0);
551 }
552 if(split) {
553 for(i=m; i<=nnew; i++)
554 Memory[i] = Memory[i+1];
555 blockinfo[m-1].blkceil = blockinfo[m].blkceil;
556 blockinfo[m].blkbot = 0;
557 }
558 m = (nnew+1)/2;
559 if(nnew & 1) {
560 nnew++;
561 for(i=nnew; i>m; i--)
562 Memory[i] = Memory[i-1];
563 blockinfo[m].blkceil /= 2;
564 blockinfo[m+1].blkbot = blockinfo[m].blkceil;
565 }
566 for(i=nnew; i>m; i--)
567 blockinfo[i].flag = RESERVED;
568 noofblocks = nnew;
569 #endif /* M_SMALL */
570 return(1);
571 }
572 /*---------------------------------------------------------*/
inpack(obj,pack)573 PUBLIC int inpack(obj,pack)
574 truc obj, pack;
575 {
576 variant v;
577 int sys;
578
579 v.xx = obj;
580 sys = (v.pp.ww < userBot);
581 if(pack == arisym)
582 return(sys);
583 else if(pack == usersym)
584 return(!sys);
585 else
586 return(0);
587 }
588 /*---------------------------------------------------------*/
memstatistics(slot)589 PRIVATE void memstatistics(slot)
590 long slot[4];
591 {
592 int i, flg;
593 unsigned b,c;
594 unsigned long nres = 0, nact = 0, nfree = 0, nsymb;
595 unsigned s = sizeof(truc);
596
597 for(i=1; i<=noofblocks; i++) {
598 b = blockinfo[i].blkbot;
599 c = blockinfo[i].blkceil;
600 if((flg = blockinfo[i].flag) == RESERVED) {
601 nres += c - b;
602 }
603 else {
604 nact += c - b;
605 if(flg < FULL) {
606 b = (i == curblock ? memBot : blockinfo[i].curbot);
607 nfree += c - b;
608 }
609 }
610 }
611 slot[0] = s * nres;
612 slot[1] = s * nact;
613 slot[2] = s * nfree;
614 nsymb = Stringpool - (char *)(Symbol + symBot);
615 slot[3] = nsymb;
616 }
617 /*---------------------------------------------------------*/
displaymem(s)618 PRIVATE void displaymem(s)
619 long s[];
620 {
621 int n;
622 long diff;
623
624 diff = s[1] - s[2];
625 n = s2form(OutBuf,"~8D Bytes reserved; ~D Bytes active ",
626 (wtruc)s[0],(wtruc)s[1]);
627 s2form(OutBuf+n,"(~D used, ~D free)",(wtruc)diff,(wtruc)s[2]);
628 fprintline(tstdout,OutBuf);
629 s1form(OutBuf,
630 "~8D Bytes free for user defined symbols and symbol names", (wtruc)s[3]);
631 fprintline(tstdout,OutBuf);
632 }
633 /*---------------------------------------------------------*/
gcstatistics()634 PRIVATE void gcstatistics()
635 {
636 fnewline(tstdout);
637 s1form(OutBuf,"total number of garbage collections: ~D", (wtruc)gccount);
638 fprintline(tstdout,OutBuf);
639 }
640 /*---------------------------------------------------------*/
Fmemavail(argn)641 PRIVATE truc Fmemavail(argn)
642 int argn;
643 {
644 long s[4];
645 unsigned f;
646 int verbose;
647
648 verbose = (argn == 0 || *argStkPtr != zero);
649
650 memstatistics(s);
651 if(verbose) {
652 gcstatistics();
653 displaymem(s);
654 }
655 f = s[2] >> 10; /* free kilobytes */
656 return(mkfixnum(f));
657 }
658 /*---------------------------------------------------------*/
stringalloc(size)659 PUBLIC char *stringalloc(size)
660 unsigned int size; /* unit for size is sizeof(char) */
661 {
662 if(Stringpool - size <= (char *)(Symbol + symBot))
663 faterr(err_memory);
664 Stringpool -= size;
665 return(Stringpool);
666 }
667 /*---------------------------------------------------------*/
getblocksize()668 PUBLIC unsigned getblocksize()
669 {
670 return(blockSize);
671 }
672 /*---------------------------------------------------------*/
new0(size)673 PUBLIC size_t new0(size)
674 unsigned int size; /* unit for size is sizeof(truc) */
675 {
676 size_t loc;
677
678 loc = symBot;
679 symBot += size;
680 #ifdef ALIGN8
681 if (symBot & 0x1)
682 symBot++;
683 #endif
684 if(Stringpool <= (char *)(Symbol + symBot))
685 faterr(err_memory);
686 return(loc);
687 }
688 /*---------------------------------------------------------*/
newobj(flg,size,ptraddr)689 PUBLIC truc newobj(flg,size,ptraddr)
690 int flg;
691 unsigned int size;
692 trucptr *ptraddr;
693 {
694 variant v;
695
696 if(size > memCeil - memBot) {
697 nextblock(size);
698 }
699 v.pp.b0 = flg;
700 v.pp.b1 = curblock;
701 v.pp.ww = memBot;
702 *ptraddr = Memory[curblock] + memBot;
703
704 memBot += size;
705 return(v.xx);
706 }
707 /*---------------------------------------------------------*/
708 /*
709 ** allocation from memory block 0
710 ** (for symbols, not moved during garbage collection)
711 */
new0obj(flg,size,ptraddr)712 PUBLIC truc new0obj(flg,size,ptraddr)
713 int flg;
714 unsigned int size; /* unit for size is sizeof(truc) */
715 trucptr *ptraddr;
716 {
717 variant v;
718 size_t loc = new0(size);
719
720 v.pp.b0 = flg;
721 v.pp.b1 = 0;
722 v.pp.ww = loc;
723 *ptraddr = Symbol + loc;
724
725 return(v.xx);
726 }
727 /*---------------------------------------------------------*/
nextblock(size)728 PRIVATE void nextblock(size)
729 unsigned int size;
730 {
731 int i,k;
732 int collected = 0;
733
734 blockinfo[curblock].curbot = memBot;
735 blockinfo[curblock].flag =
736 (memCeil - memBot >= NOAGERL ? HALFFULL : FULL);
737
738 if(size > blockSize) {
739 reset(err_2large);
740 }
741 nochmal:
742 k = curblock;
743 for(i=1; i<=noofblocks; i++) {
744 if(++k > noofblocks)
745 k = 1;
746 if((blockinfo[k].flag <= HALFFULL) &&
747 (size <= blockinfo[k].blkceil - blockinfo[k].curbot)) {
748 memBot = blockinfo[k].curbot;
749 memCeil = blockinfo[k].blkceil;
750 curblock = k;
751 return;
752 }
753 }
754 if(!collected && garbcollect(1)) {
755 collected = 1;
756 goto nochmal;
757 }
758 clearbufs();
759 if(garbcollect(0))
760 reset(err_memev);
761 else
762 faterr(err_garb);
763 }
764 /*------------------------------------------------------------*/
clearbufs()765 PRIVATE void clearbufs()
766 {
767 *res3Ptr = zero;
768 *res2Ptr = zero;
769 *res1Ptr = zero;
770 *brkbindPtr = zero;
771 }
772 /*------------------------------------------------------------*/
Fgc(argn)773 PRIVATE truc Fgc(argn)
774 int argn;
775 {
776 garbcollect(1);
777 return Fmemavail(argn);
778 }
779 /*------------------------------------------------------------*/
garbcollect(mode)780 PRIVATE int garbcollect(mode)
781 int mode; /* mode = 0: emergency collection */
782 {
783 static int merk = 0;
784
785 gccount++;
786 if(merk++) {
787 merk = 0;
788 return(0);
789 }
790 prepgc();
791 mvsymtab();
792 if(mode > 0) {
793 mvargstk();
794 mvevalstk();
795 }
796 endgc();
797
798 --merk;
799 return(1);
800 }
801 /*------------------------------------------------------------*/
prepgc()802 PRIVATE void prepgc()
803 {
804 int i, first = 1;
805 for(i=1; i<=noofblocks; i++) {
806 blockinfo[i].curbot = blockinfo[i].blkbot;
807 if(blockinfo[i].flag == RESERVED) {
808 blockinfo[i].flag = FREE;
809 if(first) {
810 curblock = i;
811 memBot = blockinfo[i].curbot;
812 memCeil = blockinfo[i].blkceil;
813 first = 0;
814 }
815 }
816 else
817 blockinfo[i].flag = RESERVED;
818 }
819 }
820 /*------------------------------------------------------------*/
endgc()821 PRIVATE void endgc()
822 {
823 int scratchind, auxind;
824
825 blockinfo[curblock].curbot = memBot;
826
827 if(blockinfo[1].flag == RESERVED) {
828 scratchind = 1;
829 auxind = 2;
830 }
831 else {
832 scratchind = noofblocks;
833 auxind = auxindex0;
834 }
835 AriScratch = (word2 *)Memory[scratchind];
836 AuxBuf = (word2 *)Memory[auxind];
837 }
838 /*------------------------------------------------------------*/
mvsymtab()839 PRIVATE void mvsymtab()
840 {
841 int n, flg;
842 truc *x;
843
844 *res3Ptr = zero;
845 n = 0;
846 while((x = nextsymptr(n++)) != NULL) {
847 flg = *FLAGPTR(x);
848 if(flg & sGCMOVEBIND)
849 moveobj(SYMBINDPTR(x));
850 }
851 }
852 /*------------------------------------------------------------*/
mvargstk()853 PRIVATE void mvargstk()
854 {
855 truc *ptr;
856
857 ptr = ArgStack - 1;
858 while(++ptr <= argStkPtr)
859 moveobj(ptr);
860 }
861 /*------------------------------------------------------------*/
mvevalstk()862 PRIVATE void mvevalstk()
863 {
864 truc *ptr;
865
866 ptr = WorkStack - 1;
867 while(++ptr <= workStkPtr)
868 moveobj(ptr);
869
870 ptr = WorkStack + workstkSize;
871 while(--ptr >= evalStkPtr)
872 moveobj(ptr);
873 }
874 /*------------------------------------------------------------*/
moveobj(x)875 PRIVATE void moveobj(x)
876 truc *x;
877 {
878 int flg;
879 unsigned int len;
880 truc *ptr, *ptr2;
881
882 nochmal:
883 flg = toupdate(x);
884 if(!flg)
885 return;
886
887 ptr = TAddress(x);
888 if(*FLAGPTR(ptr) == GCMARK) { /* update *x */
889 *x = *ptr;
890 *FLAGPTR(x) = flg;
891 return;
892 }
893 len = obj4size(flg,ptr);
894
895 if(len == 0) /* this case should not happen */
896 return;
897
898 *x = newobj(flg,len,&ptr2);
899 cpy4arr(ptr,len,ptr2);
900 *ptr = *x; /* put forwarding address */
901 *FLAGPTR(ptr) = GCMARK;
902
903 if(datupdate(flg) && (len >= 2)) {
904 while(--len > 1) /* first element always fixed */
905 moveobj(++ptr2);
906 /*** tail recursion elimination *******/
907 x = ptr2 + 1;
908 goto nochmal;
909 }
910 }
911 /*------------------------------------------------------------*/
912 /*
913 ** returns 0, if *x needs no update; else returns flag of *x
914 */
toupdate(x)915 PRIVATE int toupdate(x)
916 truc *x;
917 {
918 int flg, seg;
919
920 flg = *FLAGPTR(x);
921 if(flg & FIXMASK)
922 return(0);
923 seg = *SEGPTR(x);
924 if(seg == 0 || blockinfo[seg].flag != RESERVED)
925 return(0);
926 else {
927 return(flg);
928 }
929 }
930 /*------------------------------------------------------------*/
931 /*
932 ** returns 0, if data of object are fixed, else returns 1
933 */
datupdate(flg)934 PRIVATE int datupdate(flg)
935 int flg;
936 {
937 if(flg == fSTREAM)
938 return(0);
939 else if(flg <= fVECTOR)
940 return(1);
941 else
942 return(0);
943 }
944 /*------------------------------------------------------------*/
945 /*
946 ** return size of objects (unit is sizeof(truc)=4)
947 ** which are not fixed during garbage collection
948 */
obj4size(type,ptr)949 PUBLIC unsigned obj4size(type,ptr)
950 int type;
951 truc *ptr;
952 {
953 unsigned int len;
954
955 switch(type) {
956 case fBIGNUM:
957 case fGF2NINT:
958 len = ((struct bigcell *)ptr)->len;
959 return(SIZEOFBIG(len));
960 case fSTRING:
961 case fBYTESTRING:
962 len = ((struct strcell *)ptr)->len;
963 return(SIZEOFSTRING(len));
964 case fSTREAM:
965 return(SIZEOFSTREAM);
966 case fVECTOR:
967 len = ((struct vector *)ptr)->len;
968 return(SIZEOFVECTOR(len));
969 case fPOINTER:
970 case fRECORD:
971 len = ((struct record *)ptr)->len;
972 return(SIZEOFRECORD(len));
973 case fSPECIAL1:
974 case fBUILTIN1:
975 return(SIZEOFOPNODE(1));
976 case fSPECIAL2:
977 case fBUILTIN2:
978 return(SIZEOFOPNODE(2));
979 case fTUPLE:
980 case fWHILEXPR:
981 case fIFEXPR:
982 case fFOREXPR:
983 case fCOMPEXPR:
984 len = ((struct compnode *)ptr)->len;
985 return(SIZEOFCOMP(len));
986 case fSPECIALn:
987 case fBUILTINn:
988 case fFUNCALL:
989 len = *ARGCPTR(ptr);
990 return(SIZEOFFUNODE(len));
991 case fFUNDEF:
992 return(SIZEOFFUNDEF);
993 case fSTACK:
994 return(SIZEOFSTACK);
995 default:
996 if(type >= fFLTOBJ) {
997 len = fltprec(type);
998 return(SIZEOFFLOAT(len));
999 }
1000 else {
1001 error(gcsym,err_case,mkfixnum(type));
1002 return(0);
1003 }
1004 }
1005 }
1006 /*------------------------------------------------------------*/
1007 /*
1008 ** kopiert das word4-Array (ptr1,len) nach ptr2
1009 */
cpy4arr(ptr1,len,ptr2)1010 PUBLIC void cpy4arr(ptr1,len,ptr2)
1011 truc *ptr1, *ptr2;
1012 unsigned int len;
1013 {
1014 while(len--)
1015 *ptr2++ = *ptr1++;
1016 }
1017 /************************************************************************/
1018