/*
 * Definitions and declarations used throughout the run-time system.
 * These are also used by the linker in constructing data for use by
 * the run-time system.
 */

#ifdef StandardC
#include <time.h>
#endif					/* StandardC */
#include "..\h\cpuconf.h"
#include "..\h\memsize.h"

/*
 * Constants that are not likely to vary between implementations.
 */

#define BitOffMask (IntBits-1)
#define CsetSize (256/IntBits)	/* number of ints to hold 256 cset
				 *  bits. Use (256/IntBits)+1 if
				 *  256 % IntBits != 0 */
#define MinListSlots	    8	/* number of elements in an expansion
				 * list element block  */

#define MaxCvtLen	   257	/* largest string in conversions; the extra
				 *  one is for a terminating null */
#define MaxReadStr	   512	/* largest string to read() in one piece */
#define MaxIn		  32767	/* largest number of bytes to read() at once */
#define RandA        1103515245	/* random seed multiplier */
#define RandC	      453816694	/* random seed additive constant */
#define RanScale 4.65661286e-10	/* random scale factor = 1/(2^31-1)) */

/*
 * File status flags in status field of file blocks.
 */
#define Fs_Read		 01	/* read access */
#define Fs_Write	 02	/* write access */
#define Fs_Create	 04	/* file created on open */
#define Fs_Append	010	/* append mode */
#define Fs_Pipe		020	/* reading/writing on a pipe */

#ifdef RecordIO
#define Fs_Record       040     /* record structured file */
#endif					/* RecordIO */

#ifdef StandardLib
#define Fs_Reading     0100     /* last file operation was read */
#define Fs_Writing     0200     /* last file operation was write */
#endif					/* StandardLib */

/*
 * Definitions for interpreter actions.
 */
#define A_Failure	1		/* routine failed */
#define A_Suspension	2		/* routine suspended */
#define A_Return	3		/* routine returned */
#define A_Pret_uw	4		/* interp unwind for Op_Pret */
#define A_Unmark_uw	5		/* interp unwind for Op_Unmark */
#define A_Resumption	6		/* resume generator */
#define A_Pfail_uw	7		/* interp unwind for Op_Pfail */
#define A_Lsusp_uw	8		/* interp unwind for Op_Lsusp */
#define A_Eret_uw	9		/* interp unwind for Op_Eret */
#define A_Coact		10		/* co-expression activated */
#define A_Coret		11		/* co-expression returned */
#define A_Cofail	12		/* co-expression failed */

/*
 * Codes returned by invoke to indicate action.
 */
#define I_Builtin	201	/* A built-in routine is to be invoked */
#define I_Fail		202	/* goal-directed evaluation failed */
#define I_Continue	203	/* Continue execution in the interp loop */
#define I_Vararg	204	/* A function with a variable number of args */

/*
 * Codes returned by runtime support routines.
 *  Note, some conversion routines also return type codes. Other routines may
 *  return positive values other than return codes. sort() places restrictions
 *  on Less, Equal, and Greater.
 */
#define Less		-1
#define Equal		0
#define Greater		1
#define CvtFail		-2
#define Cvt		-3
#define NoCvt		-4
#define Failure		-5
#define Defaulted	-6
#define Success		-7
#define Error		-8

/*
 * Generator types.
 */
#define G_Csusp		1
#define G_Esusp		2
#define G_Psusp		3

/*
 * Type codes (descriptors and blocks).
 */
#define T_Null		 0	/* null value */
#define T_Integer	 1	/* integer */

#ifdef LargeInts
#define T_Bignum	 2	/* long integer */
#endif					/* LargeInts */

#define T_Real		 3	/* real number */
#define T_Cset		 4	/* cset */
#define T_File		 5	/* file */
#define T_Proc		 6	/* procedure */
#define T_List		 7	/* list header */
#define T_Table		 8	/* table header */
#define T_Record	 9	/* record */
#define T_Telem		10	/* table element */
#define T_Lelem		11	/* list element */
#define T_Tvsubs	12	/* substring trapped variable */
#define T_Tvkywd	13	/* keyword trapped variable */
#define T_Tvtbl		14	/* table element trapped variable */
#define T_Set		15	/* set header */
#define T_Selem		16	/* set element */
#define T_Refresh	17	/* refresh block */
#define T_Coexpr	18	/* co-expression */
#define T_External	19	/* external block */
#define T_Slots		20	/* set/table hash slots */

#define MaxType		20	/* maximum type number */

/*
 * Descriptor types and flags.
 */

#define D_Null		(word)(T_Null | F_Nqual)
#define D_Integer	(word)(T_Integer | F_Nqual)

