Wild Life: copy.c Source File

Wild Life 2.30

- Main Page
- Data Structures
- Files

- File List
- Globals

All Data Structures Files Functions Variables Typedefs Macros
copy.c
Go to the documentation of this file.
1
10 /* Copyright 1991 Digital Equipment Corporation.
11 ** All Rights Reserved.
12 *****************************************************************/
13
14 #include "defs.h"
15
16 static struct hashentry hashtable[HASHSIZE];
17 static struct hashbucket *hashbuckets; /* Array of buckets */
18 static long hashtime; /* Currently valid timestamp */
19 static long hashfree; /* Index into array of buckets */
20 static long numbuckets; /* Total number of buckets; initially=NUMBUCKETS */
21
22 /* #define HASHSTATS 1000 20.8 */
23 /* long hashstats[HASHSTATS]; 20.8 */
24
32 void init_copy()
33 {
34 long i;
35
36 /* for(i=0; i<HASHSTATS; i++) hashstats[i]=0; 20.8 */
37
38 for(i=0; i<HASHSIZE; i++) hashtable[i].timestamp = 0;
39 hashtime = 0;
40 numbuckets = NUMBUCKETS;
41 hashbuckets = (struct hashbucket *)
42 malloc(NUMBUCKETS * sizeof(struct hashbucket));
43 }
44
53 void clear_copy()
54 {
55 hashtime++;
56 hashfree=0;
57 }
58
67 void insert_translation(ptr_psi_term a,ptr_psi_term b,long info)
68 {
69 long index;
70 long lastbucket;
71
72 /* Ensure there are free buckets by doubling their number if necessary */
73 if (hashfree >= numbuckets) {
74 numbuckets *= 2;
75 hashbuckets = (struct hashbucket *)
76 realloc((void *) hashbuckets, numbuckets * sizeof(struct hashbucket));
77 /* *** Do error handling here *** */
78 traceline("doubled the number of hashbuckets to %d\n", numbuckets);
79 }
80
81 /* Add a bucket to the beginning of the list */
82 index = HASH(a);
83 if (hashtable[index].timestamp == hashtime)
84 lastbucket = hashtable[index].bucketindex;
85 else {
86 lastbucket = HASHEND;
87 hashtable[index].timestamp = hashtime;
88 }
89 hashtable[index].bucketindex = hashfree;
90 hashbuckets[hashfree].old_value = a;
91 hashbuckets[hashfree].new_value = b;
92 hashbuckets[hashfree].info = info;
93 hashbuckets[hashfree].next = lastbucket;
94 hashfree++;
95 }
96
97
108 ptr_psi_term translate(ptr_psi_term a,long **infoptr) /* RM: Jan 27 1993 */
109 {
110 long index;
111 /* long i; 20.8 */
112 long bucket;
113
114 index = HASH(a);
115 if (hashtable[index].timestamp != hashtime) return NULL;
116 bucket = hashtable[index].bucketindex;
117 /* i=0; 20.8 */
118 while (bucket != HASHEND && hashbuckets[bucket].old_value != a) {
119 /* i++; 20.8 */
120 bucket = hashbuckets[bucket].next;
121 }
122 /* hashstats[i]++; 20.8 */
123 if (bucket != HASHEND) {
124 *infoptr = &hashbuckets[bucket].info;
125 return (hashbuckets[bucket].new_value);
126 }
127 else
128 return NULL;
129 }
130
131
132 /****************************************************************************/
133
134
148 static ptr_node copy_tree(ptr_node t, long copy_flag, long heap_flag)
149 {
150 ptr_node r;
151 ptr_psi_term t1,t2;
152
153 /* if (t) { RM: Dec 15 1992 this test is useless */
154
155 if (HEAPDONE(t)) return t;
156 r=NEW(t,node);
157 r->key = t->key;
158 r->left = (t->left) ? copy_tree(t->left,copy_flag,heap_flag) : NULL;
159 t1 = (ptr_psi_term)(t->data);
160 t2 = copy(t1,copy_flag,heap_flag);
161 r->data = (GENERIC) t2;
162 r->right = (t->right) ? copy_tree(t->right,copy_flag,heap_flag) : NULL;
163
164 /* } else r=NULL; */
165
166 return r;
167 }
168
176 ptr_psi_term exact_copy(ptr_psi_term t, long heap_flag)
177 { to_heap=FALSE; return (copy(t, EXACT_FLAG, heap_flag)); }
178
186 ptr_psi_term quote_copy(ptr_psi_term t, long heap_flag)
187 { to_heap=FALSE; return (copy(t, QUOTE_FLAG, heap_flag)); }
188
196 ptr_psi_term eval_copy(ptr_psi_term t, long heap_flag)
197 { to_heap=FALSE; return (copy(t, EVAL_FLAG, heap_flag)); }
198
206 ptr_psi_term inc_heap_copy(ptr_psi_term t)
207 { to_heap=TRUE; return (copy(t, EXACT_FLAG, TRUE)); }
208
209 static long curr_status;
210
248 ptr_psi_term copy(ptr_psi_term t, long copy_flag, long heap_flag)
249 {
250 ptr_psi_term u;
251 long old_status;
252 long local_copy_flag;
253 long *infoptr;
254
255
256 if ((u=t)) {
257 deref_ptr(t); /* Always dereference when copying */
258
259 if (HEAPDONE(t)) return t;
260 u = translate(t,&infoptr);
261
262 if (u && *infoptr!=QUOTE_STUB) { /* 24.8 */
263 /* If it was eval-copied before, then quote it now. */
264 if (*infoptr==EVAL_FLAG && copy_flag==QUOTE_FLAG) { /* 24.8 25.8 */
265 mark_quote_c(t,heap_flag);
266 *infoptr=QUOTE_FLAG; /* I.e. don't touch this term any more */
267 }
268 if (copy_flag==EVAL_FLAG) { /* PVR 14.2.94 */
269 /* If any subterm has zero curr_status (i.e., if u->status==0),
270 then so does the whole term: */
271 old_status=curr_status;
272 curr_status=u->status;
273 if (curr_status) curr_status=old_status;
274 }
275 }
276 else {
277 if (heap_pointer-stack_pointer < COPY_THRESHOLD) {
278 Errorline("psi-term too large -- get a bigger Life!\n");
279 (void)abort_life(TRUE);
280 longjmp(env,FALSE); /* Back to main loop */ /* RM: Feb 15 1993 */
281 }
282 if (copy_flag==EVAL_FLAG && !t->type->evaluate_args) /* 24.8 25.8 */
283 local_copy_flag=QUOTE_FLAG; /* All arguments will be quoted 24.8 */
284 else /* 24.8 */
285 local_copy_flag=copy_flag;
286 if (copy_flag==EVAL_FLAG) {
287 old_status = curr_status;
288 curr_status = 4;
289 }
290 if (u) { /* 15.9 */
291 *infoptr=QUOTE_FLAG;
292 local_copy_flag=QUOTE_FLAG;
293 copy_flag=QUOTE_FLAG;
294 }
295 else {
296 u=NEW(t,psi_term);
297 insert_translation(t,u,local_copy_flag); /* 24.8 */
298 }
299 *u = *t;
300 u->resid=NULL; /* 24.8 Don't copy residuations */
301 #ifdef TS
302 u->time_stamp=global_time_stamp; /* 9.6 */
303 #endif
304
305 if (t->attr_list)
306 u->attr_list=copy_tree(t->attr_list, local_copy_flag, heap_flag);
307
308 if (copy_flag==EVAL_FLAG) {
309 switch((long)t->type->type_def) {
310 case (long)type_it:
311 if (t->type->properties)
312 curr_status=0;
313 break;
314
315 case (long)function_it:
316 curr_status=0;
317 break;
318
319 case (long)global_it: /* RM: Feb 8 1993 */
320 curr_status=0;
321 break;
322
323 default:
324 break;
325 }
326 u->status=curr_status;
327 u->flags=curr_status?QUOTED_TRUE:FALSE; /* 14.9 */
328 /* If any subterm has zero curr_status,
329 then so does the whole term: */
330 if (curr_status) curr_status=old_status;
331 } else if (copy_flag==QUOTE_FLAG) {
332 u->status=4;
333 u->flags=QUOTED_TRUE; /* 14.9 */
334 }
335 /* else copy_flag==EXACT_FLAG & u->status=t->status */
336
337 if (heap_flag==HEAP) {
338 if (t->type==cut) u->value_3=NULL;
339 } else {
340 if (t->type==cut) {
341 u->value_3=(GENERIC)choice_stack;
342 traceline("current choice point is %x\n",choice_stack);
343 }
344 }
345 }
346 }
347
348 return u;
349 }
350
351
352
353 /****************************************************************************/
354
355
366 ptr_node distinct_tree(ptr_node t)
367 {
368 ptr_node n;
369
370 n=NULL;
371 if (t) {
372 n=STACK_ALLOC(node);
373 n->key=t->key;
374 n->data=t->data;
375 n->left=distinct_tree(t->left);
376 n->right=distinct_tree(t->right);
377 }
378
379 return n;
380 }
381
393 ptr_psi_term distinct_copy(ptr_psi_term t)
394 {
395 ptr_psi_term res;
396
397 res=STACK_ALLOC(psi_term);
398 *res= *t;
399 #ifdef TS
400 res->time_stamp=global_time_stamp; /* 9.6 */
401 #endif
402 /* res->coref=distinct_copy(t->coref); */
403 res->attr_list=distinct_tree(t->attr_list);
404
405 return res;
406 }
407
434 void mark_quote_c(ptr_psi_term t,long heap_flag)
435 {
436 // ptr_list l;
437 long *infoptr;
438 ptr_psi_term u;
439
440 if (t) {
441 deref_ptr(t);
442 u=translate(t,&infoptr);
443 /* assert(u!=NULL); 15.9 */
444 if (u) {
445 if (*infoptr==EVAL_FLAG) {
446 *infoptr=QUOTE_FLAG;
447 u->status=4;
448 u->flags=QUOTED_TRUE; /* 14.9 */
449 mark_quote_tree_c(t->attr_list,heap_flag);
450 }
451 }
452 else { /* u does not exist yet */ /* 15.9 */
453 /* Create a stub & mark it as to-be-quoted. */
454 u=NEW(t,psi_term);
455 insert_translation(t,u,QUOTE_STUB);
456 }
457 }
458 }
459
467 void mark_quote_tree_c(ptr_node n,long heap_flag)
468 {
469 if (n) {
470 mark_quote_tree_c(n->left,heap_flag);
471 mark_quote_c((ptr_psi_term) (n->data),heap_flag);
472 mark_quote_tree_c(n->right,heap_flag);
473 }
474 }
475
476 /****************************************************************************/
477
478
479 static long mark_nonstrict_flag;
480
498 void mark_eval(ptr_psi_term t) /* 24.8 25.8 */
499 {
500 clear_copy();
501 mark_nonstrict_flag=FALSE;
502 mark_eval_new(t);
503 }
504
513 void mark_nonstrict(ptr_psi_term t)
514 {
515 clear_copy();
516 mark_nonstrict_flag=TRUE;
517 mark_eval_new(t);
518 }
519
527 void mark_quote_new2(ptr_psi_term t)
528 {
529 clear_copy();
530 mark_nonstrict_flag=FALSE;
531 mark_quote_new(t);
532 }
533
540 void mark_eval_new(ptr_psi_term t)
541 {
542 long *infoptr,flag;
543 ptr_psi_term u;
544 long old_status;
545
546 if (t) {
547 deref_ptr(t);
548 flag = t->type->evaluate_args;
549 u=translate(t,&infoptr);
550 if (u) {
551 /* Quote the subgraph if it was already copied as to be evaluated. */
552 if (!flag && *infoptr) {
553 mark_quote_new(t);
554 *infoptr=FALSE;
555 }
556 /* If any subterm has zero curr_status (i.e., if t->status==0),
557 then so does the whole term: PVR 14.2.94 */
558 old_status=curr_status;
559 curr_status=(long)t->status;
560 if (curr_status) curr_status=old_status;
561 }
562 else {
563 insert_translation(t,(ptr_psi_term)TRUE,flag);
564 old_status=curr_status;
565 curr_status=4;
566
567 if (flag) /* 16.9 */
568 mark_eval_tree_new(t->attr_list);
569 else
570 mark_quote_tree_new(t->attr_list);
571
572 switch((long)t->type->type_def) {
573 case type_it:
574 if (t->type->properties)
575 curr_status=0;
576 break;
577
578 case function_it:
579 curr_status=0;
580 break;
581
582 case global_it: /* RM: Feb 8 1993 */
583 curr_status=0;
584 break;
585
586 default:
587 break;
588 }
589 if (mark_nonstrict_flag) { /* 25.8 */
590 if (curr_status) {
591 /* Only increase the status, never decrease it: */
592 t->status=curr_status;
593 }
594 }
595 else {
596 t->status=curr_status;
597 t->flags=curr_status?QUOTED_TRUE:FALSE; /* 14.9 */
598 }
599 /* If any subterm has zero curr_status, then so does the whole term: */
600 if (curr_status) curr_status=old_status;
601 }
602 }
603 }
604
611 void mark_eval_tree_new(ptr_node n)
612 {
613 if (n) {
614 mark_eval_tree_new(n->left);
615 mark_eval_new((ptr_psi_term) (n->data));
616 mark_eval_tree_new(n->right);
617 }
618 }
619
626 void mark_quote_new(ptr_psi_term t)
627 {
628 long *infoptr;
629 ptr_psi_term u;
630
631 if (t) {
632 deref_ptr(t);
633 u=translate(t,&infoptr);
634
635 /* Return if the subgraph is already quoted. */
636 if (u && !*infoptr) return;
637
638 /* Otherwise quote the subgraph */
639 if (!u) insert_translation(t,(ptr_psi_term)TRUE,FALSE);
640 else *infoptr = FALSE; /* sanjay */
641 t->status= 4;
642 t->flags=QUOTED_TRUE; /* 14.9 */
643 mark_quote_tree_new(t->attr_list);
644 }
645 }
646
653 void mark_quote_tree_new(ptr_node n)
654 {
655 if (n) {
656 mark_quote_tree_new(n->left);
657 mark_quote_new((ptr_psi_term) (n->data));
658 mark_quote_tree_new(n->right);
659 }
660 }
661
662 extern void mark_quote_tree(); /* A forward declaration */
663
674 void mark_quote(ptr_psi_term t)
675 {
676 if (t && !(t->status&RMASK)) {
677 t->status = 4;
678 t->flags=QUOTED_TRUE; /* 14.9 */
679 t->status |= RMASK;
680 mark_quote(t->coref);
681 mark_quote_tree(t->attr_list);
682 t->status &= ~RMASK;
683 }
684 }
685
692 void mark_quote_tree(ptr_node t)
693 {
694 if (t) {
695 mark_quote_tree(t->left);
696 mark_quote((ptr_psi_term) (t->data));
697 mark_quote_tree(t->right);
698 }
699 }
700
708 void bk_mark_quote(ptr_psi_term t)
709 {
710 if (t && !(t->status&RMASK)) {
711 if(t->status!=4 && (GENERIC)t<heap_pointer)/* RM: Jul 16 1993 */
712 push_ptr_value(int_ptr,(GENERIC *)&(t->status));
713 t->status = 4;
714 t->flags=QUOTED_TRUE; /* 14.9 */
715 t->status |= RMASK;
716 bk_mark_quote(t->coref);
717 bk_mark_quote_tree(t->attr_list);
718 t->status &= ~RMASK;
719 }
720 }
721
728 void bk_mark_quote_tree(ptr_node t)
729 {
730 if (t) {
731 bk_mark_quote_tree(t->left);
732 bk_mark_quote((ptr_psi_term) (t->data));
733 bk_mark_quote_tree(t->right);
734 }
735 }
736
737
738 /****************************************************************************/
hashtable
static struct hashentry hashtable[HASHSIZE]
Definition: copy.c:16
stack_pointer
GENERIC stack_pointer
used to allocate from stack - size allocated added - adj for alignment
Definition: def_glob.h:69
hashfree
static long hashfree
Definition: copy.c:19
COPY_THRESHOLD
#define COPY_THRESHOLD
Copy threshold (1/8 of GC_THRESHOLD is reasonable)
Definition: def_const.h:125
mark_eval_new
void mark_eval_new(ptr_psi_term t)
mark_eval_new
Definition: copy.c:540
NUMBUCKETS
#define NUMBUCKETS
Total number of buckets in initial hash table;.
Definition: def_const.h:1292
wl_psi_term::resid
ptr_residuation resid
Definition: def_struct.h:189
function_it
#define function_it
was enum (def_type) in extern.h now there is typedef ptr_definition
Definition: def_const.h:1408
push_ptr_value
void push_ptr_value(type_ptr t, GENERIC *p)
push_ptr_value
Definition: login.c:383
translate
ptr_psi_term translate(ptr_psi_term a, long **infoptr)
translate
Definition: copy.c:108
HEAP
#define HEAP
Flag to indicate heap allocation.
Definition: def_const.h:324
clear_copy
void clear_copy()
clear_copy
Definition: copy.c:53
heap_pointer
GENERIC heap_pointer
used to allocate from heap - size allocated subtracted - adj for alignment
Definition: def_glob.h:55
wl_definition::evaluate_args
char evaluate_args
Definition: def_struct.h:156
exact_copy
ptr_psi_term exact_copy(ptr_psi_term t, long heap_flag)
exact_copy
Definition: copy.c:176
cut
ptr_definition cut
symbol in syntax module
Definition: def_glob.h:242
numbuckets
static long numbuckets
Definition: copy.c:20
mark_quote_tree_c
void mark_quote_tree_c(ptr_node n, long heap_flag)
mark_quote_tree_c
Definition: copy.c:467
QUOTE_STUB
#define QUOTE_STUB
flag having to do with copying in copy.c
Definition: def_const.h:1328
EXACT_FLAG
#define EXACT_FLAG
flag to copy function in copy.c to indicate kind of copy
Definition: def_const.h:1306
bk_mark_quote_tree
void bk_mark_quote_tree(ptr_node t)
bk_mark_quote_tree
Definition: copy.c:728
wl_definition::type_def
def_type type_def
Definition: def_struct.h:153
defs.h
includes
wl_psi_term
Definition: def_struct.h:177
HASHEND
#define HASHEND
Tail of hash bucket.
Definition: def_const.h:1299
mark_nonstrict
void mark_nonstrict(ptr_psi_term t)
mark_nonstrict
Definition: copy.c:513
ptr_psi_term
struct wl_psi_term * ptr_psi_term
quotedStackCopy
Definition: def_struct.h:62
insert_translation
void insert_translation(ptr_psi_term a, ptr_psi_term b, long info)
insert_translation
Definition: copy.c:67
global_it
#define global_it
was enum (def_type) in extern.h now there is typedef ptr_definition
Definition: def_const.h:1422
wl_node::data
GENERIC data
Definition: def_struct.h:201
NULL
#define NULL
Definition: def_const.h:533
distinct_tree
ptr_node distinct_tree(ptr_node t)
distinct_tree
Definition: copy.c:366
hashbucket::old_value
ptr_psi_term old_value
Definition: def_struct.h:385
NEW
#define NEW(A, TYPE)
Definition: def_macro.h:284
hashtime
static long hashtime
Definition: copy.c:18
mark_eval_tree_new
void mark_eval_tree_new(ptr_node n)
mark_eval_tree_new
Definition: copy.c:611
abort_life
long abort_life(int nlflag)
abort_life
Definition: built_ins.c:2259
wl_node::left
ptr_node left
Definition: def_struct.h:199
traceline
void traceline(char *format,...)
traceline
Definition: error.c:186
hashbucket::new_value
ptr_psi_term new_value
Definition: def_struct.h:386
type_it
#define type_it
was enum (def_type) in extern.h now there is typedef ptr_definition
Definition: def_const.h:1415
hashbucket::next
long next
Definition: def_struct.h:388
EVAL_FLAG
#define EVAL_FLAG
flag to copy function in copy.c to indicate kind of copy
Definition: def_const.h:1320
quote_copy
ptr_psi_term quote_copy(ptr_psi_term t, long heap_flag)
quote_copy
Definition: copy.c:186
Errorline
void Errorline(char *format,...)
Errorline.
Definition: error.c:465
GENERIC
unsigned long * GENERIC
unsigned long *GENERIC
Definition: def_struct.h:35
deref_ptr
#define deref_ptr(P)
Definition: def_macro.h:100
bk_mark_quote
void bk_mark_quote(ptr_psi_term t)
bk_mark_quote
Definition: copy.c:708
wl_node::key
char * key
Definition: def_struct.h:198
distinct_copy
ptr_psi_term distinct_copy(ptr_psi_term t)
distinct_copy
Definition: copy.c:393
TRUE
#define TRUE
Standard boolean.
Definition: def_const.h:268
mark_quote_tree_new
void mark_quote_tree_new(ptr_node n)
mark_quote_tree_new
Definition: copy.c:653
copy
ptr_psi_term copy(ptr_psi_term t, long copy_flag, long heap_flag)
copy
Definition: copy.c:248
RMASK
#define RMASK
Bit mask for status field of psi-terms: RMASK is used as a flag to avoid infinite loops when tracing ...
Definition: def_const.h:359
copy_tree
static ptr_node copy_tree(ptr_node t, long copy_flag, long heap_flag)
ptr_node copy_tree
Definition: copy.c:148
mark_eval
void mark_eval(ptr_psi_term t)
mark_eval
Definition: copy.c:498
curr_status
static long curr_status
Definition: copy.c:209
to_heap
long to_heap
Definition: def_glob.h:905
FALSE
#define FALSE
Standard boolean.
Definition: def_const.h:275
wl_psi_term::value_3
GENERIC value_3
Definition: def_struct.h:186
mark_quote_c
void mark_quote_c(ptr_psi_term t, long heap_flag)
mark_quote_c
Definition: copy.c:434
hashentry::timestamp
long timestamp
Definition: def_struct.h:392
wl_psi_term::coref
ptr_psi_term coref
Definition: def_struct.h:188
hashentry
Definition: def_struct.h:391
hashbuckets
static struct hashbucket * hashbuckets
Definition: copy.c:17
mark_quote_new
void mark_quote_new(ptr_psi_term t)
mark_quote_new
Definition: copy.c:626
inc_heap_copy
ptr_psi_term inc_heap_copy(ptr_psi_term t)
inc_heap_copy
Definition: copy.c:206
STACK_ALLOC
#define STACK_ALLOC(A)
Definition: def_macro.h:21
mark_quote
void mark_quote(ptr_psi_term t)
mark_quote
Definition: copy.c:674
hashentry::bucketindex
long bucketindex
Definition: def_struct.h:393
wl_psi_term::status
long status
Definition: def_struct.h:182
wl_psi_term::flags
long flags
Definition: def_struct.h:185
hashbucket::info
long info
Definition: def_struct.h:387
env
jmp_buf env
Definition: def_glob.h:877
mark_nonstrict_flag
static long mark_nonstrict_flag
Definition: copy.c:479
HASH
#define HASH(A)
Definition: def_macro.h:278
global_time_stamp
unsigned long global_time_stamp
Definition: login.c:28
HEAPDONE
#define HEAPDONE(R)
Definition: def_macro.h:296
QUOTE_FLAG
#define QUOTE_FLAG
flag to copy function in copy.c to indicate kind of copy
Definition: def_const.h:1313
eval_copy
ptr_psi_term eval_copy(ptr_psi_term t, long heap_flag)
eval_copy
Definition: copy.c:196
wl_node
Definition: def_struct.h:197
hashbucket
Definition: def_struct.h:384
wl_psi_term::type
ptr_definition type
Definition: def_struct.h:181
wl_definition::properties
ptr_triple_list properties
Definition: def_struct.h:149
QUOTED_TRUE
#define QUOTED_TRUE
True flags for the flags field of psi-terms.
Definition: def_const.h:254
mark_quote_new2
void mark_quote_new2(ptr_psi_term t)
mark_quote_new2
Definition: copy.c:527
init_copy
void init_copy()
init_copy
Definition: copy.c:32
wl_psi_term::attr_list
ptr_node attr_list
Definition: def_struct.h:187
HASHSIZE
#define HASHSIZE
Size of hash table; must be a power of 2.
Definition: def_const.h:1284
mark_quote_tree
void mark_quote_tree()
choice_stack
ptr_choice_point choice_stack
Definition: def_glob.h:1026
wl_node::right
ptr_node right
Definition: def_struct.h:200
int_ptr
#define int_ptr
values of type_ptr
Definition: def_const.h:397