/*****************************************************************************

			      PilotForth

      Copyright (C) 1997, Ivan A. Curtis.  All rights reserved.

			       based on
C-FORTH: a portable, C-coded figFORTH interpreter by Allan Pratt April 1985.

This program may not be redistibuted in part or in whole without this Copyright
Message being included at the top of each file.

   This is free software, licensed under the GNU Public License V2.
		  See the file COPYING for details.

*******************************************************************************
*******************************************************************************

Filename:	Forth/prims.h

Description:	code for the primitive functions of PilotForth

Update History:   (most recent first)
   I. Curtis  15-May-97 20:59 -- v0.1 Released.
   I. Curtis  30-Apr-97 21:14 -- Created.

******************************************************************************/
/*
 * These are the definitions of the functions
 * which implement the primitive operation
 */
extern void zbranch(void);	/* add an offset (branch); if tos == 0 */
extern void ploop(void);	/* (loop); -- loop control */
extern void pploop(void);	/* (+loop); -- almost the same */
extern void pdo(void);		/* (do);: limit init -- [pushed to rstack] */
extern void i(void);		/* copy top of return stack to cstack */
extern void r(void);		/* this must be a primitive as well as I */
extern void digit(void);	/* digit: c -- FALSE or [v TRUE] */
extern void pfind(void); 	/* WORD TOP -- xx FLAG, where TOP is NFA to start at */
extern void enclose(void);
extern void cmove(void);	/* cmove: source dest number -- */
extern void fill(void);		/* fill: c dest number -- */
extern void ustar(void);
extern void uslash(void);	/* u/: NUM.LO NUM.HI DENOM -- REM QUOT */
extern void swap(void);		/* swap: a b -- b a */
extern void rot(void);		/* rotate */
extern void tfetch(void);	/* 2@: addr -- mem[addr+1] mem[addr] */
extern void store(void);	/* !: val addr -- <set mem[addr] = val> */
extern void cstore(void);	/* C!: val addr --  */
extern void tstore(void);	/* 2!: val1 val2 addr -- */
extern void leave(void);	/* set the index = the limit of a DO */
extern void dplus(void);	/* D+: double-add */
extern void subtract(void);	/* -: a b -- (a-b); */
extern void dsubtract(void);	/* D-: double-subtract */
extern void dminus(void);	/* DMINUS: negate a double number */
extern void over(void);		/* over: a b -- a b a */
extern void dup(void);		/* dup: a -- a a */
extern void tdup(void);		/* 2dup: a b -- a b a b */
extern void pstore(void);	/* +!: val addr -- <add val to mem[addr]> */
extern void toggle(void);	/* toggle: addr bits -- <xor mem[addr] */
extern void less(void);
extern void pcold(void);
extern void prslw(void);
#ifdef WANT_PSAVE
extern void psave(void);
#endif

/*
 * These are primitive operations which for performance
 * reasons are inlined
 */
 				/* push mem[ip] to cstack */
#define lit() { push (fth_mfetch(ip++)); }
			/* add an offset (this word) to ip */
#define branch() { ip += fth_mfetch(ip); }
			/* return a key from input */
#define key() { push(pkey()); }
		/* return TRUE if break key pressed */
#define qterminal() { pqterm(); }
				/* and: a b -- a & b */
#define and() { push (pop() & pop()); }
				/* or: a b -- a | b */
#define or() { push (pop() | pop()); }
				/* xor: a b -- a ^ b */
#define xor() { push (pop() ^ pop()); }
			/* sp@: push the stack pointer */
#define spfetch() { push (csp); }
			/* sp!: load initial value into SP */
#define spstore() { csp = fth_mfetch(S0); }
			/* rp@: fetch the return stack pointer */
#define rpfetch() { push (rsp); }
			/* rp!: load initial value into RP */
#define rpstore() { rsp = fth_mfetch(R0); }
			/* ;S: ends a colon definition. */
#define semis() { ip = rpop(); }
			/* @: addr -- mem[addr] */
#define fetch() { push (fth_mfetch(pop())); }
			/* C@: addr -- mem[addr] */
#define cfetch() { push (fth_mfetch(pop()) & 0xff); }
			/* push to return stack */
#define tor() { rpush(pop()); }
			/* pop from return stack */
#define fromr() { push (rpop()); }
			/* 0=: a -- (a == 0) */
#define zeq() { push ( pop() == 0 ); }
			/* 0<: a -- (a < 0) */
#define zless() { push ( pop() < 0 ); }
			/* +: a b -- (a+b) */
#define plus() { push (pop () + pop ()); }
			/* MINUS: negate a number */
#define minus() { push (-pop()); }
				/* drop: a -- */
#define drop() { pop(); }
			/* DOCOL: push ip & start a thread */
#define docol() { rpush(ip); ip = w + 1; }
			/* do a constant: push the value at mem[w+1] */
#define docon() { push (fth_mfetch(w + 1)); }
			/* do a variable: push (w+1) (the PFA) to the stack */
#define dovar() { push (w + 1); }
		/* execute a user variable: add UP to the offset found in PF */
#define douse() { push (fth_mfetch(w + 1) + ORIGIN); }

#define allot() { fth_callot(pop()); }
				/* comparison tests */
#define equal() { push(pop() == pop()); }
				/* not equal */
#define noteq() { push (pop() != pop()); }
				/* DODOES -- not supported */
#define dodoes() { errexit("DOES> is not supported."); }
				/* DOVOC -- not supported */
#define dovoc() { errexit("VOCABULARIES are not supported."); }
				/* (BYE) -- exit with error code */
#define pbye() { exit(0); }
				/* TRON -- trace at pop() depth */
#define tron() { trace = TRUE; tracedepth = pop(); }
				/* TROFF -- stop tracing */
#define troff() { trace = 0; }
