copy.c

Go to the documentation of this file.

/* Copyright 1991 Digital Equipment Corporation.
** All Rights Reserved.
*****************************************************************/

#include "defs.h"

static struct hashentry hashtable[HASHSIZE];
static struct hashbucket *hashbuckets; /* Array of buckets */
static long hashtime; /* Currently valid timestamp */
static long hashfree; /* Index into array of buckets */
static long numbuckets; /* Total number of buckets; initially=NUMBUCKETS */

/* #define HASHSTATS 1000 20.8 */
/* long hashstats[HASHSTATS]; 20.8 */

void init_copy()
{
  long i;

  /* for(i=0; i<HASHSTATS; i++) hashstats[i]=0; 20.8 */

  for(i=0; i<HASHSIZE; i++) hashtable[i].timestamp = 0;
  hashtime = 0;
  numbuckets = NUMBUCKETS;
  hashbuckets = (struct hashbucket *)
    malloc(NUMBUCKETS * sizeof(struct hashbucket));
}

void clear_copy()
{
  hashtime++;
  hashfree=0;
}

void insert_translation(ptr_psi_term a,ptr_psi_term b,long info)
{
  long index;
  long lastbucket;
  
  /* Ensure there are free buckets by doubling their number if necessary */
  if (hashfree >= numbuckets) {
    numbuckets *= 2;
    hashbuckets = (struct hashbucket *) 
      realloc((void *) hashbuckets, numbuckets * sizeof(struct hashbucket));
    /* *** Do error handling here *** */
    traceline("doubled the number of hashbuckets to %d\n", numbuckets);
  }

  /* Add a bucket to the beginning of the list */
  index = HASH(a);
  if (hashtable[index].timestamp == hashtime)
    lastbucket = hashtable[index].bucketindex;
  else {
    lastbucket = HASHEND;
    hashtable[index].timestamp = hashtime;
  }
  hashtable[index].bucketindex = hashfree;
  hashbuckets[hashfree].old_value = a;
  hashbuckets[hashfree].new_value = b;
  hashbuckets[hashfree].info = info;
  hashbuckets[hashfree].next = lastbucket;
  hashfree++;
}


ptr_psi_term translate(ptr_psi_term a,long **infoptr)   /*  RM: Jan 27 1993  */
{
  long index;
  /* long i; 20.8 */
  long bucket;

  index = HASH(a);
  if (hashtable[index].timestamp != hashtime) return NULL;
  bucket = hashtable[index].bucketindex;
  /* i=0; 20.8 */
  while (bucket != HASHEND && hashbuckets[bucket].old_value != a) {
    /* i++; 20.8 */
    bucket = hashbuckets[bucket].next;
  }
  /* hashstats[i]++; 20.8 */
  if (bucket != HASHEND) {
    *infoptr = &hashbuckets[bucket].info;
    return (hashbuckets[bucket].new_value);
  }
  else
    return NULL;
}


/****************************************************************************/


static ptr_node copy_tree(ptr_node t, long copy_flag, long heap_flag)
{
  ptr_node r;
  ptr_psi_term t1,t2;

  /* if (t) {   RM: Dec 15 1992  this test is useless */
  
  if (HEAPDONE(t)) return t;
  r=NEW(t,node);
  r->key = t->key;
  r->left  = (t->left)  ? copy_tree(t->left,copy_flag,heap_flag)  : NULL;
  t1 = (ptr_psi_term)(t->data);
  t2 = copy(t1,copy_flag,heap_flag);
  r->data = (GENERIC) t2;
  r->right = (t->right) ? copy_tree(t->right,copy_flag,heap_flag) : NULL;

  /* } else r=NULL; */

  return r;
}

ptr_psi_term exact_copy(ptr_psi_term t, long heap_flag)
{ to_heap=FALSE; return (copy(t, EXACT_FLAG, heap_flag)); }

ptr_psi_term quote_copy(ptr_psi_term t, long heap_flag)
{ to_heap=FALSE; return (copy(t, QUOTE_FLAG, heap_flag)); }

ptr_psi_term eval_copy(ptr_psi_term t, long heap_flag)
{ to_heap=FALSE; return (copy(t, EVAL_FLAG, heap_flag)); }

ptr_psi_term inc_heap_copy(ptr_psi_term t)
{ to_heap=TRUE; return (copy(t, EXACT_FLAG, TRUE)); }

static long curr_status;

