home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
rtsi.com
/
2014.01.www.rtsi.com.tar
/
www.rtsi.com
/
OS9
/
OSK
/
EFFO
/
pd3.lzh
/
SBPROLOG2.2
/
SIM
/
aux.h
< prev
next >
Wrap
Text File
|
1991-08-10
|
5KB
|
160 lines
/************************************************************************
* *
* 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.
------------------------------------------------------------------ */
/* aux.h */
#define NUM 0x2
#define CS 0x1
#define FREE 0x0
#define LIST 0x3
#define CS_TAG 0x1
#define LIST_TAG 0x3
#define NUM_TAG 0x2
#define INT_TAG 0x6
#define FLOAT_TAG 0x2
#define MASK 0x3ffffffc
#define TAGMASK 0x3
#define PSW_FLOATBIT 0x1
#define EPSILON 0.00001
/***************************************************************************/
#define follow(opn) (*(pw)(opn))
#define makeint(op) ((word)((((long)(op)) << 3) | INT_TAG))
#define reset_floatflag psw = psw & ~PSW_FLOATBIT
#define set_psw_if_float(op) if (isfloat(op)) psw = psw | PSW_FLOATBIT
#define makenum(op) ((psw & PSW_FLOATBIT) ? makefloat(op) : makeint(op))
#define intval(op) (((long)(op)) >> 3)
#define isnum(op) (((op)&3)==NUM_TAG)
#define isinteger(op) (((op)&7)==INT_TAG)
#define isfloat(op) (((op)&7)==FLOAT_TAG)
#define numval(op) (isinteger(op) ? intval(op) : floatval(op))
#define isconstr(op) (((op)&3)==CS_TAG)
#define islist(op) (((op)&3)==LIST_TAG)
#define isnil(op) (op == nil_sym)
#define untag(op) op &= 0xfffffffc
#define untagged(op) ((op) & 0xfffffffc)
#define gregc(regno) (follow(reg+regno))
#define get_str_psc(op) ((struct psc_rec *)(follow(untagged(op))))
#define get_str_arity(x) get_arity(get_str_psc(x))
#define get_str_length(x) get_length(get_str_psc(x))
#define isnonvar(op) ((op)&3) /* must have been dereffed */
#define isfree(variable) ((word)variable == follow(variable))
#define isatom(op) (isconstr(op) && (get_str_arity(op)==0))
#define deref(op) while (!(op&3)) {top=(pw)op; if (isfree(top)) break; op=follow(top);}
#define nderef(opn, labl) top=(pw)opn; if ((word)top != follow(top)) \
{opn = follow(top); goto labl;}
#define pushtrail(val) \
if (((val) > (word)breg) || ((val) < (word)hbreg)) *trreg-- = val;
/************************************************************************/
/* The followings are macros for setting heap values. */
#define make_free(variable) \
(variable) = (word)(&variable)
/* must pass a simple pointer, not an expression */
#define new_heap_free make_free(*hreg); hreg++
/* make a free variable on the top of the heap */
#define new_heap_con(x) *hreg++ = ((x)|CS_TAG)
/* make a new con node on the heap, with pointer value x, which can
be any untagged one word type */
#define new_heap_int(val) *hreg++ = makeint(val)
#define new_heap_float(val) *hreg++ = val
/* make a new num node on the heap, with value val */
#define new_heap_node(x) *hreg++ = x
/* make a new heap node with value x (one word type ) */
/*************************************************************************/
/* IMPORTANT ! ! ! ! */
/* The followings are macros for accessing PSC table entry. PLEASE try
to use them other than actual field name so that we can change
the data structure easily in the future !!! */
/* in the following macros , "ptr" is typed " (struct psc_rec *) " */
#define get_etype(ptr) ((ptr)->entry_type)
#define get_arity(ptr) ((ptr)->arity)
#define get_length(ptr) ((ptr)->length)
#define get_ep(ptr) ((ptr)->ep)
#define get_name(ptr) ((ptr)->nameptr)
#define is_PRED(psc) (get_etype(psc) == T_PRED)
#define is_DYNA(psc) (get_etype(psc) == T_DYNA)
#define is_ORDI(psc) (get_etype(psc) == T_ORDI)
#define is_BUFF(psc) (get_etype(psc) == T_BUFF)
/* macro for computing indexing */
#define gensot(opcode, arg1, arg2, arg3, ep) \
*(ep++) = opcode; \
*(ep++) = arg1; \
*(((pw)ep)++) = arg2; \
*(((pw)ep)++) = arg3
#define gentry(opcode, arg1, arg2, ep) \
*(ep++) = opcode; \
*(ep++) = arg1; \
*((pw)ep) = arg2; \
ep += 4
#define ihash(val, size) \
((val & 0x3ffffffc) >> 2 + (val & 0x3)) % size
struct hrec {
long l;
word *link;
} ;
#ifndef OS9
struct hrec indextab[1024];
#else
extern struct hrec indextab[1024];
#endif
/****************************************************************************/
#define error(arg) \
printf ("error %d\n",arg)
#define Fail1 \
/* if (hitrace) printf("Fail\n");*/ \
lpcreg = (pb)*(breg + 1)
#define Fail0 \
if (hitrace) printf("Fail\n"); \
pcreg = (pb)*(breg + 1)
/************************************************************************/