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


euslisp
Author(s): Toshihiro Matsui
autogenerated on Thu Jun 6 2019 20:00:44