#ifdef LargeInts
#define D_Bignum	(word)(T_Bignum | F_Ptr | F_Nqual)
#endif					/* LargeInts */

#define D_Real		(word)(T_Real | F_Ptr | F_Nqual)
#define D_Cset		(word)(T_Cset | F_Ptr | F_Nqual)
#define D_File		(word)(T_File | F_Ptr | F_Nqual)
#define D_Proc		(word)(T_Proc | F_Ptr | F_Nqual)
#define D_List		(word)(T_List | F_Ptr | F_Nqual)
#define D_Table		(word)(T_Table | F_Ptr | F_Nqual)
#define D_Telem		(word)(T_Telem | F_Ptr | F_Nqual)
#define D_Tvsubs	(word)(T_Tvsubs | D_Tvar)
#define D_Tvkywd	(word)(T_Tvkywd | D_Tvar)
#define D_Tvtbl		(word)(T_Tvtbl | D_Tvar)
#define D_Record	(word)(T_Record | F_Ptr | F_Nqual)
#define D_Set		(word)(T_Set | F_Ptr | F_Nqual)
#define D_Refresh	(word)(T_Refresh | F_Ptr | F_Nqual)
#define D_Coexpr	(word)(T_Coexpr | F_Ptr | F_Nqual)
#define D_External	(word)(T_External | F_Ptr | F_Nqual)
#define D_Slots		(word)(T_Slots | F_Ptr | F_Nqual)

#define D_Var		(word)(F_Var | F_Nqual | F_Ptr)
#define D_Tvar		(word)(D_Var | F_Tvar)

#define TypeMask	63	/* type mask */
#define OffsetMask	(~(D_Tvar)) /* offset mask for variables */

/*
 * Run-time data structures.
 */

/*
 * Icode consists of operators and arguments.  Operators are small integers,
 *  while arguments may be pointers.  To conserve space in icode files on
 *  computers with 16-bit ints, icode is written by the linker as a mixture
 *  of ints and words (longs).  When an icode file is read in and processed
 *  by the interpreter, it looks like a C array of mixed ints and words.
 *  Accessing this "nonstandard" structure is handled by a union of int and
 *  word pointers and incrementing is done by incrementing the appropriate
 *  member of the union (see the interpreter).  This is a rather dubious
 *  method and certainly not portable.  A better way might be to address
 *  icode with a char *, but the incrementing code might be inefficient
 *  (at a place that experiences a lot of execution activity).
 *
 * For the moment, the dubious coding is isolated under control of the
 *  size of integers.
 */

#if IntBits == 16

typedef union {
   int *op;
   word *opnd;
   } inst;

#else					/* IntBits == 16 */

typedef union {
   word *op;
   word *opnd;
   } inst;

#endif					/* IntBits == 16 */

/*
 * Descriptor
 */

struct descrip {		/* descriptor */
   word dword;			/*   type field */
   union {
      word integr;		/*   integer value */
      char *sptr;		/*   pointer to character string */
      union block *bptr;	/*   pointer to a block */
      dptr descptr;		/*   pointer to a descriptor */
      } vword;
   };

struct sdescrip {
   word length;			/*   length of string */
   char *string;		/*   pointer to string */
   };

/*
 * Run-time error numbers and text.
 */
struct errtab {
   int err_no;			/* error number */
   char *errmsg;		/* error message */
   };

/*
 * Frame markers
 */
struct ef_marker {		/* expression frame marker */
   inst ef_failure;		/*   failure ipc */
   struct ef_marker *ef_efp;	/*   efp */
   struct gf_marker *ef_gfp;	/*   gfp */
   word ef_ilevel;		/*   ilevel */
   };

struct pf_marker {		/* procedure frame marker */
   word pf_nargs;		/*   number of arguments */
   struct pf_marker *pf_pfp;	/*   saved pfp */
   struct ef_marker *pf_efp;	/*   saved efp */
   struct gf_marker *pf_gfp;	/*   saved gfp */
   dptr pf_argp;		/*   saved argp */
   inst pf_ipc;			/*   saved ipc */
   word pf_ilevel;		/*   saved ilevel */
   dptr pf_scan;		/*   saved scanning environment */
   struct descrip pf_locals[1];	/*   descriptors for locals */
   };

struct gf_marker {		/* generator frame marker */
   word gf_gentype;		/*   type */
   struct ef_marker *gf_efp;	/*   efp */
   struct gf_marker *gf_gfp;	/*   gfp */
   inst gf_ipc;			/*   ipc */
   struct pf_marker *gf_pfp;	/*   pfp */
   dptr gf_argp;		/*   argp */
   };

