home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / lifeos2.zip / LIFE-1.02 / SOURCE / MEMORY.C < prev    next >
C/C++ Source or Header  |  1996-06-16  |  41KB  |  1,691 lines
  1. /* Copyright 1991 Digital Equipment Corporation.
  2. ** All Rights Reserved.
  3. *****************************************************************/
  4. /*     $Id: memory.c,v 1.10 1995/07/27 19:03:24 duchier Exp $     */
  5.  
  6. #ifndef lint
  7. static char vcid[] = "$Id: memory.c,v 1.10 1995/07/27 19:03:24 duchier Exp $";
  8. #endif /* lint */
  9.  
  10. /* need stdlib.h to declare atof */
  11. #include <stdlib.h>
  12. #include "extern.h"
  13. #include "print.h"
  14. #include "login.h"
  15. #include "lefun.h"
  16. #include "token.h"
  17. #include "error.h"
  18. #include "xpred.h"
  19. #include "modules.h" /*  RM: Jan 13 1993  */
  20. /* #include <malloc.h> 11.9 */
  21.  
  22. /* external variables */
  23.  
  24. GENERIC mem_base;
  25. GENERIC mem_limit;
  26. GENERIC stack_pointer;
  27. GENERIC heap_pointer;
  28. GENERIC other_base;
  29.  
  30. GENERIC other_limit;
  31. GENERIC other_pointer;
  32.  
  33. static long delta;
  34.  
  35. #ifdef prlDEBUG
  36. static long amount_used;
  37. #endif
  38.  
  39. #ifdef CLIFE
  40. long pass;
  41. #else 
  42. static long pass;
  43. #endif /* CLIFE */
  44.  
  45. #define LONELY 1
  46.  
  47. #ifndef OS2_PORT
  48. static struct tms last_garbage_time;
  49. #else
  50. static float last_garbage_time;
  51. #endif
  52. static float gc_time, life_time;
  53.  
  54.  
  55. int mem_size;
  56. int alloc_words;
  57.  
  58. #define ALIGNUP(X) { (X) = (GENERIC)( ((long) (X) + (ALIGN-1)) & ~(ALIGN-1) ); }
  59.  
  60.  
  61.  
  62. /************* STUFF FOR PARSING COMMAND LINE ARGS ************************/
  63.  
  64. char *GetStrOption(name,def)
  65. char *name;
  66. char *def;
  67. {
  68.   int i;
  69.   char *result=def;
  70.   int l=strlen(name);
  71.   
  72.   for(i=1;i<arg_c;i++)
  73.     if(arg_v[i][0]=='-' && (int)strlen(arg_v[i])>=l+1)
  74.       if(!strncmp(arg_v[i]+1,name,l))
  75.     if(arg_v[i][l+1]=='=')
  76.       result=arg_v[i]+l+2;
  77.     else
  78.       result=arg_v[i]+l+1;  
  79.   
  80.   return result;
  81. }
  82.  
  83.  
  84.  
  85. int GetBoolOption(name)
  86. char *name;
  87. {
  88.   char *s;
  89.   s=GetStrOption(name,"off");
  90.   return strcmp(s,"off");
  91. }
  92.  
  93.  
  94.  
  95. int GetIntOption(name,def)
  96. char *name;
  97. int def;
  98. {
  99.   char *s;
  100.   char buffer[40];
  101.   sprintf(buffer,"%d",def);
  102.   s=GetStrOption(name,buffer);
  103.   return atof(s);
  104. }
  105.  
  106. /****************************************************************************/
  107.  
  108.  
  109.  
  110.  
  111.  
  112. void pchoices() /*  RM: Oct 28 1993  For debugging. */
  113. {
  114.   ptr_choice_point c;
  115.   printf("stack pointer is: %x\n",stack_pointer);
  116.   for(c=choice_stack;c;c=c->next)
  117.     printf("\tc=%x\ts=%x\tg=%x\tu=%x\n",c,c->stack_top,c->goal_stack,c->undo_point);
  118. }
  119.  
  120.  
  121.  
  122.  
  123. /****************************************************************************/
  124.  
  125. /* GC sanity checks */
  126.  
  127. /* Keep for release versions, unless the garbage collector is very robust */
  128. /* #define GCTEST */
  129.  
  130. /* Remove for release versions */
  131. /* #define GCVERBOSE */
  132.  
  133. #ifndef GCTEST
  134. #undef assert
  135. #define assert(N)
  136. #endif
  137.  
  138. void print_undo_stack()
  139. {
  140.   ptr_stack u=undo_stack;
  141.  
  142.   while (u) {
  143.     if (u->a<mem_base || u->a>mem_limit ||
  144.         (GENERIC)u->next<mem_base || (GENERIC)u->next>mem_limit) {
  145.       printf("UNDO: type:%ld a:%lx b:%lx next:%lx\n",u->type,u->a,u->b,u->next);
  146.       fflush(stdout);
  147.     }
  148.     u=u->next;
  149.   }
  150. }
  151.  
  152. long bounds_undo_stack()
  153. /* Address field in undo_stack is within range */
  154. /* The only valid address outside this range is that of xevent_state */
  155. {
  156.   ptr_stack u=undo_stack;
  157.  
  158.   while (u) {
  159.     if (  (GENERIC)u<mem_base
  160.        || (GENERIC)u>mem_limit
  161.        || (!VALID_ADDRESS(u->a) && !(u->type & undo_action))
  162.        ) {
  163.       if ((GENERIC)u<mem_base || (GENERIC)u>mem_limit) {
  164.         printf("\nUNDO: u=%lx\n",(long)u);
  165.       }
  166.       else {
  167.         printf("\nUNDO: u:%lx type:%ld a:%lx b:%lx next:%lx\n",
  168.                (long)u,u->type,u->a,u->b,u->next);
  169.       }
  170.       fflush(stdout);
  171.       return FALSE;
  172.     }
  173.     u=u->next;
  174.   }
  175.  
  176.   return TRUE;
  177. }
  178.  
  179.  
  180. /****************************************************************************/
  181.  
  182. /* Forward declarations */
  183. static void check_psi_list();
  184. static void check_resid_list(); /* 21.9 */
  185. static void check_choice();
  186. static void check_undo_stack();
  187.  
  188.  
  189.  
  190.  
  191. /******** FAIL_ALL()
  192.   This routines provokes a total failure, in case of a bad error
  193.   (out of memory, abort, etc...).
  194.   All goals are abandoned.
  195. */
  196. void fail_all()
  197. {
  198.   output_stream=stdout;        
  199.   choice_stack=NULL;
  200.   goal_stack=NULL;
  201.   undo_stack=NULL;
  202.   abort_life(TRUE);
  203.   /* printf("\n*** Abort\n"); */
  204.   stdin_cleareof();
  205.   open_input_file("stdin");
  206. }
  207.  
  208.  
  209.  
  210.  
  211. /******************************************************************************
  212.  
  213.   GARBAGE COLLECTING.
  214.  
  215. */
  216.  
  217.  
  218.  
  219. void check_attr();
  220. void check_psi_term();
  221. void check_definition();
  222. void check_resid_block();
  223.  
  224.  
  225. /*  RM: Jan 29 1993  Replaced with PVR's version of 26.1 */
  226.  
  227. /******** COMPRESS()
  228.   This routine compresses the memory contents and
  229.   calculates the new addresses. First the Stack is compressed, bottom up.
  230.   Secondly the Heap is compressed, top down.
  231. */
  232. static void compress()
  233. {
  234.     GENERIC addr, new_addr;
  235.     long len, i;
  236.   
  237.     /* Compressing the stack: */
  238.   
  239.     addr=new_addr=mem_base;
  240.     while (addr<=stack_pointer) {
  241.       len = *(addr+delta);
  242.       if (len) {
  243.         /* There are lots of these: */
  244.         /* if (len==LONELY) printf("Isolated LONELY at %lx\n",addr); */
  245.         if (len==LONELY) len=ALIGN;
  246.         else if (len & (ALIGN-1)) len=len-(len & (ALIGN-1))+ALIGN;
  247.         /* if (len & (ALIGN-1)) len=len-(len & (ALIGN-1))+ALIGN; 12.6 */
  248.         assert((len & (ALIGN-1))==0);
  249.         len /= sizeof(*addr);
  250.         assert(len>0);
  251.   
  252.         for (i=0; i<len; i++) {
  253.       *new_addr = *addr;
  254.           if (i>0) {
  255.             if (*(addr+delta)>=len)
  256.               assert(i>0 ? *(addr+delta)<len : TRUE);
  257.           }
  258.           assert(VALID_ADDRESS(new_addr));
  259.       *(addr+delta) = (long)new_addr + 1; /* Set low bit */
  260. #ifdef prlDEBUG
  261.       if (*(addr+delta) & 1 == 0)
  262.         printf ("compress: could be a bug ...\n");
  263. #endif
  264.             addr++;
  265.       new_addr++;
  266.         }
  267.       }
  268.       else
  269.         addr++;
  270.     }
  271.     other_pointer=stack_pointer; /* 10.6 this var. is unused */
  272.     stack_pointer=new_addr;
  273.   
  274.     /* Compressing the heap: */
  275.   
  276.     addr=new_addr=mem_limit;
  277.     addr--;  /* PVR fix: adding this statement avoids accessing beyond */
  278.          /* the memory's edge, which causes a segmentation fault on*/
  279.          /* SPARC. */
  280.     while (addr>=heap_pointer) {
  281.     skip_addr:
  282.       len= *(addr+delta);
  283.       if (len) {
  284.         if (len!=LONELY) {
  285.  
  286.           if (len & (ALIGN-1)) len=len-(len & (ALIGN-1))+ALIGN;
  287.           assert((len & (ALIGN-1))==0);
  288.           len /= sizeof (*addr);
  289.           assert(len>0);
  290.  
  291.         } else { /* len==LONELY */
  292.           GENERIC a;
  293.  
  294.           if (len & (ALIGN-1)) len=len-(len & (ALIGN-1))+ALIGN;
  295.           assert((len & (ALIGN-1))==0);
  296.           len /= sizeof (*addr);
  297.           assert(len==1);
  298.  
  299.       /* Check if the LONELY field is actually part of a block. */
  300.       /* If so, skip to the beginning of the block. */
  301.           a=addr;
  302.       do {
  303.         a--;
  304.           } while (a>=heap_pointer &&
  305.            (*(a+delta)==0 || *(a+delta)==LONELY));
  306.       if (a>=heap_pointer && *(a+delta)/sizeof(*a)+a>addr) {
  307.         addr=a;
  308.         goto skip_addr;
  309.       }
  310.         }
  311.  
  312.         /* Move a block or an isolated LONELY field. */
  313.         addr += len;
  314.         for (i=0; i<len; i++) {
  315.       addr--;
  316.       new_addr--;
  317.       *new_addr = *addr;
  318.           assert(VALID_ADDRESS(new_addr));
  319.       *(addr+delta) = (long)new_addr + 1;
  320.         }
  321.       }
  322.       addr--;
  323.     }
  324.     heap_pointer=new_addr;
  325. }
  326.  
  327.  
  328.  
  329. #define UNCHECKED(P) (! *((GENERIC)(P)+delta))
  330.  
  331. /******** UNCHECKED(p,l)
  332.   P is a pointer to a structure L bytes in length.
  333.   If L=LONELY then that means that P is a pointer to a sub-field of a
  334.   structure.
  335.   The function returns TRUE if the structure has not been yet thoroughly
  336.   explored, otherwise FALSE.
  337.   If this is the second pass then it translates P to its new value
  338.   (as calculated by COMPRESS).
  339. */
  340.  
  341.  
  342.  
  343. #ifdef CLIFE
  344. long unchecked (p, len)
  345. #else
  346. static long unchecked (p, len)
  347. #endif /* CLIFE */
  348. GENERIC *p; 
  349. long len;
  350. {
  351.   GENERIC addr;
  352.   long result=FALSE, value;
  353.  
  354.   assert(len>0);
  355.   if ((unsigned long)*p>MAX_BUILT_INS) {
  356. #ifdef GCTEST
  357.     if (!VALID_ADDRESS(*p)) {
  358.       printf("p=%lx,*p=%lx\n",p,*p);
  359.     }
  360. #endif
  361.     assert(VALID_ADDRESS(*p));
  362.     addr = *p + delta;
  363.     value = *addr;
  364.     switch (pass) {
  365.     case 1:
  366. #ifdef GCTEST
  367.       if (FALSE /* len>100 || value>100 13.8 */) {
  368.         /* This does in fact happen */
  369.         printf("len=%ld,value=%ld\n",len,value);
  370.         fflush(stdout);
  371.       }
  372. #endif
  373.       /* if (!value) */
  374.       if (!value || value==LONELY) {
  375.         /* Pointer not yet explored */
  376.         result=TRUE;
  377.         *addr=len;
  378. #ifdef prlDEBUG
  379.         amount_used+=len;
  380. #endif
  381.       }
  382.       else if (value < len && len != LONELY) {
  383.         Errorline("in garbage collection, %d < %d.\n", value, len);
  384.       }
  385.       else if (value > len && len != LONELY) {
  386.         Errorline("in garbage collection, %d > %d.\n", value, len);
  387.       }
  388.       break;
  389.     case 2:
  390.       if (value & 1) { /* If low bit set */
  391.         value--;       /* Reset low bit */
  392.         *addr=value;
  393. #ifdef prlDEBUG
  394.         amount_used+=len;
  395. #endif
  396.         result=TRUE;
  397.       }
  398.       if (!VALID_ADDRESS(value))
  399.         assert(VALID_ADDRESS(value));
  400.       *p = (GENERIC) value;
  401.       break;
  402.     }
  403.   }
  404.   return result;
  405. }
  406.  
  407.  
  408.  
  409. /******** CHECK_STRING(s)
  410.   Claim the memory used by the string S.
  411. */
  412. static void check_string (s)
  413. GENERIC *s;
  414. {
  415.   GENERIC addr;
  416.   long value;
  417.   long bytes;
  418.  
  419.   if ((unsigned long) *s > MAX_BUILT_INS) {
  420.     switch (pass) {
  421.     case 1:
  422.       bytes=strlen((char *)*s)+1;
  423.       /* if (bytes==LONELY) {
  424.     fprintf(stderr,"Caught an empty string!\n");
  425.     fflush(stderr);
  426.       } */
  427.       /* Make sure there's no conflict with LONELY (this occurs for an */
  428.       /* empty string, which still needs a single byte of storage). */
  429.       /* This does occasionally happen. */
  430.       unchecked(s, (bytes==LONELY)?bytes+1:bytes);
  431.       break;
  432.     case 2:
  433.       addr=(*s+delta);
  434.       value= *addr;
  435.       if (value & 1) { /* If low bit set */
  436.         value--;
  437.         *s=(GENERIC)value;
  438.         *addr=value;
  439. #ifdef prlDEBUG
  440.         amount_used+=strlen(*s)+1;
  441. #endif
  442.       }
  443.       *s=(GENERIC)value;
  444.       break;
  445.     }
  446.   }
  447. }
  448.  
  449. /* DENYS: BYTEDATA */
  450. /******** CHECK_BYTEDATA(s)
  451.   Claim the memory used by a block of bytes
  452.   */
  453. static void check_bytedata(s)
  454.      GENERIC *s;
  455. {
  456.   GENERIC addr;
  457.   long value;
  458.   if ((unsigned long) *s > MAX_BUILT_INS) {
  459.     unsigned long bytes = *((unsigned long *) *s);
  460.     unsigned long size = bytes + sizeof(bytes);
  461.     switch (pass) {
  462.     case 1:
  463.       unchecked(s,size);
  464.       break;
  465.     case 2:
  466.       addr=(*s+delta);
  467.       value= *addr;
  468.       if (value & 1) {
  469.     value--;
  470.     *s=(GENERIC) value;
  471.     *addr=value;
  472. #ifdef prlDEBUG
  473.     amount_used+=size;
  474. #endif
  475.       }
  476.       *s=(GENERIC)value;
  477.       break;
  478.     }
  479.   }
  480. }
  481.  
  482. /******** CHECK_CODE(c)
  483.   Claim the memory used by a type code (=list of integers).
  484. */
  485. static void check_code(c)
  486. ptr_int_list *c;
  487. {
  488.   while (unchecked(c,sizeof(int_list)))
  489.     c= &((*c)->next);
  490. }
  491.  
  492.  
  493.  
  494. /******** CHECK_PAIR_LIST
  495.   Checks a list of <GOAL,BODY> pairs.
  496. */
  497. static void check_pair_list(p)
  498. ptr_pair_list *p;
  499. {  
  500.   while (unchecked(p,sizeof(pair_list))) {
  501.     check_psi_term(&((*p)->a));
  502.     check_psi_term(&((*p)->b));
  503.     p= &((*p)->next);
  504.   }
  505. }
  506.  
  507.  
  508.  
  509.  
  510. /******** CHECK_TRIPLE_LIST
  511.   Checks a list of <GOAL,BODY,DEF> triples.
  512. */
  513. static void check_triple_list(p)
  514. ptr_triple_list *p;
  515. {  
  516.   while (unchecked(p,sizeof(triple_list))) {
  517.     check_psi_term(&((*p)->a));
  518.     check_psi_term(&((*p)->b));
  519.     check_definition(&((*p)->c));
  520.     p= &((*p)->next);
  521.   }
  522. }
  523.  
  524.  
  525.  
  526. /******** CHECK_KIDS(c)
  527.   Check a list of parents or children of a given type.
  528. */
  529. static void check_kids(c)
  530. ptr_int_list *c;
  531. {
  532.   while (unchecked(c,sizeof(int_list))) {
  533.     check_definition(&((*c)->value));
  534.     c= &((*c)->next);
  535.   }
  536. }
  537.  
  538.  
  539.  
  540. /******** CHECK_OPERATOR_DATA(op)
  541.   Explore a list of operator declarations.
  542. */
  543. static void check_operator_data(op)
  544. ptr_operator_data *op;
  545. {
  546.   while (unchecked(op,sizeof(operator_data))) {
  547.     op = &((*op)->next);
  548.   }
  549. }
  550.  
  551.  
  552. static void check_module();
  553. void check_hash_table();          /*  RM: Feb  3 1993  */
  554. static void check_keyword();      /*  RM: Jan 12 1993  */
  555.  
  556.  
  557.  
  558. /******** CHECK_MODULE_LIST(c)
  559.   Check a list of modules.
  560. */
  561.  
  562. static void check_module_list(c)    /*  RM: Jan 12 1993  */
  563.      
  564.      ptr_int_list *c;
  565. {
  566.   while (unchecked(c,sizeof(int_list))) {
  567.     check_module(&((*c)->value));
  568.     c= &((*c)->next);
  569.   }
  570. }
  571.  
  572.  
  573. /******** CHECK_MODULE_TREE
  574.   This goes through the module table, checking all nodes.
  575. */
  576. static void check_module_tree(n)    /*  RM: Jan 13 1993  */
  577.      ptr_node *n;
  578. {
  579.   if (unchecked(n,sizeof(node))) {
  580.     check_module_tree(&((*n)->left));
  581.     check_string(&((*n)->key));
  582.     check_module(&((*n)->data));
  583.     check_module_tree(&((*n)->right));
  584.   }
  585. }
  586.  
  587.  
  588.  
  589. /******** CHECK_MODULE(m) 
  590.   Checks a module.
  591.   */
  592.  
  593. static void check_module(m)        /*  RM: Jan 12 1993  */
  594.      
  595.      ptr_module *m;
  596. {
  597.   if(unchecked(m,sizeof(struct wl_module))) {
  598.     check_string(&((*m)->module_name));
  599.     check_string(&((*m)->source_file));
  600.     check_module_list(&((*m)->open_modules));
  601.     check_module_list(&((*m)->inherited_modules));
  602.     check_hash_table((*m)->symbol_table);
  603.   }
  604. }
  605.  
  606.  
  607.  
  608. /******** CHECK_HASH_TABLE(table)
  609.   Check a hash table of keywords. The actual table is not stored within LIFE
  610.   memory.
  611.   */
  612.  
  613. void check_hash_table(table) /*  RM: Feb  3 1993  */
  614.      
  615.      ptr_hash_table table;
  616. {
  617.   long i;
  618.   
  619.   for(i=0;i<table->size;i++)
  620.     if(table->data[i])
  621.       check_keyword(&(table->data[i]));
  622. }
  623.  
  624.  
  625.  
  626. /******** CHECK_KEYWORD(k)
  627.   Checks a keyword.
  628.   */
  629.  
  630. static void check_keyword(k)      /*  RM: Jan 12 1993  */
  631.      
  632.      ptr_keyword *k;
  633. {
  634.   if(unchecked(k,sizeof(struct wl_keyword))) {
  635.     check_module(&((*k)->module));
  636.     check_string(&((*k)->symbol));
  637.     check_string(&((*k)->combined_name));
  638.     check_definition(&((*k)->definition));
  639.   }
  640. }
  641.  
  642.  
  643.  
  644. /******** CHECK_DEFINITION
  645.   This goes through the type tree which contains the parents and children lists
  646.   for all types, and the attributed code. The code field is not checked as
  647.   this has been done separately by CHECK_GAMMA.
  648. */
  649. void check_definition(d)
  650. ptr_definition *d;
  651. {  
  652.   if(unchecked(d,sizeof(definition))) {
  653.     
  654.     check_keyword(&((*d)->keyword)); /*  RM: Jan 12 1993  */
  655.     
  656. #ifdef prlDEBUG
  657.     printf("%lx %20s %ld\n",*d,(*d)->keyword->symbol,amount_used);
  658. #endif
  659.  
  660.     check_code(&((*d)->code));
  661.     check_pair_list(&((*d)->rule));
  662.     check_triple_list(&((*d)->properties));
  663.     
  664.     if ((*d)->type==type) {
  665.       check_kids(&((*d)->parents));
  666.       check_kids(&((*d)->children));
  667.     }
  668.  
  669.     check_psi_term(&((*d)->global_value)); /*  RM: Feb  9 1993  */
  670.     check_psi_term(&((*d)->init_value));   /*  RM: Mar 23 1993  */
  671.     
  672.     check_operator_data(&((*d)->op_data)); /* PVR 5.6 */
  673.  
  674. #ifdef CLIFE
  675.     check_block_def(&((*d)->block_def)); /*  RM: Jan 27 1993  */
  676. #endif /* CLIFE */
  677.   }
  678. }
  679.  
  680.  
  681.  
  682. /******** CHECK_DEFINITION_LIST
  683.   This checks the entire list of definitions.
  684. */
  685. void check_definition_list()   /*  RM: Feb 15 1993  */
  686.  
  687. {
  688.   ptr_definition *d;
  689.  
  690.   d= &first_definition;
  691.  
  692.   while(*d) {
  693.     check_definition(d);
  694.     d= &((*d)->next);
  695.   }
  696. }
  697.  
  698.  
  699.  
  700. /******** CHECK_DEF_CODE(d)
  701.   This routine checks the CODE field in a definition.
  702.   It may only be invoked by CHECK_GAMMA.
  703. */
  704. static void check_def_code(d)
  705. ptr_definition *d;
  706. {  
  707.   if (unchecked(d,sizeof(definition)))
  708.     check_code(&((*d)->code));
  709.   /* p = &((*d)->properties); */
  710.   /* check_def_prop(p); */
  711. }
  712.  
  713.  
  714.  
  715. /******** CHECK_DEF_REST(d)
  716.   This routine checks the other fields in a definition.
  717.   It may only be invoked by CHECK_GAMMA_REST.
  718. */
  719. static void check_def_rest(d)
  720. ptr_definition *d;
  721. {
  722.   if (*d) {
  723.     check_keyword(&((*d)->keyword)); /*  RM: Jan 12 1993  */
  724.     check_pair_list(&((*d)->rule));
  725.     check_triple_list(&((*d)->properties));
  726.     
  727.     if ((*d)->type==type) {
  728.       check_kids(&((*d)->parents));
  729.       check_kids(&((*d)->children));
  730.     }
  731.     check_operator_data(&((*d)->op_data)); /* PVR 5.6 */
  732. #ifdef CLIFE
  733.     check_block_def(&((*d)->block_def));  /*CB 25/01/93 */
  734. #endif /* CLIFE */
  735.   }
  736. }
  737.  
  738.  
  739.  
  740. /******** CHECK_SYMBOL
  741.   This goes through the symbol table, checking all nodes, symbols, strings
  742.   and definitions not contained in the type table.
  743. */
  744. static void check_symbol(n)
  745. ptr_node *n;
  746. {
  747.   if (unchecked(n,sizeof(node))) {
  748.     check_symbol(&((*n)->left));
  749.     check_string(&((*n)->key));
  750.     check_keyword(&((*n)->data));   /*  RM: Jan 12 1993  */
  751.     check_symbol(&((*n)->right));
  752.   }
  753. }
  754.  
  755.  
  756.  
  757. /******** CHECK_TYPE_DISJ
  758.   Checks the list of definitions appearing in a type disjunction.
  759. */
  760. static void check_type_disj(p)
  761. ptr_int_list *p;
  762. {  
  763.   while (unchecked(p,sizeof(int_list))) {
  764.     check_definition(&((*p)->value));
  765.     p= &((*p)->next);
  766.   }
  767. }
  768.  
  769.  
  770.  
  771. /******** CHECK_GOAL_STACK
  772.   Check the goal_stack. This is quite complicated as each type of goal (prove,
  773.   unify, eval, eval_cut etc...) gives its own meanings to the three other
  774.   fields (A,B and C) present in each goal.
  775. */
  776. static void check_goal_stack(g)
  777. ptr_goal *g;
  778. {
  779.   while (unchecked(g,sizeof(goal))) {
  780.     
  781.     switch ((*g)->type) {
  782.       
  783.     case fail:
  784.       break;
  785.       
  786.     case unify:
  787.     case unify_noeval: /* PVR 5.6 */
  788.       check_psi_term(&((*g)->a));
  789.       check_psi_term(&((*g)->b));
  790.       break;
  791.       
  792.     case prove:
  793.       check_psi_term(&((*g)->a));
  794.       if ((unsigned long)(*g)->b!=DEFRULES) check_pair_list(&((*g)->b));
  795.       check_pair_list(&((*g)->c));
  796.       break;
  797.       
  798.     case disj: 
  799.       check_psi_term(&((*g)->a));
  800.       check_psi_term(&((*g)->b));
  801.       break;
  802.       
  803.     case what_next:
  804.       /* check_choice(&((*g)->b)); */
  805.       break;
  806.       
  807.     case eval: 
  808.       check_psi_term(&((*g)->a));
  809.       check_psi_term(&((*g)->b));
  810.       check_pair_list(&((*g)->c));
  811.       break;
  812.  
  813.     case load:
  814.       check_psi_term(&((*g)->a));
  815.       check_string(&((*g)->c));
  816.       break;
  817.       
  818.     case match:
  819.       check_psi_term(&((*g)->a));
  820.       check_psi_term(&((*g)->b));
  821.       check_resid_block(&((*g)->c));
  822.       break;
  823.  
  824.     case general_cut:
  825.       /* assert((GENERIC)(*g)->a <= (GENERIC)choice_stack); 12.7 17.7 */
  826.       if (pass==1 && (ptr_choice_point)(*g)->a>choice_stack)
  827.         (*g)->a=(ptr_psi_term)choice_stack;
  828.       unchecked(&((*g)->a),LONELY);
  829.       break;
  830.       
  831.     case eval_cut:
  832.       check_psi_term(&((*g)->a));
  833.       /* assert((GENERIC)(*g)->b <= (GENERIC)choice_stack); 12.7 17.7 */
  834.       if (pass==1 && (ptr_choice_point)(*g)->b>choice_stack)
  835.         (*g)->b=(ptr_psi_term)choice_stack;
  836.       unchecked(&((*g)->b),LONELY);
  837.       check_resid_block(&((*g)->c));
  838.       break;
  839.  
  840.     case freeze_cut:
  841.     case implies_cut:
  842.       check_psi_term(&((*g)->a));
  843.       /* assert((GENERIC)(*g)->b <= (GENERIC)choice_stack); 12.7 17.7 */
  844.       if (pass==1 && (ptr_choice_point)(*g)->b>choice_stack)
  845.         (*g)->b=(ptr_psi_term)choice_stack;
  846.       unchecked(&((*g)->b),LONELY);
  847.       check_resid_block(&((*g)->c));
  848.       break;
  849.       
  850.     case type_disj:
  851.       check_psi_term(&((*g)->a));
  852.       check_type_disj(&((*g)->b));
  853.       break;
  854.       
  855.     case clause:
  856.       check_psi_term(&((*g)->a));
  857.       check_psi_term(&((*g)->b));
  858.       unchecked(&((*g)->c),LONELY);
  859.       /* check_pair_list((*g)->c); */ /* 6.8 */
  860.       break;
  861.  
  862.     case del_clause:
  863.       check_psi_term(&((*g)->a));
  864.       check_psi_term(&((*g)->b));
  865.       unchecked(&((*g)->c),LONELY);
  866.       /* check_pair_list((*g)->c); */ /* 6.8 */
  867.       break;
  868.  
  869.     case retract:
  870.       unchecked(&((*g)->a),LONELY);
  871.       /* check_pair_list((*g)->a); */ /* 6.8 */
  872.       /*PVR*/ /* check_choice(&((*g)->b)); 9.6 */
  873.       break;
  874.  
  875.     default:
  876.       Errorline("in garbage collection, bad goal on stack.\n");
  877.     }
  878.     
  879.     g= &((*g)->next);
  880.   }
  881. }
  882.  
  883.  
  884.  
  885. /******** CHECK_RESID(r)
  886.   Explore a list of residuations.
  887. */
  888. static void check_resid(r)
  889. ptr_residuation *r;
  890. {
  891.   ptr_int_list code;
  892.   ptr_list *l;
  893.  
  894.   while (unchecked(r,sizeof(residuation))) {
  895.  
  896.     if ((*r)->sortflag) /* 22.9 */
  897.       check_definition(&((*r)->bestsort));
  898.     else
  899.       check_code(&((*r)->bestsort)); /* 21.9 */
  900.  
  901.     /* Handling of the value field (6.10) */
  902.     code = (*r)->sortflag ? ((ptr_definition)((*r)->bestsort))->code
  903.               : (ptr_int_list)(*r)->bestsort;
  904.     /* Copied (almost) verbatim from check_psi_term: */
  905.     if ((*r)->value) {
  906.       if (code==alist->code) { /*  RM: Dec 15 1992  Will be removed */
  907.       l=(ptr_list *) &((*r)->value);
  908.       if (l)
  909.       printf("Found an old list!!\n");
  910.       }
  911.       else if (sub_CodeType(code,real->code))
  912.         unchecked(&((*r)->value),sizeof(REAL));
  913.       else if (sub_CodeType(code,quoted_string->code))
  914.         check_string(&((*r)->value));
  915.       /* DENYS: BYTEDATA */
  916.       else if (sub_CodeType(code,sys_bytedata->code))
  917.     check_bytedata(&((*r)->value));
  918.       else if (sub_CodeType(code,cut->code)) {
  919.         if (pass==1 && (*r)->value>(GENERIC)choice_stack)
  920.           (*r)->value=(GENERIC)choice_stack;
  921.         unchecked(&((*r)->value),LONELY);
  922.       }
  923.       else if (sub_CodeType(code,variable->code)) /* 8.8 */
  924.     check_string(&((*r)->value));
  925.     }
  926.  
  927.     check_goal_stack(&((*r)->goal));
  928.     r= &((*r)->next);
  929.   }
  930. }
  931.  
  932.  
  933.  
  934. /******** CHECK_RESID_BLOCK(rb)
  935.   Explore a residuation block.
  936. */
  937. void check_resid_block(rb)
  938. ptr_resid_block *rb;
  939. {
  940.   if (*rb) {
  941.     if (unchecked(rb,sizeof(resid_block))) {
  942.       check_goal_stack(&((*rb)->ra));
  943.       check_resid_list(&((*rb)->rv)); /* 21.9 */
  944.       /* unchecked(&((*rb)->rl),LONELY); 12.6 */  /* 10.6 */
  945.       unchecked(&((*rb)->md),LONELY); /* 10.6 */
  946.       /* check_goal_stack(&((*rb)->rl)); 10.6 */
  947.       /* check_psi_term(&((*rb)->md)); 10.6 */
  948.     }
  949.   }
  950. }
  951.  
  952.  
  953.  
  954. /******** CHECK_PSI_TERM(t)
  955.   Explore a psi_term.
  956. */
  957. void check_psi_term(t)
  958. ptr_psi_term *t;
  959. {
  960.   ptr_list *l;
  961.  
  962.   while (unchecked(t,sizeof(psi_term))) {
  963.       
  964.     /* A psi-term on the heap has no residuation list. */
  965.     if (pass==1 && (GENERIC)(*t)>=heap_pointer && (GENERIC)(*t)<mem_limit) {
  966.       assert((*t)->resid==NULL);
  967.     }
  968.     check_definition(&((*t)->type));
  969.     check_attr(&((*t)->attr_list));
  970.     
  971.     if ((*t)->value) {
  972.  
  973.       if ((*t)->type==alist) { /*  RM: Dec 15 1992  Should be removed  */
  974.       l=(ptr_list *) &((*t)->value);
  975.       if (l)
  976.       printf("Found an old list!\n");
  977.       }
  978.       else
  979.  
  980.     if (sub_type((*t)->type,real))
  981.       unchecked(&((*t)->value),sizeof(REAL));
  982.     else if (sub_type((*t)->type,quoted_string))
  983.       check_string(&((*t)->value));
  984.       /* DENYS: BYTEDATA */
  985.     else if (sub_type((*t)->type,sys_bytedata))
  986.       check_bytedata(&((*t)->value));
  987. #ifdef CLIFE
  988.     else if ((*t)->type->type==block) {  /*  RM: Jan 27 1993  */
  989.       check_block_value(&((*t)->value));
  990.     }
  991. #endif /* CLIFE */
  992.     else if ((*t)->type==cut) { /*  RM: Oct 28 1993  */
  993.       /* assert((*t)->value <= (GENERIC)choice_stack); 12.7 17.7 */
  994.       if (pass==1 && (*t)->value>(GENERIC)choice_stack)
  995.         (*t)->value=(GENERIC)choice_stack;
  996.       unchecked(&((*t)->value),LONELY);
  997.     }
  998.     else if (sub_type((*t)->type,variable)) /* 8.8 */
  999.       check_string(&((*t)->value));
  1000.     else if ((*t)->type!=stream)
  1001.       Errorline("non-NULL value field in garbage collector, type='%s', value=%d.\n",
  1002.             (*t)->type->keyword->combined_name,
  1003.             (*t)->value);
  1004.     }
  1005.     
  1006.     /* check_psi_term(&((*t)->coref)); 9.6 */
  1007.     if ((*t)->resid)
  1008.       check_resid(&((*t)->resid));
  1009.     
  1010.     t = &((*t)->coref);
  1011.   }
  1012. }
  1013.  
  1014.  
  1015.  
  1016. /******** CHECK_ATTR(attribute-tree)
  1017.   Check an attribute tree.
  1018.   (Could improve this by randomly picking left or right subtree
  1019.   for last call optimization.  This would never overflow, even on
  1020.   very skewed attribute trees.)
  1021. */
  1022. void check_attr(n)
  1023. ptr_node *n;
  1024. {
  1025.   while (unchecked(n,sizeof(node))) {
  1026.     check_attr(&((*n)->left));
  1027.     check_string(&((*n)->key));
  1028.     check_psi_term(&((*n)->data));
  1029.  
  1030.     n = &((*n)->right);
  1031.     /* check_attr(&((*n)->right)); 9.6 */
  1032.   }
  1033. }
  1034.  
  1035.  
  1036.  
  1037. /******** CHECK_GAMMA_CODE()
  1038.   Check and update the code
  1039.   reversing table.  In this part, only the codes are checked in
  1040.   the definitions, this is vital because these codes are used
  1041.   later to distinguish between the various data types and to
  1042.   determine the type of the VALUE field in psi_terms. Misunderstanding this
  1043.   caused a lot of bugs in the GC.
  1044. */
  1045. void check_gamma_code()
  1046. {
  1047.   long i;
  1048.  
  1049.   if (unchecked(&gamma_table,type_count*sizeof(ptr_definition))) {
  1050.     for (i=0;i<type_count;i++)
  1051.       check_def_code(&(gamma_table[i]));
  1052.   }
  1053. }
  1054.  
  1055.  
  1056.  
  1057. /******** CHECK_GAMMA_REST()
  1058.   Check and update the code reversing table.
  1059. */
  1060. static void check_gamma_rest()
  1061. {
  1062.   long i;
  1063.  
  1064.   for (i=0;i<type_count;i++)
  1065.     check_def_rest(&(gamma_table[i]));
  1066. }
  1067.  
  1068.  
  1069.  
  1070. /******** CHECK_UNDO_STACK()
  1071.   This looks after checking the addresses of objects pointed to in the trail.
  1072.   The type of the pointer to be restored on backtracking is known, which
  1073.   allows the structure it is referring to to be accordingly checked.
  1074. */
  1075. static void check_undo_stack(s)
  1076. ptr_stack *s;
  1077. {
  1078.   while (unchecked(s,sizeof(stack))) {
  1079.        
  1080.     switch((*s)->type) {
  1081.       
  1082.     case psi_term_ptr:
  1083.       check_psi_term(&((*s)->b));
  1084.       break;
  1085.       
  1086.     case resid_ptr:
  1087.       check_resid(&((*s)->b));
  1088.       break;
  1089.       
  1090.     case int_ptr:
  1091.       /* int_ptr's are used to trail time_stamps, so they can get large. */
  1092.       break;
  1093.       
  1094.     case def_ptr:
  1095.       check_definition(&((*s)->b));
  1096.       break;
  1097.       
  1098.     case code_ptr:
  1099.       check_code(&((*s)->b));
  1100.       break;
  1101.  
  1102.     case goal_ptr:
  1103.       check_goal_stack(&((*s)->b));
  1104.       break;
  1105.  
  1106.     case cut_ptr: /* 22.9 */
  1107.       break;
  1108. #ifdef CLIFE
  1109.     case block_ptr: /*  CB: Jan 28 1993  */
  1110.       check_block_value(&((*s)->b));
  1111.       break;
  1112.  
  1113. #endif /* CLIFE */
  1114.     /* All undo actions here */
  1115.     case destroy_window:
  1116.     case show_window:
  1117.     case hide_window:
  1118.       /* No pointers to follow */
  1119.       break;
  1120.     }
  1121.  
  1122.     s= &((*s)->next);
  1123.   }
  1124. }
  1125.  
  1126.  
  1127.  
  1128. /******** CHECK_CHOICE(c)
  1129.   This routine checks all choice points.
  1130. */
  1131. static void check_choice_structs(c)
  1132.      ptr_choice_point *c;
  1133. {
  1134.   while(unchecked(c,sizeof(choice_point))) {
  1135.     c= &((*c)->next);
  1136.   }
  1137. }
  1138.  
  1139. static void check_choice(c)
  1140.      ptr_choice_point *c;
  1141. {
  1142.   while(*c) {
  1143.     check_undo_stack(&((*c)->undo_point)); /* 17.7 */
  1144.     check_goal_stack(&((*c)->goal_stack));
  1145.     c= &((*c)->next);
  1146.   }
  1147. }
  1148.  
  1149.  
  1150.  
  1151. /******** CHECK_SPECIAL_ADDRESSES
  1152.   Here we check all the addresses which do not point to a whole data structure,
  1153.   but to something within, for example a field such as VALUE which might
  1154.   have been modified in a PSI_TERM structure.  These are the LONELY addresses.
  1155. */
  1156. static void check_special_addresses()
  1157. {
  1158.   ptr_choice_point c;
  1159.   ptr_stack p;
  1160.   ptr_goal g;
  1161.  
  1162.   c=choice_stack;
  1163.   while(c) {
  1164.     /* unchecked(&(c->undo_point),LONELY); 17.7 */
  1165.     unchecked(&(c->stack_top),LONELY);
  1166.     c=c->next;
  1167.   }
  1168.  
  1169.   p=undo_stack;
  1170.   while (p) {
  1171.     if (!(p->type & undo_action)) {
  1172.       /* Only update an address if it's within the Life data space! */
  1173.       if (VALID_RANGE(p->a)) unchecked(&(p->a),LONELY);
  1174.       if (p->type==cut_ptr) unchecked(&(p->b),LONELY); /* 22.9 */
  1175.     }
  1176.     p=p->next;
  1177.   }
  1178. }
  1179.  
  1180.  
  1181.  
  1182. /******** CHECK_PSI_LIST
  1183.   Update all the values in the list of residuation variables, which is a list
  1184.   of psi_terms.
  1185. */
  1186. static void check_psi_list(l)
  1187. ptr_int_list *l;
  1188. {
  1189.   while(unchecked(l,sizeof(int_list))) {
  1190.     check_psi_term(&((*l)->value));
  1191.     l= &((*l)->next);
  1192.   }
  1193. }
  1194.  
  1195.  
  1196.  
  1197. /******** CHECK_RESID_LIST
  1198.   Update all the values in the list of residuation variables, which is a list
  1199.   of pairs of psi_terms.
  1200. */
  1201. static void check_resid_list(l)
  1202. ptr_resid_list *l;
  1203. {
  1204.   while(unchecked(l,sizeof(resid_list))) {
  1205.     check_psi_term(&((*l)->var));
  1206.     check_psi_term(&((*l)->othervar));
  1207.     l= &((*l)->next);
  1208.   }
  1209. }
  1210.  
  1211.  
  1212.  
  1213. /******** CHECK_VAR(t)
  1214.   Go through the VARiable tree.
  1215.   (This could be made tail recursive.)
  1216. */
  1217. static void check_var(n)
  1218. ptr_node *n;
  1219. {
  1220.   if (unchecked(n,sizeof(node))) {
  1221.     check_var(&((*n)->left));
  1222.     check_string(&((*n)->key));
  1223.     check_psi_term(&((*n)->data));
  1224.     check_var(&((*n)->right));
  1225.   }
  1226. }
  1227.  
  1228.  
  1229.  
  1230. /******** CHECK
  1231.   This routine checks all pointers and psi_terms to find out which memory cells
  1232.   must be preserved and which can be discarded.
  1233.  
  1234.   This routine explores all known structures. It is vital that it should visit
  1235.   them all exactly once. It thus creates a map of what is used in memory, which
  1236.   COMPRESS uses to compact the memory and recalculate the addresses.
  1237.   Exploration of these structures should be done in exactly the same order
  1238.   in both passes. If it is the second pass, pointers are assigned their new
  1239.   values.
  1240.  
  1241.   A crucial property of this routine: In pass 2, a global variable (i.e. a
  1242.   root for GC) must be updated before it is accessed.  E.g. don't use the
  1243.   variable goal_stack before updating it.
  1244. */
  1245. static void check()
  1246. {
  1247. #ifdef prlDEBUG
  1248.   amount_used=0;
  1249. #endif
  1250.  
  1251.   /* First of all, get all the codes right so that data type-checking remains
  1252.      coherent.
  1253.  
  1254.      Kids and Parents cannot be checked because the built-in types have codes
  1255.      which might have been moved.
  1256.   */
  1257.   /* print_undo_stack(); */
  1258.  
  1259.   
  1260.   check_choice_structs(&choice_stack); /*  RM: Oct 28 1993  */
  1261.   
  1262.   assert((pass==1?bounds_undo_stack():TRUE));
  1263.   check_gamma_code();
  1264.   
  1265.   /* Now, check the rest of the definitions and all global roots */
  1266.   
  1267.   check_gamma_rest();
  1268.  
  1269.   assert((pass==1?bounds_undo_stack():TRUE));
  1270.  
  1271.   check_definition(&abortsym); /* 26.1 */
  1272.   check_definition(&aborthooksym); /* 26.1 */
  1273.  
  1274.   check_definition(&add_module1); /*  RM: Mar 12 1993  */
  1275.   check_definition(&add_module2);
  1276.   check_definition(&add_module3);
  1277.     
  1278.   check_definition(&and);
  1279.   check_definition(&apply);
  1280.   check_definition(&boolean);
  1281.   check_definition(&boolpredsym);
  1282.   check_definition(&built_in);
  1283.   check_definition(&colonsym);
  1284.   check_definition(&commasym);
  1285.   check_definition(&comment);
  1286.   /* check_definition(&conjunction); 19.8 */
  1287.   check_definition(&constant);
  1288.   check_definition(&cut);
  1289.   check_definition(&disjunction);
  1290.   check_definition(&disj_nil);  /*  RM: Feb 16 1993  */
  1291.   check_definition(&eof);
  1292.   check_definition(&eqsym);
  1293.   check_definition(&false);
  1294.   check_definition(&funcsym);
  1295.   check_definition(&functor);
  1296.   check_definition(&iff);
  1297.   check_definition(&integer);
  1298.   check_definition(&alist);
  1299.   check_definition(&life_or); /*  RM: Apr  6 1993  */
  1300.   check_definition(&minus_symbol); /*  RM: Jun 21 1993  */
  1301.   check_definition(&nil); /*  RM: Dec  9 1992  */
  1302.   check_definition(¬hing);
  1303.   check_definition(&predsym);
  1304.   check_definition("e);
  1305.   check_definition("ed_string);
  1306.   check_definition(&real);
  1307.   check_definition(&stream);
  1308.   check_definition(&succeed);
  1309.   check_definition(&such_that);
  1310.   check_definition(&top);
  1311.   check_definition(&true);
  1312.   check_definition(×ym);
  1313.   check_definition(&tracesym); /* 26.1 */
  1314.   check_definition(&typesym);
  1315.   check_definition(&variable);
  1316.   check_definition(&opsym);
  1317.   check_definition(&loadsym);
  1318.   check_definition(&dynamicsym);
  1319.   check_definition(&staticsym);
  1320.   check_definition(&encodesym);
  1321.   check_definition(&listingsym);
  1322.   /* check_definition(&provesym); */
  1323.   check_definition(&delay_checksym);
  1324.   check_definition(&eval_argsym);
  1325.   check_definition(&inputfilesym);
  1326.   check_definition(&call_handlersym);
  1327.   check_definition(&xf_sym);
  1328.   check_definition(&fx_sym);
  1329.   check_definition(&yf_sym);
  1330.   check_definition(&fy_sym);
  1331.   check_definition(&xfx_sym);
  1332.   check_definition(&xfy_sym);
  1333.   check_definition(&yfx_sym);
  1334.   check_definition(&nullsym);
  1335.  
  1336.   /*  RM: Jul  7 1993  */
  1337.   check_definition(&final_dot);
  1338.   check_definition(&final_question);
  1339.  
  1340.   check_sys_definitions();
  1341.   
  1342. #ifdef X11
  1343.   check_definition(&xevent);
  1344.   check_definition(&xmisc_event);
  1345.   check_definition(&xkeyboard_event);
  1346.   check_definition(&xbutton_event);
  1347.   check_definition(&xconfigure_event);
  1348.   check_definition(&xmotion_event);
  1349.   check_definition(&xenter_event);
  1350.   check_definition(&xleave_event);
  1351.   check_definition(&xexpose_event);
  1352.   check_definition(&xdestroy_event);
  1353.   check_definition(&xdisplay);
  1354.   check_definition(&xdrawable);
  1355.   check_definition(&xwindow);
  1356.   check_definition(&xpixmap);
  1357.   check_definition(&xgc);
  1358.   check_definition(&xdisplaylist);
  1359. #endif
  1360.   
  1361.   /* check_psi_term(&empty_list); 5.8 */
  1362.   
  1363.   check_string(&one);
  1364.   check_string(&two);
  1365.   check_string(&three);
  1366.   check_string(&year_attr);
  1367.   check_string(&month_attr);
  1368.   check_string(&day_attr);
  1369.   check_string(&hour_attr);
  1370.   check_string(&minute_attr);
  1371.   check_string(&second_attr);
  1372.   check_string(&weekday_attr);
  1373.  
  1374.   check_psi_term(&input_state);
  1375.   check_psi_term(&stdin_state);
  1376.   check_psi_term(&error_psi_term);
  1377.   check_psi_term(&saved_psi_term);
  1378.   check_psi_term(&old_saved_psi_term);
  1379.   check_psi_term(&null_psi_term);
  1380.   check_psi_term(&old_state); /*  RM: Feb 17 1993  */
  1381.  
  1382.   assert((pass==1?bounds_undo_stack():TRUE));
  1383. #ifdef X11
  1384.   check_psi_term(&xevent_list);
  1385.   check_psi_term(&xevent_existing);
  1386. #endif
  1387.  
  1388.   check_choice(&choice_stack);
  1389.   /* check_choice(&prompt_choice_stack); 12.7 */
  1390.  
  1391.  
  1392.   /*  RM: Feb  3 1993  */
  1393.   /* check_symbol(&symbol_table); */
  1394.   /* check_definition(&first_definition); */
  1395.   check_definition_list(); /*  RM: Feb 15 1993  */
  1396.  
  1397.   
  1398.   /*** MODULES ***/
  1399.   /*  RM: Jan 13 1993  */
  1400.  
  1401.   check_module_tree(&module_table);
  1402.   check_module(&sys_module);
  1403.   check_module(&bi_module);
  1404.   check_module(&user_module);  /*  RM: Jan 27 1993  */
  1405.   check_module(&no_module);
  1406.   check_module(&x_module);
  1407.   check_module(&syntax_module);
  1408.   check_module(¤t_module);
  1409.   
  1410.   /*** End ***/
  1411.  
  1412.  
  1413.   
  1414.   check_var(&var_tree);
  1415.  
  1416.   check_goal_stack(&goal_stack);
  1417.   check_goal_stack(&aim); /* 7.10 */
  1418.  
  1419.   if (TRUE /*resid_aim 10.6 */) check_resid_list(&resid_vars); /* 21.9 */
  1420.   
  1421.   check_goal_stack(&resid_aim);
  1422.  
  1423.   assert((pass==1?bounds_undo_stack():TRUE));
  1424.   check_undo_stack(&undo_stack);
  1425.  
  1426.   assert((pass==1?bounds_undo_stack():TRUE));
  1427.   check_special_addresses();
  1428.  
  1429.   assert((pass==1?bounds_undo_stack():TRUE));
  1430. }
  1431.  
  1432.  
  1433. void print_gc_info(timeflag)
  1434. long timeflag;
  1435. {
  1436.   fprintf(stderr," [%ld%% free (%ldK), %ld%% heap, %ld%% stack",
  1437.           (100*((unsigned long)heap_pointer-(unsigned long)stack_pointer)+mem_size/2)/mem_size,
  1438.           ((unsigned long)heap_pointer-(unsigned long)stack_pointer+512)/1024,
  1439.           (100*((unsigned long)mem_limit-(unsigned long)heap_pointer)+mem_size/2)/mem_size,
  1440.           (100*((unsigned long)stack_pointer-(unsigned long)mem_base)+mem_size/2)/mem_size);
  1441.   if (timeflag) {
  1442.     fprintf(stderr,", %1.3fs cpu (%ld%%)",
  1443.             gc_time,
  1444.             (unsigned long)(0.5+100*gc_time/(life_time+gc_time)));
  1445.   }
  1446.   fprintf(stderr,"]\n");
  1447. }
  1448.  
  1449.  
  1450. /******** GARBAGE()
  1451.   The garbage collector.
  1452.   This routine is called whenever memory is getting low.
  1453.   It returns TRUE if insufficient memory was freed to allow
  1454.   the interpreter to carry on working.
  1455.  
  1456.   This is a half-space GC, it first explores all known structures, then
  1457.   compresses the heap and the stack, then during the second pass assigns
  1458.   all the new addresses.
  1459.   
  1460.   Bugs will appear if the collector is called during parsing or other
  1461.   such routines which are 'unsafe'. In order to avoid this problem, before
  1462.   one of these routines is invoked the program will check to see whether
  1463.   there is enough memory available to work, and will call the GC if not
  1464.   (this is a fix, because it is not possible to determine in advance
  1465.   what the size of a psi_term read by the parser will be).
  1466. */
  1467. void garbage()
  1468. {
  1469.   GENERIC addr;
  1470. #ifndef OS2_PORT
  1471.   struct tms garbage_start_time,garbage_end_time;
  1472. #else
  1473.   float garbage_start_time,garbage_end_time;
  1474. #endif
  1475.   long start_number_cells, end_number_cells;
  1476.  
  1477.   start_number_cells = (stack_pointer-mem_base) + (mem_limit-heap_pointer);
  1478.  
  1479.   times(&garbage_start_time);
  1480.  
  1481.   /* Time elapsed since last garbage collection */
  1482. #ifndef OS2_PORT
  1483.   life_time=(garbage_start_time.tms_utime - last_garbage_time.tms_utime)/60.0;
  1484. #else
  1485.   life_time=(garbage_start_time - last_garbage_time)/60.0;
  1486. #endif
  1487.  
  1488.   if (verbose) {
  1489.     fprintf(stderr,"*** Garbage Collect "); /*  RM: Jan 26 1993  */
  1490.     fprintf(stderr,"\n*** Begin");
  1491.     print_gc_info(FALSE);
  1492.     fflush(stderr);
  1493.   }
  1494.  
  1495.   
  1496.   /* reset the other base */
  1497.   for (addr = other_base; addr < other_limit; addr ++)
  1498.     *addr = 0;
  1499.  
  1500.   pass=1;
  1501.  
  1502.   check();
  1503. #ifdef GCVERBOSE
  1504.   fprintf(stderr,"- Done pass 1 ");
  1505. #endif
  1506.  
  1507.   assert(bounds_undo_stack());
  1508.   compress();
  1509. #ifdef GCVERBOSE
  1510.   fprintf(stderr,"- Done compress ");
  1511. #endif
  1512.  
  1513.   pass=2;
  1514.  
  1515.   check();
  1516.   assert(bounds_undo_stack());
  1517. #ifdef GCVERBOSE
  1518.   fprintf(stderr,"- Done pass 2\n");
  1519. #endif
  1520.  
  1521.   clear_copy();
  1522.  
  1523.   printed_pointers=NULL;
  1524.   pointer_names=NULL;
  1525.   
  1526.   times(&garbage_end_time);
  1527. #ifndef OS2_PORT
  1528.   gc_time=(garbage_end_time.tms_utime - garbage_start_time.tms_utime)/60.0;
  1529. #else
  1530.   gc_time=(garbage_end_time - garbage_start_time)/60.0;
  1531. #endif
  1532.   garbage_time+=gc_time;
  1533.  
  1534.   if (verbose) {
  1535.     fprintf(stderr,"*** End  ");
  1536.     print_gc_info(TRUE); /*  RM: Jan 26 1993  */
  1537.     stack_info(stderr);
  1538.     fflush(stderr);
  1539.   }
  1540.  
  1541.   last_garbage_time=garbage_end_time;
  1542.  
  1543.   end_number_cells = (stack_pointer-mem_base) + (mem_limit-heap_pointer);
  1544.   assert(end_number_cells<=start_number_cells);
  1545.   
  1546.   ignore_eff=FALSE;
  1547.  
  1548. }
  1549.  
  1550.  
  1551.  
  1552. /****************************************************************************
  1553.  
  1554.   MEMORY ALLOCATION ROUTINES.
  1555.  
  1556. */
  1557.  
  1558.  
  1559.  
  1560. /******** HEAP_ALLOC(s)
  1561.   This returns a pointer to S bytes of memory in the heap.
  1562.   Alignment is taken into account in the following manner:
  1563.   the macro ALIGN is supposed to be a power of 2 and the pointer returned
  1564.   is a multiple of ALIGN.
  1565. */
  1566. GENERIC heap_alloc (s)
  1567. long s;
  1568. {
  1569.     if (s & (ALIGN-1))
  1570.       s = s - (s & (ALIGN-1))+ALIGN;
  1571.     /* assert(s % sizeof(*heap_pointer) == 0); */
  1572.     s /= sizeof (*heap_pointer);
  1573.   
  1574.     heap_pointer -= s;
  1575.  
  1576.     if (stack_pointer>heap_pointer)
  1577.       Errorline("the heap overflowed into the stack.\n");
  1578.  
  1579.     return heap_pointer;
  1580. }
  1581.  
  1582.  
  1583.  
  1584. /******** STACK_ALLOC(s)
  1585.   This returns a pointer to S bytes of memory in the stack.
  1586.   Alignment is taken into account in the following manner:
  1587.   the macro ALIGN is supposed to be a power of 2 and the pointer returned
  1588.   is a multiple of ALIGN.
  1589. */
  1590. GENERIC stack_alloc(s)
  1591. long s;
  1592. {
  1593.     GENERIC r;
  1594.  
  1595.     r = stack_pointer;
  1596.  
  1597.     if (s & (ALIGN-1))
  1598.       s = s - (s & (ALIGN-1)) + ALIGN;
  1599.     /* assert(s % sizeof(*stack_pointer) == 0); */
  1600.     s /= sizeof (*stack_pointer);
  1601.  
  1602.     stack_pointer += s;
  1603.  
  1604.     if (stack_pointer>heap_pointer)
  1605.       Errorline("the stack overflowed into the heap.\n");
  1606.   
  1607.     return r;
  1608. }
  1609.  
  1610.  
  1611.  
  1612. /******** INIT_MEMORY()
  1613.   Get two big blocks of memory to work in.
  1614.   The second is only used for the half-space garbage collector.
  1615.   The start and end addresses of the blocks are re-aligned correctly.
  1616.   to allocate.  
  1617. */
  1618.  
  1619.  
  1620. void init_memory ()
  1621. {
  1622.   alloc_words=GetIntOption("memory",ALLOC_WORDS);
  1623.   mem_size=alloc_words*sizeof(long);
  1624.   
  1625.   mem_base   = (GENERIC) malloc(mem_size);
  1626.   other_base = (GENERIC) malloc(mem_size);
  1627.  
  1628.   if (mem_base && other_base) {
  1629.     /* Rewrote some rather poor code... RM: Mar  1 1994  */
  1630.     ALIGNUP(mem_base);
  1631.     stack_pointer = mem_base;
  1632.     
  1633.     mem_limit=mem_base+alloc_words-2;
  1634.     ALIGNUP(mem_limit);
  1635.     heap_pointer = mem_limit;
  1636.  
  1637.     ALIGNUP(other_base);
  1638.     other_pointer = other_base;
  1639.  
  1640.     other_limit=other_base+alloc_words-2;
  1641.     ALIGNUP(other_limit);
  1642.     
  1643.     delta = other_base - mem_base;
  1644.     buffer = (char *) malloc (PRINT_BUFFER); /* The printing buffer */
  1645.  
  1646.     /*  RM: Oct 22 1993  */
  1647.     /* Fill the memory with rubbish data */
  1648.     /*
  1649.     {
  1650.       int i;
  1651.       
  1652.       for(i=0;i<alloc_words;i++) {
  1653.     mem_base[i]= -1234;
  1654.     other_base[i]= -1234;
  1655.       }
  1656.     }
  1657.     */
  1658.   }
  1659.   else
  1660.     Errorline("Wild_life could not allocate sufficient memory to run.\n\n");
  1661. }
  1662.  
  1663.  
  1664.  
  1665. /******** MEMORY_CHECK()
  1666.   This function tests to see whether enough memory is available to allow
  1667.   execution to continue.  It causes a garbage collection if not, and if that
  1668.   fails to release enough memory it returns FALSE.
  1669. */
  1670. long memory_check ()
  1671. {
  1672.   long success=TRUE;
  1673.   
  1674.   if (heap_pointer-stack_pointer < GC_THRESHOLD) {
  1675.     if(verbose) fprintf(stderr,"\n"); /*  RM: Feb  1 1993  */
  1676.     garbage();
  1677.     /* Abort if didn't recover at least GC_THRESHOLD/10 of memory */
  1678.     if (heap_pointer-stack_pointer < GC_THRESHOLD+GC_THRESHOLD/10) {
  1679.       fprintf(stderr,"*********************\n");
  1680.       fprintf(stderr,"*** OUT OF MEMORY ***\n");
  1681.       fprintf(stderr,"*********************\n");
  1682.       fail_all();
  1683.       success=FALSE;
  1684.     }
  1685.   }
  1686.   return success;
  1687. }
  1688.  
  1689.  
  1690.  
  1691.