home *** CD-ROM | disk | FTP | other *** search
/ Amiga ACS 1998 #4 / amigaacscoverdisc1998-041998.iso / utilities / shareware / dev / ucb_logoppc / source / mem.c < prev    next >
Encoding:
C/C++ Source or Header  |  1997-06-25  |  17.1 KB  |  767 lines
  1. /*
  2.  *      mem.c           logo memory management module           dvb 6/28/88
  3.  *
  4.  *    Copyright (C) 1993 by the Regents of the University of California
  5.  *
  6.  *      This program is free software; you can redistribute it and/or modify
  7.  *      it under the terms of the GNU General Public License as published by
  8.  *      the Free Software Foundation; either version 2 of the License, or
  9.  *      (at your option) any later version.
  10.  *  
  11.  *      This program is distributed in the hope that it will be useful,
  12.  *      but WITHOUT ANY WARRANTY; without even the implied warranty of
  13.  *      MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14.  *      GNU General Public License for more details.
  15.  *  
  16.  *      You should have received a copy of the GNU General Public License
  17.  *      along with this program; if not, write to the Free Software
  18.  *      Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  19.  */
  20.  
  21. #include "logo.h"
  22. #include "globals.h"
  23.  
  24. /* #ifdef ibm */
  25. /* #ifndef __ZTC__ */
  26. /* #include <alloc.h> */
  27. /* #endif */
  28. /* #endif */
  29.  
  30. #ifdef PUNY
  31. #define GCMAX 1000
  32. #else
  33. #ifdef THINK_C
  34. #define GCMAX 8000
  35. #else
  36. #ifdef __ZTC__
  37. #define GCMAX 5800
  38. #else
  39. #define GCMAX 16000
  40.  
  41. #endif
  42. #endif
  43. #endif
  44.  
  45. #ifdef THINK_C
  46. extern NODE *gcstack[];
  47. #else
  48. NODE *gcstack[GCMAX];
  49. #endif
  50.  
  51. NODE **mark_gcstack = gcstack;
  52. NODE **gctop = gcstack;
  53. NODE **gcbottom = gcstack;
  54.  
  55. long int mem_nodes = 0, mem_max = 0;    /* for Logo NODES primitive */
  56.  
  57. /* GC heuristic parameters. These parameters can be modified to fine tune
  58.    the performance of the GC program. The values below are a good set of
  59.    default parameters that should work well for most data */
  60.  
  61. /* Number of times to collect at the current GC state before going to
  62.    the next state. Basically the number of times a given generation is
  63.    collected its members are moved to an older generation */
  64. #define gc_age_threshold 4
  65.  
  66. /* A new segment of nodes is added if fewer than freed_threshold nodes are
  67.    freed in one GC run */
  68. #define freed_threshold ((long int)(SEG_SIZE * 0.4))
  69.  
  70. NODE *free_list = NIL;                /* global ptr to free node list */
  71. struct segment *segment_list = NULL;  /* global ptr to segment list */
  72.  
  73. long int mem_allocated = 0, mem_freed = 0;
  74.  
  75. #define NUM_GENS 4
  76.  
  77. /* ptr to list of Nodes in the same generation */
  78. NODE *generation[NUM_GENS] = {NIL};
  79.  
  80. /* ptr to list of nodes that point to younger nodes */
  81. NODE *oldyoungs = NIL;
  82.  
  83. long int current_gc = 0;
  84.  
  85. long int gc_stack_malloced = 0;
  86.  
  87. long int gc_stack_size = GCMAX;
  88.  
  89. long int gc_overflow_flag = 0;
  90.  
  91. NODE *reserve_tank = NIL;
  92.  
  93. BOOLEAN inside_gc = 0, int_during_gc = 0;
  94.  
  95. int next_gen_gc = 0, max_gen = 0;
  96.  
  97. int mark_gen_gc;
  98.  
  99. /* #define GC_DEBUG 1 */
  100.  
  101. #ifdef GC_DEBUG
  102. long int num_examined;
  103. #endif
  104.  
  105. BOOLEAN addseg(void) {
  106.     long int p;
  107.     struct segment *newseg;
  108.  
  109.     if ((newseg = (struct segment *)malloc(sizeof(struct segment)))
  110.             != NULL) {
  111.         newseg->next = segment_list;
  112.         segment_list = newseg;
  113.         for (p = 0; p < SEG_SIZE; p++) {
  114.             newseg->nodes[p].next = free_list;
  115.             free_list = &newseg->nodes[p];
  116.         settype(&newseg->nodes[p], NTFREE);
  117.     }
  118.     return 1;
  119.     } else
  120.       return 0;
  121. }
  122.  
  123. #ifdef THINK_C
  124. #pragma options(!global_optimizer)
  125. #endif
  126. #ifdef WIN32
  127. #pragma optimize("",off)
  128. #endif
  129. /* Think C tries to load ptr_val->node_type early if optimized */
  130.  
  131. BOOLEAN valid_pointer (volatile NODE *ptr_val) {
  132.     struct segment* current_seg;
  133.     unsigned long int ptr = (unsigned long int)ptr_val;
  134.    
  135.     if (ptr_val == NIL) return 0;
  136.     for (current_seg = segment_list; current_seg != NULL;
  137.         current_seg = current_seg->next) {
  138.     if ((ptr >= (unsigned long int)¤t_seg->nodes[0]) &&
  139.         (ptr <= (unsigned long int)¤t_seg->nodes[SEG_SIZE-1]) &&
  140.         ((ptr - (unsigned long int)¤t_seg->nodes[0])%
  141.                      (sizeof(struct logo_node)) == 0))
  142.         return (ptr_val->node_type != NTFREE);
  143.     }
  144.     return 0;
  145. }
  146.  
  147. #ifdef THINK_C
  148. #pragma options(global_optimizer)
  149. #endif
  150. #ifdef WIN32
  151. #pragma optimize("",on)
  152. #endif
  153.  
  154. NODETYPES nodetype(NODE *nd) {
  155.     if (nd == NIL) return (PNIL);
  156.     return(nd->node_type);
  157. }
  158.  
  159. void check_oldyoung(NODE *old, NODE *new) {
  160.     if (valid_pointer(new) && (new->my_gen < old->my_gen) &&
  161.                   old->oldyoung_next == NIL) {
  162.     old->oldyoung_next = oldyoungs;
  163.     oldyoungs = old;
  164.     }
  165. }
  166.  
  167. void check_valid_oldyoung(NODE *old, NODE *new) {
  168.     if (new == NIL) return;
  169.     if ((new->my_gen < old->my_gen) && old->oldyoung_next == NIL) {
  170.     old->oldyoung_next = oldyoungs;
  171.     oldyoungs = old;
  172.     }
  173. }
  174.  
  175. /* setcar/cdr/object should be called only when the new pointee is really
  176.  * a node.  Otherwise just directly assign to the field (e.g. for CONTs). */
  177.  
  178. void setobject(NODE *nd, NODE *newobj) {
  179.     nd->n_obj = newobj;
  180.     check_valid_oldyoung(nd, newobj);
  181. }
  182.  
  183. void setcar(NODE *nd, NODE *newcar) {
  184.     nd->n_car = newcar;
  185.     check_valid_oldyoung(nd, newcar);
  186. }
  187.  
  188. void setcdr(NODE *nd, NODE *newcdr) {
  189.     nd->n_cdr = newcdr;
  190.     check_valid_oldyoung(nd, newcdr);
  191. }
  192.  
  193. #ifdef THINK_C
  194. #pragma options(honor_register)
  195. #endif
  196. #ifdef WIN32
  197. #pragma optimize("",off)
  198. #endif
  199.  
  200. void do_gc(BOOLEAN full) {
  201.     register NODE *pa, *pb, *pc, *pd, *pe;    /* get registers onto stack */
  202.     register int aa, bb, cc, dd, ee;
  203.     
  204.     int_during_gc = 0;
  205.     inside_gc++;
  206.     gc(full);
  207.     inside_gc = 0;
  208.     if (int_during_gc != 0) {
  209.     if (int_during_gc < 0) 
  210. #if defined(__ZTC__) || defined(WIN32)
  211.         logo_pause(0);
  212. #else
  213.         logo_pause();
  214. #endif
  215.     else 
  216. #if defined(__ZTC__) || defined(WIN32)
  217.         logo_stop(0);
  218. #else
  219.         logo_stop();
  220. #endif
  221.     }
  222. }
  223.  
  224. NODE *newnode(NODETYPES type) {
  225.     register NODE *newnd;
  226.     static NODE phony;
  227.  
  228.     while ((newnd = free_list) == NIL && NOT_THROWING) {
  229.     do_gc(FALSE);
  230.     }
  231.     if (newnd != NIL) {
  232.     free_list = newnd->next;
  233.     settype(newnd, type);
  234.     newnd->n_car = NIL;
  235.     newnd->n_cdr = NIL;
  236.     newnd->n_obj = NIL;
  237.     newnd->my_gen = 0;
  238.     newnd->gen_age = gc_age_threshold;
  239.     newnd->mark_gc = 0;
  240.     newnd->next = generation[0];
  241.     generation[0] = newnd;
  242.     newnd->oldyoung_next = NIL;
  243.     mem_nodes++;
  244.     if (mem_nodes > mem_max) mem_max = mem_nodes;
  245.     return(newnd);
  246.     } else return &phony;
  247. }
  248.  
  249. #ifdef THINK_C
  250. #pragma options(!honor_register)
  251. #endif
  252. #ifdef WIN32
  253. #pragma optimize("",on)
  254. #endif
  255.  
  256. NODE *cons(NODE *x, NODE *y) {
  257.     NODE *val = newnode(CONS);
  258.  
  259.     /* New node can't possibly point to younger one, so no need to check */
  260.     val->n_car = x;
  261.     val->n_cdr = y;
  262.     return(val);
  263. }
  264.  
  265. #define mmark(child) {if ((child)->my_gen < nd->my_gen) \
  266.              {mark(child); got_young++;}}
  267.  
  268. NODE **inter_gen_mark (NODE **prev) {
  269. /* Mark/traverse pointers to younger generations only */
  270.     NODE* nd = *prev;
  271.     NODE** array_ptr;
  272.     NODE* tmp_node;
  273.     int loop;
  274.     int got_young = 0;
  275.  
  276.     if (nd->my_gen <= mark_gen_gc) return &(nd->oldyoung_next);
  277.     switch (nodetype(nd)) {
  278.     case CONS:
  279.     case CASEOBJ:
  280.     case RUN_PARSE:
  281.     case QUOTE:
  282.     case COLON:
  283.     case TREE:
  284.     case LINE:
  285.         if (valid_pointer(nd->n_car))
  286.         mmark(nd->n_car);
  287.         if (valid_pointer(nd->n_obj))
  288.         mmark(nd->n_obj);
  289.     case CONT:
  290.         if (valid_pointer(nd->n_cdr))
  291.         mmark(nd->n_cdr);
  292.         break;
  293.     case ARRAY:
  294.         array_ptr = getarrptr(nd);
  295.         loop = getarrdim(nd);
  296.         while (--loop >= 0) {
  297.         tmp_node = *array_ptr++;
  298.         if (valid_pointer(tmp_node))
  299.             mmark(tmp_node);
  300.         }
  301.         break;
  302.     }
  303.     if (!got_young) {    /* nd no longer points to younger */
  304.     *prev = nd->oldyoung_next;
  305.        nd->oldyoung_next = NIL;
  306.        return prev;
  307.     }
  308.     return &(nd->oldyoung_next);
  309. }
  310.  
  311. void gc_inc () {
  312.     NODE **new_gcstack;
  313.     long int loop;
  314.  
  315.     if (gc_overflow_flag == 1) return;
  316.  
  317.     if (gctop == &mark_gcstack[gc_stack_size-1])
  318.     gctop = mark_gcstack;
  319.     else
  320.     gctop++;
  321.     if (gctop == gcbottom) { /* gc STACK overflow */
  322. #ifdef GC_DEBUG
  323.     printf("\nAllocating new GC stack\n");
  324. #endif
  325.     if ((new_gcstack = (NODE**) malloc ((size_t) sizeof(NODE *) *
  326.                 (gc_stack_size + GCMAX))) == NULL) {
  327.  
  328.         /* no room to increse GC Stack */
  329.         printf ("\nWarning: Not enough memory to run garbage collector.\n");
  330.         printf ("GC disabled - Save important data and exit!\n");
  331.  
  332.         gc_overflow_flag = 1;
  333.     } else {
  334.         /* transfer old stack to new stack */
  335.         new_gcstack[0] = *gcbottom;
  336.         if (gcbottom == &mark_gcstack[gc_stack_size-1])
  337.         gcbottom = mark_gcstack;
  338.         else
  339.         gcbottom++;
  340.  
  341.         for (loop = 1 ; gcbottom != gctop ; loop++) {
  342.         new_gcstack[loop] = *gcbottom;
  343.         if (gcbottom == &mark_gcstack[gc_stack_size-1])
  344.             gcbottom = mark_gcstack;
  345.         else
  346.             gcbottom++;
  347.         }
  348.         gc_stack_size = gc_stack_size + GCMAX;
  349.         if (gc_stack_malloced == 1) free(mark_gcstack);
  350.         gc_stack_malloced = 1;
  351.  
  352.         mark_gcstack = new_gcstack;
  353.         gctop = &mark_gcstack[loop];
  354.         gcbottom = mark_gcstack;
  355.     }
  356.     }
  357. }
  358.  
  359. /* Iterative mark procedure */
  360. void mark(NODE* nd) {
  361.     int loop;
  362.     NODE** array_ptr;
  363.  
  364.     if (gc_overflow_flag == 1) return;
  365.     if (!valid_pointer(nd)) return; /* NIL pointer */
  366.     if (nd->my_gen > mark_gen_gc) return; /* I'm too old */
  367.     if (nd->mark_gc == current_gc) return; /* I'm already marked */
  368.  
  369.     *gctop = nd;
  370.     gc_inc();
  371.  
  372.     while (gcbottom != gctop) {
  373.     nd = *gcbottom;
  374.     if ((valid_pointer(nd)) && (nd->my_gen <= mark_gen_gc) &&
  375.         (nd->mark_gc != current_gc)) {
  376.         if (nd->mark_gc == -1) {
  377.         nd->mark_gc = 0;    /* this is a caseobj during gctwa */
  378.         goto no_mark;        /* so don't really mark yet */
  379.         }
  380.         nd->mark_gc = current_gc;
  381. #ifdef GC_DEBUG
  382.         num_examined++;
  383. #endif
  384.         switch (nodetype(nd)) {
  385.         case CONS:
  386.         case CASEOBJ:
  387.         case RUN_PARSE:
  388.         case QUOTE:
  389.         case COLON:
  390.         case TREE:
  391.         case LINE:
  392.             *gctop = nd->n_car;
  393.             gc_inc();
  394.             *gctop = nd->n_obj;
  395.             gc_inc();
  396.         case CONT:
  397.             *gctop = nd->n_cdr;
  398.             gc_inc();
  399.             break;
  400.         case ARRAY:
  401.             array_ptr = getarrptr(nd);
  402.             loop = getarrdim(nd);
  403.             while (--loop >= 0) {
  404.             *gctop = *array_ptr++;
  405.             gc_inc();
  406.             }
  407.         break;
  408.         }
  409.     }
  410. no_mark:
  411.     if (gcbottom == &mark_gcstack[gc_stack_size-1])
  412.         gcbottom = mark_gcstack;
  413.     else
  414.         gcbottom++;
  415.     }
  416. }
  417.  
  418. void gc(BOOLEAN no_error) {
  419.     NODE *top;
  420.     NODE **top_stack;
  421.     NODE *nd, *tmpnd;
  422.     long int num_freed = 0;
  423.     NODE **tmp_ptr, **prev;
  424.     long int freed_sofar = 0;
  425.     NODE** array_ptr;
  426.     NODE* tmp_node;
  427.     NODE *obj, *caselist;
  428.     int anygood;
  429.     int i;
  430.     short int loop;
  431.     int gen_gc; /* deepest generation to garbage collect */
  432.     int gctwa;    /* garbage collect truly worthless atoms */
  433.  
  434.     if (gc_overflow_flag == 1) {
  435.     if (!addseg()) {
  436.         err_logo(OUT_OF_MEM, NIL);
  437.         if (free_list == NIL)
  438.         err_logo(OUT_OF_MEM_UNREC, NIL);
  439.     }
  440.     return;
  441.     }
  442.  
  443.     check_throwing;
  444.  
  445.     top_stack = ⊤
  446.  
  447.     mark_gen_gc = gen_gc = (no_error ? max_gen : next_gen_gc);
  448.  
  449.     gctwa = (gen_gc == max_gen && max_gen > 1) || no_error;
  450.  
  451.     if (gctwa) {
  452.     /* Every caseobj must be marked twice to count */
  453.     for (loop = 0; loop < HASH_LEN ; loop++) {
  454.         for (nd = hash_table[loop]; nd != NIL; nd = cdr(nd)) {
  455.         tmpnd = caselist__object(car(nd));
  456.         while (tmpnd != NIL) {
  457.             (car(tmpnd))->mark_gc = -1;
  458.             tmpnd = cdr(tmpnd);
  459.         }
  460.         }
  461.     }
  462.     }
  463.  
  464. re_mark:
  465.  
  466.     current_gc++;
  467.  
  468. #ifdef GC_DEBUG
  469.     printf("gen = %d\n", gen_gc);
  470.     num_examined = 0;
  471. #endif
  472.  
  473.     /* Begin Mark Phase */
  474.  
  475.     /* Check globals for NODE pointers */
  476.  
  477.     mark(current_line);
  478.  
  479.     mark(throw_node);
  480.     mark(err_mesg);
  481.  
  482.     mark(fun);
  483.     mark(ufun);
  484.     mark(last_ufun);
  485.     mark(this_line);
  486.     mark(last_line);
  487.     mark(var_stack);
  488.     mark(var);
  489.     mark(last_call);
  490.     mark(didnt_output_name);
  491.     mark(didnt_get_output);
  492.     mark(output_node);
  493.     mark(qm_list);
  494.  
  495.     mark(file_list);
  496.     mark(reader_name);
  497.     mark(writer_name);
  498.  
  499.     mark(the_generation);
  500.     mark(Not_Enough_Node);
  501.     mark(Unbound);
  502.  
  503.     mark(cnt_list);
  504.     mark(cnt_last);
  505.  
  506. #ifdef GC_DEBUG
  507.     printf("globals %ld + ", num_examined);
  508.     num_examined = 0;
  509. #endif
  510.  
  511.     for (loop = 0; loop < HASH_LEN ; loop++)
  512.     mark(hash_table[loop]);
  513.  
  514. #ifdef GC_DEBUG
  515.     printf("oblist %ld + ", num_examined);
  516.     num_examined = 0;
  517. #endif
  518.  
  519.     /* Check Stack for NODE pointers */
  520.  
  521.     if (top_stack < bottom_stack) { /* check direction stack grows */
  522.     for (tmp_ptr = top_stack; tmp_ptr <= bottom_stack; 
  523. #if defined(THINK_C) || defined(__ZTC__)
  524.          tmp_ptr = (NODE **)(((unsigned long int)tmp_ptr)+2)
  525. #else
  526.          tmp_ptr++
  527. #endif
  528.          ) {
  529.         if (valid_pointer(*tmp_ptr)) {
  530.             mark(*tmp_ptr);
  531.         }
  532.     }
  533.     } else {
  534.     for (tmp_ptr = top_stack; tmp_ptr >= bottom_stack; 
  535. #if defined(THINK_C) || defined(__ZTC__)
  536.          tmp_ptr = (NODE **)(((unsigned long int)tmp_ptr)-2)
  537. #else
  538.          tmp_ptr--
  539. #endif
  540.          ) {
  541.         if (valid_pointer(*tmp_ptr)) {
  542.             mark(*tmp_ptr);
  543.         }
  544.     }
  545.     }
  546.  
  547. #ifdef GC_DEBUG
  548.     printf("stack %ld + ", num_examined);
  549.     num_examined = 0;
  550. #endif
  551.  
  552.     /* check pointers from old generations to young */
  553.     for (prev = &oldyoungs; *prev != Unbound; prev = inter_gen_mark(prev)) ;
  554.  
  555. #ifdef GC_DEBUG
  556.     printf("inter_gen %ld marked\n", num_examined);
  557.     num_examined = 0;
  558. #endif
  559.  
  560.     if (gc_overflow_flag) return;
  561.  
  562.     if (gctwa) {
  563.  
  564. #ifdef GC_DEBUG
  565.     printf("GCTWA: ");
  566.     num_examined = 0;
  567. #endif
  568.     for (loop = 0; loop < HASH_LEN ; loop++) {
  569.         tmpnd = NIL;
  570.         for (nd = hash_table[loop]; nd != NIL; nd = cdr(nd)) {
  571.         obj = car(nd);
  572.         if (procnode__object(obj) == UNDEFINED &&
  573.             valnode__object(obj) == UNBOUND &&
  574.             plist__object(obj) == NIL &&
  575.             !flag__object(obj, PERMANENT)) {
  576. #ifdef GC_DEBUG
  577.                 num_examined++;
  578. #endif
  579.             anygood = 0;
  580.             for (caselist = caselist__object(obj);
  581.                     caselist != NIL; caselist = cdr(caselist)) {
  582.                 if ((car(caselist))->mark_gc == current_gc) {
  583.                 anygood = 1;
  584.                 break;
  585.                 }
  586.             }
  587.             if (anygood) {    /* someone points here, don't gctwa */
  588.                 tmpnd = nd;
  589.             } else {    /* do gctwa */
  590.                 if (tmpnd == NIL)
  591.                 hash_table[loop] = cdr(hash_table[loop]);
  592.                 else
  593.                 setcdr(tmpnd, cdr(nd));
  594.             }
  595.         } else            /* has a value, don't gctwa */
  596.             tmpnd = nd;
  597.         }
  598.     }
  599.  
  600. #ifdef GC_DEBUG
  601.     printf("%ld collected\n", num_examined);
  602.     num_examined = 0;
  603. #endif
  604.     gctwa = 0;
  605.     goto re_mark;
  606.     }
  607.  
  608.     /* Begin Sweep Phase */
  609.        
  610.     for (loop = gen_gc; loop >= 0; loop--) {
  611.     tmp_ptr = &generation[loop];
  612.     for (nd = generation[loop]; nd != NIL; nd = *tmp_ptr) {
  613.         if (nd->mark_gc == current_gc) {
  614.         if (--(nd->gen_age) == 0 && loop < NUM_GENS-1) {
  615.             /* promote to next gen */
  616.             *tmp_ptr = nd->next;
  617.             nd->next = generation[loop+1];
  618.             generation[loop+1] = nd;
  619.             nd->my_gen = loop+1;
  620.             if (max_gen == loop) max_gen++;
  621.             nd->gen_age = gc_age_threshold;
  622.             switch (nodetype(nd)) {
  623.             case CONS:
  624.             case CASEOBJ:
  625.             case RUN_PARSE:
  626.             case QUOTE:
  627.             case COLON:
  628.             case TREE:
  629.             case LINE:
  630.                 check_oldyoung(nd, nd->n_car);
  631.                 check_oldyoung(nd, nd->n_obj);
  632.             case CONT:
  633.                 check_oldyoung(nd, nd->n_cdr);
  634.                 break;
  635.             case ARRAY:
  636.                 array_ptr = getarrptr(nd);
  637.                 i = getarrdim(nd);
  638.                 while (--i >= 0) {
  639.                 tmp_node = *array_ptr++;
  640.                 check_oldyoung(nd, tmp_node);
  641.                 }
  642.                 break;
  643.             }
  644.                } else {
  645.             /* keep in this gen */
  646.             tmp_ptr = &(nd->next);
  647.              }
  648.         } else {
  649.         /* free */
  650.         num_freed++;
  651.         mem_nodes--;
  652.              *tmp_ptr = nd->next;
  653.              if (nd->oldyoung_next != NIL) {
  654.             for (prev = &oldyoungs; *prev != nd;
  655.                 prev = &((*prev)->oldyoung_next))
  656.                 ;
  657.             *prev = nd->oldyoung_next;
  658.             nd->oldyoung_next = NIL;
  659.         }
  660.          nd->next = free_list;
  661.          free_list = nd;
  662.             switch (nodetype(nd)) {
  663.             case ARRAY:
  664.             free((char *)getarrptr(nd));
  665.                      break;
  666.             case STRING:
  667.             case BACKSLASH_STRING:
  668.             case VBAR_STRING:
  669.             if (getstrhead(nd) != NULL &&
  670.                     decstrrefcnt(getstrhead(nd)) == 0)
  671.                 free(getstrhead(nd));
  672.                 break;
  673.                }
  674.              settype (nd, NTFREE);
  675.         }
  676.     }
  677. #ifdef GC_DEBUG
  678.     printf("%ld + ", num_freed - freed_sofar);
  679. #endif
  680.     freed_sofar = num_freed;
  681.     }
  682.  
  683. #ifdef GC_DEBUG
  684.     printf("= %ld freed\n", num_freed);
  685. #endif
  686.  
  687.     if (num_freed > freed_threshold)
  688.     next_gen_gc = 0;
  689.     else if (gen_gc < max_gen)
  690.     next_gen_gc = gen_gc+1;
  691.     else
  692.     next_gen_gc = 0;
  693.  
  694.     if (num_freed < freed_threshold) {
  695.     if (!addseg() && num_freed < 50 && gen_gc == max_gen && !no_error) {
  696.         err_logo(OUT_OF_MEM, NIL);
  697.         if (free_list == NIL)
  698.         err_logo(OUT_OF_MEM_UNREC, NIL);
  699.     }
  700. #ifdef __ZTC__
  701.     (void)addseg();
  702. #endif
  703.     }
  704.  
  705. #ifdef GC_DEBUG
  706. /*    getchar(); */
  707. #endif
  708. }
  709.  
  710. #ifdef GC_DEBUG
  711. void prname(NODE *foo) {
  712.     ndprintf(stdout, "%s ", car(foo));
  713. }
  714. #endif
  715.  
  716. NODE *lgc(NODE *args) {
  717.     do_gc(args != NIL);
  718.     return UNBOUND;
  719. }
  720.  
  721. NODE *lnodes(NODE *args) {
  722.     long int temp_max, temp_nodes;
  723.  
  724. #ifdef GC_DEBUG
  725. /*    map_oblist(&prname); */
  726. #endif
  727.     do_gc(TRUE);    /* get real in-use figures */
  728.     temp_max = mem_max;
  729.     temp_nodes = mem_nodes;
  730.     mem_max = mem_nodes;
  731.     return cons(make_intnode(temp_nodes),
  732.         cons(make_intnode(temp_max), NIL));
  733. }
  734.  
  735. void fill_reserve_tank(void) {
  736.     NODE *newnd, *p = NIL;
  737.     int i = 50;
  738.  
  739.     while (--i >= 0) {    /* make pairs not in any generation */
  740.     if ((newnd = free_list) == NIL) break;
  741.     free_list = newnd->next;
  742.     settype(newnd, CONS);
  743.     newnd->n_car = NIL;
  744.     newnd->n_cdr = p;
  745.     newnd->n_obj = NIL;
  746.     newnd->next = NIL;
  747.     newnd->oldyoung_next = NIL;
  748.     p = newnd;
  749.     }
  750.     reserve_tank = p;
  751. }
  752.  
  753. void use_reserve_tank(void) {
  754.     NODE *nd = reserve_tank;
  755.     
  756.     reserve_tank = NIL;
  757.     for ( ; nd != NIL; nd = cdr(nd) ) {
  758.         settype(nd, NTFREE);
  759.         nd->next = free_list;
  760.         free_list = nd;
  761.     }
  762. }
  763.  
  764. void check_reserve_tank(void) {
  765.     if (reserve_tank == NIL) fill_reserve_tank();
  766. }
  767.