/*
 * Generator frame marker dummy -- used only for sizing "small"
 *  generator frames where procedure infomation need not be saved.
 *  The first five members here *must* be identical to those for
 *  gf_marker.
 */
struct gf_smallmarker {		/* generator frame marker */
   word gf_gentype;		/*   type */
   struct ef_marker *gf_efp;	/*   efp */
   struct gf_marker *gf_gfp;	/*   gfp */
   inst gf_ipc;			/*   ipc */
   };

#ifdef LargeInts

typedef unsigned int DIGIT;

struct b_bignum {		/* large integer block */
   word title;			/*   T_Bignum */
   word blksize;		/*   block size */
   word msd, lsd;		/*   most and least significant digits */
   int sign;			/*   sign; 0 positive, 1 negative */
   DIGIT digits[1];		/*   digits */
   };

#endif					/* LargeInts */
struct b_real {			/* real block */
   word title;			/*   T_Real */
   double realval;		/*   value */
   };

struct b_cset {			/* cset block */
   word title;			/*   T_Cset */
   word size;			/*   size of cset */
   int bits[CsetSize];		/*   array of bits */
   };

struct b_file {			/* file block */
   word title;			/*   T_File */
   FILE *fd;			/*   Unix file descriptor */
   word status;			/*   file status */
   struct descrip fname;	/*   file name (string qualifier) */
   };

struct b_proc {			/* procedure block */
   word title;			/*   T_Proc */
   word blksize;		/*   size of block */
   union {			/*   entry points for */
      int (*ccode)();		/*     C routines */
      uword ioff;		/*     and icode as offset */
      pointer icode;		/*     and icode as absolute pointer */
      } entryp;
   word nparam;			/*   number of parameters */
   word ndynam;			/*   number of dynamic locals */
   word nstatic;		/*   number of static locals */
   word fstatic;		/*   index (in global table) of first static */
   struct descrip pname;	/*   procedure name (string qualifier) */
   struct descrip lnames[1];	/*   list of local names (qualifiers) */
   };

/*
 * b_iproc blocks are used to statically initialize information about
 *  functions.	They are identical to b_proc blocks except for
 *  the pname field which is a sdecrip (simple/string descriptor) instead
 *  of a descrip.  This is done because unions cannot be initialized.
 */
	
struct b_iproc {		/* procedure block */
   word ip_title;		/*   T_Proc */
   word ip_blksize;		/*   size of block */
   int (*ip_entryp)();		/*   entry point (code) */
   word ip_nparam;		/*   number of parameters */
   word ip_ndynam;		/*   number of dynamic locals */
   word ip_nstatic;		/*   number of static locals */
   word ip_fstatic;		/*   index (in global table) of first static */
   struct sdescrip ip_pname;	/*   procedure name (string qualifier) */
   struct descrip ip_lnames[1];	/*   list of local names (qualifiers) */
   };

struct b_list {			/* list-header block */
   word title;			/*   T_List */
   word size;			/*   current list size */
   word id;			/*   identification number */
   union block *listhead;	/*   pointer to first list-element block */
   union block *listtail;	/*   pointer to last list-element block */
   };

struct b_lelem {		/* list-element block */
   word title;			/*   T_Lelem */
   word blksize;		/*   size of block */
   union block *listprev;	/*   previous list-element block */
   union block *listnext;	/*   next list-element block */
   word nslots;			/*   total number of slots */
   word first;			/*   index of first used slot */
   word nused;			/*   number of used slots */
   struct descrip lslots[1];	/*   array of slots */
   };

struct b_slots {		/* set/table hash slots */
   word title;			/*   T_Slots */
   word blksize;		/*   size of block */
   union block *hslots[HSlots];	/*   array of slots (HSlots * 2^n entries) */
   };

struct b_table {		/* table-header block */
   word title;			/*   T_Table */
   word size;			/*   current table size */
   word id;			/*   identification number */
   word mask;			/*   mask to get slot num, equals n slots - 1 */
   struct b_slots *hdir[HSegs];	/*   directory of hash slot segments */
   struct descrip defvalue;	/*   default table element value */
   };

struct b_telem {		/* table-element block */
   word title;			/*   T_Telem */
   union block *clink;		/*   hash chain link */
   uword hashnum;		/*   for ordering chain */
   struct descrip tref;		/*   entry value */
   struct descrip tval;		/*   assigned value */
   };

/*
 * A set header must be a proper prefix of a table header,
 *  and a set element must be a proper prefix of a table element.
 */