ptr_psi_term copy(ptr_psi_term t, long copy_flag, long heap_flag)
{
  ptr_psi_term u;
  long old_status;
  long local_copy_flag;
  long *infoptr;

  
  if ((u=t)) {    
    deref_ptr(t); /* Always dereference when copying */
    
    if (HEAPDONE(t)) return t;
    u = translate(t,&infoptr);
    
    if (u && *infoptr!=QUOTE_STUB) { /* 24.8 */
      /* If it was eval-copied before, then quote it now. */
      if (*infoptr==EVAL_FLAG && copy_flag==QUOTE_FLAG) { /* 24.8 25.8 */
    mark_quote_c(t,heap_flag);
    *infoptr=QUOTE_FLAG; /* I.e. don't touch this term any more */
      }
      if (copy_flag==EVAL_FLAG) { /* PVR 14.2.94 */
    /* If any subterm has zero curr_status (i.e., if u->status==0),
       then so does the whole term: */
    old_status=curr_status;
    curr_status=u->status;
    if (curr_status) curr_status=old_status;
      }
    }
    else {
      if (heap_pointer-stack_pointer < COPY_THRESHOLD) {
    Errorline("psi-term too large -- get a bigger Life!\n");
    (void)abort_life(TRUE);
    longjmp(env,FALSE); /* Back to main loop */ /*  RM: Feb 15 1993  */
      }
      if (copy_flag==EVAL_FLAG && !t->type->evaluate_args) /* 24.8 25.8 */
    local_copy_flag=QUOTE_FLAG; /* All arguments will be quoted 24.8 */
      else /* 24.8 */
    local_copy_flag=copy_flag;
      if (copy_flag==EVAL_FLAG) {
    old_status = curr_status;
    curr_status = 4;
      }
      if (u) { /* 15.9 */
    *infoptr=QUOTE_FLAG;
    local_copy_flag=QUOTE_FLAG;
    copy_flag=QUOTE_FLAG;
      }
      else {
    u=NEW(t,psi_term);
    insert_translation(t,u,local_copy_flag); /* 24.8 */
      }
      *u = *t;
      u->resid=NULL; /* 24.8 Don't copy residuations */
#ifdef TS
      u->time_stamp=global_time_stamp; /* 9.6 */
#endif
      
      if (t->attr_list)
    u->attr_list=copy_tree(t->attr_list, local_copy_flag, heap_flag);
      
      if (copy_flag==EVAL_FLAG) {   
    switch((long)t->type->type_def) {
    case (long)type_it:
      if (t->type->properties)
        curr_status=0;
      break;
      
    case (long)function_it:
      curr_status=0;
      break;

    case (long)global_it: /*  RM: Feb  8 1993  */
      curr_status=0;
      break;

    default:
      break;
    }
    u->status=curr_status;
    u->flags=curr_status?QUOTED_TRUE:FALSE; /* 14.9 */
    /* If any subterm has zero curr_status,
       then so does the whole term: */
    if (curr_status) curr_status=old_status;
      } else if (copy_flag==QUOTE_FLAG) {
    u->status=4;
    u->flags=QUOTED_TRUE; /* 14.9 */
      }
      /* else copy_flag==EXACT_FLAG & u->status=t->status */
      
      if (heap_flag==HEAP) {
    if (t->type==cut) u->value_3=NULL;
      } else {
    if (t->type==cut) {
      u->value_3=(GENERIC)choice_stack;
      traceline("current choice point is %x\n",choice_stack);
    }
      }
    }
  }

  return u;
}



/****************************************************************************/


ptr_node distinct_tree(ptr_node t)
{
  ptr_node n;
  
  n=NULL;
  if (t) {
    n=STACK_ALLOC(node);
    n->key=t->key;
    n->data=t->data;
    n->left=distinct_tree(t->left);
    n->right=distinct_tree(t->right);
  }

  return n;
}

ptr_psi_term distinct_copy(ptr_psi_term t)
{
  ptr_psi_term res;

  res=STACK_ALLOC(psi_term);
  *res= *t;
#ifdef TS
  res->time_stamp=global_time_stamp; /* 9.6 */
#endif
  /* res->coref=distinct_copy(t->coref); */
  res->attr_list=distinct_tree(t->attr_list);

  return res;
}

void mark_quote_c(ptr_psi_term t,long heap_flag)
{
  //  ptr_list l;
  long *infoptr;
  ptr_psi_term u;

  if (t) {
    deref_ptr(t);
    u=translate(t,&infoptr);
    /* assert(u!=NULL); 15.9 */
    if (u) {
      if (*infoptr==EVAL_FLAG) {
        *infoptr=QUOTE_FLAG;
        u->status=4;
        u->flags=QUOTED_TRUE; /* 14.9 */
        mark_quote_tree_c(t->attr_list,heap_flag);
      }
    }
    else { /* u does not exist yet */ /* 15.9 */
      /* Create a stub & mark it as to-be-quoted. */
      u=NEW(t,psi_term);
      insert_translation(t,u,QUOTE_STUB);
    }
  }
}

void mark_quote_tree_c(ptr_node n,long heap_flag)
{
  if (n) {
    mark_quote_tree_c(n->left,heap_flag);
    mark_quote_c((ptr_psi_term) (n->data),heap_flag);
    mark_quote_tree_c(n->right,heap_flag);
  }
}

