/* xlisp - a small subset of lisp */

/* system specific definitions */
#define CI

#ifdef AZTEC
#include "stdio.h"
#include "setjmp.h"
#else
#include <stdio.h>
#include <setjmp.h>
#include <ctype.h>
#endif

/* NNODES	number of nodes to allocate in each request */
/* TDEPTH	trace stack depth */
/* FORWARD	type of a forward declaration (usually "") */
/* LOCAL	type of a local function (usually "static") */

/* for the Computer Innovations compiler */
#ifdef CI
#define NNODES		1000
#define TDEPTH		500
#endif

/* for the CPM68K compiler */
#ifdef CPM68K
#define NNODES		1000
#define TDEPTH		500
#define LOCAL
#undef NULL
#define NULL		(char *)0
#endif

/* for the DeSmet compiler */
#ifdef DESMET
#define NNODES		1000
#define TDEPTH		500
#define LOCAL
#define getc(fp)	getcx(fp)
#define putc(ch,fp)	putcx(ch,fp)
#define EOF		-1
#endif

/* for the VAX-11 C compiler */
#ifdef vms
#define NNODES		2000
#define TDEPTH		1000
#endif

/* for the DECUS C compiler */
#ifdef decus
#define NNODES		200
#define TDEPTH		100
#define FORWARD		extern
#endif

/* for unix compilers */
#ifdef unix
#define NNODES		200
#define TDEPTH		100
#endif

/* for the AZTEC C compiler */
#ifdef AZTEC
#define NNODES		200
#define TDEPTH		100
#define getc(fp)	getcx(fp)
#define putc(ch,fp)	aputc(ch,fp)
#define malloc		alloc
#endif

/* default important definitions */
#ifndef NNODES
#define NNODES	200
#endif
#ifndef TDEPTH
#define TDEPTH	100
#endif
#ifndef FORWARD
#define FORWARD
#endif
#ifndef LOCAL
#define LOCAL	static
#endif

/* useful definitions */
#define TRUE	1
#define FALSE	0

/* program limits */
#define STRMAX		100		/* maximum length of a string constant */
	
/* node types */
#define FREE	0
#define SUBR	1
#define FSUBR	2
#define LIST	3
#define SYM	4
#define INT	5
#define STR	6
#define OBJ	7
#define FPTR	8

/* node flags */
#define MARK	1
#define LEFT	2

/* string types */
#define DYNAMIC	0
#define STATIC	1

/* new node access macros */
#define ntype(x)	((x)->n_type)
#define atom(x)		((x) == NULL || (x)->n_type != LIST)
#define null(x)		((x) == NULL)
#define listp(x)	((x) == NULL || (x)->n_type == LIST)
#define consp(x)	((x) && (x)->n_type == LIST)
#define subrp(x)	((x) && (x)->n_type == SUBR)
#define fsubrp(x)	((x) && (x)->n_type == FSUBR)
#define stringp(x)	((x) && (x)->n_type == STR)
#define symbolp(x)	((x) && (x)->n_type == SYM)
#define filep(x)	((x) && (x)->n_type == FPTR)
#define objectp(x)	((x) && (x)->n_type == OBJ)
#define fixp(x)		((x) && (x)->n_type == INT)
#define car(x)		((x)->n_car)
#define cdr(x)		((x)->n_cdr)
#define rplaca(x,y)	((x)->n_car = (y))
#define rplacd(x,y)	((x)->n_cdr = (y))

/* symbol structure */
struct xsym {
    struct node *xsy_plist;	/* symbol plist - points to (name.plist) */
    struct node *xsy_value;	/* the current value */
};

/* subr/fsubr node structure */
struct xsubr {
    struct node *(*xsu_subr)();	/* pointer to an internal routine */
};

/* list node structure */
struct xlist {
    struct node *xl_car;	/* the car pointer */
    struct node *xl_cdr;	/* the cdr pointer */
};

/* integer node structure */
struct xint {
    int xi_int;			/* integer value */
};