struct b_set {			/* set-header block */
   word title;			/*   T_Set */
   word size;			/*   size of the set */
   word id;			/*   identification number */
   word mask;			/*   mask to get slot num, equals n slots - 1 */
   struct b_slots *hdir[HSegs];	/*   directory of hash slot segments */
   };

struct b_selem {		/* set-element block */
   word title;			/*   T_Selem */
   union block *clink;		/*   hash chain link */
   uword hashnum;		/*   hash number */
   struct descrip setmem;	/*   the element */
   };

struct b_record {		/* record block */
   word title;			/*   T_Record */
   word blksize;		/*   size of block */
   word id;			/*   identification number */
   union block *recdesc;	/*   pointer to record constructor */
   struct descrip fields[1];	/*   fields */
   };

/*
 * Alternate uses for procedure block fields, applied to records.
 */
#define nfields	nparam		/* number of fields */
#define recnum nstatic		/* record number */
#define recid fstatic		/* record serial number */
#define recname	pname		/* record name */

struct b_tvkywd {		/* keyword trapped variable block */
   word title;			/*   T_Tvkywd */
   int (*putval)();		/*   assignment function for keyword */
   struct descrip kyval;	/*   keyword value */
   struct descrip kyname;	/*   keyword name */
   };

struct b_tvsubs {		/* substring trapped variable block */
   word title;			/*   T_Tvsubs */
   word sslen;			/*   length of substring */
   word sspos;			/*   position of substring */
   struct descrip ssvar;	/*   variable that substring is from */
   };

struct b_tvtbl {		/* table element trapped variable block */
   word title;			/*   T_Tvtbl */
   union block *clink;		/*   pointer to table header block */
   uword hashnum;		/*   hash number */
   struct descrip tref;		/*   entry value */
   struct descrip tval;		/*   reserved for assigned value */
   };

struct b_coexpr {		/* co-expression stack block */
   word title;			/*   T_Coexpr */
   word size;			/*   number of results produced */
   word id;			/*   identification number */
   struct b_coexpr *nextstk;	/*   pointer to next allocated stack */
   struct pf_marker *es_pfp;	/*   current pfp */
   struct ef_marker *es_efp;	/*   efp */
   struct gf_marker *es_gfp;	/*   gfp */
   dptr es_argp;		/*   argp */
   inst es_ipc;			/*   ipc */
   word es_ilevel;		/*   interpreter level */
   word *es_sp;			/*   sp */
   dptr tvalloc;		/*   where to place transmitted value */
   struct descrip freshblk;	/*   refresh block pointer */
   struct astkblk *es_actstk;	/*   pointer to activation stack structure */
   word cstate[CStateSize];	/*   C state information */
   };

struct astkblk {		  /* co-expression activator-stack block */
   int nactivators;		  /*   number of valid activator entries in
				   *    this block */
   struct astkblk *astk_nxt;	  /*   next activator block */
   struct actrec {		  /*   activator record */
      word acount;		  /*     number of calls by this activator */
      struct b_coexpr *activator; /*     the activator itself */
      } arec[ActStkBlkEnts];
   };

struct b_refresh {		/* co-expression block */
   word title;			/*   T_Refresh */
   word blksize;		/*   size of block */
   word *ep;			/*   entry point */
   word numlocals;		/*   number of locals */
   struct pf_marker pfmkr;	/*   marker for enclosing procedure */
   struct descrip elems[1];	/*   arguments and locals, including Arg0 */
   };

struct b_external {		/* external block */
   word title;			/*   T_External */
   word blksize;		/*   size of block */
   word descoff;		/*   offset to first descriptor */
   word exdata[1];		/*   words of external data */
   };

union block {			/* general block */

#ifdef LargeInts
   struct b_bignum bignumblk;
#endif					/* LargeInts */

   struct b_real realblk;
   struct b_cset cset;
   struct b_file file;
   struct b_proc proc;
   struct b_list list;
   struct b_lelem lelem;
   struct b_table table;
   struct b_telem telem;
   struct b_set set;
   struct b_selem selem;
   struct b_record record;
   struct b_tvkywd tvkywd;
   struct b_tvsubs tvsubs;
   struct b_tvtbl tvtbl;
   struct b_refresh refresh;
   struct b_coexpr coexpr;
   struct b_external externl;
   struct b_slots slots;
   };

/*
 * Declarations for entries in tables associating icode location with
 *  source program location.
 */
struct ipc_fname {
   word ipc;		/* offset of instruction into code region */
   word fname;		/* offset of file name into string region */
   };

struct ipc_line {
   word ipc;		/* offset of instruction into code region */
   int line;		/* line number */
   };

/*
 * External declarations.
 */

extern char *code;		/* start of icode */

