memory.c
Go to the documentation of this file.
00001 /****************************************************************/
00002 /* memory.c:    memory manager for eulisp                       */
00003 /*      Copyright(c) Toshihiro MATSUI
00004 /*                   Electrotechnical Laboratory,1986.
00005 /****************************************************************/
00006 static char *rcsid="@(#)$Id$";
00007 
00008 #if vxworks
00009 #include        <sys/types.h>
00010 #else
00011 #include        <sys/types.h>
00012 #include        <sys/times.h>
00013 #endif
00014 
00015 #if alpha
00016 #include        <stdlib.h>
00017 #include        <unistd.h>
00018 #endif
00019 
00020 #include        "eus.h"
00021 #if Solaris2
00022 #include        <synch.h>
00023 #include        <thread.h>
00024 #endif
00025 
00026 #if 0 /* moved to eus.h */
00027 #define nextbuddy(p) ((bpointer)((eusinteger_t)p+(buddysize[p->h.bix]*sizeof(pointer))))
00028 #define marked(p)  (p->h.mark)
00029 #define markon(p)  p->h.mark=1
00030 #define markoff(p) p->h.mark=0
00031 #endif
00032 #define myctx (euscontexts[thr_self()])
00033 
00034 /* Written by I.Hara 01/12/95 */
00035 #if Solaris2 || Linux
00036 extern _end();
00037 #elif SunOS4_1
00038 extern edata;
00039 #else
00040 extern edata(),_end();
00041 #endif
00042 
00043 #if alpha
00044 static eusinteger_t top_addr, bottom_addr;
00045 #endif
00046 
00047 extern pointer QPARAGC;
00048 extern pointer K_DISPOSE;
00049 
00050 char *maxmemory=(char *)0x100000;
00051 #if Cygwin
00052 char *minmemory=(char *)0xffffffff;
00053 #endif
00054 long freeheap=0,totalheap=0;    /*size of heap left and allocated*/
00055 struct chunk *chunklist=NULL;
00056 /* timers */
00057 long gccount,marktime,sweeptime;
00058 long alloccount[MAXBUDDY];
00059 
00060 /*disposal processing*/
00061 #define MAXDISPOSE 256
00062 static  pointer dispose[MAXDISPOSE];
00063 static  int dispose_count;
00064 
00065 newchunk(k)
00066 register int k;
00067 { register int s;
00068   register struct chunk *cp;  
00069   eusinteger_t tail;
00070 #if defined(BIX_DEBUG) || defined(DEBUG_COUNT)
00071   static int count = 0;
00072 
00073   count++;
00074 #endif
00075 //      fprintf(stderr, "\x1b[1;31mnewchunk(%d)\x1b[0m\n", k);
00076   if (k<DEFAULTCHUNKINDEX) k=DEFAULTCHUNKINDEX;
00077   if (QDEBUG && debug) fprintf(stderr,";; newchunk: k=%d\n",k);
00078   s=buddysize[k];
00079   cp=(struct chunk *)((long)malloc((s+2)*sizeof(pointer)+(sizeof(pointer)-1)) & ~(sizeof(pointer)-1));
00080 #if defined(RGC)
00081   set_heap_range((unsigned int)cp,
00082       (unsigned int)cp + (s+2)*sizeof(pointer)+(sizeof(pointer)-1));
00083 #endif
00084 #if Cygwin
00085   if (minmemory > (char *)cp) minmemory = (char *)cp;
00086   if (maxmemory < (char *)sbrk(0)) maxmemory = (char *)sbrk(0);
00087   if (maxmemory < (char *)cp+(s+2)*sizeof(pointer)+(sizeof(pointer)-1)) maxmemory = ((char *)cp+(s+2)*sizeof(pointer)+(sizeof(pointer)-1));
00088 #elif Linux
00089   if (maxmemory < (char *)sbrk(0)) maxmemory = (char *)sbrk(0);
00090   if (maxmemory < (char *)cp+(s+2)*sizeof(pointer)+(sizeof(pointer)-1)) maxmemory = ((char *)cp+(s+2)*sizeof(pointer)+(sizeof(pointer)-1));
00091 #else
00092   maxmemory=(char *)sbrk(0);
00093 #endif
00094   if (QDEBUG && debug) fprintf(stderr,";; maxmemory=%p\n",maxmemory);
00095   if (cp==NULL) return(ERR);    /*can't allocate new memory*/
00096 #if alpha
00097   if( chunklist == NULL ) {
00098     top_addr = (eusinteger_t)cp;
00099 /*printf( "first topaddr = 0x%lx\n", top_addr );*/
00100 }
00101   if( (eusinteger_t)cp < top_addr ) {
00102     top_addr = (eusinteger_t)chunklist;
00103 /*printf( "topaddr = 0x%lx\n", top_addr );*/
00104 }
00105 #endif
00106   
00107 #if defined(RGC)// && !defined(__USE_MARK_BITMAP)
00108   /* sort by address */
00109   if (chunklist == NULL) {
00110     cp->nextchunk = NULL;
00111     chunklist = cp;
00112   } else {
00113     struct chunk *ccp;
00114     for (ccp = chunklist; ccp->nextchunk < cp && ccp->nextchunk != NULL; 
00115         ccp = ccp->nextchunk);
00116     cp->nextchunk = ccp->nextchunk;
00117     ccp->nextchunk = cp;
00118   }
00119 #else
00120   cp->nextchunk=chunklist;      /*link to chunk list*/
00121   chunklist=cp;
00122 #endif
00123 
00124   cp->chunkbix=k;
00125   cp->rootcell.h.mark=0;
00126   cp->rootcell.h.smark=0;
00127   cp->rootcell.h.pmark=0;
00128   cp->rootcell.h.b=1;           /*initial buddy marks*/
00129   cp->rootcell.h.m=0;
00130   cp->rootcell.h.nodispose=0;
00131   cp->rootcell.h.bix=k;
00132 #ifndef RGC
00133   cp->rootcell.b.nextbcell=0;
00134 #else
00135   cp->rootcell.b.nextbcell = buddy[k].bp;
00136 #endif
00137 #if alpha
00138   tail = (eusinteger_t)cp + (s+2)*sizeof(pointer);
00139   if( tail > bottom_addr ) {
00140     bottom_addr = tail;
00141 /*printf( "bottom_addr = 0x%lx\n", bottom_addr );*/
00142 }
00143 #endif
00144 #ifdef RGC
00145   /* the color of free cells are GRAY */
00146   cp->rootcell.h.bix |= FREETAG;
00147   cp->rootcell.h.cix = -1; /* free tag */
00148   if((char *)cp < minmemory)
00149     minmemory = (char *)cp;
00150 #endif
00151   cp->rootcell.h.cix = -1; /* free tag */
00152   buddy[k].bp= &cp->rootcell;
00153   buddy[k].count++;
00154   totalheap += s; freeheap += s;
00155   return(k);
00156   }
00157 
00158 void splitheap(k,buddy) /*heart of the allocator*/
00159 register int k;
00160 register struct buddyfree *buddy;
00161 { register bpointer b1,b2,bnext;
00162 #if defined(BIX_DEBUG) || defined(DEBUG_COUNT)
00163   static int count;
00164 
00165   count++;
00166 #endif
00167 
00168   b1= buddy[k].bp;      /*root buddy pointer*/
00169   bnext=b1->b.nextbcell;
00170   buddy[k].bp= bnext;   /*remove first element*/
00171   buddy[k].count--;
00172   b2= (bpointer)((long)b1+buddysize[k-1]*sizeof(pointer));
00173   if (k==2) {   /*b1 and b2 are of the same size*/
00174     b1->b.nextbcell=b2;
00175     b2->b.nextbcell=buddy[k-1].bp;
00176     buddy[k-1].bp=b1;
00177     buddy[k-1].count +=2;
00178 #ifdef RGC
00179     b2->h.bix = 1 | FREETAG;
00180     b2->h.cix = -1; /* free tag */
00181 #else
00182     b2->h.bix= 1;
00183     b2->h.cix = -1; /* free tag */
00184 #endif
00185   } else {
00186     b1->b.nextbcell= buddy[k-1].bp;
00187     buddy[k-1].bp=b1;
00188     buddy[k-1].count++;
00189     b2->b.nextbcell=buddy[k-2].bp;
00190     buddy[k-2].bp=b2;
00191     buddy[k-2].count++;
00192 #ifdef RGC
00193     b2->h.bix = (k-2 | FREETAG);
00194     b2->h.cix = -1; /* free tag */
00195 #else
00196     b2->h.bix= k-2;
00197     b2->h.cix = -1; /* free tag */
00198 #endif
00199   }
00200   b2->h.m=b1->h.m;
00201   b1->h.m=b1->h.b;
00202   b1->h.b=0; 
00203 #ifdef RGC
00204   b1->h.bix = (k-1 | FREETAG);
00205 #else
00206   b1->h.bix= k-1; 
00207 #endif
00208   b2->h.b=1;
00209   b2->h.mark=b2->h.smark=b2->h.pmark=0;
00210   b1->h.nodispose=b2->h.nodispose=0;}
00211 
00212 bpointer root_alloc_big(ctx, req)
00213 register context *ctx;
00214 register int req;       /*index to buddy: must be greater than 0*/
00215 { register int i, k;
00216   register bpointer b,b2;
00217   numunion nu;
00218   pointer gcm;
00219 
00220 #if THREADED
00221   mutex_lock(&alloc_lock); 
00222 #endif
00223 
00224   ctx->alloc_big_count++;
00225 
00226     k=req;
00227     while (buddy[k].bp==0) k++; /*find blocks of adequate size*/
00228     if (k>=MAXBUDDY) {          /*no bigger free cell*/
00229       if (buddysize[req]<totalheap/8) { /*relatively small cell is requested;*/
00230         gc();                   /* then try garbage collection*/
00231         gcm=speval(GCMARGIN);
00232         while (freeheap < (totalheap*min(5.0,fltval(gcm))))
00233           newchunk(req); /*still not enough space*/
00234         for (k=req; buddy[k].bp==0; ) k++;}
00235       if (k>=MAXBUDDY) {
00236         k=newchunk(req);
00237         if (k==ERR) { 
00238 #if THREADED
00239           mutex_unlock(&alloc_lock);
00240 #endif
00241           error(E_ALLOCATION);}}}
00242 
00243     while (req<k) { splitheap(k--,buddy); if (k>req) k--;}
00244     k=buddysize[req]-1;
00245     b=buddy[req].bp;
00246     b2=b->b.nextbcell;
00247     for (i=0; i<k; i++) b->b.c[i]=0;
00248     ctx->lastalloc=makepointer(b);
00249     buddy[req].bp=b2;
00250     buddy[req].count--;
00251 #ifdef DEBUG
00252   printf( "root_alloc_big: alloc 1 block (%d), 0x%lx\n", req, b );
00253 #endif
00254     freeheap -= buddysize[req];
00255     alloccount[req]++;
00256 #if THREADED
00257   mutex_unlock(&alloc_lock); 
00258 #endif
00259   return(b);}
00260 
00261 void root_alloc_small(ctx, req)
00262 register context *ctx;
00263 register int req;       /*index to buddy: must be greater than 0*/
00264 { register int i, j, k,kk;
00265   register bpointer b, b2;
00266   register struct buddyfree *tb=ctx->thr_buddy;
00267   static long buddyfill[MAXTHRBUDDY+1]={0,500,300,20,15,10,0};
00268   numunion nu;
00269   int collected=0;
00270 
00271 #if THREADED
00272   mutex_lock(&alloc_lock); 
00273 #endif
00274   
00275   ctx->alloc_small_count++;
00276 
00277   alloc_again:
00278   for (i=1; i<MAXTHRBUDDY; i++) {
00279     k=kk=buddyfill[i] - tb[i].count; /*how many cells are needed*/
00280     while (buddy[i].count < k) {   /*Do we have enough free in the root?*/
00281 /*      fprintf(stderr, "free_count=%d; k=%d\n",buddy[i].count,k);  */
00282         j=i+1;
00283         while (buddy[j].bp==0) j++;
00284         if (j>=MAXBUDDY) {      /*no free cell*/
00285           if (!collected) {
00286             /* fprintf(stderr, "GC: free=%d total=%d, margin=%f\n",
00287                         freeheap, totalheap, fltval(speval(GCMARGIN))); */
00288             gc(); collected=1;
00289             goto alloc_again;}
00290           while (freeheap<(totalheap*min(5.0,fltval(speval(GCMARGIN))))) {
00291             j=newchunk(DEFAULTCHUNKINDEX); /*still not enough space*/
00292             if (j==ERR) { 
00293 #if THREADED
00294               mutex_unlock(&alloc_lock); 
00295 #endif
00296               error(E_ALLOCATION);}} }
00297         if (j>=MAXBUDDY) {      /*hard fragmentation seen*/
00298           j=newchunk(DEFAULTCHUNKINDEX);
00299           if (j==ERR) { 
00300 #if THREADED
00301             mutex_unlock(&alloc_lock);
00302 #endif
00303             error(E_ALLOCATION);}} 
00304         splitheap(j, buddy);}
00305     /*sufficient free cells collected in the root free list*/
00306     if (k>0) {
00307       b=buddy[i].bp;
00308       while (k>0) { b2=b; b->h.cix=0; b=b->b.nextbcell; k--;}
00309       b2->b.nextbcell=tb[i].bp;
00310       tb[i].bp=buddy[i].bp;
00311       buddy[i].bp=b;
00312       buddy[i].count -= kk;
00313       tb[i].count=buddyfill[i];
00314       freeheap -= buddysize[i]*kk;
00315       alloccount[i] += kk;
00316 #ifdef DEBUG
00317       printf( "root_alloc_small: alloc %d block(s) (%d)\n", kk, i);
00318 #endif
00319       }}
00320 #if THREADED
00321   mutex_unlock(&alloc_lock); 
00322 #endif
00323   /*return(b);*/
00324   }
00325 
00326 #ifndef RGC
00327 pointer gc_alloc(s,e,cid,nils)  /*allocate heap of 's' longwords*/
00328 register int s,nils;
00329 int e,cid;
00330 { register int req=1,i,ss;
00331   register pointer p;
00332   register pointer *v;
00333   register bpointer b,b2;
00334   register context *ctx=myctx;
00335   register struct buddyfree *tb= ctx->thr_buddy;
00336 #if defined(DEBUG) || defined(DEBUG_COUNT)
00337   static int count=0;
00338 
00339   count++;
00340 
00341   if( nils > s ) {
00342       printf( "alloc:%d:nils(=%d) > s(=%d)!!\n", count, nils, s );
00343   }
00344 #endif
00345   ss=max(3,s+1);         /*one more word for the allocation information*/
00346   while (buddysize[req]<ss) req++;
00347 #ifdef DEBUG
00348   printf( "alloc:%d:s=%d, e=%d, cid=%d, nils=%d\n",
00349          count, s, e, cid, nils );
00350 #endif
00351   if (req>=MAXTHRBUDDY)  b=root_alloc_big(ctx, req);
00352   else { /*small cell is requested*/
00353     if (tb[req].count==0) {/*find a cell in the local free list*/
00354       root_alloc_small(ctx, req);
00355 #ifdef DEBUG
00356       printf( "alloc:" );
00357       dump_bcell(req,ctx->thr_buddy);
00358 #endif
00359   }
00360 #if THREADED
00361     rw_rdlock(&gc_lock);
00362 #endif
00363 #ifdef DEBUG
00364     fflush( stdout );
00365     printf( "alloc:%d:", count );
00366     dump_bcell( req, tb );
00367 #endif
00368     b=tb[req].bp;
00369     ctx->lastalloc=makepointer(b);
00370     ss=buddysize[req]-1;
00371     tb[req].bp=b->b.nextbcell;
00372 #if defined(DEBUG) || defined(UALLOC_DEBUG)
00373     printf( "alloc:%d:allocate for user[%d(buddysize=%d)] = 0x%lx: new list top = 0x%lx\n",
00374            count, req, buddysize[req], b, tb[req].bp );
00375 #endif
00376     for (i=0; i<ss; i++) b->b.c[i]=0;
00377     tb[req].count--;
00378 #if THREADED
00379     rw_unlock(&gc_lock);
00380 #endif
00381     }
00382   b->h.elmtype=e;
00383   b->h.cix=cid;
00384   b->h.extra=0;
00385   b->h.nodispose=0;
00386   p=makepointer(b);
00387   v=p->c.obj.iv;
00388 #ifdef DEBUG
00389   printf( "alloc:%d:fill NIL:nils = %d, s = %d\n",
00390          count, nils, s );
00391 #endif
00392   i=0;
00393   while (i<nils) v[i++]=NIL;    /*fill NILs in user's  slots*/
00394 /* while (nils<s) v[nils++]=NIL; */
00395   i=buddysize[req]-1;
00396   while (s<i) v[s++]=NULL;      /*fill NULLs in buddy-cells extra slots*/
00397 #ifdef DEBUG
00398   printf( "alloc:%d:after filling NIL:", count );
00399   dump_bcell( req, tb );
00400 #endif
00401 
00402   return(p);}
00403 
00404 #endif /* RGC */
00405 
00406 
00407 /****************************************************************/
00408 /* gc: garbage collector
00409 /****************************************************************/
00410 
00411 #define DEFAULT_MAX_GCSTACK 65536*2
00412 pointer *gcstack, *gcsplimit, *gcsp;
00413 #define gcpush(v) (*lgcsp++=((pointer)v))
00414 #define gcpop() (*--lgcsp)
00415 #if Solaris2 
00416 #define out_of_heap(p) ((int)p<(int)_end || (pointer)0x20000000<p)
00417 #else /* Solaris2 */
00418 #if Linux
00419 #if (WORD_SIZE == 64)
00420 #define out_of_heap(p) ((unsigned long)p<(unsigned long)_end || (pointer)maxmemory <p)
00421 #else
00422 #define out_of_heap(p) ((unsigned int)p<(unsigned int)_end || (pointer)maxmemory <p)
00423 #endif
00424 #else /* Linux */
00425 #if Cygwin /* Cygwin does not have _end */ || Darwin
00426 #define out_of_heap(p) ((unsigned int)p<(unsigned int)minmemory || (pointer)maxmemory <p)
00427 #else /* Cygwin */
00428 #if alpha
00429 #if THREADED
00430 #define out_of_heap(p) ((long)p<4 || bottom_addr<(long)p)
00431 #else
00432 #define out_of_heap(p) ((long)p<(long)edata || (pointer)0x000003ff00000000<p)
00433 #endif
00434 #else /* alpha */
00435 #if SunOS4_1
00436 #define out_of_heap(p) ((int)p<(int)edata || (pointer)0x20000000<p)
00437 #else
00438 #if (WORD_SIZE == 64)
00439 #define out_of_heap(p) ((long)p<(long)edata || (pointer)0x20000000<p)
00440 #else
00441 #define out_of_heap(p) ((int)p<(int)edata || (pointer)0x20000000<p)
00442 #endif
00443 #endif /* SunOS4_1 */
00444 #endif /* alpha */
00445 #endif /* Linux */
00446 #endif /* Cygwin */
00447 #endif /* Solaris2 */
00448 
00449 
00450 pointer mark_root, marking, marking2;
00451 
00452 void mark(p)
00453 register pointer p;
00454 { register int i,s;
00455   register bpointer bp;
00456   register pointer p2;
00457   register pointer *lgcsp=gcstack;
00458   register pointer *lgcsplimit=gcsplimit;
00459 
00460   mark_root=p;
00461   gcpush(p);
00462 markloop:
00463   if (lgcsp<=gcstack) return;
00464   p=gcpop();
00465 markagain:
00466   if (out_of_heap(p)) goto markloop;
00467 
00468   bp=bpointerof(p);
00469   if (marked(bp)) goto markloop;        /*already marked*/
00470   markon(bp);                   /*mark it first to avoid endless marking*/
00471 #ifdef MARK_DEBUG
00472   printf( "mark: markon 0x%lx\n", bp );
00473 #endif
00474   if (pisclosure(p)) goto markloop;     /*avoid marking contents of closure*/
00475   marking=p;
00476 /*  printf("%x, %x, %d, %d, %d\n", p, bp, bp->h.elmtype, bp->h.bix, buddysize[bp->h.bix] );*/
00477   if (bp->h.elmtype==ELM_FIXED) {       /*contents are all pointers*/
00478     s=buddysize[bp->h.bix]-1;
00479     while (lgcsp+s>gcsplimit) { 
00480       newgcstack(lgcsp); lgcsp=gcsp;}
00481     for (i=0; i<s; i++) {
00482         p2=p->c.obj.iv[i];
00483         if (ispointer(p2)) /* && !marked(bpointerof(p2)))*/  gcpush(p2); }
00484     goto markloop;}
00485   else if (bp->h.elmtype==ELM_POINTER) { /*varing number of pointers*/
00486     s=buddysize[bp->h.bix]-2;
00487     while (lgcsp+s>gcsplimit) { 
00488       newgcstack(lgcsp); lgcsp=gcsp;}
00489     for (i=0; i<s; i++) {
00490         p2=p->c.vec.v[i];
00491         if (ispointer(p2)) /* && !marked(bpointerof(p2)))*/   gcpush(p2); }
00492       goto markloop;}
00493   else goto markloop;
00494   }
00495 
00496 
00497 void newgcstack(oldsp)
00498 register pointer *oldsp;
00499 { register pointer *oldstack, *stk, *newstack, *newgcsp;
00500   long top, oldsize, newsize;
00501 
00502   oldstack=stk=gcstack;
00503   oldsize=gcsplimit-gcstack;
00504   newsize=oldsize*2;
00505   top=oldsp-gcstack;
00506   newgcsp=newstack=(pointer *)malloc(newsize * sizeof(pointer)+16);
00507   if(isatty(0)) {
00508     fprintf(stderr, "\n;; extending gcstack %p[%ld] --> %p[%ld] top=%lx\n",
00509             oldstack, oldsize, newstack, newsize, top);}
00510   while (stk<oldsp) *newgcsp++= *stk++;
00511   gcstack=newstack;
00512   gcsplimit= &gcstack[newsize-10];
00513   gcsp= &gcstack[top];
00514   cfree(oldstack);
00515   }
00516 
00517 int mark_state;
00518 context *mark_ctx;
00519 long mark_stack_root;
00520 long mark_buddy_q;
00521 
00522 void markall()
00523 { register pointer *p,*spsave;
00524   register int i,j;
00525   register context *ctx;
00526   register bpointer q;
00527 /*#if defined(DEBUG_COUNT) || defined(MARK_DEBUG)*/
00528   static int count = 0;
00529 
00530   count++;
00531 /*#endif*/
00532 
00533   mark_state=1;
00534 #ifdef MARK_DEBUG
00535   printf( "markall:%d: mark(SYSTEM_OBJECTS)\n", count );
00536 #endif
00537   mark(sysobj);         /*mark internally reachable objects*/
00538   mark_state=2;
00539 #ifdef MARK_DEBUG
00540   printf( "markall:%d: mark(PACKAGE_LIST)\n", count );
00541 #endif
00542   mark(pkglist);        /*mark all packages*/
00543   for (i=0; i<MAXTHREAD; i++) {
00544     /*mark everything reachable from stacks in euscontexts*/
00545     if ((ctx=euscontexts[i])) {
00546       mark_ctx=ctx; mark_state=3;
00547 #ifdef MARK_DEBUG
00548       printf( "markall:%d: mark(threadobj %d)\n", count, i );
00549 #endif
00550       mark(ctx->threadobj);
00551       mark_state=4;
00552       mark_stack_root=(long)ctx->stack;
00553 
00554       /* mark from thread's stack */
00555       for (p=ctx->stack; p<ctx->vsp; p++) {
00556         mark_state=(long)p;
00557 #if (WORD_SIZE == 64)
00558         if ((((eusinteger_t)(*p) & 7L)==0L) && 
00559 #else
00560         if ((((eusinteger_t)(*p) & 3)==0) && 
00561 #endif
00562             ((ctx->stack>(pointer *)*p) || ((pointer *)*p>ctx->stacklimit)))
00563                 { mark(*p); } ;}
00564       mark_state=0x10000;
00565 
00566       /* mark free list already acquired in local buddy list */
00567       for (j=1; j<MAXTHRBUDDY; j++) {
00568         q=ctx->thr_buddy[j].bp;
00569         mark_buddy_q=(long)q;
00570         while (q) { markon(q);
00571 #ifdef MARK_DEBUG
00572                     printf( "markall:%d: markon 0x%ld\n", count, q );
00573 #endif
00574  q=q->b.nextbcell; mark_state++;}
00575         }
00576       mark_state=0x20000;
00577 
00578       /* mark thread special variables */
00579 #ifdef MARK_DEBUG
00580       printf( "markall:%d: mark(SPECIALS)\n", count );
00581 #endif
00582       mark(ctx->specials);
00583 
00584       q=bpointerof(ctx->lastalloc);
00585       if (q && ispointer(q)) /* markon(q); */
00586 #ifdef MARK_DEBUG
00587         printf( "markall:%d: mark(lastalloc)\n", count );
00588 #endif
00589         mark(ctx->lastalloc);
00590       }}
00591   mark_state=5;
00592   for (i=0; i<MAXCLASS; i++) {
00593     if (ispointer(classtab[i].def)) mark(classtab[i].def); }
00594   mark_state=0;
00595   }
00596 
00597 #ifndef RGC
00598 void reclaim(p)
00599 register bpointer p;
00600 { register int rbix,stat;
00601   register pointer s;
00602   s=makepointer(p);
00603   if (pisfilestream(s)) {
00604     if (!isint(s->c.fstream.fname) && s->c.fstream.direction!=NIL) {
00605       if (s->c.fstream.fd==makeint(0) || s->c.fstream.fd==makeint(1)) {
00606         fprintf(stderr,";; gc! bogus stream at %lx fd=%ld\n",
00607                 (unsigned long int)s,intval(s->c.fstream.fd));}
00608 #if (WORD_SIZE == 64)
00609       else if (s->c.fstream.fd == 0) {
00610         // Sometimes, s->c.fstream.fd is 0.
00611         // c.fstream.fd should be eus integer which least 2bits is 10.
00612         // So, the condition that s->c.fstream.fd is 0 is obviously bug.
00613         fprintf(stderr, ";; closing fstream was failed, %p, %d\n", s, s->cix);
00614       }
00615       else if ((s->c.stream.buffer == NULL) ||
00616                ((unsigned long)(s->c.stream.buffer) & 0x7L) != 0x0L ||
00617                s->c.stream.buffer->cix == -1) {
00618         // stream buffer already reclaimed?????
00619         // very dirty code for avoiding segmentation falut.
00620         // there are some bugs before here.
00621         fprintf(stderr, ";; bad stream buffer, %p\n", s->c.stream.buffer);
00622       }
00623 #endif
00624       else if ((closestream(s)==0) && debug)
00625         fprintf(stderr,";; gc: dangling stream(address=%lx fd=%ld) is closed\n",
00626                 (unsigned long int)s,intval(s->c.fstream.fd)); } }
00627   p->h.cix= -1;
00628   rbix=p->h.bix;
00629   p->b.nextbcell=buddy[rbix].bp;
00630   buddy[rbix].bp=p; buddy[rbix].count++;
00631   freeheap+=buddysize[rbix];}
00632 #endif
00633 
00634 static bpointer mergecell(p,cbix)
00635 register bpointer p;
00636 int cbix;
00637 /*the cell pointed by 'p' must not be marked*/
00638 /*mergecell kindly returns next uncollectable cell address*/
00639 { register bpointer np,p2;
00640 #if defined(DEBUG_COUNT) || defined(MERGE_DEBUG)
00641   static int count = 0;
00642 
00643   count++;
00644 #endif
00645   np=nextbuddy(p);
00646   while (p->h.b==0 && (int)p->h.bix<cbix) {
00647     if (marked(np)) return(np);
00648     if (np->h.nodispose==1) return(np);
00649     p2=mergecell(np,cbix);      /*merge neighbor cell*/
00650     if (np->h.b==1) {           /*can be merged*/
00651       p->h.b=p->h.m;            /*merge them into bigger cell*/
00652       p->h.m=np->h.m;
00653       p->h.bix++;
00654 #ifdef MERGE_DEBUG
00655       printf( "mergecell:%d:p=0x%lx, np=0x%lx\n", count, p, np );
00656 #endif
00657       np=p2;}
00658     else {
00659 #ifdef MERGE_DEBUG
00660         printf( "mergecell:%d:call reclaim:np=0x%lx\n", count, np );
00661 #endif
00662       reclaim(np);
00663       return(p2);}}
00664   return(np);}
00665   
00666 static void sweep(cp,gcmerge)
00667 register struct chunk *cp;
00668 register int gcmerge;
00669 { register int s;
00670   register bpointer p,np,tail;
00671 #if defined(DEBUG_COUNT) || defined(SWEEP_DEBUG) || defined(MARK_DEBUG)
00672   static int count = 0;
00673   int count2 = 0;
00674 
00675   count++;
00676 #endif
00677   s=buddysize[cp->chunkbix];
00678   p= &cp->rootcell;
00679   tail=(bpointer)((eusinteger_t)p+(s<<WORDSHIFT));/* ???? */
00680 #ifdef SWEEP_DEBUG
00681   printf( "sweep:%d:top=0x%lx, tail=0x%lx\n", count, p, tail );
00682 #endif
00683   while (p<tail) {
00684 #ifdef SWEEP_DEBUG
00685       printf( "sweep:%d,%d:p=0x%lx:NIL->cix=%d\n", count, count2++, p, NIL->cix );
00686 #endif
00687     if (marked(p)) {  /*don't reclaim*/
00688       markoff(p);
00689 #ifdef MARK_DEBUG
00690                      printf( "sweep:%d,%d: markoff 0x%lx\n", count, count2, p );
00691 #endif
00692 
00693  p=nextbuddy(p);}       /*don't collect*/
00694     else {
00695       if (p->h.nodispose==1) {
00696         /* fprintf(stderr,";; dispose %x\n", p); */
00697         if (dispose_count>=MAXDISPOSE) 
00698           fprintf(stderr, "no more space for disposal processing\n");
00699         else dispose[dispose_count++]=makepointer(p);
00700         p=nextbuddy(p); }
00701       else if (gcmerge>freeheap) { /* no merge */
00702         np=nextbuddy(p);
00703         reclaim(p);
00704         p=np;} 
00705       else {
00706         np=mergecell(p,cp->chunkbix);   /*update free buddy list*/
00707         reclaim(p);
00708         p=np;} } }
00709   }  
00710 
00711 call_disposers()
00712 { int i;
00713   context *ctx=current_ctx;
00714   pointer p,a,curclass;
00715   /*if (debug) fprintf(stderr, ";; disposal call=%d\n", dispose_count);*/
00716   for (i=0; i<dispose_count; i++) {
00717     p=dispose[i];
00718     p->nodispose=0;
00719     a=(pointer)findmethod(ctx,K_DISPOSE,classof(p), &curclass); 
00720     if (debug) fprintf(stderr, ";; (send %p :dispose)\n", p);
00721     if (a!=NIL) csend(ctx,p,K_DISPOSE,0);
00722     }}
00723 
00724 void sweepall()
00725 { 
00726   context *ctx;
00727   register struct chunk *chp;
00728   register int i, gcmerge;
00729   numunion nu;
00730 
00731   dispose_count=0;
00732   ctx=euscontexts[thr_self()];
00733   gcmerge=totalheap * min(1.0,fltval(speval(GCMARGIN)))
00734                     * max(0.1,fltval(speval(GCMERGE)));
00735 
00736   for (i=0; i<MAXBUDDY-1; i++) {
00737     buddy[i].bp=0;      /*purge buddies*/
00738     buddy[i].count=0;   /*clear free cell count*/
00739     }
00740   freeheap=0;
00741   for (chp=chunklist; chp!=0; chp=chp->nextchunk) sweep(chp,gcmerge);
00742   call_disposers();
00743 
00744   }
00745 
00746 #if THREADED
00747 suspend_all_threads()
00748 { register int i, self, stat;
00749   
00750   self=thr_self();
00751   for (i=0; i<MAXTHREAD; i++) 
00752     if (i!=self && euscontexts[i]) {
00753       stat=thr_suspend(i);
00754       if (stat) fprintf(stderr, "gc cannot suspend thread %d\n",i);  }
00755   }
00756 
00757 resume_all_threads()
00758 { register int i, self, stat;
00759   
00760   self=thr_self();
00761   for (i=0; i<MAXTHREAD; i++) 
00762     if (i!=self && euscontexts[i]) {
00763       stat=thr_continue(i);
00764       if (stat) fprintf(stderr, "gc cannot resume thread %d\n",i);  }
00765   }
00766 
00767 #endif
00768 
00769 #if vxworks
00770 void gc()
00771 { if (debug)  fprintf(stderr,"\n;; gc:");
00772   breakck;
00773   gccount++;
00774   markall();
00775   sweepall();
00776   if (debug) {
00777     fprintf(stderr," free/total=%d/%d stack=%d ",
00778                 freeheap,totalheap,markctx->vsp-markctx->stack);
00779     }
00780   breakck;  }
00781 #else 
00782 
00783 void gc()
00784 { struct tms tbuf1,tbuf2,tbuf3;
00785   int i, r;
00786   context *ctx=euscontexts[thr_self()];
00787 
00788   if (debug)  fprintf(stderr,"\n;; gc: thread=%d ",thr_self());
00789   breakck;
00790   gccount++;
00791   times(&tbuf1);
00792 
00793 #if THREADED
00794 /*  mutex_lock(&alloc_lock);  is not needed since gc is assumed to be called
00795     from alloc_small or alloc_big and they have already locked alloc_lock.*/
00796   r = mutex_trylock(&mark_lock);
00797   if ( r != 0 ) {
00798     if (debug) fprintf(stderr, ";; gc:mutex_lock %d ", r);
00799     return;
00800   }
00801   rw_wrlock(&gc_lock);
00802   suspend_all_threads();
00803 #endif
00804 
00805   markall();
00806 
00807   times(&tbuf2);
00808   marktime+=(tbuf2.tms_utime-tbuf1.tms_utime);
00809   sweepall();
00810   times(&tbuf3);
00811   sweeptime+=(tbuf3.tms_utime-tbuf2.tms_utime);
00812 
00813 #if THREADED
00814   resume_all_threads();
00815   rw_unlock(&gc_lock);
00816   mutex_unlock(&mark_lock);
00817 /*  mutex_unlock(&alloc_lock); */
00818 #endif
00819   if (debug) {
00820     fprintf(stderr," free/total=%ld/%ld stack=%d ",
00821             freeheap,totalheap,(int)(myctx->vsp - myctx->stack));
00822     fprintf(stderr," mark=%ld sweep=%ld\n", marktime,sweeptime);
00823   }
00824   if (speval(QGCHOOK)!=NIL) {
00825     pointer gchook=speval(QGCHOOK);
00826     vpush(makeint(freeheap)); vpush(makeint(totalheap));
00827     ufuncall(ctx,gchook,gchook,(pointer)(ctx->vsp-2),ctx->bindfp,2);
00828     ctx->vsp -= 2;
00829     }
00830   breakck;
00831 }
00832 #endif
00833 
00834 #ifdef DEBUG
00835 dump_bcell( k, b )
00836 int k;
00837 struct buddyfree *b;
00838 {
00839     bpointer bp;
00840     int i;
00841 
00842     printf( "buddy[%d] = { %d, (", k, b[k].count );
00843     bp = b[k].bp;
00844     for( i = 0; i < b[k].count; i++ ) {
00845         printf( "0x%lx ->", bp );
00846         bp = bp->b.nextbcell;
00847     }
00848     printf( ")}\n" );
00849 }
00850 #endif
00851 
00852 #ifdef STACK_DEBUG
00853 pointer p_print( v, ctx )
00854 pointer v;
00855 context *ctx;
00856 {
00857     printf( "vpush:0x%lx->[0x%lx]\n", v, ctx->vsp );
00858 
00859     return v;
00860 }
00861 #endif


euslisp
Author(s): Toshihiro Matsui
autogenerated on Thu Mar 9 2017 04:57:50