home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / lifeos2.zip / LIFE-1.02 / SOURCE / COPY.C < prev    next >
C/C++ Source or Header  |  1996-06-04  |  19KB  |  732 lines
  1. /* Copyright 1991 Digital Equipment Corporation.
  2. ** All Rights Reserved.
  3. *****************************************************************/
  4. /*     $Id: copy.c,v 1.2 1994/12/08 23:21:30 duchier Exp $     */
  5.  
  6. #ifndef lint
  7. static char vcid[] = "$Id: copy.c,v 1.2 1994/12/08 23:21:30 duchier Exp $";
  8. #endif /* lint */
  9.  
  10. #include "extern.h"
  11. #include "memory.h"
  12. #include "parser.h"
  13. #include "trees.h"
  14. #include "login.h"
  15. #include "copy.h"
  16. /* #include <malloc.h> 11.9 */
  17.  
  18. jmp_buf env; /* To jump back to main() when copy(..) overflows */
  19.  
  20. /****************************************************************************/
  21.  
  22. /* New translation routines for Wild_Life                     */
  23. /* These routines work for any size structure.                */
  24. /* They are based on a hash table with buckets and timestamp. */
  25. /* This allows fast clearing of the table and fast insertion  */
  26. /* and lookup.                                                */
  27.  
  28. /* Size of hash table; must be a power of 2 */
  29. /* A big hash table means it is sparse and therefore fast */
  30. #define HASHSIZE 2048
  31.  
  32. /* Total number of buckets in initial hash table; */
  33. /* this is dynamically increased if necessary.    */
  34. #define NUMBUCKETS 1024
  35.  
  36. /* Simple hash function */
  37. #define HASH(A) (((long) A + ((long) A >> 3)) & (HASHSIZE-1))
  38.  
  39. /* Tail of hash bucket */
  40. #define HASHEND (-1)
  41.  
  42. struct hashbucket {
  43.    ptr_psi_term old_value;
  44.    ptr_psi_term new_value;
  45.    long info;
  46.    long next;
  47. };
  48.  
  49. struct hashentry {
  50.    long timestamp;
  51.    long bucketindex;
  52. };
  53.  
  54. static struct hashentry hashtable[HASHSIZE];
  55. static struct hashbucket *hashbuckets; /* Array of buckets */
  56. static long hashtime; /* Currently valid timestamp */
  57. static long hashfree; /* Index into array of buckets */
  58. static long numbuckets; /* Total number of buckets; initially=NUMBUCKETS */
  59.  
  60.  
  61. /* #define HASHSTATS 1000 20.8 */
  62. /* long hashstats[HASHSTATS]; 20.8 */
  63.  
  64.  
  65. /******** INIT_COPY()
  66.   Execute once upon startup of Wild_Life.
  67. */
  68. void init_copy()
  69. {
  70.   long i;
  71.  
  72.   /* for(i=0; i<HASHSTATS; i++) hashstats[i]=0; 20.8 */
  73.  
  74.   for(i=0; i<HASHSIZE; i++) hashtable[i].timestamp = 0;
  75.   hashtime = 0;
  76.   numbuckets = NUMBUCKETS;
  77.   hashbuckets = (struct hashbucket *)
  78.     malloc(NUMBUCKETS * sizeof(struct hashbucket));
  79. }
  80.  
  81.  
  82. /******** CLEAR_COPY()
  83.   Erase the hash table.
  84.   This must be done as a prelude to any copying operation.
  85. */
  86. void clear_copy()
  87. {
  88.   hashtime++;
  89.   hashfree=0;
  90. }
  91.  
  92.  
  93. /******** INSERT_TRANSLATION(a,b,info)
  94.   Add the translation of address A to address B in the translation table.
  95.   Also add an info field.
  96. */
  97. /* static */ void insert_translation(a,b,info)
  98. ptr_psi_term a;
  99. ptr_psi_term b;
  100. long info;
  101. {
  102.   long index;
  103.   long lastbucket;
  104.   
  105.   /* Ensure there are free buckets by doubling their number if necessary */
  106.   if (hashfree >= numbuckets) {
  107.     numbuckets *= 2;
  108.     hashbuckets = (struct hashbucket *) 
  109.       realloc((void *) hashbuckets, numbuckets * sizeof(struct hashbucket));
  110.     /* *** Do error handling here *** */
  111.     Traceline("doubled the number of hashbuckets to %d\n", numbuckets);
  112.   }
  113.  
  114.   /* Add a bucket to the beginning of the list */
  115.   index = HASH(a);
  116.   if (hashtable[index].timestamp == hashtime)
  117.     lastbucket = hashtable[index].bucketindex;
  118.   else {
  119.     lastbucket = HASHEND;
  120.     hashtable[index].timestamp = hashtime;
  121.   }
  122.   hashtable[index].bucketindex = hashfree;
  123.   hashbuckets[hashfree].old_value = a;
  124.   hashbuckets[hashfree].new_value = b;
  125.   hashbuckets[hashfree].info = info;
  126.   hashbuckets[hashfree].next = lastbucket;
  127.   hashfree++;
  128. }
  129.  
  130.  
  131. /******** TRANSLATE(a,info)
  132.   Get the translation of address A and the info field stored with it.
  133.   Return NULL if none is found.
  134. */
  135. /* static */ ptr_psi_term translate(a,infoptr)   /*  RM: Jan 27 1993  */
  136. ptr_psi_term a;
  137. long **infoptr;
  138. {
  139.   long index;
  140.   /* long i; 20.8 */
  141.   long bucket;
  142.  
  143.   index = HASH(a);
  144.   if (hashtable[index].timestamp != hashtime) return NULL;
  145.   bucket = hashtable[index].bucketindex;
  146.   /* i=0; 20.8 */
  147.   while (bucket != HASHEND && hashbuckets[bucket].old_value != a) {
  148.     /* i++; 20.8 */
  149.     bucket = hashbuckets[bucket].next;
  150.   }
  151.   /* hashstats[i]++; 20.8 */
  152.   if (bucket != HASHEND) {
  153.     *infoptr = &hashbuckets[bucket].info;
  154.     return (hashbuckets[bucket].new_value);
  155.   }
  156.   else
  157.     return NULL;
  158. }
  159.  
  160.  
  161. /****************************************************************************/
  162.  
  163.  
  164. /******** COPY_TREE(t)
  165.   Return a pointer to a copy of the binary tree t.
  166.   Structure sharing between trees is not preserved by this routine,
  167.   this is not a problem seeing that coreferences in the nodes will ensure
  168.   coherence.
  169. */
  170.  
  171. /* TRUE means: heap_flag==TRUE & only copy to heap those objects not */
  172. /* already on heap, i.e. incremental copy to heap.                   */
  173. long to_heap;
  174.  
  175. /* TRUE iff R is on the heap */
  176. #define ONHEAP(R) ((GENERIC)R>=heap_pointer)
  177.  
  178. /* Allocate a new record on the heap or stack if necessary: */
  179. #define NEW(A,TYPE) (heap_flag==HEAP \
  180.                     ? (to_heap \
  181.                       ? (ONHEAP(A) \
  182.                         ? A \
  183.                         : HEAP_ALLOC(TYPE) \
  184.                         ) \
  185.                       : HEAP_ALLOC(TYPE) \
  186.                       ) \
  187.                     : STACK_ALLOC(TYPE) \
  188.                     )
  189.  
  190. /* TRUE iff to_heap is TRUE & work is done, i.e. the term is on the heap. */
  191. #define HEAPDONE(R) (to_heap && ONHEAP(R))
  192.  
  193.  
  194. ptr_psi_term copy(); /* Forward declarations */
  195. void mark_quote_c();
  196.  
  197. static ptr_node copy_tree(t, copy_flag, heap_flag)
  198. ptr_node t;
  199. long copy_flag, heap_flag;
  200. {
  201.   ptr_node r;
  202.   ptr_psi_term t1,t2;
  203.  
  204.   /* if (t) {   RM: Dec 15 1992  this test is useless */
  205.   
  206.   if (HEAPDONE(t)) return t;
  207.   r=NEW(t,node);
  208.   r->key = t->key;
  209.   r->left  = (t->left)  ? copy_tree(t->left,copy_flag,heap_flag)  : NULL;
  210.   t1 = (ptr_psi_term)(t->data);
  211.   t2 = copy(t1,copy_flag,heap_flag);
  212.   r->data = (GENERIC) t2;
  213.   r->right = (t->right) ? copy_tree(t->right,copy_flag,heap_flag) : NULL;
  214.  
  215.   /* } else r=NULL; */
  216.  
  217.   return r;
  218. }
  219.  
  220.  
  221.  
  222. /******** COPY(t)
  223.   This is the workhorse of the interpreter (alas!).
  224.   All copy-related routines are non-interruptible by the garbage collector.
  225.   
  226.   Make a copy in the STACK or in the HEAP of psi_term t, which is located in
  227.   the HEAP.  A copy is done whenever invoking a rule, so it had better be fast.
  228.   This routine uses hash tables with buckets and partial inlining for speed.
  229.  
  230.   The following three versions of copy all rename their variables and return
  231.   a completely dereferenced object:
  232.  
  233.   u=exact_copy(t,hf)  u is an exact copy of t.
  234.   u=quote_copy(t,hf)  u is a copy of t that is recursively marked evaluated.
  235.   u=eval_copy(t,hf)   u is a copy of t that is recursively marked unevaluated.
  236.  
  237.   This version of copy is an incremental copy to the heap.  It copies only
  238.   those parts of a psi_term that are on the stack, leaving the others
  239.   unchanged:
  240.  
  241.   u=inc_heap_copy(t)  u is an exact copy of t, on the heap.  This is like
  242.                       hf==HEAP, except that objects already on the heap are
  243.                       untouched.  Relies on no pointers from heap to stack.
  244.  
  245.   hf = heap_flag.  hf = HEAP or STACK means allocate in the HEAP or STACK.
  246.   Marking eval/uneval is done by modifying the STATUS field of the copied
  247.   psi_term.
  248.   In eval_copy, a term's status is set to 0 if the term or any subterm needs
  249.   evaluation.
  250.   Terms are dereferenced when copying them to the heap.
  251. */
  252.  
  253. #define EXACT_FLAG 0
  254. #define QUOTE_FLAG 1
  255. #define EVAL_FLAG  2
  256. /* See mark_quote_c: */ /* 15.9 */
  257. #define QUOTE_STUB 3
  258.  
  259. ptr_psi_term exact_copy(t, heap_flag)
  260. ptr_psi_term t;
  261. long heap_flag;
  262. { to_heap=FALSE; return (copy(t, EXACT_FLAG, heap_flag)); }
  263.  
  264. ptr_psi_term quote_copy(t, heap_flag)
  265. ptr_psi_term t;
  266. long heap_flag;
  267. { to_heap=FALSE; return (copy(t, QUOTE_FLAG, heap_flag)); }
  268.  
  269. ptr_psi_term eval_copy(t, heap_flag)
  270. ptr_psi_term t;
  271. long heap_flag;
  272. { to_heap=FALSE; return (copy(t, EVAL_FLAG, heap_flag)); }
  273.  
  274. /* There is a bug in inc_heap_copy */
  275. ptr_psi_term inc_heap_copy(t)
  276. ptr_psi_term t;
  277. { to_heap=TRUE; return (copy(t, EXACT_FLAG, TRUE)); }
  278.  
  279. static long curr_status;
  280.  
  281.  
  282.  
  283. ptr_psi_term copy(t, copy_flag, heap_flag)
  284.      ptr_psi_term t;
  285.      long copy_flag,heap_flag;
  286. {
  287.   ptr_psi_term u;
  288.   long old_status;
  289.   long local_copy_flag;
  290.   long *infoptr;
  291.  
  292.   
  293.   if (u=t) {    
  294.     deref_ptr(t); /* Always dereference when copying */
  295.     
  296.     if (HEAPDONE(t)) return t;
  297.     u = translate(t,&infoptr);
  298.     
  299.     if (u && *infoptr!=QUOTE_STUB) { /* 24.8 */
  300.       /* If it was eval-copied before, then quote it now. */
  301.       if (*infoptr==EVAL_FLAG && copy_flag==QUOTE_FLAG) { /* 24.8 25.8 */
  302.     mark_quote_c(t,heap_flag);
  303.     *infoptr=QUOTE_FLAG; /* I.e. don't touch this term any more */
  304.       }
  305.       if (copy_flag==EVAL_FLAG) { /* PVR 14.2.94 */
  306.     /* If any subterm has zero curr_status (i.e., if u->status==0),
  307.        then so does the whole term: */
  308.     old_status=curr_status;
  309.     curr_status=u->status;
  310.     if (curr_status) curr_status=old_status;
  311.       }
  312.     }
  313.     else {
  314.       if (heap_pointer-stack_pointer < COPY_THRESHOLD) {
  315.     Errorline("psi-term too large -- get a bigger Life!\n");
  316.     abort_life(TRUE);
  317.     longjmp(env,FALSE); /* Back to main loop */ /*  RM: Feb 15 1993  */
  318.       }
  319.       if (copy_flag==EVAL_FLAG && !t->type->evaluate_args) /* 24.8 25.8 */
  320.     local_copy_flag=QUOTE_FLAG; /* All arguments will be quoted 24.8 */
  321.       else /* 24.8 */
  322.     local_copy_flag=copy_flag;
  323.       if (copy_flag==EVAL_FLAG) {
  324.     old_status = curr_status;
  325.     curr_status = 4;
  326.       }
  327.       if (u) { /* 15.9 */
  328.     *infoptr=QUOTE_FLAG;
  329.     local_copy_flag=QUOTE_FLAG;
  330.     copy_flag=QUOTE_FLAG;
  331.       }
  332.       else {
  333.     u=NEW(t,psi_term);
  334.     insert_translation(t,u,local_copy_flag); /* 24.8 */
  335.       }
  336.       *u = *t;
  337.       u->resid=NULL; /* 24.8 Don't copy residuations */
  338. #ifdef TS
  339.       u->time_stamp=global_time_stamp; /* 9.6 */
  340. #endif
  341.       
  342.       if (t->attr_list)
  343.     u->attr_list=copy_tree(t->attr_list, local_copy_flag, heap_flag);
  344.       
  345.       if (copy_flag==EVAL_FLAG) {
  346.     switch(t->type->type) {
  347.     case type:
  348.       if (t->type->properties)
  349.         curr_status=0;
  350.       break;
  351.       
  352.     case function:
  353.       curr_status=0;
  354.       break;
  355.  
  356.     case global: /*  RM: Feb  8 1993  */
  357.       curr_status=0;
  358.       break;
  359.  
  360.     default:
  361.       break;
  362.     }
  363.     u->status=curr_status;
  364.     u->flags=curr_status?QUOTED_TRUE:FALSE; /* 14.9 */
  365.     /* If any subterm has zero curr_status,
  366.        then so does the whole term: */
  367.     if (curr_status) curr_status=old_status;
  368.       } else if (copy_flag==QUOTE_FLAG) {
  369.     u->status=4;
  370.     u->flags=QUOTED_TRUE; /* 14.9 */
  371.       }
  372.       /* else copy_flag==EXACT_FLAG & u->status=t->status */
  373.       
  374.       if (heap_flag==HEAP) {
  375.     if (t->type==cut) u->value=NULL;
  376.       }    else {
  377.     if (t->type==cut) {
  378.       u->value=(GENERIC)choice_stack;
  379.       Traceline("current choice point is %x\n",choice_stack);
  380.     }
  381.       }
  382.     }
  383.   }
  384.  
  385.   return u;
  386. }
  387.  
  388.  
  389.  
  390. /****************************************************************************/
  391.  
  392.  
  393. /******** DISTINCT_TREE(t)
  394.   Return an exact copy of an attribute tree.
  395.   This is used by APPLY in order to build the calling psi-term which is used
  396.   for matching.
  397. */
  398. ptr_node distinct_tree(t)
  399. ptr_node t;
  400. {
  401.   ptr_node n;
  402.   
  403.   n=NULL;
  404.   if (t) {
  405.     n=STACK_ALLOC(node);
  406.     n->key=t->key;
  407.     n->data=t->data;
  408.     n->left=distinct_tree(t->left);
  409.     n->right=distinct_tree(t->right);
  410.   }
  411.  
  412.   return n;
  413. }
  414.  
  415.  
  416. /******** DISTINCT_COPY(t)
  417.   Make a distinct copy of T and T's attribute tree, which are identical to T,
  418.   only located elsewhere in memory. This is used by apply to build the calling
  419.   psi-term which is used for matching.  Note that this routine is not
  420.   recursive, i.e. it only copies the main functor & the attribute tree.
  421. */
  422. ptr_psi_term distinct_copy(t)
  423. ptr_psi_term t;
  424. {
  425.   ptr_psi_term res;
  426.  
  427.   res=STACK_ALLOC(psi_term);
  428.   *res= *t;
  429. #ifdef TS
  430.   res->time_stamp=global_time_stamp; /* 9.6 */
  431. #endif
  432.   /* res->coref=distinct_copy(t->coref); */
  433.   res->attr_list=distinct_tree(t->attr_list);
  434.  
  435.   return res;
  436. }
  437.  
  438.  
  439. /****************************************************************************/
  440.  
  441. /* The new mark_quote to be used from copy. */
  442.  
  443. extern void mark_quote_tree_c(); /* A forward declaration */
  444.  
  445. /* Meaning of the info field in the translation table: */
  446. /* With u=translate(t,&infoptr): */
  447. /* If infoptr==QUOTE_FLAG then the whole subgraph from u is quoted. */
  448. /* If infoptr==EVAL_FLAG then anything is possible. */
  449. /* If infoptr==QUOTE_STUB then the term does not exist yet, e.g., there  */
  450. /* is a cycle in the term & copy(...) has not created it yet, for  */
  451. /* example X:s(L,t(X),R), where non_strict(t), in which R does not */
  452. /* exist when the call to mark_quote_c is done.  When the term is  */
  453. /* later created, it must be created as quoted. */
  454.  
  455. /* Mark a psi-term u (which is a copy of t) as completely evaluated. */
  456. /* Only t is given as the argument. */
  457. /* Assumes the psi-term is a copy of another psi-term t, which is made through */
  458. /* eval_copy.  Therefore the copy is accessible through the translation table. */
  459. /* Assumes all translation table entries already exist. */
  460. /* The infoptr field is updated so that each subgraph is only traversed once. */
  461. /* This routine is called only from the main copy routine. */
  462. void mark_quote_c(t,heap_flag)
  463. ptr_psi_term t;
  464. long heap_flag;
  465. {
  466.   ptr_list l;
  467.   long *infoptr;
  468.   ptr_psi_term u;
  469.  
  470.   if (t) {
  471.     deref_ptr(t);
  472.     u=translate(t,&infoptr);
  473.     /* assert(u!=NULL); 15.9 */
  474.     if (u) {
  475.       if (*infoptr==EVAL_FLAG) {
  476.         *infoptr=QUOTE_FLAG;
  477.         u->status=4;
  478.         u->flags=QUOTED_TRUE; /* 14.9 */
  479.         mark_quote_tree_c(t->attr_list,heap_flag);
  480.       }
  481.     }
  482.     else { /* u does not exist yet */ /* 15.9 */
  483.       /* Create a stub & mark it as to-be-quoted. */
  484.       u=NEW(t,psi_term);
  485.       insert_translation(t,u,QUOTE_STUB);
  486.     }
  487.   }
  488. }
  489.  
  490. void mark_quote_tree_c(n,heap_flag)
  491. ptr_node n;
  492. long heap_flag;
  493. {
  494.   if (n) {
  495.     mark_quote_tree_c(n->left,heap_flag);
  496.     mark_quote_c((ptr_psi_term) (n->data),heap_flag);
  497.     mark_quote_tree_c(n->right,heap_flag);
  498.   }
  499. }
  500.  
  501. /****************************************************************************/
  502.  
  503. /* A (possibly) correct mark_eval and its companion mark_quote. */
  504.  
  505. /* The translation table is used to record whether a subgraph has already */
  506. /* been quoted or not. */
  507.  
  508. /* Forward declarations */
  509. void mark_eval_new();
  510. void mark_quote_new();
  511. void mark_eval_tree_new();
  512. void mark_quote_tree_new();
  513.  
  514. static long mark_nonstrict_flag;
  515.  
  516. /* Mark a psi-term as to be evaluated (i.e. strict), except for arguments   */
  517. /* of a nonstrict term, which are marked quoted.  Set status correctly and  */
  518. /* propagate zero status upwards.  Avoid doing superfluous work: non-shared */
  519. /* terms are traversed once; shared terms are traversed at most twice (this */
  520. /* only occurs if the first occurrence encountered is strict and a later    */
  521. /* occurrence is nonstrict).  The translation table is used to indicate (1) */
  522. /* whether a term has already been traversed, and if so, (2) whether there  */
  523. /* was a nonstrict traversal (in that case, the info field is FALSE). */
  524. void mark_eval(t) /* 24.8 25.8 */
  525. ptr_psi_term t;
  526. {
  527.   clear_copy();
  528.   mark_nonstrict_flag=FALSE;
  529.   mark_eval_new(t);
  530. }
  531.  
  532. /* Same as above, except that the status is only changed from 0 to 4 when */
  533. /* needed; it is never changed from 4 to 0. */
  534. void mark_nonstrict(t)
  535. ptr_psi_term t;
  536. {
  537.   clear_copy();
  538.   mark_nonstrict_flag=TRUE;
  539.   mark_eval_new(t);
  540. }
  541.  
  542. /* Mark a term as quoted. */
  543. void mark_quote_new2(t)
  544. ptr_psi_term t;
  545. {
  546.   clear_copy();
  547.   mark_nonstrict_flag=FALSE;
  548.   mark_quote_new(t);
  549. }
  550.  
  551. void mark_eval_new(t)
  552. ptr_psi_term t;
  553. {
  554.   ptr_list l;
  555.   long *infoptr,flag;
  556.   ptr_psi_term u;
  557.   long old_status;
  558.  
  559.   if (t) {
  560.     deref_ptr(t);
  561.     flag = t->type->evaluate_args;
  562.     u=translate(t,&infoptr);
  563.     if (u) {
  564.       /* Quote the subgraph if it was already copied as to be evaluated. */
  565.       if (!flag && *infoptr) {
  566.         mark_quote_new(t);
  567.         *infoptr=FALSE;
  568.       }
  569.       /* If any subterm has zero curr_status (i.e., if t->status==0),
  570.      then so does the whole term: PVR 14.2.94 */
  571.       old_status=curr_status;
  572.       curr_status=t->status;
  573.       if (curr_status) curr_status=old_status;
  574.     }
  575.     else {
  576.       insert_translation(t,(ptr_psi_term)TRUE,flag);
  577.       old_status=curr_status;
  578.       curr_status=4;
  579.  
  580.       if (flag) /* 16.9 */
  581.         mark_eval_tree_new(t->attr_list);
  582.       else
  583.     mark_quote_tree_new(t->attr_list);
  584.  
  585.       switch(t->type->type) {
  586.       case type:
  587.         if (t->type->properties)
  588.           curr_status=0;
  589.         break;
  590.     
  591.       case function:
  592.         curr_status=0;
  593.         break;
  594.  
  595.       case global: /*  RM: Feb  8 1993  */
  596.         curr_status=0;
  597.         break;
  598.  
  599.       default:
  600.     break;
  601.       }
  602.       if (mark_nonstrict_flag) { /* 25.8 */
  603.         if (curr_status) {
  604.           /* Only increase the status, never decrease it: */
  605.           t->status=curr_status;
  606.         }
  607.       }
  608.       else {
  609.         t->status=curr_status;
  610.         t->flags=curr_status?QUOTED_TRUE:FALSE; /* 14.9 */
  611.       }
  612.       /* If any subterm has zero curr_status, then so does the whole term: */
  613.       if (curr_status) curr_status=old_status;
  614.     }
  615.   }
  616. }
  617.  
  618. void mark_eval_tree_new(n)
  619. ptr_node n;
  620. {
  621.   if (n) {
  622.     mark_eval_tree_new(n->left);
  623.     mark_eval_new((ptr_psi_term) (n->data));
  624.     mark_eval_tree_new(n->right);
  625.   }
  626. }
  627.  
  628.  
  629. void mark_quote_new(t)
  630. ptr_psi_term t;
  631. {
  632.   ptr_list l;
  633.   long *infoptr;
  634.   ptr_psi_term u;
  635.  
  636.   if (t) {
  637.     deref_ptr(t);
  638.     u=translate(t,&infoptr);
  639.  
  640.     /* Return if the subgraph is already quoted. */
  641.     if (u && !*infoptr) return;
  642.  
  643.     /* Otherwise quote the subgraph */
  644.     if (!u) insert_translation(t,(ptr_psi_term)TRUE,FALSE);
  645.     else *infoptr = FALSE;    /* sanjay */
  646.     t->status=4;
  647.     t->flags=QUOTED_TRUE; /* 14.9 */
  648.     mark_quote_tree_new(t->attr_list);
  649.   }
  650. }
  651.  
  652.  
  653. void mark_quote_tree_new(n)
  654. ptr_node n;
  655. {
  656.   if (n) {
  657.     mark_quote_tree_new(n->left);
  658.     mark_quote_new((ptr_psi_term) (n->data));
  659.     mark_quote_tree_new(n->right);
  660.   }
  661. }
  662.  
  663.  
  664. /****************************************************************************/
  665.  
  666. /* A more efficient version of mark_quote */
  667. /* This version avoids using the translation table by setting a 'visited' */
  668. /* in the status field. */
  669.  
  670. extern void mark_quote_tree(); /* A forward declaration */
  671.  
  672. /* Mark a psi-term as completely evaluated. */
  673. void mark_quote(t)
  674. ptr_psi_term t;
  675. {
  676.   ptr_list l;
  677.  
  678.   if (t && !(t->status&RMASK)) {
  679.     t->status = 4;
  680.     t->flags=QUOTED_TRUE; /* 14.9 */
  681.     t->status |= RMASK;
  682.     mark_quote(t->coref);
  683.     mark_quote_tree(t->attr_list);
  684.     t->status &= ~RMASK;
  685.   }
  686. }
  687.  
  688. void mark_quote_tree(t)
  689. ptr_node t;
  690. {
  691.   if (t) {
  692.     mark_quote_tree(t->left);
  693.     mark_quote((ptr_psi_term) (t->data));
  694.     mark_quote_tree(t->right);
  695.   }
  696. }
  697.  
  698.  
  699. /* Back-trackably mark a psi-term as completely evaluated. */
  700.  
  701. void bk_mark_quote_tree();
  702.      
  703. void bk_mark_quote(t)
  704. ptr_psi_term t;
  705. {
  706.   ptr_list l;
  707.  
  708.   if (t && !(t->status&RMASK)) {
  709.     if(t->status!=4 && (GENERIC)t<heap_pointer)/*  RM: Jul 16 1993  */
  710.       push_ptr_value(int_ptr,&(t->status));
  711.     t->status = 4;
  712.     t->flags=QUOTED_TRUE; /* 14.9 */
  713.     t->status |= RMASK;
  714.     bk_mark_quote(t->coref);
  715.     bk_mark_quote_tree(t->attr_list);
  716.     t->status &= ~RMASK;
  717.   }
  718. }
  719.  
  720. void bk_mark_quote_tree(t)
  721. ptr_node t;
  722. {
  723.   if (t) {
  724.     bk_mark_quote_tree(t->left);
  725.     bk_mark_quote((ptr_psi_term) (t->data));
  726.     bk_mark_quote_tree(t->right);
  727.   }
  728. }
  729.  
  730.  
  731. /****************************************************************************/
  732.