extern word stksize;		/* size of co-expression stacks in words */
extern word *stackend;		/* end of evaluation stack */
extern struct b_coexpr *stklist;/* base of co-expression stack list */

extern word mstksize;		/* size of main stack in words */

extern char *statbase;		/* start of static space */
extern char *statend;		/* end of static space */
extern char *statfree;		/* static space free list header */
extern word statsize;		/* size of static space */
extern word statincr;		/* size of increment for static space */

extern word ssize;		/* size of string space (bytes) */
extern char *strbase;		/* start of string space */
extern char *strend;		/* end of string space */
extern char *strfree;		/* string space free pointer */

extern word abrsize;		/* size of allocated block region (words) */
extern char *blkbase;		/* base of allocated block region */
extern char *blkend;		/* maximum address in allocated block region */
extern char *blkfree;		/* first free location in allocated block region */

extern int bsizes[];		/* sizes of blocks */
extern int firstd[];		/* offset (words) of first descrip. */
extern char *blkname[];		/* print names for block types. */
extern uword segsize[];		/* size of hash bucket segment */


extern struct b_tvkywd tvky_err;	/* trapped variable for &error */
extern struct b_tvkywd tvky_pos;	/* trapped variable for &pos */
extern struct b_tvkywd tvky_ran;	/* trapped variable for &random */
extern struct b_tvkywd tvky_sub;	/* trapped variable for &subject */
extern struct b_tvkywd tvky_trc;	/* trapped variable for &trace */


#define k_error tvky_err.kyval.vword.integr	/* value of &error */
#define k_pos tvky_pos.kyval.vword.integr	/* value of &pos */
#define k_random tvky_ran.kyval.vword.integr	/* value of &random */
#define k_subject tvky_sub.kyval		/* value of &subject */
#define k_trace tvky_trc.kyval.vword.integr	/* value of &trace */

extern struct b_cset k_ascii;		/* value of &ascii */
extern struct b_cset k_cset;		/* value of &cset */
extern struct b_cset k_digits;		/* value of &lcase */
extern struct b_file k_errout;		/* value of &errout */
extern struct b_file k_input;		/* value of &input */
extern struct b_cset k_lcase;		/* value of &lcase */
extern struct b_cset k_letters;		/* value of &letters */
extern int k_level;			/* value of &level */
extern char *k_errortext;		/* value of &errortext */
extern int k_errornumber;		/* value of &errornumber */
extern struct descrip k_errorvalue;	/* value of &errorvalue */
extern struct descrip k_main;		/* value of &main */
extern struct descrip k_current;	/* &current */
extern struct b_file k_output;		/* value of &output */
extern struct b_cset k_ucase;		/* value of &ucase */

#ifdef StandardLib
extern clock_t starttime;		/* start time in milliseconds */
#else					/* StandardLib */
extern long starttime;			/* start time in milliseconds */
#endif					/* StandardLib */

extern struct descrip nulldesc;		/* null value */
extern struct descrip zerodesc;		/* zero */
extern struct descrip onedesc;		/* one */
extern struct descrip emptystr;		/* empty string */
extern struct descrip blank;		/* blank */
extern struct descrip letr;		/* letter "r" */
extern struct descrip maps2;		/* second argument to map() */
extern struct descrip maps3;		/* third argument to map() */
extern struct descrip input;		/* &input */
extern struct descrip errout;		/* &errout */
extern struct descrip lcase;		/* lowercase string */
extern struct descrip ucase;		/* uppercase string */

extern int ntended;		/* number of active tended descriptors */
extern struct descrip tended[];	/* tended descriptors */

extern word *sp;		/* interpreter stack pointer */
extern word *stack;		/* interpreter stack base */
extern struct pf_marker *pfp;	/* procedure frame pointer */
extern struct ef_marker *efp;	/* expression frame pointer */
extern struct gf_marker *gfp;	/* generator frame pointer */
extern inst ipc;		/* interpreter program counter */
extern dptr argp;		/* argument pointer */
extern int ilevel;		/* interpreter level */

#ifdef ExecImages
extern int dumped;		/* the interpreter has been dumped */
#endif					/* ExecImages */

#if EBCDIC == 2
extern char ToEBCDIC[], FromEBCDIC[]; /* ASCII<->EBCDIC maps */
#define ToAscii(e) (FromEBCDIC[e])
#define FromAscii(e) (ToEBCDIC[e])
#else					/* EBCDIC == 2 */
#define ToAscii(e) (e)
#define FromAscii(e) (e)
#endif					/* EBCDIC == 2 */


/*
 * Evaluation stack overflow margin
 */

#define PerilDelta 100