/****************************************************************************/


static long mark_nonstrict_flag;

void mark_eval(ptr_psi_term t) /* 24.8 25.8 */
{
  clear_copy();
  mark_nonstrict_flag=FALSE;
  mark_eval_new(t);
}

void mark_nonstrict(ptr_psi_term t)
{
  clear_copy();
  mark_nonstrict_flag=TRUE;
  mark_eval_new(t);
}

void mark_quote_new2(ptr_psi_term t)
{
  clear_copy();
  mark_nonstrict_flag=FALSE;
  mark_quote_new(t);
}

void mark_eval_new(ptr_psi_term t)
{
  long *infoptr,flag;
  ptr_psi_term u;
  long old_status;

  if (t) {
    deref_ptr(t);
    flag = t->type->evaluate_args;
    u=translate(t,&infoptr);
    if (u) {
      /* Quote the subgraph if it was already copied as to be evaluated. */
      if (!flag && *infoptr) {
        mark_quote_new(t);
        *infoptr=FALSE;
      }
      /* If any subterm has zero curr_status (i.e., if t->status==0),
     then so does the whole term: PVR 14.2.94 */
      old_status=curr_status;
      curr_status=(long)t->status;
      if (curr_status) curr_status=old_status;
    }
    else {
      insert_translation(t,(ptr_psi_term)TRUE,flag);
      old_status=curr_status;
      curr_status=4;

      if (flag) /* 16.9 */
        mark_eval_tree_new(t->attr_list);
      else
    mark_quote_tree_new(t->attr_list);

      switch((long)t->type->type_def) {
      case type_it:
        if (t->type->properties)
          curr_status=0;
        break;
    
      case function_it:
        curr_status=0;
        break;

      case global_it: /*  RM: Feb  8 1993  */
        curr_status=0;
        break;

      default:
    break;
      }
      if (mark_nonstrict_flag) { /* 25.8 */
        if (curr_status) {
          /* Only increase the status, never decrease it: */
          t->status=curr_status;
        }
      }
      else {
        t->status=curr_status;
        t->flags=curr_status?QUOTED_TRUE:FALSE; /* 14.9 */
      }
      /* If any subterm has zero curr_status, then so does the whole term: */
      if (curr_status) curr_status=old_status;
    }
  }
}

void mark_eval_tree_new(ptr_node n)
{
  if (n) {
    mark_eval_tree_new(n->left);
    mark_eval_new((ptr_psi_term) (n->data));
    mark_eval_tree_new(n->right);
  }
}

void mark_quote_new(ptr_psi_term t)
{
  long *infoptr;
  ptr_psi_term u;

  if (t) {
    deref_ptr(t);
    u=translate(t,&infoptr);

    /* Return if the subgraph is already quoted. */
    if (u && !*infoptr) return;

    /* Otherwise quote the subgraph */
    if (!u) insert_translation(t,(ptr_psi_term)TRUE,FALSE);
    else *infoptr = FALSE;  /* sanjay */
    t->status= 4;
    t->flags=QUOTED_TRUE; /* 14.9 */
    mark_quote_tree_new(t->attr_list);
  }
}

void mark_quote_tree_new(ptr_node n)
{
  if (n) {
    mark_quote_tree_new(n->left);
    mark_quote_new((ptr_psi_term) (n->data));
    mark_quote_tree_new(n->right);
  }
}

extern void mark_quote_tree(); /* A forward declaration */

void mark_quote(ptr_psi_term t)
{
  if (t && !(t->status&RMASK)) {
    t->status = 4;
    t->flags=QUOTED_TRUE; /* 14.9 */
    t->status |= RMASK;
    mark_quote(t->coref);
    mark_quote_tree(t->attr_list);
    t->status &= ~RMASK;
  }
}

void mark_quote_tree(ptr_node t)
{
  if (t) {
    mark_quote_tree(t->left);
    mark_quote((ptr_psi_term) (t->data));
    mark_quote_tree(t->right);
  }
}

void bk_mark_quote(ptr_psi_term t)
{
  if (t && !(t->status&RMASK)) {
    if(t->status!=4 && (GENERIC)t<heap_pointer)/*  RM: Jul 16 1993  */
      push_ptr_value(int_ptr,(GENERIC *)&(t->status));
    t->status = 4;
    t->flags=QUOTED_TRUE; /* 14.9 */
    t->status |= RMASK;
    bk_mark_quote(t->coref);
    bk_mark_quote_tree(t->attr_list);
    t->status &= ~RMASK;
  }
}

void bk_mark_quote_tree(ptr_node t)
{
  if (t) {
    bk_mark_quote_tree(t->left);
    bk_mark_quote((ptr_psi_term) (t->data));
    bk_mark_quote_tree(t->right);
  }
}


/****************************************************************************/