#
/*		Copyright 1976 by Bill Webb. 		*/
/*

		X          X     XXXX   XXXXX
		X          X    X       X    X
		X          X     XXXX   X    X
		X          X         X  XXXXX
		X          X    X    X  X
		XXXXXX     X     XXXX   X

 */

#define	NUMERIC double				/* lisp numbers are dp fpt */
#define	EVER	;;
#define	ATOMP(X)	(X->type & ATOM)
#define	PMACROP(X)	(X->type & PMACRO)
#define	LITATOM(x)	((x->type&ATOM) && !NUMP(x))
#define	NUMP(x)	(x->type&NUMBER)
#define	INTP(x)	((x-type&REAL)==0)
#define	REALP(x) (x->type&REAL)
#define	CAR(X)		(X->car)
#define	CDR(X)		(X->cdr)
#define	EQUAL	eqlist		/* test if equal list structures */
#define	BOOL(x) ( x ? t : nil)
#define	EQATOM(a,b) ((NUMP(a) && NUMP(b)) ? a->realval == b->realval : a == b)

#define	CHKNUM(p)	if(!NUMP(p)) numerr()
#define	CHKNOTNUM(p)	if(NUMP(p))  notnumerr()
#define	CHKATOM(x)	if(!ATOMP(x)) error("not atomic")
#define	CHKLIT(x)	if(!LITATOM(x)) error("not literal atom");
#define	CHKLIST(x)	if(ATOMP(x)) error("not a list")
#define	SCANLIST(l,p)	for (p=l; p!=nil; p=p->cdr)
#define	SCANPROP(l,p)	for (p=l; p!=nil; p=p->cdr->cdr)
#define	NEXT(p)		p = p->cdr

#define	CONSTYPE	0	/* ordinary cons cell */
#define	GC	0200		/* garbage collector bit */
#define	ATOM 01
#define	REAL 04
#define	INT 0
#define	TRACE	010
#define	NUMBER	02
#define	PMACRO	020

struct cons
{
int type;
struct cons *car;
struct cons *cdr;
};


struct atomic
{
int type;
struct cons *car;
struct cons *cdr;
char pname[];
};

struct init 
{
char *name;
struct cons **addr;
char minargs, maxargs;
};

struct numeric
{
int type;
struct cons *car;
struct cons *cdr;
NUMERIC	realval;
};

char lastchar;
struct atomic *nil, *t, *undef, *expr, *subr, *nsubr, *pmacro;
struct atomic *qt, *junk, *lambda, *nexpr, *fexpr, *fsubr;
struct atomic *nlambda, *flambda;
struct cons *oblist;


#define	CONSSIZE	6
#define	NUMSIZE	CONSSIZE+8

char *atoms[], *subrs[], *nsubrs[], *fsubrs[];
int level;
#define	MAXSTK	2048
struct cons *evalstack[MAXSTK];
struct cons **evalsp;
extern fin, fout;
int argc;
char **argv;
int tflg;
#define	MAXBUFF	256
char buffer[MAXBUFF];
int cons_cnt, atom_cnt, num_cnt;
int gen_cnt;
char *badptr;
int defprop;
int elevel;
char pfx;		/* input prefix character */

char *membottom, *memnext, *memtop;
NUMERIC number();

struct stk
{
struct stk *slast;		/* link to previous stack frame */
struct stk *snext;		/* link to following stack frame */
struct cons *sform;		/* current form being evaluated */
int stype;			/* type of form */
int *r5;			/* c stack frame pointer */
char **sbind;			/* variable bindings info */
int argcnt;			/* count of number of actual args */
struct cons *arglist[1];	/* actual arguments */
struct cons *pnext;		/* next prog form to execute */
} *curstk;

#define	T_LAMBDA	0
#define	T_NLAMBDA	1
#define	T_FLAMBDA	2
#define	T_SUBR		3
#define	T_FSUBR		4
#define	T_NSUBR		5
#define	T_DEF	6
#define	T_PROG	7
#define	TAB	'\t'

#define	ARG1 args[0]
#define	ARG2 args[1]
#define	ARG3 args[2]

#define	SUBR(fn)	fn(cnt,args) struct cons *args[];
#define	NSUBR(fn)	fn(cnt,args) struct cons *args[];
#define	FSUBR(fn)	fn(l) struct cons *l;

#define	MAXNUM	100
struct cons *numatoms[MAXNUM];

#define	NORMAL	0
#define	NOMACRO	1		/* no macro processing */
#define	NOSPACE	2		/* no spacing between s exprs */
#define	PQUOTE	4		/* print with quote marks if needed */
#define	TERSE	8		/* terse mode */