/*
 * Macro definitions related to descriptors.
 */

/*
 * The following code is operating-system dependent [@rt.01].  Define
 *  PushAval for computers that store longs and pointers differently.
 */

#if PORT
#define PushAVal(x) PushVal(x)
Deliberate Syntax Error
#endif					/* PORT */

#if AMIGA || ATARI_ST || HIGHC_386 || MACINTOSH || MVS || UNIX || VM || VMS
#define PushAVal(x) PushVal(x)
#endif					/* AMIGA || ATARI_ST || HIGHC_386 ... */

#if MSDOS || OS2
static union {
       pointer stkadr;
       word stkint;
   } stkword;

#define PushAVal(x)  {sp++; \
			stkword.stkadr = (char *)(x); \
			*sp = stkword.stkint;}
#endif					/* MSDOS || OS2 */

/*
 * End of operating-system specific code.
 */

/*
 * Pointer to block.
 */
#define BlkLoc(d)	((d).vword.bptr)

/*
 * Check for null-valued descriptor.
 */
#define ChkNull(d)	((d).dword==D_Null)

/*
 * Dereference descriptor.
 */
#define DeRef(d)	(Var(d) ? deref(&d) : Success)

/*
 * Check for equivalent descriptors.
 */
#define EqlDesc(d1,d2)	((d1).dword == (d2).dword && BlkLoc(d1) == BlkLoc(d2))

/*
 * Integer value.
 */
#define IntVal(d)	((d).vword.integr)

/*
 * Offset from top of block to value of variable.
 */
#define Offset(d)	((d).dword & OffsetMask)

/*
 * Check for pointer.
 */
#define Pointer(d)	((d).dword & F_Ptr)

/*
 * Check for qualifier.
 */
#define Qual(d)		(!((d).dword & F_Nqual))

/*
 * Length of string.
 */
#define StrLen(q)	((q).dword)

/*
 * Location of first character of string.
 */
#define StrLoc(q)	((q).vword.sptr)

/*
 * Check for trapped variable.
 */
#define Tvar(d)		((d).dword & F_Tvar)

/*
 * Location of trapped-variable block.
 */
#define TvarLoc(d)	((d).vword.bptr)

/*
 * Type of descriptor.
 */
#define Type(d)		(int)((d).dword & TypeMask)

/*
 * Check for variable.
 */
#define Var(d)		((d).dword & F_Var)

/*
 * Location of the value of a variable.
 */
#define VarLoc(d)	((d).vword.descptr)

/*
 *  Important note:  The code that follows is not strictly legal C.
 *   It tests to see if pointer p2 is between p1 and p3. This may
 *   involve the comparison of pointers in different arrays, which
 *   is not well-defined.  The casts of these pointers to unsigned "words"
 *   (longs or ints, depending) works with all C compilers and architectures
 *   on which Icon has been implemented.  However, it is possible it will
 *   not work on some system.  If it doesn't, there may be a "false
 *   positive" test, which is likely to cause a memory violation or a
 *   loop. It is not practical to implement Icon on a system on which this
 *   happens.
 */

#define InRange(p1,p2,p3) ((uword)(p2) >= (uword)(p1) && (uword)(p2) < (uword)(p3))

/*
 * Macros for pushing values on the interpreter stack.
 */

/*
 * Push descriptor.
 */
#define PushDesc(d)	{*++sp = ((d).dword); sp++;*sp =((d).vword.integr);}

/*
 * Push null-valued descriptor.
 */
#define PushNull	{*++sp = D_Null; sp++; *sp = 0;}

/*
 * Push word.
 */
#define PushVal(v)	{*++sp = (word)(v);}

/*
 * Macros related to function and operator definition.
 */

/*
 * Procedure block for a function.
 */

#define FncBlock(f,nargs,deref) \
	struct b_iproc Cat(B,f) = {\
	T_Proc,\
	Vsizeof(struct b_proc),\
	Cat(X,f),\
	nargs,\
	-1,\
	deref, 0,\
	{sizeof(Lit(f))-1,Lit(f)}};


/*
 * Function declaration for variable number of arguments.
 */
#define FncDcl(nm,n) FncBlock(nm,n,0) Cat(X,nm)(cargp)  register dptr cargp;

/*
 * Function declaration for variable number of arguments.
 */
#define FncDclV(nm) FncBlock(nm,-1,0) Cat(X,nm)(nargs,cargp) register dptr cargp;

/*
 * Function declaration without dereferenced arguments.
 */
#define FncNDcl(nm,n) FncBlock(nm,n,-1) Cat(X,nm)(cargp)  register dptr cargp;

/*
 * Function declaration for variable number of arguments.
 */
