home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Vectronix 2
/
VECTRONIX2.iso
/
FILES_01
/
X_PROLOG.LZH
/
X_PROLOG
/
SOURCES
/
MEMORY.C
< prev
next >
Wrap
C/C++ Source or Header
|
1990-08-13
|
7KB
|
301 lines
/*
* X PROLOG Vers. 2.0
*
*
* Written by : Andreas Toenne
* CS Dept. , IRB
* University of Dortmund, W-Germany
* <at@unido.uucp>
* <....!seismo!unido!at>
* <at@unido.bitnet>
*
* Copyright : This software is copyrighted by Andreas Toenne.
* Permission is granted hereby to copy the entire
* package including this copyright notice without fee.
*
*/
#include "prolog.h"
#include "error.h"
#include "extern.h"
#ifdef VAX
#define lmalloc malloc
#endif
#define EVEN(x) (((long)(x) & ~(1L)) + 2) /* make adress even */
extern char *malloc();
extern char *lmalloc();
extern void panic(); /* error */
term **top_trail(); /* forward */
/*****************************************************************************/
/* Allocation of all data areas */
/*****************************************************************************/
void alloc_area(fu, cl, tr, pr, cp, st)
long fu,cl,tr,pr,cp,st;
{
long overall;
long i;
overall = fu+cl*sizeof(clause)+tr*sizeof(term *)+pr+cp+st+20;
if ((functorsp = lmalloc(overall)) == NULL)
panic(NOMEMORY);
functornext = functorsp;
functorfull = functorsp+fu;
clausesp = (clause *)EVEN(functorfull);
clausefree = (clause *)0L;
clausefull = cl;
clausenext = clausesp;
trailstack = (term **)EVEN(clausesp + cl);
trailtop = 0L;
trailfull = tr;
protostack = (char *)EVEN(trailstack+tr);
prototop = NULL;
protonext = (term *)protostack;
protofull = (char *)((long)protostack + pr);
for (i=0; i<=MAXARGS; i++)
protofree[i] = (term *)0L;
copystack = (char *)EVEN(protofull);
copytop = NULL;
copynext = (term *)copystack;
copyfull = (char *)((long)copystack + cp);
stack = (char *)EVEN(copyfull);
stacktop = stack;
stackfull = stack+st;
Backpoint = (backlog *)0L;
Topenv = Preenv = (env *)0L;
}
/*****************************************************************************/
/* FUNCTORS */
/*****************************************************************************/
functor *make_functor(name)
char *name;
{
functor *f;
short i;
i = sizeof(functor)+strlen(name);
if ((long)functornext+i > (long)functorfull)
panic(FUNCTORFULL);
f = (functor *)functornext;
strcpy(f->name, name);
functornext += i;
if ((long)functornext & 0x1) /* odd address */
functornext++;
return(f);
}
/******************************************************************************/
/* TERMS */
/******************************************************************************/
term *push_proto(nargs)
short nargs;
{
if (protofree[nargs]) /* got a used element */
{
term *t;
t = protofree[nargs];
protofree[nargs] = ARG(t,0); /* unlink first free */
return(t);
}
prototop = protonext; /* make new element */
protonext = (term *) ((long)protonext + sizeof(term) +
nargs*sizeof(term *));
if ((long)protonext > (long)protofull)
panic(PROTOFULL);
return(prototop);
}
term *push_copy(nargs)
short nargs;
{
copytop = copynext; /* make new element */
copynext = (term *) ((long)copynext + sizeof(term) +
nargs*sizeof(term *));
if ((long)copynext > (long)copyfull)
panic(COPYFULL);
return(copytop);
}
void reclaim_proto(t) /* put t in freelist */
term *t;
{
short i=0;
if (ISSTRUCT(t)) /* got arguments */
{
for (i=1; i<=ARITY(t); i++)
reclaim_proto(ARG(t,i));
i = ARITY(t);
}
ARG(t,0) = protofree[i]; /* link to free list */
t->flags = i|FREE;
protofree[i] = t;
}
void pop_copies(t)
term *t;
{
copytop = t;
if (ISSTRUCT(t))
copynext = (term *) ((long)copytop + sizeof(term) +
ARITY(copytop)*sizeof(term *));
else
copynext = (term *) ((long)copytop + sizeof(term));
}
/*****************************************************************************/
/* BACKTRACK STACK */
/*****************************************************************************/
void push_back(c)
char *c;
{
register backlog *b;
if (stacktop+sizeof(backlog) > stackfull)
panic(STACKFULL);
b = (backlog *)stacktop;
stacktop += sizeof(backlog);
b->frozen_env = Topenv; /* the frozen enviroment */
b->resume = c; /* where to start next time */
b->copylev = copytop; /* locked bejond */
b->traillev= trailtop; /* remember for later use */
b->pre = Backpoint; /* set stack link */
Backpoint = b;
}
/*****************************************************************************/
/* ENVIROMENT STACK */
/*****************************************************************************/
void push_env(a, t)
env *a; /* the ancestor enviroment */
term *t; /* the current term */
{
register env *e;
if (stacktop+sizeof(env) > stackfull)
panic(STACKFULL);
e = Topenv = (env *)stacktop;
stacktop += sizeof(env);
e->pre = a;
e->current = t;
Preenv = a;
}
/*****************************************************************************/
/* TRAIL STACK */
/*****************************************************************************/
void pop_trails(t)
long t;
{
while (trailtop != t)
REF(trailstack[--trailtop]) = FREEVAR;
}
/* remove all trails, that lie outside the currently frozen stacks */
void demolish_trails(t)
long t;
{
long i;
for (i=t; i<trailtop; i++)
if ((long)trailstack[i] <= (long)Backpoint->copylev ||
(long)trailstack[i]<(long)Backpoint)
trailstack[t++] = trailstack[i];
trailtop = t;
}
/*****************************************************************************/
/* FRAME VAR STACK */
/*****************************************************************************/
void push_frame(e,n)
register env *e; /* the frame belongs to e */
register short n; /* how many vars in that frame */
{
register term *p;
if (stacktop+n*sizeof(term) > stackfull)
panic(STACKFULL);
p = (term *)stacktop;
stacktop += n*sizeof(term);
e->frame = p; /* enter frame and # */
e->nvars = n;
while (n--) /* init the frame */
{
p->flags = VAR;
REF(p) = FREEVAR;
p += 1; /* skip to next term */
}
}
/*****************************************************************************/
/* CLAUSE SPACE */
/*****************************************************************************/
clause *make_clause(flags, head, tail, n)
short flags, n;
term *head,*tail;
{
register clause *c;
if (clausefree) /* got some free clauses in list */
{
c = clausefree;
clausefree = clausefree->next;
}
else
{
if ((long)(clausesp+clausefull) < (long)clausenext)
panic(CLAUSEFULL);
c = clausenext;
clausenext++;
}
c->flags = flags;
c->head = head;
c->body = tail;
c->nvars = n;
c->next = NULL;
return(c);
}
void remove_clause(c)
clause *c;
{
if (!ISBUILTIN(c))
{
reclaim_proto(c->head);
reclaim_proto(c->body);
}
c->next = clausefree;
clausefree = c;
}