/* string node structure */
struct xstr {
    int xst_type;		/* string type */
    char *xst_str;		/* string pointer */
};

/* object node structure */
struct xobj {
    struct node *xo_obclass;	/* class of object */
    struct node *xo_obdata;	/* instance data */
};

/* file pointer node structure */
struct xfptr {
    FILE *xf_fp;		/* the file pointer */
    int xf_savech;		/* lookahead character for input files */
};


/* shorthand macros for accessing node substructures */

/* symbol node */
#define n_symplist	n_info.n_xsym.xsy_plist
#define n_symvalue	n_info.n_xsym.xsy_value

/* subr/fsubr node */
#define n_subr		n_info.n_xsubr.xsu_subr

/* list node */
#define n_car		n_info.n_xlist.xl_car
#define n_cdr		n_info.n_xlist.xl_cdr
#define n_ptr		n_info.n_xlist.xl_car

/* integer node */
#define n_int		n_info.n_xint.xi_int

/* string node */
#define n_str		n_info.n_xstr.xst_str
#define n_strtype	n_info.n_xstr.xst_type

/* object node */
#define n_obclass	n_info.n_xobj.xo_obclass
#define n_obdata	n_info.n_xobj.xo_obdata

/* file pointer node */
#define n_fp		n_info.n_xfptr.xf_fp
#define n_savech	n_info.n_xfptr.xf_savech

/* node structure */
typedef struct node {
    char n_type;		/* type of node */
    char n_flags;		/* flag bits */
    union {			/* value */
	struct xsym n_xsym;	/*     symbol node */
	struct xsubr n_xsubr;	/*     subr/fsubr node */
	struct xlist n_xlist;	/*     list node */
	struct xint n_xint;	/*     integer node */
	struct xstr n_xstr;	/*     string node */
	struct xobj n_xobj;	/*     object node */
	struct xfptr n_xfptr;	/*     file pointer node */
    } n_info;
} NODE;

/* execution context flags */
#define CF_GO		1
#define CF_RETURN	2
#define CF_THROW	4
#define CF_ERROR	8

/* execution context */
typedef struct context {
    int c_flags;			/* context type flags */
    struct node *c_expr;		/* expression (type dependant) */
    jmp_buf c_jmpbuf;			/* longjmp context */
    struct context *c_xlcontext;	/* old value of xlcontext */
    struct node *c_xlstack;		/* old value of xlstack */
    struct node *c_xlenv,*c_xlnewenv;	/* old values of xlenv and xlnewenv */
    int c_xltrace;			/* old value of xltrace */
} CONTEXT;

/* function table entry structure */
struct fdef {
    char *f_name;
    int f_type;
    struct node *(*f_fcn)();
};

/* memory segment structure definition */
struct segment {
    int sg_size;
    struct segment *sg_next;
    struct node sg_nodes[1];
};

/* external procedure declarations */
extern struct node *xleval();		/* evaluate an expression */
extern struct node *xlapply();		/* apply a function to arguments */
extern struct node *xlevlist();		/* evaluate a list of arguments */
extern struct node *xlarg();		/* fetch an argument */
extern struct node *xlevarg();		/* fetch and evaluate an argument */
extern struct node *xlmatch();		/* fetch an typed argument */
extern struct node *xlevmatch();	/* fetch and evaluate a typed arg */
extern struct node *xlsend();		/* send a message to an object */
extern struct node *xlenter();		/* enter a symbol */
extern struct node *xlsenter();		/* enter a symbol with a static pname */
extern struct node *xlintern();		/* intern a symbol */
extern struct node *xlmakesym();	/* make an uninterned symbol */
extern struct node *xlsave();		/* generate a stack frame */
extern struct node *xlobsym();		/* find an object's class or instance
					   variable */
extern struct node *xlgetprop();	/* get the value of a property */
extern char *xlsymname();		/* get the print name of a symbol */

extern struct node *newnode();		/* allocate a new node */
extern char *stralloc();		/* allocate string space */
extern char *strsave();			/* make a safe copy of a string */