#define FncNDclV(nm) FncBlock(nm,-1,-1) Cat(X,nm)(nargs,cargp) register dptr cargp;

/*
 * Declaration for library routine.
 */
#define LibDcl(nm,n,pn) OpBlock(nm,n,pn,0) Cat(O,nm)(nargs,cargp) \
   register dptr cargp;
/*
 * Procedure block for an operator.
 */
#define OpBlock(f,nargs,sname,realargs)\
	struct b_iproc Cat(B,f) = {\
	T_Proc,\
	Vsizeof(struct b_proc),\
	Cat(O,f),\
	nargs,\
	-1,\
	realargs,\
	0,\
	{sizeof(sname)-1,sname}};

/*
 * Operator declaration.
 */
#define OpDcl(nm,n,pn) OpBlock(nm,n,pn,0) Cat(O,nm)(cargp) register dptr cargp;

/*
 * Agent routine declaration.
 */
#define AgtDcl(nm) Cat(A,nm)(cargp) register dptr cargp;

#ifdef StrInvoke
/*
 * Structure for mapping string names of procedures to block addresses.
 */
struct pstrnm {
   char *pstrep;
   struct b_proc *pblock;
   };

#endif					/* StrInvoke */
/*
 * Character translations.
 */
#if EBCDIC == 2
extern char ToEBCDIC[], FromEBCDIC[]; /* ASCII<->EBCDIC maps */
#define ToAscii(e) (FromEBCDIC[e])
#define FromAscii(e) (ToEBCDIC[e])
#else					/* EBCDIC == 2 */
#define ToAscii(e) (e)
#define FromAscii(e) (e)
#endif					/* EBCDIC == 2 */

/*
 * Macros to access Icon arguments in C functions.
 */

/*
 * n-th argument.
 */
#define Arg(n)	 	(cargp[n])

/*
 * Type field of n-th argument.
 */
#define ArgType(n)	(cargp[n].dword)

/*
 * Value field of n-th argument.
 */
#define ArgVal(n)	(cargp[n].vword.integr)

/*
 * Specific arguments.
 */
#define Arg0	(cargp[0])
#define Arg1	(cargp[1])
#define Arg2	(cargp[2])
#define Arg3	(cargp[3])
#define Arg4	(cargp[4])
#define Arg5	(cargp[5])
#define Arg6	(cargp[6])

/*
 * Code expansions for exits from C code for top-level routines.
 */
#define Fail		return A_Failure
#define Return		return A_Return

#define Suspend  { \
   int rc; \
   if ((rc = interp(G_Csusp,cargp)) != A_Resumption) \
      return rc;} 

#define Forward(agent) return Cat(A,agent)(cargp)

/*
 * Miscellaneous macro definitions.
 */

/*
 * Error exit from non top-level routines.
 */
#define RetError(n,v) {\
   k_errornumber = n;\
   k_errortext = "";\
   k_errorvalue = v;\
   return Error;}

/*
 * Get floating-point number from real block.
 */
#ifdef Double
#define GetReal(dp,res)	{ \
                         word *rp, *rq; \
                         rp = (word *) &(res); \
                         rq = (word *) &(BlkLoc(*dp)->realblk.realval); \
                         *rp++ = *rq++; \
                         *rp = *rq;} 
#else					/* Double */
#define GetReal(dp,res)	res = BlkLoc(*dp)->realblk.realval
#endif					/* Double */

/*
 * Absolute value of x (word).
 */
#if SASC
#define Abs(x) __builtin_abs(x)
#else					/* SASC */
#define Abs(x) (((x) < 0) ? (-(x)) : (x))
#endif					/* SASC */

/*
 * Maximum of x and y.
 */
#define Max(x,y)        ((x)>(y)?(x):(y))
#if SASC
#undef Max
#define Max(x,y)     __builtin_max(x,y)
#endif					/* SASC */

/*
 * Minimum of x and y.
 */
#define Min(x,y)        ((x)<(y)?(x):(y))
#if SASC
#undef Min
#define Min(x,y)     __builtin_min(x,y)
#endif					/* SASC */

/*
 * Some C compilers take '\n' and '\r' to be the same, so the
 *  following definitions are used.
 */
#if EBCDIC
/*
 * Note that, in EBCDIC, "line feed" and "new line" are distinct
 *  characters.  Icon's use of "line feed" is really "new line" in
 *  C terms.
 */
#define LineFeed '\n' /* if really "line feed", that's 37 */
#define CarriageReturn '\r'
#else					/* EBCDIC */
#define LineFeed  10
#define CarriageReturn 13
#endif					/* EBCDIC */

