memory.c
Go to the documentation of this file.
1 /****************************************************************/
2 /* memory.c: memory manager for eulisp */
3 /* Copyright(c) Toshihiro MATSUI
4 /* Electrotechnical Laboratory,1986.
5 /****************************************************************/
6 static char *rcsid="@(#)$Id$";
7 
8 #if vxworks
9 #include <sys/types.h>
10 #else
11 #include <sys/types.h>
12 #include <sys/times.h>
13 #endif
14 
15 #if alpha
16 #include <stdlib.h>
17 #include <unistd.h>
18 #endif
19 
20 #include "eus.h"
21 #if Solaris2
22 #include <synch.h>
23 #include <thread.h>
24 #endif
25 
26 #if 0 /* moved to eus.h */
27 #define nextbuddy(p) ((bpointer)((eusinteger_t)p+(buddysize[p->h.bix]*sizeof(pointer))))
28 #define marked(p) (p->h.mark)
29 #define markon(p) p->h.mark=1
30 #define markoff(p) p->h.mark=0
31 #endif
32 #define myctx (euscontexts[thr_self()])
33 
34 /* Written by I.Hara 01/12/95 */
35 #if Solaris2 || Linux
36 extern eusinteger_t _end();
37 #elif SunOS4_1
38 extern edata;
39 #else
40 extern edata(),_end();
41 #endif
42 
43 #if alpha
45 #endif
46 
47 extern pointer QPARAGC;
48 extern pointer K_DISPOSE;
49 
50 char *maxmemory=(char *)0x0;
51 #if (WORD_SIZE == 64)
52 char *minmemory=(char *)0xffffffffffffffff;
53 #else
54 char *minmemory=(char *)0xffffffff;
55 #endif
56 long freeheap=0,totalheap=0; /*size of heap left and allocated*/
58 /* timers */
60 long alloccount[MAXBUDDY];
61 
62 /*disposal processing*/
63 #define MAXDISPOSE 256
65 static int dispose_count;
66 
67 int newchunk(k)
68 register int k;
69 { register int s;
70  register struct chunk *cp;
72 #if defined(BIX_DEBUG) || defined(DEBUG_COUNT)
73  static int count = 0;
74 
75  count++;
76 #endif
77 // fprintf(stderr, "\x1b[1;31mnewchunk(%d)\x1b[0m\n", k);
78  if (k<DEFAULTCHUNKINDEX) k=DEFAULTCHUNKINDEX;
79  if (QDEBUG && debug) fprintf(stderr,";; newchunk: k=%d\n",k);
80  s=buddysize[k];
81  cp=(struct chunk *)((euspointer_t)malloc((s+2)*sizeof(pointer)+(sizeof(pointer)-1)) & ~(sizeof(pointer)-1));
82 #if defined(RGC)
83  set_heap_range((unsigned int)cp,
84  (unsigned int)cp + (s+2)*sizeof(pointer)+(sizeof(pointer)-1));
85 #endif
86  if (cp==NULL) {
87  fprintf(stderr, ";; can not allocate newchunk(%d)\n", k);
88  return(ERR); /*can't allocate new memory*/
89  }
90 #if Linux || Cygwin || Darwin
91  if (minmemory > (char *)cp) minmemory = (char *)cp;
92  if (maxmemory < (char *)sbrk(0)) maxmemory = (char *)sbrk(0);
93  if (maxmemory < (char *)cp+(s+2)*sizeof(pointer)+(sizeof(pointer)-1)) maxmemory = ((char *)cp+(s+2)*sizeof(pointer)+(sizeof(pointer)-1));
94 #else
95  maxmemory=(char *)sbrk(0);
96 #endif
97  if (QDEBUG && debug) fprintf(stderr,";; maxmemory=%p\n",maxmemory);
98 #if alpha
99  if( chunklist == NULL ) {
100  top_addr = (eusinteger_t)cp;
101 /*printf( "first topaddr = 0x%lx\n", top_addr );*/
102 }
103  if( (eusinteger_t)cp < top_addr ) {
105 /*printf( "topaddr = 0x%lx\n", top_addr );*/
106 }
107 #endif
108 
109 #if defined(RGC)// && !defined(__USE_MARK_BITMAP)
110  /* sort by address */
111  if (chunklist == NULL) {
112  cp->nextchunk = NULL;
113  chunklist = cp;
114  } else {
115  struct chunk *ccp;
116  for (ccp = chunklist; ccp->nextchunk < cp && ccp->nextchunk != NULL;
117  ccp = ccp->nextchunk);
118  cp->nextchunk = ccp->nextchunk;
119  ccp->nextchunk = cp;
120  }
121 #else
122  cp->nextchunk=chunklist; /*link to chunk list*/
123  chunklist=cp;
124 #endif
125 
126  cp->chunkbix=k;
127  cp->rootcell.h.mark=0;
128  cp->rootcell.h.smark=0;
129  cp->rootcell.h.pmark=0;
130  cp->rootcell.h.b=1; /*initial buddy marks*/
131  cp->rootcell.h.m=0;
132  cp->rootcell.h.nodispose=0;
133  cp->rootcell.h.bix=k;
134 #ifndef RGC
135  cp->rootcell.b.nextbcell=0;
136 #else
137  cp->rootcell.b.nextbcell = buddy[k].bp;
138 #endif
139 #if alpha
140  tail = (eusinteger_t)cp + (s+2)*sizeof(pointer);
141  if( tail > bottom_addr ) {
142  bottom_addr = tail;
143 /*printf( "bottom_addr = 0x%lx\n", bottom_addr );*/
144 }
145 #endif
146 #ifdef RGC
147  /* the color of free cells are GRAY */
148  cp->rootcell.h.bix |= FREETAG;
149  cp->rootcell.h.cix = -1; /* free tag */
150  if((char *)cp < minmemory)
151  minmemory = (char *)cp;
152 #endif
153  cp->rootcell.h.cix = -1; /* free tag */
154  buddy[k].bp= &cp->rootcell;
155  buddy[k].count++;
156  totalheap += s; freeheap += s;
157  return(k);
158  }
159 
160 void splitheap(k,buddy) /*heart of the allocator*/
161 register int k;
162 register struct buddyfree *buddy;
163 { register bpointer b1,b2,bnext;
164 #if defined(BIX_DEBUG) || defined(DEBUG_COUNT)
165  static int count;
166 
167  count++;
168 #endif
169 
170  b1= buddy[k].bp; /*root buddy pointer*/
171  bnext=b1->b.nextbcell;
172  buddy[k].bp= bnext; /*remove first element*/
173  buddy[k].count--;
174  b2= (bpointer)((euspointer_t)b1+buddysize[k-1]*sizeof(pointer));
175  if (k==2) { /*b1 and b2 are of the same size*/
176  b1->b.nextbcell=b2;
177  b2->b.nextbcell=buddy[k-1].bp;
178  buddy[k-1].bp=b1;
179  buddy[k-1].count +=2;
180 #ifdef RGC
181  b2->h.bix = 1 | FREETAG;
182  b2->h.cix = -1; /* free tag */
183 #else
184  b2->h.bix= 1;
185  b2->h.cix = -1; /* free tag */
186 #endif
187  } else {
188  b1->b.nextbcell= buddy[k-1].bp;
189  buddy[k-1].bp=b1;
190  buddy[k-1].count++;
191  b2->b.nextbcell=buddy[k-2].bp;
192  buddy[k-2].bp=b2;
193  buddy[k-2].count++;
194 #ifdef RGC
195  b2->h.bix = (k-2 | FREETAG);
196  b2->h.cix = -1; /* free tag */
197 #else
198  b2->h.bix= k-2;
199  b2->h.cix = -1; /* free tag */
200 #endif
201  }
202  b2->h.m=b1->h.m;
203  b1->h.m=b1->h.b;
204  b1->h.b=0;
205 #ifdef RGC
206  b1->h.bix = (k-1 | FREETAG);
207 #else
208  b1->h.bix= k-1;
209 #endif
210  b2->h.b=1;
211  b2->h.mark=b2->h.smark=b2->h.pmark=0;
212  b1->h.nodispose=b2->h.nodispose=0;}
213 
215 register context *ctx;
216 register int req; /*index to buddy: must be greater than 0*/
217 { register int i, k;
218  register bpointer b,b2;
219  numunion nu;
220  pointer gcm;
221 
222 #if THREADED
223  mutex_lock(&alloc_lock);
224 #endif
225 
226  ctx->alloc_big_count++;
227 
228  k=req;
229  while (buddy[k].bp==0) k++; /*find blocks of adequate size*/
230  if (k>=MAXBUDDY) { /*no bigger free cell*/
231  if (buddysize[req]<totalheap/8) { /*relatively small cell is requested;*/
232  gc(); /* then try garbage collection*/
233  gcm=speval(GCMARGIN);
234  while (freeheap < (totalheap*min(5.0,fltval(gcm))))
235  newchunk(req); /*still not enough space*/
236  for (k=req; buddy[k].bp==0; ) k++;}
237  if (k>=MAXBUDDY) {
238  k=newchunk(req);
239  if (k==ERR) {
240 #if THREADED
241  mutex_unlock(&alloc_lock);
242 #endif
243  error(E_ALLOCATION);}}}
244 
245  while (req<k) { splitheap(k--,buddy); if (k>req) k--;}
246  k=buddysize[req]-1;
247  b=buddy[req].bp;
248  b2=b->b.nextbcell;
249  for (i=0; i<k; i++) b->b.c[i]=0;
250  ctx->lastalloc=makepointer(b);
251  buddy[req].bp=b2;
252  buddy[req].count--;
253 #ifdef DEBUG
254  printf( "root_alloc_big: alloc 1 block (%d), 0x%lx\n", req, b );
255 #endif
256  freeheap -= buddysize[req];
257  alloccount[req]++;
258 #if THREADED
259  mutex_unlock(&alloc_lock);
260 #endif
261  return(b);}
262 
263 void root_alloc_small(ctx, req)
264 register context *ctx;
265 register int req; /*index to buddy: must be greater than 0*/
266 { register int i, j, k,kk;
267  register bpointer b, b2;
268  register struct buddyfree *tb=ctx->thr_buddy;
269  static long buddyfill[MAXTHRBUDDY+1]={0,500,300,20,15,10,0};
270  numunion nu;
271  int collected=0;
272 
273 #if THREADED
274  mutex_lock(&alloc_lock);
275 #endif
276 
277  ctx->alloc_small_count++;
278 
279  alloc_again:
280  for (i=1; i<MAXTHRBUDDY; i++) {
281  k=kk=buddyfill[i] - tb[i].count; /*how many cells are needed*/
282  while (buddy[i].count < k) { /*Do we have enough free in the root?*/
283 /* fprintf(stderr, "free_count=%d; k=%d\n",buddy[i].count,k); */
284  j=i+1;
285  while (buddy[j].bp==0) j++;
286  if (j>=MAXBUDDY) { /*no free cell*/
287  if (!collected) {
288  /* fprintf(stderr, "GC: free=%d total=%d, margin=%f\n",
289  freeheap, totalheap, fltval(speval(GCMARGIN))); */
290  gc(); collected=1;
291  goto alloc_again;}
292  while (freeheap<(totalheap*min(5.0,fltval(speval(GCMARGIN))))) {
293  j=newchunk(DEFAULTCHUNKINDEX); /*still not enough space*/
294  if (j==ERR) {
295 #if THREADED
296  mutex_unlock(&alloc_lock);
297 #endif
298  error(E_ALLOCATION);}} }
299  if (j>=MAXBUDDY) { /*hard fragmentation seen*/
300  j=newchunk(DEFAULTCHUNKINDEX);
301  if (j==ERR) {
302 #if THREADED
303  mutex_unlock(&alloc_lock);
304 #endif
305  error(E_ALLOCATION);}}
306  splitheap(j, buddy);}
307  /*sufficient free cells collected in the root free list*/
308  if (k>0) {
309  b=buddy[i].bp;
310  while (k>0) { b2=b; b->h.cix=0; b=b->b.nextbcell; k--;}
311  b2->b.nextbcell=tb[i].bp;
312  tb[i].bp=buddy[i].bp;
313  buddy[i].bp=b;
314  buddy[i].count -= kk;
315  tb[i].count=buddyfill[i];
316  freeheap -= buddysize[i]*kk;
317  alloccount[i] += kk;
318 #ifdef DEBUG
319  printf( "root_alloc_small: alloc %d block(s) (%d)\n", kk, i);
320 #endif
321  }}
322 #if THREADED
323  mutex_unlock(&alloc_lock);
324 #endif
325  /*return(b);*/
326  }
327 
328 #ifndef RGC
329 pointer gc_alloc(s,e,cid,nils) /*allocate heap of 's' longwords*/
330 register int s,nils;
331 int e,cid;
332 { register int req=1,i,ss;
333  register pointer p;
334  register pointer *v;
335  register bpointer b,b2;
336  register context *ctx=myctx;
337  register struct buddyfree *tb= ctx->thr_buddy;
338 #if defined(DEBUG) || defined(DEBUG_COUNT)
339  static int count=0;
340 
341  count++;
342 
343  if( nils > s ) {
344  printf( "alloc:%d:nils(=%d) > s(=%d)!!\n", count, nils, s );
345  }
346 #endif
347  ss=max(3,s+1); /*one more word for the allocation information*/
348  while (buddysize[req]<ss) req++;
349 #ifdef DEBUG
350  printf( "alloc:%d:s=%d, e=%d, cid=%d, nils=%d\n",
351  count, s, e, cid, nils );
352 #endif
353  if (req>=MAXTHRBUDDY) b=root_alloc_big(ctx, req);
354  else { /*small cell is requested*/
355  if (tb[req].count==0) {/*find a cell in the local free list*/
356  root_alloc_small(ctx, req);
357 #ifdef DEBUG
358  printf( "alloc:" );
359  dump_bcell(req,ctx->thr_buddy);
360 #endif
361  }
362 #if THREADED
363  rw_rdlock(&gc_lock);
364 #endif
365 #ifdef DEBUG
366  fflush( stdout );
367  printf( "alloc:%d:", count );
368  dump_bcell( req, tb );
369 #endif
370  b=tb[req].bp;
371  ctx->lastalloc=makepointer(b);
372  ss=buddysize[req]-1;
373  tb[req].bp=b->b.nextbcell;
374 #if defined(DEBUG) || defined(UALLOC_DEBUG)
375  printf( "alloc:%d:allocate for user[%d(buddysize=%d)] = 0x%lx: new list top = 0x%lx\n",
376  count, req, buddysize[req], b, tb[req].bp );
377 #endif
378  for (i=0; i<ss; i++) b->b.c[i]=0;
379  tb[req].count--;
380 #if THREADED
381  rw_unlock(&gc_lock);
382 #endif
383  }
384  b->h.elmtype=e;
385  b->h.cix=cid;
386  b->h.extra=0;
387  b->h.nodispose=0;
388  p=makepointer(b);
389  v=p->c.obj.iv;
390 #ifdef DEBUG
391  printf( "alloc:%d:fill NIL:nils = %d, s = %d\n",
392  count, nils, s );
393 #endif
394  i=0;
395  while (i<nils) v[i++]=NIL; /*fill NILs in user's slots*/
396 /* while (nils<s) v[nils++]=NIL; */
397  i=buddysize[req]-1;
398  while (s<i) v[s++]=NULL; /*fill NULLs in buddy-cells extra slots*/
399 #ifdef DEBUG
400  printf( "alloc:%d:after filling NIL:", count );
401  dump_bcell( req, tb );
402 #endif
403 
404  return(p);}
405 
406 #endif /* RGC */
407 
408 
409 /****************************************************************/
410 /* gc: garbage collector
411 /****************************************************************/
412 
413 #define DEFAULT_MAX_GCSTACK 65536*2
415 #define gcpush(v) (*lgcsp++=((pointer)v))
416 #define gcpop() (*--lgcsp)
417 #if Solaris2
418 #define out_of_heap(p) ((int)p<(int)_end || (pointer)0x20000000<p)
419 #else /* Solaris2 */
420 #if Linux || Cygwin || Darwin
421 #if (WORD_SIZE == 64)
422 #define out_of_heap(p) ((unsigned long)p<(unsigned long)minmemory || (pointer)maxmemory <p)
423 #else
424 #define out_of_heap(p) ((unsigned int)p<(unsigned int)minmemory || (pointer)maxmemory <p)
425 #endif
426 #else /* Linux || Cygwin || Darwin */
427 #if alpha
428 #if THREADED
429 #define out_of_heap(p) ((long)p<4 || bottom_addr<(long)p)
430 #else
431 #define out_of_heap(p) ((long)p<(long)edata || (pointer)0x000003ff00000000<p)
432 #endif
433 #else /* alpha */
434 #if SunOS4_1
435 #define out_of_heap(p) ((int)p<(int)edata || (pointer)0x20000000<p)
436 #else
437 #if (WORD_SIZE == 64)
438 #define out_of_heap(p) ((long)p<(long)edata || (pointer)0x20000000<p)
439 #else
440 #define out_of_heap(p) ((int)p<(int)edata || (pointer)0x20000000<p)
441 #endif
442 #endif /* SunOS4_1 */
443 #endif /* alpha */
444 #endif /* Linux || Cygwin || Darwin */
445 #endif /* Solaris2 */
446 
447 
449 
450 void mark(p)
451 register pointer p;
452 { register int i,s;
453  register bpointer bp;
454  register pointer p2;
455  register pointer *lgcsp=gcstack;
456  register pointer *lgcsplimit=gcsplimit;
457 
458  mark_root=p;
459  gcpush(p);
460 markloop:
461  if (lgcsp<=gcstack) return;
462  p=gcpop();
463 markagain:
464  if (out_of_heap(p)) goto markloop;
465 
466  bp=bpointerof(p);
467  if (marked(bp)) goto markloop; /*already marked*/
468  markon(bp); /*mark it first to avoid endless marking*/
469 #ifdef MARK_DEBUG
470  printf( "mark: markon 0x%lx\n", bp );
471 #endif
472  if (pisclosure(p)) goto markloop; /*avoid marking contents of closure*/
473  marking=p;
474 /* printf("%x, %x, %d, %d, %d\n", p, bp, bp->h.elmtype, bp->h.bix, buddysize[bp->h.bix] );*/
475  if (bp->h.elmtype==ELM_FIXED) { /*contents are all pointers*/
476  s=buddysize[bp->h.bix]-1;
477  while (lgcsp+s>gcsplimit) {
478  newgcstack(lgcsp); lgcsp=gcsp;}
479  for (i=0; i<s; i++) {
480  p2=p->c.obj.iv[i];
481  if (ispointer(p2)) /* && !marked(bpointerof(p2)))*/ gcpush(p2); }
482  goto markloop;}
483  else if (bp->h.elmtype==ELM_POINTER) { /*varing number of pointers*/
484  s=buddysize[bp->h.bix]-2;
485  while (lgcsp+s>gcsplimit) {
486  newgcstack(lgcsp); lgcsp=gcsp;}
487  for (i=0; i<s; i++) {
488  p2=p->c.vec.v[i];
489  if (ispointer(p2)) /* && !marked(bpointerof(p2)))*/ gcpush(p2); }
490  goto markloop;}
491  else goto markloop;
492  }
493 
494 
495 void newgcstack(oldsp)
496 register pointer *oldsp;
497 { register pointer *oldstack, *stk, *newstack, *newgcsp;
498  long top, oldsize, newsize;
499 
500  oldstack=stk=gcstack;
501  oldsize=gcsplimit-gcstack;
502  newsize=oldsize*2;
503  top=oldsp-gcstack;
504  newgcsp=newstack=(pointer *)malloc(newsize * sizeof(pointer)+16);
505  if(isatty(0)) {
506  fprintf(stderr, "\n;; extending gcstack %p[%ld] --> %p[%ld] top=%lx\n",
507  oldstack, oldsize, newstack, newsize, top);}
508  while (stk<oldsp) *newgcsp++= *stk++;
509  gcstack=newstack;
510  gcsplimit= &gcstack[newsize-10];
511  gcsp= &gcstack[top];
512  cfree(oldstack);
513  }
514 
519 
520 void markall()
521 { register pointer *p,*spsave;
522  register int i,j;
523  register context *ctx;
524  register bpointer q;
525 /*#if defined(DEBUG_COUNT) || defined(MARK_DEBUG)*/
526  static int count = 0;
527 
528  count++;
529 /*#endif*/
530 
531  mark_state=1;
532 #ifdef MARK_DEBUG
533  printf( "markall:%d: mark(SYSTEM_OBJECTS)\n", count );
534 #endif
535  mark(sysobj); /*mark internally reachable objects*/
536  mark_state=2;
537 #ifdef MARK_DEBUG
538  printf( "markall:%d: mark(PACKAGE_LIST)\n", count );
539 #endif
540  mark(pkglist); /*mark all packages*/
541  for (i=0; i<MAXTHREAD; i++) {
542  /*mark everything reachable from stacks in euscontexts*/
543  if ((ctx=euscontexts[i])) {
544  mark_ctx=ctx; mark_state=3;
545 #ifdef MARK_DEBUG
546  printf( "markall:%d: mark(threadobj %d)\n", count, i );
547 #endif
548  mark(ctx->threadobj);
549  mark_state=4;
551 
552  /* mark from thread's stack */
553  for (p=ctx->stack; p<ctx->vsp; p++) {
555 #if (WORD_SIZE == 64)
556  if ((((euspointer_t)(*p) & 7L)==0L) &&
557 #else
558  if ((((euspointer_t)(*p) & 3)==0) &&
559 #endif
560  ((ctx->stack>(pointer *)*p) || ((pointer *)*p>ctx->stacklimit)))
561  { mark(*p); } ;}
562  mark_state=0x10000;
563 
564  /* mark free list already acquired in local buddy list */
565  for (j=1; j<MAXTHRBUDDY; j++) {
566  q=ctx->thr_buddy[j].bp;
568  while (q) { markon(q);
569 #ifdef MARK_DEBUG
570  printf( "markall:%d: markon 0x%ld\n", count, q );
571 #endif
572  q=q->b.nextbcell; mark_state++;}
573  }
574  mark_state=0x20000;
575 
576  /* mark thread special variables */
577 #ifdef MARK_DEBUG
578  printf( "markall:%d: mark(SPECIALS)\n", count );
579 #endif
580  mark(ctx->specials);
581 
582  q=bpointerof(ctx->lastalloc);
583  if (q && ispointer(q)) /* markon(q); */
584 #ifdef MARK_DEBUG
585  printf( "markall:%d: mark(lastalloc)\n", count );
586 #endif
587  mark(ctx->lastalloc);
588  }}
589  mark_state=5;
590  for (i=0; i<MAXCLASS; i++) {
591  if (ispointer(classtab[i].def)) mark(classtab[i].def); }
592  mark_state=0;
593  }
594 
595 #ifndef RGC
596 void reclaim(p)
597 register bpointer p;
598 { register int rbix,stat;
599  register pointer s;
600  s=makepointer(p);
601  if (pisfilestream(s)) {
602  if (!isint(s->c.fstream.fname) && s->c.fstream.direction!=NIL) {
603  if (s->c.fstream.fd==makeint(0) || s->c.fstream.fd==makeint(1)) {
604  fprintf(stderr,";; gc! bogus stream at %lx fd=%ld\n",
605  (unsigned long int)s,intval(s->c.fstream.fd));}
606 #if (WORD_SIZE == 64)
607  else if (s->c.fstream.fd == 0) {
608  // Sometimes, s->c.fstream.fd is 0.
609  // c.fstream.fd should be eus integer which least 2bits is 10.
610  // So, the condition that s->c.fstream.fd is 0 is obviously bug.
611  fprintf(stderr, ";; closing fstream was failed, %p, %d\n", s, s->cix);
612  }
613  else if ((s->c.stream.buffer == NULL) ||
614  ((unsigned long)(s->c.stream.buffer) & 0x7L) != 0x0L ||
615  s->c.stream.buffer->cix == -1) {
616  // stream buffer already reclaimed?????
617  // very dirty code for avoiding segmentation falut.
618  // there are some bugs before here.
619  fprintf(stderr, ";; bad stream buffer, %p\n", s->c.stream.buffer);
620  }
621 #endif
622  else if ((closestream(s)==0) && debug)
623  fprintf(stderr,";; gc: dangling stream(address=%lx fd=%ld) is closed\n",
624  (unsigned long int)s,intval(s->c.fstream.fd)); } }
625  p->h.cix= -1;
626  rbix=p->h.bix;
627  p->b.nextbcell=buddy[rbix].bp;
628  buddy[rbix].bp=p; buddy[rbix].count++;
629  freeheap+=buddysize[rbix];}
630 #endif
631 
632 static bpointer mergecell(p,cbix)
633 register bpointer p;
634 int cbix;
635 /*the cell pointed by 'p' must not be marked*/
636 /*mergecell kindly returns next uncollectable cell address*/
637 { register bpointer np,p2;
638 #if defined(DEBUG_COUNT) || defined(MERGE_DEBUG)
639  static int count = 0;
640 
641  count++;
642 #endif
643  np=nextbuddy(p);
644  while (p->h.b==0 && (int)p->h.bix<cbix) {
645  if (marked(np)) return(np);
646  if (np->h.nodispose==1) return(np);
647  p2=mergecell(np,cbix); /*merge neighbor cell*/
648  if (np->h.b==1) { /*can be merged*/
649  p->h.b=p->h.m; /*merge them into bigger cell*/
650  p->h.m=np->h.m;
651  p->h.bix++;
652 #ifdef MERGE_DEBUG
653  printf( "mergecell:%d:p=0x%lx, np=0x%lx\n", count, p, np );
654 #endif
655  np=p2;}
656  else {
657 #ifdef MERGE_DEBUG
658  printf( "mergecell:%d:call reclaim:np=0x%lx\n", count, np );
659 #endif
660  reclaim(np);
661  return(p2);}}
662  return(np);}
663 
664 static void sweep(cp,gcmerge)
665 register struct chunk *cp;
666 register int gcmerge;
667 { register int s;
668  register bpointer p,np,tail;
669 #if defined(DEBUG_COUNT) || defined(SWEEP_DEBUG) || defined(MARK_DEBUG)
670  static int count = 0;
671  int count2 = 0;
672 
673  count++;
674 #endif
675  s=buddysize[cp->chunkbix];
676  p= &cp->rootcell;
677  tail=(bpointer)((eusinteger_t)p+(s<<WORDSHIFT));/* ???? */
678 #ifdef SWEEP_DEBUG
679  printf( "sweep:%d:top=0x%lx, tail=0x%lx\n", count, p, tail );
680 #endif
681  while (p<tail) {
682 #ifdef SWEEP_DEBUG
683  printf( "sweep:%d,%d:p=0x%lx:NIL->cix=%d\n", count, count2++, p, NIL->cix );
684 #endif
685  if (marked(p)) { /*don't reclaim*/
686  markoff(p);
687 #ifdef MARK_DEBUG
688  printf( "sweep:%d,%d: markoff 0x%lx\n", count, count2, p );
689 #endif
690 
691  p=nextbuddy(p);} /*don't collect*/
692  else {
693  if (p->h.nodispose==1) {
694  /* fprintf(stderr,";; dispose %x\n", p); */
696  fprintf(stderr, "no more space for disposal processing\n");
697  else dispose[dispose_count++]=makepointer(p);
698  p=nextbuddy(p); }
699  else if (gcmerge>freeheap) { /* no merge */
700  np=nextbuddy(p);
701  reclaim(p);
702  p=np;}
703  else {
704  np=mergecell(p,cp->chunkbix); /*update free buddy list*/
705  reclaim(p);
706  p=np;} } }
707  }
708 
710 { int i;
711  context *ctx=current_ctx;
712  pointer p,a,curclass;
713  /*if (debug) fprintf(stderr, ";; disposal call=%d\n", dispose_count);*/
714  for (i=0; i<dispose_count; i++) {
715  p=dispose[i];
716  p->nodispose=0;
717  a=(pointer)findmethod(ctx,K_DISPOSE,classof(p), &curclass);
718  if (debug) fprintf(stderr, ";; (send %p :dispose)\n", p);
719  if (a!=NIL) csend(ctx,p,K_DISPOSE,0);
720  }}
721 
722 void sweepall()
723 {
724  context *ctx;
725  register struct chunk *chp;
726  register int i, gcmerge;
727  numunion nu;
728 
729  dispose_count=0;
730  ctx=euscontexts[thr_self()];
731  gcmerge=totalheap * min(1.0,fltval(speval(GCMARGIN)))
732  * max(0.1,fltval(speval(GCMERGE)));
733 
734  for (i=0; i<MAXBUDDY-1; i++) {
735  buddy[i].bp=0; /*purge buddies*/
736  buddy[i].count=0; /*clear free cell count*/
737  }
738  freeheap=0;
739  for (chp=chunklist; chp!=0; chp=chp->nextchunk) sweep(chp,gcmerge);
740  call_disposers();
741 
742  }
743 
744 #if THREADED
746 { register int i, self, stat;
747 
748  self=thr_self();
749  for (i=0; i<MAXTHREAD; i++)
750  if (i!=self && euscontexts[i]) {
751  stat=thr_suspend(i);
752  if (stat) fprintf(stderr, "gc cannot suspend thread %d\n",i); }
753  }
754 
756 { register int i, self, stat;
757 
758  self=thr_self();
759  for (i=0; i<MAXTHREAD; i++)
760  if (i!=self && euscontexts[i]) {
761  stat=thr_continue(i);
762  if (stat) fprintf(stderr, "gc cannot resume thread %d\n",i); }
763  }
764 
765 #endif
766 
767 #if vxworks
768 void gc()
769 { if (debug) fprintf(stderr,"\n;; gc:");
770  breakck;
771  gccount++;
772  markall();
773  sweepall();
774  if (debug) {
775  fprintf(stderr," free/total=%d/%d stack=%d ",
777  }
778  breakck; }
779 #else
780 
781 void gc()
782 { struct tms tbuf1,tbuf2,tbuf3;
783  int i, r;
784  context *ctx=euscontexts[thr_self()];
785 
786  if (debug) fprintf(stderr,"\n;; gc: thread=%d ",thr_self());
787  breakck;
788  gccount++;
789  times(&tbuf1);
790 
791 #if THREADED
792 /* mutex_lock(&alloc_lock); is not needed since gc is assumed to be called
793  from alloc_small or alloc_big and they have already locked alloc_lock.*/
794  r = mutex_trylock(&mark_lock);
795  if ( r != 0 ) {
796  if (debug) fprintf(stderr, ";; gc:mutex_lock %d ", r);
797  return;
798  }
799  rw_wrlock(&gc_lock);
801 #endif
802 
803  markall();
804 
805  times(&tbuf2);
806  marktime+=(tbuf2.tms_utime-tbuf1.tms_utime);
807  sweepall();
808  times(&tbuf3);
809  sweeptime+=(tbuf3.tms_utime-tbuf2.tms_utime);
810 
811 #if THREADED
813  rw_unlock(&gc_lock);
814  mutex_unlock(&mark_lock);
815 /* mutex_unlock(&alloc_lock); */
816 #endif
817  if (debug) {
818  fprintf(stderr," free/total=%ld/%ld stack=%d ",
819  freeheap,totalheap,(int)(myctx->vsp - myctx->stack));
820  fprintf(stderr," mark=%ld sweep=%ld\n", marktime,sweeptime);
821  }
822  if (speval(QGCHOOK)!=NIL) {
823  pointer gchook=speval(QGCHOOK);
824  vpush(makeint(freeheap)); vpush(makeint(totalheap));
825  ufuncall(ctx,gchook,gchook,(pointer)(ctx->vsp-2),ctx->bindfp,2);
826  ctx->vsp -= 2;
827  }
828  breakck;
829 }
830 #endif
831 
832 #ifdef DEBUG
833 dump_bcell( k, b )
834 int k;
835 struct buddyfree *b;
836 {
837  bpointer bp;
838  int i;
839 
840  printf( "buddy[%d] = { %d, (", k, b[k].count );
841  bp = b[k].bp;
842  for( i = 0; i < b[k].count; i++ ) {
843  printf( "0x%lx ->", bp );
844  bp = bp->b.nextbcell;
845  }
846  printf( ")}\n" );
847 }
848 #endif
849 
850 #ifdef STACK_DEBUG
852 pointer v;
853 context *ctx;
854 {
855  printf( "vpush:0x%lx->[0x%lx]\n", v, ctx->vsp );
856 
857  return v;
858 }
859 #endif
cellheader::elmtype
unsigned elmtype
Definition: eus.h:182
gcmerge
static int gcmerge
Definition: collector.c:45
numunion
Definition: eus.h:428
resume_all_threads
void resume_all_threads()
Definition: memory.c:755
buddy
struct buddyfree buddy[MAXBUDDY+1]
Definition: eus.c:46
marking
pointer marking
Definition: memory.c:448
gc
void gc()
Definition: memory.c:768
cellheader::m
unsigned m
Definition: eus.h:179
NIL
pointer NIL
Definition: eus.c:110
MAXDISPOSE
#define MAXDISPOSE
Definition: memory.c:63
dispose_count
static int dispose_count
Definition: memory.c:65
QGCHOOK
pointer QGCHOOK
Definition: eus.c:122
bcell::nextbcell
struct bcell * nextbcell
Definition: eus.h:442
chunk::rootcell
struct bcell rootcell
Definition: eus.h:450
makeint
#define makeint(v)
Definition: sfttest.c:2
context
Definition: eus.h:524
bottom_addr
static eusinteger_t bottom_addr
Definition: memory.c:44
chunk::nextchunk
struct chunk * nextchunk
Definition: eus.h:448
alloccount
long alloccount[MAXBUDDY]
Definition: memory.c:60
newgcstack
void newgcstack(pointer *oldsp)
Definition: memory.c:495
s
short s
Definition: structsize.c:2
cellheader::pmark
unsigned pmark
Definition: eus.h:181
bcell::h
struct cellheader h
Definition: eus.h:440
gcsp
pointer * gcsp
Definition: memory.c:414
mark
void mark(pointer p)
Definition: memory.c:450
splitheap
void splitheap(int k, struct buddyfree *buddy)
Definition: memory.c:160
rcsid
static char * rcsid
Definition: memory.c:6
intval
#define intval(p)
Definition: sfttest.c:1
min
#define min(x, y)
Definition: rmflags.c:17
suspend_all_threads
void suspend_all_threads()
Definition: memory.c:745
pointer
struct cell * pointer
Definition: eus.h:165
context::thr_buddy
struct buddyfree * thr_buddy
Definition: eus.h:540
mergecell
static bpointer mergecell(bpointer p, int cbix)
Definition: memory.c:632
_end
eusinteger_t _end()
Definition: eus.c:33
gcstack
pointer * gcstack
Definition: memory.c:414
mark_buddy_q
euspointer_t mark_buddy_q
Definition: memory.c:518
cell::nodispose
unsigned nodispose
Definition: eus.h:390
eus.h
mark_lock
mutex_t mark_lock
Definition: mthread.c:25
mark_state
int mark_state
Definition: memory.c:515
maxmemory
char * maxmemory
Definition: memory.c:50
gccount
long gccount
Definition: memory.c:59
QDEBUG
pointer QDEBUG
Definition: eus.c:123
gcpush
#define gcpush(v, off)
Definition: memory.mutex.c:296
context::threadobj
pointer threadobj
Definition: eus.h:538
rw_wrlock
int rw_wrlock(rwlock_t *)
Definition: pthreads.c:188
reclaim
void reclaim(bpointer p)
Definition: memory.c:596
context::specials
pointer specials
Definition: eus.h:545
chunk
Definition: eus.h:447
thr_suspend
int thr_suspend(int)
Definition: pthreads.c:64
cell::c
union cell::cellunion c
markall
void markall()
Definition: memory.c:520
context::bindfp
struct bindframe * bindfp
Definition: eus.h:531
dump_bcell
dump_bcell(int k, struct buddyfree *b)
Definition: memory.c:833
markctx
context * markctx
Definition: memory.safe.c:133
cellheader::smark
unsigned smark
Definition: eus.h:180
dispose
static pointer dispose[MAXDISPOSE]
Definition: memory.c:64
cell::cix
short cix
Definition: eus.h:398
NULL
#define NULL
Definition: transargv.c:8
totalheap
long totalheap
Definition: memory.c:56
bpointer
struct bcell * bpointer
Definition: eus.h:445
fltval
float fltval()
FREETAG
#define FREETAG
Definition: collector.h:169
vector::v
pointer v[1]
Definition: eus.h:301
euscontexts
context * euscontexts[MAXTHREAD]
Definition: eus.c:105
classtab
struct class_desc classtab[MAXCLASS]
Definition: eus.c:138
rw_unlock
int rw_unlock(rwlock_t *)
Definition: pthreads.c:197
gc_alloc
pointer gc_alloc(int s, int e, int cid, int nils)
Definition: memory.c:329
mark_stack_root
euspointer_t mark_stack_root
Definition: memory.c:517
cellheader::mark
unsigned mark
Definition: eus.h:177
pkglist
pointer pkglist
Definition: eus.c:109
csend
pointer csend(context *,...)
object::iv
pointer iv[2]
Definition: eus.h:321
bcell::b
union bcell::@12 b
QPARAGC
pointer QPARAGC
Definition: eus.c:125
cellheader::bix
unsigned bix
Definition: eus.h:185
tail
tail(char *cp)
Definition: eustags.c:1181
marking2
pointer marking2
Definition: memory.c:448
bcell::c
struct cell * c[2]
Definition: eus.h:443
K_DISPOSE
pointer K_DISPOSE
Definition: eus.c:135
euspointer_t
unsigned long euspointer_t
Definition: eus.h:20
top_addr
static eusinteger_t top_addr
Definition: memory.c:44
minmemory
char * minmemory
Definition: memory.c:52
context::stack
pointer * stack
Definition: eus.h:525
chunklist
struct chunk * chunklist
Definition: memory.c:57
sysobj
pointer sysobj
Definition: eus.c:54
bp
static int bp
Definition: helpsub.c:22
E_ALLOCATION
@ E_ALLOCATION
Definition: eus.h:923
cell::cellunion::obj
struct object obj
Definition: eus.h:417
GCMERGE
pointer GCMERGE
Definition: eus.c:173
mark_root
pointer mark_root
Definition: memory.c:448
sweepall
void sweepall()
Definition: memory.c:722
root_alloc_small
void root_alloc_small(context *ctx, int req)
Definition: memory.c:263
context::stacklimit
pointer * stacklimit
Definition: eus.h:525
set_heap_range
void set_heap_range(unsigned int min, unsigned int max)
Definition: external_markbits.c:15
error
pointer error(enum errorcode ec,...) pointer error(va_alist) va_dcl
Definition: eus.c:297
count
int count
Definition: thrtest.c:11
root_alloc_big
bpointer root_alloc_big(context *ctx, int req)
Definition: memory.c:214
buddyfree
Definition: eus.h:563
max
#define max(I1, I2)
Definition: eustags.c:134
chunk::chunkbix
int chunkbix
Definition: eus.h:449
sweeptime
long sweeptime
Definition: memory.c:59
findmethod
pointer findmethod(context *, pointer, pointer, pointer *)
Definition: leo.c:203
cell
Definition: eus.h:381
context::lastalloc
pointer lastalloc
Definition: eus.h:536
eusinteger_t
long eusinteger_t
Definition: eus.h:19
context::vsp
pointer * vsp
Definition: eus.h:525
closestream
int closestream(pointer)
Definition: eusstream.c:53
buddysize
long buddysize[MAXBUDDY+1]
Definition: eus.c:103
sweep
static void sweep(struct chunk *cp, int gcmerge)
Definition: memory.c:664
marktime
long marktime
Definition: memory.c:59
edata
edata
rw_rdlock
int rw_rdlock(rwlock_t *)
Definition: pthreads.c:179
cellheader::extra
unsigned extra
Definition: eus.h:187
newchunk
int newchunk(int k)
Definition: memory.c:67
cellheader::nodispose
unsigned nodispose
Definition: eus.h:183
buddyfree::bp
bpointer bp
Definition: eus.h:565
bcell
Definition: eus.h:439
ufuncall
pointer ufuncall(context *, pointer, pointer, pointer, struct bindframe *, int)
Definition: eval.c:1469
myctx
#define myctx
Definition: rgc_mem.c:9
alloc_lock
mutex_t alloc_lock
Definition: memory.mutex.c:42
cell::cellunion::vec
struct vector vec
Definition: eus.h:414
a
char a[26]
Definition: freq.c:4
mark_ctx
context * mark_ctx
Definition: memory.c:516
cellheader::cix
short cix
Definition: eus.h:190
gcsplimit
pointer * gcsplimit
Definition: memory.c:414
thr_continue
int thr_continue(int)
Definition: pthreads.c:58
GCMARGIN
pointer GCMARGIN
Definition: eus.c:173
freeheap
long freeheap
Definition: memory.c:56
buddyfree::count
int count
Definition: eus.h:564
p_print
pointer p_print(pointer v, context *ctx)
Definition: memory.c:851
gc_lock
rwlock_t gc_lock
Definition: mthread.c:18
v
GLfloat v[8][3]
Definition: cube.c:21
cellheader::b
unsigned b
Definition: eus.h:178
call_disposers
void call_disposers()
Definition: memory.c:709
thr_self
unsigned int thr_self()
Definition: eus.c:25


euslisp
Author(s): Toshihiro Matsui
autogenerated on Thu Jun 15 2023 02:06:43