/************************************************************************
*									*
*	The SB-Prolog System						*
*	Copyright SUNY at Stony Brook, 1986				*
*									*
************************************************************************/

/*-----------------------------------------------------------------
SB-Prolog is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY.  No author or distributor
accepts responsibility to anyone for the consequences of using it
or for whether it serves any particular purpose or works at all,
unless he says so in writing.  Refer to the SB-Prolog General Public
License for full details.

Everyone is granted permission to copy, modify and redistribute
SB-Prolog, but only under the conditions described in the
SB-Prolog General Public License.   A copy of this license is
supposed to have been given to you along with SB-Prolog so you
can know your rights and responsibilities.  It should be in a
file named COPYING.  Among other things, the copyright notice
and this notice must be preserved on all copies. 
------------------------------------------------------------------ */

/* load_work.c */

#include "sim.h"
#include "aux.h"
#include <stdio.h>
#define align(ptr) ptr = (byte *)(((long)ptr + 3) & 0xfffffffc)

/************************************************************************
*                                                                       *
*  The hash function uses the arity and character string associated     *
*  with a predicate, constant, or structure to find the proper bucket   *
*  (a bucket is a linked list within the pcs table) to insert or locate *
*  pcs entries.                                                         *
*                                                                       *
************************************************************************/

int hash(name, length, arity)  /* hashing function on name,returning a 
                        bucket number in the hash table       */
char *name;
short length;
char arity;
{
  int bucknum;

    bucknum = arity+1;
    if (length > 0) {   /* first */
	bucknum = bucknum + *name; 
	if (length > 1) {   /* last */
	    bucknum = (bucknum << 2) + *(name+length-1);
	    if (length > 2) {	/* middle */
		bucknum = (bucknum << 2) + *(name+length/2);
		if (length > 3) {
		    bucknum = (bucknum << 2) + *(name+(length/2)-1);
		}
	    }
	}
    }
    return (abs(bucknum % bucket_chain));

}  /* hash */



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

word *search( name, length, arity, hash_ptr )
char *name, arity;
short length;
word *hash_ptr;

{ /* search */
  struct psc_rec *hash_psc;
  struct booleans
     {  unsigned eq   : 1;
        unsigned stop : 1;
     } flag;

  unsigned short i;

  flag.eq = false;
  flag.stop = false;

  while (!isfree(hash_ptr) && flag.stop == false) {
      hash_ptr = (pw)follow(hash_ptr); /* pointer to pair */
      hash_psc = (struct psc_rec *)follow(hash_ptr); /* pointer to psc ent */
      if ( (arity  == get_arity(hash_psc) ) &&
           (length == get_length(hash_psc) ) ) {
         flag.eq = true;
         for ( i=0; ((i < length) && (flag.eq == true)); i++ ) {
            if ( *(name + i) != *(get_name(hash_psc) + i) ) {
                flag.eq = false;
            }
         } /* for */
      }
      if (flag.eq == true) flag.stop = true;
      else hash_ptr++;
  }

  return hash_ptr;
}   /* search */


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


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

word *insert_temp(name, length, hash_ptr)
char *name;
short length;
word *hash_ptr;

{ /* insert_temp */
  struct psc_rec *temp;
  word  *new_pair;
  register char *threg;
  int i;

  new_pair = hreg++;
  follow(hash_ptr) = (word)new_pair;
  pushtrail((word)hash_ptr);	    /* trail for backtracking */
  make_free(*hreg);		    /* 2nd of pair free */
  follow(new_pair) = (word)++hreg;   /* 1st of pair points to psc_rec */
  temp = (struct psc_rec *)hreg;    /* temp points to the psc entry */
  hreg += 2; /* reserve the space on the heap,  NO EP FIELD */

    /* make nameptr point to next available space on heap */

  get_etype(temp) = T_ORDI;
  get_arity(temp) = 0;
  get_length(temp) = length;
/*  get_name(temp) = name; */

    threg = (char *)hreg;
    get_name(temp) = threg; /*  copy name, since might write over it !! */
    for (i=0;i<length;i++) *(threg++) = *(name++);
    hreg = (word *)(((long)threg + 3) & 0xfffffffc);

  return new_pair;
}  /* insert_temp */


word *insert_perm(name, length, arity, hash_ptr)
char *name, arity;
short length;
word *hash_ptr;
 