/*
 * Construct an integer descriptor.
 */
#define MakeInt(i,dp)	{ \
                 	 (dp)->dword = D_Integer; \
                         IntVal(*dp) = (word)(i);}

/*
 * Check whether a set or table needs resizing.
 */
#define SP(p) ((struct b_set *)p)
#define TooCrowded(p) \
   ((SP(p)->size > MaxHLoad*(SP(p)->mask+1)) && (SP(p)->hdir[HSegs-1] == NULL))
#define TooSparse(p) \
   ((SP(p)->hdir[1] != NULL) && (SP(p)->size < MinHLoad*(SP(p)->mask+1)))

/*
 * RunErr encapsulates a call to the function runerr, followed
 *  by Fail.  The idea is to avoid the problem of calling
 *  runerr directly and forgetting that it may actually return.
 */

#define RunErr(n,dp) {\
   runerr((int)n,dp);\
   Fail;\
   }

/*
 *  Vsizeof is for use with variable-sized (i.e., indefinite)
 *   structures containing an array of descriptors declared of size 1
 *   to avoid compiler warnings associated with 0-sized arrays.
 */

#define Vsizeof(s)	(sizeof(s) - sizeof(struct descrip))

/*
 * Offset in word of cset bit.
 */
#define CsetOff(b)	((b) & BitOffMask) 
/*
 * Address of word of cset bit.
 */
#define CsetPtr(b,c)	((c) + (((b)&0377) >> LogIntBits)) 
/*
 * Set bit b in cset c.
 */
#define Setb(b,c)	(*CsetPtr(b,c) |= (01 << CsetOff(b))) 
/*
 * Test bit b in cset c.
 */
#define Testb(b,c)	((*CsetPtr(b,c) >> CsetOff(b)) & 01) 

/*
 * Handy sizeof macros:
 *
 *  Wsizeof(x)	-- Size of x in words.
 *  Vwsizeof(x) -- Size of x in words, minus the size of a descriptor.	Used
 *   when structures have a potentially null list of descriptors
 *   at their end.
 */
#define Wsizeof(x)	((sizeof(x) + sizeof(word) - 1) / sizeof(word))
#define Vwsizeof(x)	((sizeof(x) - sizeof(struct descrip) +sizeof(word) - 1)\
			   / sizeof(word))
/*
 * Definitions and declarations used for storage management.
 */

#define F_Mark		0100000 	/* bit for marking blocks */

#define Static  1			/* collection is for static region */
#define Strings	2			/* collection is for strings */
#define Blocks	3			/* collection is for blocks */

/*
 * External definitions.
 */

extern char *currend;			/* current end of memory region */
extern uword blkneed;			/* stated need for block space */
extern uword strneed;			/* stated need for string space */
extern uword statneed;
extern dptr globals; 			/* start of global variables */
extern dptr eglobals;			/* end of global variables */
extern dptr gnames;			/* start of global variable names */
extern dptr egnames; 			/* end of global variable names */
extern dptr statics; 			/* start of static variables */
extern dptr estatics;			/* end of static variables */

extern dptr *quallist;			/* start of qualifier list */
extern word qualsize;

/*
 * Get type of block pointed at by x.
 */
#define BlkType(x)   (*(word *)x)

/*
 * BlkSize(x) takes the block pointed to by x and if the size of
 *  the block as indicated by bsizes[] is nonzero it returns the
 *  indicated size; otherwise it returns the second word in the
 *  block contains the size.
 */
#define BlkSize(x) (bsizes[*(word *)x & ~F_Mark] ? \
		     bsizes[*(word *)x & ~F_Mark] : *((word *)x + 1))

/*
 * If memory monitoring is not enabled, redefine function calls
 * to do nothing.
 */
#ifndef MemMon
#define MMAlc(n,t)
#define MMBGC(r)
#define MMEGC()
#define MMMark(b,t)
#define MMShow(d,s)
#define MMStat(a,l,c)
#define MMStr(n)
#define MMSMark(a,n)
#endif					/* MemMon */

#ifndef FixedRegions

/*
 * Information used with Icon's allocation routines with expandable-regions
 *  memory management.
 */

typedef int ALIGN;		/* pick most stringent type for alignment */

union bhead {			/* header of free block */
   struct {
      union bhead *ptr; 	/* pointer to next free block */
      uword bsize;		/* free block size */
      } s;
   ALIGN x;			/* force block alignment */
   };

typedef union bhead HEADER;
#define NALLOC 64		/* units to request at one time */

#define FREEMAGIC 0x807F	/* magic flag for free blocks (MemMon only) */

#endif					/* FixedRegions */