home *** CD-ROM | disk | FTP | other *** search
/ APDL Public Domain 1 / APDL_PD1A.iso / program / language / gofer / Sources / c / markscan < prev    next >
Encoding:
Text File  |  1993-02-12  |  5.5 KB  |  190 lines
  1. /* --------------------------------------------------------------------------
  2.  * markscan.c:  Copyright (c) Mark P Jones 1991-1993.   All rights reserved.
  3.  *              See goferite.h for details and conditions of use etc...
  4.  *              Gofer version 2.28 January 1993
  5.  *
  6.  * Mark scan garbage collector, optionally used for gofc runtime system.
  7.  * ------------------------------------------------------------------------*/
  8.  
  9. /* --------------------------------------------------------------------------
  10.  * Simple mark scan garbage collector based on the allocator and garbage
  11.  * collector used in the full interpreter.  An important difference between
  12.  * the two systems is that the Gofer compiler (i.e. this program) does not
  13.  * use conservative garbage collection (there is no need to scan the C runtime
  14.  * stack).  Obviously, this is a BIG improvement in terms of portability!
  15.  * Another advantage is that the garbage collector given here can be
  16.  * upgraded to use a more sophisticated algorithm (for example, some form
  17.  * of compacting collector, possibly stop/copy), thus avoiding the need
  18.  * for a free list and permitting extensions requiring variable length
  19.  * cells (arrays perhaps?).  The basic reason for this flexibility is the
  20.  * fact that any cell may now be relocated during garbage collection.
  21.  * ------------------------------------------------------------------------*/
  22.  
  23. static Void   heapInit        Args((Void));
  24. static Void   markPhase        Args((Void));
  25. static Void   scanPhase        Args((Void));
  26. static Cell   markCell        Args((Cell));
  27. static Void   markSnd        Args((Cell));
  28.  
  29. Int     heapSize = DEFAULTHEAP;        /* number of cells in heap       */
  30. #ifndef GLOBALcar
  31. Heap    heapTopCar;            /* tops of heap arrays           */
  32. #endif
  33. #ifndef GLOBALcdr
  34. Heap    heapTopCdr;
  35. #endif
  36. static  Heap heapCar, heapCdr;        /* bases of each heap array       */
  37. static  Cell freeList;            /* free list of unused cells       */
  38. static  Int *marks;            /* `Mark set' used during GC to       */
  39. static  Int marksSize;            /* flag visited (active) cells       */
  40. #define mark(c)  c=markCell(c)        /* mark graph and save new pointer */
  41.  
  42. static Void heapInit() {        /* initialise heap storage       */
  43.     Int i;
  44.  
  45.     heapCar = (Heap)(farCalloc(heapSize,sizeof(Cell)));
  46.     heapCdr = (Heap)(farCalloc(heapSize,sizeof(Cell)));
  47.     if (heapCar==(Heap)0 || heapCdr==(Heap)0)
  48.     abandon("Cannot allocate heap storage");
  49.     heapTopCar = heapCar + heapSize;
  50.     heapTopCdr = heapCdr + heapSize;
  51.     for (i=1; i<heapSize; ++i)
  52.     snd(-i-1) = -i;
  53.     snd(-1)   = mkCfun(0);
  54.     freeList  = -heapSize;
  55.     marksSize = bitArraySize(heapSize);
  56.     if ((marks=(Int *)calloc(marksSize, sizeof(Int)))==0)
  57.     abandon("Cannot allocate gc markspace");
  58. }
  59.  
  60. Cell pair(l,r)                /* Allocate pair (l, r) from       */
  61. Cell l, r; {                /* heap, garbage collecting first  */
  62.     Cell c = freeList;            /* if necessary ...           */
  63.  
  64.     if (!isPair(c)) {
  65.     markPhase();
  66.     mark(l);
  67.     mark(r);
  68.     scanPhase();
  69.     c = freeList;
  70.     }
  71.     freeList = snd(freeList);
  72.     fst(c)   = l;
  73.     snd(c)   = r;
  74.     return c;
  75. }
  76.  
  77. Void garbageCollect() {            /* garbage collector           */
  78.     markPhase();
  79.     scanPhase();
  80. }
  81.  
  82. static Void markPhase() {        /* mark phase of garbage collector */
  83.     StackPtr sp1;
  84.     Int         i;
  85.  
  86.     for (i=0; i<marksSize; ++i)        /* initialise mark set to empty    */
  87.     marks[i] = 0;
  88.     stackLoop(sp1)            /* mark nodes on stack           */
  89.     mark(*sp1);
  90.     for (i=0; i<num_scs; i++)        /* mark supercombinator nodes       */
  91.     mark(sc[i]);
  92.     for (i=0; i<num_dicts; i++)        /* mark dictionary entries       */
  93.     mark(dict[i]);
  94.     for (i=0; i<NUM_CHARS; ++i)        /* mark character conses       */
  95.     mark(consCharArray[i]);
  96.     mark(resps);            /* mark responses           */
  97.     primMark();                /* mark primitives           */
  98. }
  99.  
  100. static Void scanPhase() {        /* scan phase of garbage collector */
  101.     register Int mask  = 1;        /* scan heap and add unused cells  */
  102.     register Int place = 0;        /* to the freeList           */
  103.     Int      recovered = 0;
  104.     Int         i,j=0;
  105.  
  106.     for (i=1; i<=heapSize; i++) {
  107.     if ((marks[place] & mask) == 0) {
  108.         if (fst(-i)==FILECELL) {
  109.         closeFile(snd(-i));
  110.         fst(-i) = INTCELL;    /* turn file to something harmless */
  111.         }
  112.         snd(-i)  = freeList;
  113.         freeList = -i;
  114.         recovered++;
  115.     }
  116.     mask <<= 1;
  117.     if (++j == bitsPerWord) {
  118.         place++;
  119.         mask = 1;
  120.         j    = 0;
  121.     }
  122.     }
  123.  
  124.     /* can only return if freeList is nonempty on return. */
  125.     if (recovered<minRecovery || !isPair(freeList))
  126.     abandon("Garbage collection fails to reclaim sufficient space");
  127. }
  128.  
  129. static Cell markCell(c)            /* Traverse part of graph marking  */
  130. Cell c; {                /* cells reachable from given root */
  131.  
  132. mc: if (!isPair(c))
  133.     return c;
  134.  
  135.     if (fst(c)==INDIRECT) {
  136.     c = snd(c);
  137.     goto mc;
  138.     }
  139.  
  140.     {   register place = placeInSet(c);
  141.     register mask  = maskInSet(c);
  142.     if (marks[place]&mask)
  143.         return c;
  144.     else
  145.         marks[place] |= mask;
  146.     }
  147.  
  148.     if (isPair(fst(c))) {
  149.     fst(c) = markCell(fst(c));
  150.     markSnd(c);
  151.     }
  152.     else if (fst(c) > MAXBOXTAG)
  153.     markSnd(c);
  154.  
  155.     return c;
  156. }
  157.  
  158. static Void markSnd(c)            /* Variant of markCell used to     */
  159. Cell c; {                /* update snd component of cell    */
  160.     Cell t;                /* using tail recursion           */
  161.  
  162. ma: t = snd(c);
  163. mb: if (!isPair(t))
  164.     return;
  165.  
  166.     if (fst(t)==INDIRECT) {
  167.     snd(c) = t = snd(t);
  168.     goto mb;
  169.     }
  170.     c = snd(c) = t;
  171.  
  172.     {   register place = placeInSet(c);
  173.     register mask  = maskInSet(c);
  174.     if (marks[place]&mask)
  175.         return;
  176.     else
  177.         marks[place] |= mask;
  178.     }
  179.  
  180.     if (isPair(fst(c))) {
  181.     fst(c) = markCell(fst(c));
  182.     goto ma;
  183.     }
  184.     else if (fst(c) > MAXBOXTAG)
  185.     goto ma;
  186.     return;
  187. }
  188.  
  189. /*-------------------------------------------------------------------------*/
  190.