{ /* insert_perm */
  struct psc_rec  *temp;
  word *new_pair;
  int i;

  align(curr_fence);
  new_pair = (word *)curr_fence; 
  follow(hash_ptr) = (word)new_pair;	    /* prev link to here */
  curr_fence += 4;			    /* point to 2nd of pair */
  make_free(*(pw)curr_fence);		    /* set 2nd free */
  curr_fence += 4;			    /* where we'll put psc_rec */
  follow(new_pair) = (word)curr_fence;	    /* set 1st to point to psc_rec */
  temp = (struct psc_rec *)curr_fence;	    /* temp points there too */
  curr_fence += 12;	/* 12 bytes for psc_rec */
  
  get_etype(temp) = T_ORDI;
  get_arity(temp) = arity;
  get_length(temp) = length;
  get_name(temp) = (char *)curr_fence;
  for (i=0; i<length; i++) *(curr_fence++) = *(name++);

  curr_fence = (byte *)(((long)curr_fence + 1) & 0xfffffffe);
  if (curr_fence > max_fence) quit("Program area overflow\n");
  return new_pair;

}  /* insert_perm */

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


word *insert(name, length, arity, perm)
char *name, *perm, arity;
short length;
{
  int               bucket_no;
  word *temp_ptr, *perm_ptr, *perm_hashptr, *temp_hashptr, *ret_ptr;


    bucket_no = hash( name, length, arity);
    perm_hashptr = (word *)&hash_table[bucket_no][PERM];
    
    perm_ptr = search (name, length, arity, perm_hashptr);
    if (!isfree(perm_ptr))   	/* found perm psc record */
      {	if (!(*perm))
	   *perm = PERM;        /* set perm flag parameter */
	return perm_ptr;        /* return permanent */
      }

    temp_hashptr = (word *)&hash_table[bucket_no][TEMP];  /* look for temp */
    temp_ptr = search(name, length, arity, temp_hashptr);
    if (!isfree(temp_ptr))  	 	/* found temp psc record */
      { if (!(*perm))			/* Temporary wanted */
         {  return(temp_ptr); }	/* return ptr to psc record */
       else	/* Perm wanted - convert temp to perm */
        { /*printf("cvting temp to perm: %c %d %d\n", *name, length, arity);*/
	  perm_ptr = insert_perm(name,length,arity,perm_ptr);
	  follow(temp_ptr) = follow(perm_ptr);
          return(perm_ptr);
	}
      }
    else	/* Insert constant where indicated */
      { if (*perm) 
          { return insert_perm(name, length, arity, perm_ptr) ;}
        else
          { return insert_temp(name, length, temp_ptr);}
      }
}  /* insert */

/************************************?????????????????????*********/
set_temp_ep(pscrec, ep)
struct psc_rec *pscrec;
{
    if (ep >= 0) {
	get_etype(pscrec) = T_TEMP_PRED;
	get_ep(pscrec) = (byte *)ep;
    }
}

set_real_ep(psc_p, base)
char *base;
struct psc_rec *psc_p;
{
    if (get_etype(psc_p) == T_TEMP_PRED) {
	get_ep(psc_p) = (byte *) (base + (int)get_ep(psc_p)); /*???*/
	get_etype(psc_p) = T_PRED;
    }
}
    
/* set_file_ptr(pscrec, file_ptr)
struct psc_rec *pscrec;
FILE *file_ptr;
{
    get_etype(pscrec) = T_FILE;
    get_ep(pscrec) = (byte *) (file_ptr);
} */

/* unset_file_ptr(pscrec)
struct psc_rec *pscrec;
{
    get_etype(pscrec) = T_ORDI;
    get_ep(pscrec) = 0;
} */

namestring(p, s)
struct psc_rec *p;
char *s;
{
    int i;
    char *st;

    st = get_name(p);
    for (i=0; i<get_length(p); i++) *(s++) = *(st++);
    *s = 0;
}

alloc_perm(size, baddr)   /* size should be a multiple of 4 */
pw *baddr;
{
    struct psc_rec *ptr;

    align(curr_fence);
    *((int *)curr_fence) = (int) (curr_fence) + 4; /* fake 1st of pair */
    *baddr = (pw)curr_fence;
    curr_fence += 4;
    ptr = (struct psc_rec *)curr_fence;
    get_etype(ptr) = T_BUFF;
    get_arity(ptr) = 0;
    get_length(ptr) = size;
    get_name(ptr) = (char *)(curr_fence += 8); /* no ep */
    curr_fence += size;
    align(curr_fence);
    if (curr_fence > max_fence) quit("Program area overflow\n");
}