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

			UNSW Prolog (version 4)

			Written by Claude Sammut
		     Department of Computer Science
		     University of New South Wales
		   (and St. Joseph's U., Philadelphia)

		   Copyright (c)  1983 - Claude Sammut

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





		/* MEMORY ALLOCATION ROUTINES */


#include <stdio.h>
#include "g.h"

extern	compterm *record();
extern integer *stack_int;
extern char *malloc();



char *alloc(size)
unsigned size;
{
	register char *ptr;

	if((ptr = malloc((unsigned) size)) == NULL)
	{
		warning("malloc: out of core");
		exit();
	}
	return ptr;
}


pval new(t)
register itemtype t;
{
	register pval rval; 

	switch(t)
	{
	   case STRING	:
	   case ATOM	: rval = (pval) alloc(sizeof(atom));
			  rval -> a.type = t;
			  rval -> a.traced = 0;
			  rval -> a.val = 0;
			  rval -> a.pred = 0;
			  rval -> a.op_t = NONOP;
			  rval -> a.link = 0;
			  break;
	   case VAR	: rval = (pval) alloc(sizeof(var));
			  rval -> v.type = t;
			  rval -> v.offset = 0;
			  break;
	   case INT	: rval =  (pval) alloc(sizeof(integer));
			  rval -> i.type = INT;
			  rval -> i.int_val = 0;
			  break;
	   case LIST	: rval = (pval) record(1);
			  rval -> c.type = LIST;
			  break;
	}
	return(rval);
}




compterm *record(n)
char n;
{
	register compterm *r;

	r =  (compterm *) alloc(sizeof(compterm) + n * WORD_LENGTH);
	r -> type = FN;
	r -> size = n;
	return(r);
}



clause *create(ngoals, nvars)
int ngoals;
int nvars;
{
	register clause *r;

	r = (clause *) alloc(sizeof(clause) + (1 + ngoals) * WORD_LENGTH);
	r -> type = CLAUSE;
	r -> nvars = nvars;
	r -> rest = 0;
	r -> goal[0] = r -> goal[ngoals + 1] = 0;
	return(r);
}


/*	Hash table use to uniquely store atoms	*/

atom *hashtable[HASHSIZE];

hash(string)
register char *string;
{
	register h = 0;

	while (*string)
		h += *string++;
	return(h & 0177);
}




pval intern(type, string, size)
itemtype type;
register char *string,size;
{
	register h;
	register atom *p;

	h = hash(string);
	for (p = hashtable[h]; p != 0; p = p -> link)
	{
		if (strcmp(string, p->name) != 0) continue;
		if (type == STRING)
		{
			if (TYPE(p) != STRING) continue;
		}
		else if (TYPE(p) == STRING) continue;
		return((pval) p);
	}
	p =  (atom *) new(type);
	p -> name = alloc(size);
	strcpy(p -> name, string);
	p -> link = hashtable[h];
	p -> lib = FALSE;
	p -> op_t = NONOP;
	p -> pred = 0;
	hashtable[h] = p;
	return((pval) p);
}




/*   Data structures to compute the offset for each variable	*/


extern pval error();

var **varcell;

var *variable(id)
register atom *id;
{
	extern atom *anon;
	extern int argn;
	register i;
	register var *rval;

	if (id != anon)
		for (i = 0; i < argn; i++)
			if (id == varcell[i] -> pname) return(varcell[i]);
	if (++argn > MAXVAR) error("TOO MANY VARIABLES IN CLAUSE", FALSE);
	varcell[argn-1] = rval = (var *) new(VAR);
	rval -> offset = argn - 1;
	rval -> pname = id;
	return(rval);
}




pval in_uniop(oper,opand)
pval oper,opand;
{
	pval rval;

	rval = (pval) record(1);
	rval -> c.term[0] = oper;
	rval -> c.term[1] = opand;
	return(rval);
}





pval in_biop(oper, opand1, opand2)
pval oper, opand1, opand2;
{
	pval rval;

	rval = (pval) record(2);
	rval -> c.term[0] = oper;
	rval -> c.term[1] = opand1;
	rval -> c.term[2] = opand2;
	return(rval);
}




clause 	*Q;
atom 	*same_proc = 0;

atom *add_clause(cl)
register clause *cl;
{
	register atom *a;
	register clause *p;
	extern int library, read_err;

	if (read_err) return(0);
	if (isatom(cl -> goal[0]))
		a = (atom *) cl -> goal[0];
	else if (iscompound(cl->goal[0]) && isatom(cl->goal[0]->c.term[0]))
		a = (atom *) (cl -> goal[0] -> c.term[0]);
	else error("Bad principal functor in clause head", FALSE);
	if (TYPE(a) == PREDEF || (a -> lib && ! library))
		error("can't redefine a predefined function", FALSE);
	if (a == same_proc)
	{
		Q -> rest = cl;
		Q = Q -> rest;
	}
	else {
		same_proc = a;
		if (a -> val == 0) Q = a -> val = cl;
		else {
			p = a -> val;
			while (p -> rest != 0) p = p -> rest;
			Q = p -> rest = cl;
		}
		a -> lib = library;
	}
	return(a);
}



	/*		Garbage disposal		*/


free_term(t)
pval t;
{
	register i, limit;

	if (t == 0) return;
	switch(TYPE(t))
	{
	   case FREE	:
	   case ATOM	:
	   case PREDEF	:
	   case STRING	: return;
	   case INT	: if (t == (pval) stack_int) return;
			  free(t);
			  return;
	   case VAR	: TYPE(t) = FREE;
			  free(t);
			  return;
	   case FN	:
#ifndef PRINC_VAR
			  i = 1;
			  break;
#endif
	   case LIST	: i = 0;
			  break;
	   case CLAUSE	: for (i = 0; t -> g.goal[i]; i++)
				free_term(t -> g.goal[i]);
			  free(t);
			  same_proc = (atom *) 0;
			  return;
	   default	: fprintf(stderr,
				  "\nProlog error: FREE - Unknown type %d\n",
				 TYPE(t));
			  exit();
	}

	limit = SIZE(t);
	while (i <= limit)
		free_term(t -> c.term[i++]);
	free(t);
}


free_proc(p)
clause *p;
{
	register clause *q;
	register i;

	while (p)
	{
		q = p;
		p = p -> rest;
		for (i = 0; q -> goal[i]; i++)
			free_term(q -> goal[i]);
		free(q);
	}
	same_proc = (atom *) 0;
}