 /* aaaaaaaaaaaaa   aaaaa     aaaa	aaaaaaaaaaaaaaaaa
H3sm 1.4.m4
see, $segments...

H3m 3-stack programming interface (virtual machine design) in GNU C, m4,
	and GNU "as" assembler directives for x86.

199804 <--> 200003   Rick Hohensee
humbubba@smart.net	http://www.smart.net/~humbubba

199812	 Michael Somos "http://grail.cba.csuohio.edu/~somos/"
	non-endianness, routine delimiter comment lines, etc.

See also Ertl/Paysan GForth and GNU .info on gcc "labels as values",
the unix section 2 manpages, Linux man 2 intro in particular, and the
GNU .info on gas.

The sourcecode of the "Arith" and "calc" arbitrary precision arithmetic
packages for unices were consulted for this implementation of pyte
arithmetic, although pytes are quite different from numbers in those
systems.

Phil Koopman's book "Stack Computers; The New Wave" bears mention. It is
currently on the web at "http://www.cs.cmu.edu/~koopman/stack_computers/".

Also worth mention are the generally meritocratic and cooperative tones of
comp.lang.forth, MdFIG and linux-kernel@vger.rutgers.edu. Greg Patterson
was helpful at a particularly frustrating moment with C pointers. Two
design features of H3m were suggested by JET Thomas; the single-whole-pass
dictionary search method used by abbreviations, and that pyte sizes go up
to 256 bytes instead of 128. Explanations by Elizabeth Rather and others
in c.l.f led to me eliminating H3m words that access the parameter stack
pointer directly, since a pure stack that has no concept of a "stack
pointer" is sufficient for a stack machine, and probably preferable.  I
had a copy of John Brien's "Build Your Own Forth" webpage in my
/usr/src/H3m . (original URL is
"http://www.users.zetnet.co.uk/aborigine/byof.htm")

The printer Charles Lasitter of Durham, N.C. gave me has done yeoman
service as an essential debugging tool. As have the several PS/2's,
the Pentium, and the cash. I believe the technical term for the likes
of Chuck Lasitter is "angel".

H3m has also recieved direct help from Richard B. Johnson, Brian Raiter,
and direct help or inspiration from various anonymous Internet Relay Chat
personages. The nom_de_IRC's _Anarchy_, tm2, shaver and * come to mind.

As pertains copyrights and release thereof, H3m is not a derived work of
any prior work.

This version of H3m is hereby released into the public domain. I am of
the understanding that "public domain" does not release users of H3m from
the obligation of properly associating my name with the work. Subsequent
work I do on H3m may be released under more restrictive terms.

DESIGN

Virtual Machine Subroutine Threaded H3m.
	All "executable" dictionary cells contain actual addresses of code.
	The address of a sub-word is in the callER, following a "call"
	execution token cell, which is not present in more prevalent
	threading schemes.

Each of the 3 "stacks" has a distinctly different related ops from the other
2.

return
	The return stack will contain only xt's. An xt is what NEXT can use,
	an address space int-ply index to an atom, which is machine code.

pointer
	The H3m pointer stack is cell-sized, but contains only actual host
	address-space pointers usually. Such an entity is called a "pointer"
	from the H3m-user point of view. The pointer stack may be a bridge
	between the H3m VM and the host, but only with specific fundamentals
	for host services, such as system calls. Internally, the pointer stack
	index is usually left pointing to an occupied cell.
data
	The data stack operates on "pytes", groups of 1 <--> 256
	bytes. Boolean flags are the low byte of a pyte. False is zero.
	Non-zero is true. The H3m   true   word asserts 255 in a flagpyte.
	The stack index itself is byte-ply, but pyte operations are at Size.
	The data stack pointer points at the top occupied cell. This is
	important to keep in mind when changing Size.

	Size "Register"

	The current effective size of data stack operands is the Size state
	variable. There are user-visible accessors of this Size "register".
	Operations on pytes are in terms of Size, except where a pyte is
	treated as a flag or character.

So the 3 stacks are the data typing of H3m, in a sense. Typing is enforced
by the various operands. The data stack is where a datum can be treated
arbitrarily.

IMPLEMENTATION

Early versions may depend on 4 byte address cell.  For big-endian CPU see
"CONFIGURATION SWITCH" below.  Initial implementation. REQUIRES *GNU* C.

This H3m is for x86. The CPU-specific code is not much, but it is spread
around, so I'm not going to attempt to isolate it with the cpp #include
mechanism. If someone ports H3m to another platform I'll include the
whole thing in the package if they want, or a patch. The approximate
minimum machine-specific stuff for a unix would be the the exit, write and
read syscalls, which are the int 0x80 instruction on x86 Linux. This H3m
needs those syscalls for several primitives te be usable at all, and has
the calls coded in situ where needed. After those you'll want argv/env
passing, which requires machine opcodes, and other syscalls. A
per-keystroke input mechanism probably wants ioctl to set the tty to raw
mode, for example. I think.

H3m NEXT uses gcc labels_as_values and computed goto. The Linux syscalls
use gcc C expressions in asm statements. The idiom of this code overall is
what I call <C, `less-than C'. ip is a C "pointer to int", as needed for
gcc goto **. It's the only pointer declaration in H3m.

As of this writing H3m assumes a 32 bit address cell, but I suspect that
can be macro'ed out for a configurable cell size with little bloodshed.
Some of that has been done already.

C slash-asterisk comments beginning in leftmost character column are
appended to the glossary file by the Glossary script.

OK, let's get coding...	  */
	 /* bytes in an address cell */
#define CELLSIZE     sizeof(int)
#define STACKSIZE	0x2000

#define SUSPECT

 /* declare big empty stuff above main(). This keeps it out of the binary
		object file. (in .bss). This should be possible for
		block and buffer also, with some init code.	 */

typedef unsigned char byte;

int cells;

			/* allocate the front of .bss for heap. It's just 
			there, we don't use it's name. I tried to get some
			big buffers out of the dictionary, and failed, so
			the exe is several k bigger on disk than it might 
			otherwise be, but things are where thier names are 
			physically as per what you might expect.
			*/

asm (" .lcomm HEAP, 0x20000 ");

					/* data byte stack, byte access array */
byte		ds[STACKSIZE];
					/* byte-only data stack, everything gets
					converted to bytes internally in this
					implementation.	 */
int		rs[256];		/* return stack itself, ints = xt's */
int		ps[256];		/* the pointer stack itself, an array of
					 *****ints*******	   */

	/* these declarations are above main() to please arg_env.o
and gcc -nostdlib  */

int argc, i;
char ** argv;
int argspan ;

 /* CONFIGURATION SWITCH  CONFIGURATION SWITCH
endianism stuff, change $1 $2 $3 $4 to $4 $3 $2 $1 for big-endian,
(after	Michael Somos). In re 64-bit etc. I'm open to advice.  */

define(ENDIANCELL,
asm ("		.byte $1
		.byte $2
		.byte $3
		.byte $4	"); )

 /* cpp/C macros for within atoms */

#define DROP	dsi = dsi - Size ; if (dsi < 0) { dsi=0; }
#define BUMP	dsi = dsi + Size ;
#define TRUE	dsi = dsi + Size ; ds[dsi] = 255 ;
#define FALSE	dsi = dsi + Size ; ds[dsi] = 0 ;

 /* comment-anywhere macros */

			/* overwrite TOS with cell above TOS */
#define MASH				\
j = Size;				\
while ( j-- )				\
{ ds[dsi + j] = ds[dsi + j + Size] ; }	\

 /*  ######  pyte arithmatic declarations  #######    */
typedef unsigned short	dual;		/* 16 bits. 2 bytes.  */

byte bytes[512], modulo[256];
dual accum[256];
dual head;

 /* digits up to base 16. I prefer lowercase. Also, e.g. FF is then a WORD
only. Handy. */
char  digitOut[] = {	'0','1','2','3','4','5','6','7','8','9',
			'a','b','c','d','e','f'	 };

char numberString[512];		/* to save syscalling write on each digit */

 /* convert.[bi] bytes-to-int zone */
union  intbyte	{
	int    i;
	byte   b[CELLSIZE];
		} convert;

 /* MAIN MAIN MAIN MAIN MAIN MAIN MAIN MAIN MAIN MAIN MAIN MAIN
H3m is all in one C "function".	  */

char main(){	   /*

With gcc -nostdlib we get a stdIO, argv, envp...
If you want to exit cleanly you call the exit syscall, AKA quit.
There's the C-time init stuff here, and then a branch over all the
dictionary code to a NEXT that "increments ip" to H3m-time. */

int  Size = CELLSIZE  ;	 /* instruction pointer, program counter,
				what NEXT jumps to, and post-increments.
				Register declarations (ip in esp, dsi in
				ebp) I've tried weren't worthwhile.	 */

 int * ip  ;	/* instruction pointer, see NEXT */

int		dsi;
int		rsi;			/* return stack index */
int		psi;			/* pointer stack index */

int		scratch;

int ds0 = (int)&ds;	/* int faux pointer to ds array. GNU cc only? */
int rs0 = (int)&rs;

byte signA, signB ;		  /* signs of args and result */

int   gross;
byte  net;

 /*		NEXT NEXT NEXT NEXT NEXT NEXT NEXT
 In a real CPU the instruction pointer is incremented over code
automatically by every instruction. In a software Forthoid, the NEXT code
snippet at the end of each primitive does this. This is also called the
"inner interpreter", or address interpreter. H3m NEXT uses GNU cc
computed goto. ip is post-incremented.	When in a word, ip is pointing at
next word in calling thread. It occurs to me that inlining could be easy.
Just sling code together and lose NEXT. LAAETTR.  */

#define NEXT   goto **ip++;

int i, j, k, K, e ;
byte bite;

ps[psi] = 0xc001c001;			/* base of ps marker, psi 0 */

 /* set commandline args as H3m parse bounds. H3m `token' works vis-a-vis
	unix "whitespace".						*/

*(int *)&&epal	  = (int)argv[argc+1] ;
*(int *)&&thisl	   = (int)argv[0];

 /* basic variable initialization		*/
*(int *)&&dpaddy = (int)&&initial_HERE + 1000 ;
*(int *)&&latest = (int)&&initial_LATEST ;

 /* open "stdaux" to tty			*/

__asm__	 ("int $0x80"
	: "=a" (convert.i)
	: "0" (5),"b" ("/dev/tty"),"c" (0),
	  "d" (0)  );

 /* we go from sequential C to NEXT-threaded H3m in 2 moves.		*/
ip = &&zygote ;
 /* ip now contains the address of the HNC of the word "zygote" .	*/
 /* Later the init code does a NEXT like it's a H3m atom and
	it's H3m-time.				*/

goto initial_HERE;

 /* The atoms are the actual runtime machine code of H3m. They are what
the NEXTs call, once H3m itself is running.  The following code has to be
*compiled* here, but where it gets called from and where it jumps to is
what the labels are for, so we skip it for now with a goto.  Everything we
need the real machine for should be in here.  We use gotos ( in NEXT
primarily), but in the manner of _uncooked_ spaghetti, i.e. the gotos of
the NEXTs of each word are laminar, not tangled. There are no cross-word
gotos or fall-throughts. Fall-throughs would be OK, but aren't necessary.
This breaks gcc jump-optimization, e.g. gcc -O1 will remove all the atoms.
H3m is almost un-optimizable anyway though, AFAICT. Apparently gcc produces
code by default that e.g. peephole optimizing can't improve on much.

For some words that need stack items they don't modify, I use
( required ||| consumed --- produced )	 e.g.	  over	  ( a b ||| --- a )

"|null" means "or no stack item". I wish stack comments were concise, but no
guarantees. Running stack comments within words are particularly ad-hoc.

!SIZE  means word probably modifies Size.

AARDVARK!  AARDVARK!  aardvark exists just to be un-'-able due to 0 count
byte, ie. no name, and/or code field, and to be the starting point for the
dictionary linking. Handrolled ( non-macro )  empty neck.
The way to terminate a namespace traversal is when an HNC has a 0 length
byte. :NONAME isn't a problem because that's not a linked thing at all,
is it?
*/

asm	("
	1:
	0:
	.byte 0
	.byte 0
	.byte 0
	.byte 0
	.ascii \"aardvark\"
	.align 4, 0
	.int  0
	.int  0
	");
aardvark:

 /* m4m4m4m4m4m4m4m4m4m4m4 m4 macro to do dictionary things as assembly
directives.  Doing this as macros in cpp doesn't appear to be possible due
to `"' issues. The semantic overhead of an m4 pass is well paid for by the
strikingly Forthish simplicity of doing what we actually want to do
directly.

There's some running m4 logic to toggle the labels produced in each header
due to some rigidity of gas.  Thanks to Andi Kleen for the general idea.
He further suggests using a counter instead of a mere toggle, which may
come into play with multiple vocabularies, I guess. I'm still open to
simpler methods. I'm not dead sure gas can't do this on it's own, even.
 */

define(`ALTLABEL', 0:)
define(`ALTREF', 1b )

 /* these need to take a C/asm name and a H3m name.
	These could be hand-adjusted for CELL other than 4  */

define(ATOM_,
`ifelse(ALTLABEL,0:, `define(`ALTLABEL', 1:)  define(`ALTREF', 0b)',
		    `define(`ALTLABEL', 0:)  define(`ALTREF', 1b)' )'

asm	("
	`ALTLABEL'
	.byte	`len($2)'
	.byte	0
	.byte	0x80
	.byte	0
	.ascii	\"`$2'\"
	.align	4, 0
	.int	`ALTREF'
	.equ	`$1'CFA, .
	");
`$1':
)
define(HATOM_,
`ifelse(ALTLABEL,0:, `define(`ALTLABEL', 1:)  define(`ALTREF', 0b)',
		    `define(`ALTLABEL', 0:)  define(`ALTREF', 1b)' )'

asm	("
	`ALTLABEL'
	.byte	`len($2)'
	.byte	0
	.byte	0x80
	.byte	1
	.ascii	\"`$2'\"
	.align	4, 0
	.int	`ALTREF'
	.equ	`$1'CFA, .
	");
`$1':
)

define(THREAD_,
`ifelse(ALTLABEL, 0:, `define(`ALTLABEL', 1:) define(`ALTREF', 0b)' ,
			`define(`ALTLABEL', 0:) define(`ALTREF', 1b)' )'
asm	("
	`ALTLABEL'
	.byte `len($2)'
	.byte 0
	.byte 0
	.byte 0
	.ascii \"`$2'\"
	.align 4, 0
	.int  `ALTREF'
	.equ	`$1'CFA, .
	");
)

 /* The m4 pass is first. In most of these macros we compute the length of
the word name at m4-time, which means we need another macro if we need
escapes for .ascii's in asm, which look like name chars to m4. This is the
case for H3m names containing " . */

define(THREAD_NAMELEN,
`ifelse(ALTLABEL, 0:, `define(`ALTLABEL', 1:) define(`ALTREF', 0b)' ,
			`define(`ALTLABEL', 0:) define(`ALTREF', 1b)' )'
asm	("
	`ALTLABEL'
	.byte $3
	.byte 0
	.byte 0
	.byte 0
	.ascii \"`$2'\"
	.align 4, 0
	.int  `ALTREF'
	.equ	`$1'CFA, .
	");
)

 /* this is a thread header vith a non-user bit for leaving
interpreter-only  words and such out of "words", i.e. mildly hidden. */

define(NON_USER,
`ifelse(ALTLABEL, 0:, `define(`ALTLABEL', 1:) define(`ALTREF', 0b)' ,
			`define(`ALTLABEL', 0:) define(`ALTREF', 1b)' )'
asm	("
	`ALTLABEL'
	.byte `len($2)'
	.byte 0
	.byte 0
	.byte 1
	.ascii \"`$2'\"
	.align 4, 0
	.int  `ALTREF'
	.equ	`$1'CFA, .
	");
)

 /* "threading" words are analagous to Forth immediate words */

define(THREADING,
`ifelse(ALTLABEL, 0:, `define(`ALTLABEL', 1:) define(`ALTREF', 0b)' ,
			`define(`ALTLABEL', 0:) define(`ALTREF', 1b)' )'
asm	("
	`ALTLABEL'
	.byte `len($2)'
	.byte 1
	.byte 0
	.byte 0
	.ascii \"`$2'\"
	.align 4, 0
	.int  `ALTREF'
	.equ	`$1'CFA, .
	");
)

 /*
real fundamentals/primitives...
possible other primitives; move, fill, endianism converters, charsearch
 aaaaaaaaaaaaaaaaaaaaaaaaaaaa================= */

 /* comments formatted for Glossary ggggggggggggggggggggGGGGGGGGGGGgggg */
/* glossary may include NON_USER words "words" hides.			*/
/* H3m is case-sensitive. Booleans OR, AND, XOR and NOT are uppercase.	*/
/* H3m abbreviation/pronounciation  conventions:			*/
/* */
/*	@	!	->	.	&	'	$		*/
/*	fetch	store	to	print	append	tick	segment		*/
/* */
/* & (append) is analagous to Forth `comma'.				*/
/* @ is usually a copy, -> is usually a move or pop, source is dropped. */
/* & in stack comments, e.g. &HNC, sometimes means "address of"		*/
/* ||| means "stuff to the left is required but not changed".		*/
/* if* words like if, ifchar etc. produce flagpytes.			*/
/* format		(optional fields, optional order)		*/
/* name		`pronounced'   stacks effects	 "parsing syntax"   other  */
/* */
/*	ATOMS... */

 /*============================================= */
 /*================= visible dictionary ============================ */


/* address	(P --- ptr ) !rsi  action of named data, Forth VARIABLE */
ATOM_(address,address)		      /*      (P --- ptr )

Push our DFA address. analogue of Forth "dovar", but to pointer stack */

 /* threading issue */
ps[++psi] = (int) ip ;	 /* pointer stack is pre-increment. */
ip = (int *) rs[rsi--] ; /* An inline Return. Data instance words are CALLed,
				but do their own Return.  */
NEXT


 /*============================================= */

/* AND		( pytea pyteb ---  aANDb ) the bitwise Boolean		*/
ATOM_(AND,AND)

 /* example partial optimization using GNU C compound lvalues and
	taking the address of an array (ds0), allowing accessing a
	byte array as ints. 
*/

DROP
if (Size == 4)
	{
	*(int *)(ds0 + dsi) =
		*(int *)(ds0 + dsi) & *(int *)(ds0 + dsi + 4);
	}
else	{
	for ( i = 0 ; i < Size	; i++ )
		{  j=dsi+i;
		*(byte *)(ds0 + j)  =
			*(byte *)(ds0 + j) & *(byte *)(ds0 + j +Size);
		}
	}
NEXT


 /*============================================= */

/* aint		( flagp --- !flagp ) casual NOT, bitwise on lsB.	*/
ATOM_(aint,aint)
ds[dsi] = ~ ds[dsi] ;
NEXT

 /*============================================= */

/* align		(P  a  --- a_rounded_up_to_CELLSIZE)		*/
ATOM_(align,align)

ps[psi] = (ps[psi] + 3) & 0xfffffffc ;
NEXT

 /*============================================= */

/* bump		( ---  old_pyte ) undrop. Only useful in threads. */
ATOM_(bump,bump)

dsi = dsi + Size ;
NEXT

 /* =============================== */

/* bytes		1 -> Size		*/
ATOM_(bytes,bytes)
Size = 1 ;
NEXT

 /*============================================= */

/* bbytesd	bump 1->Size drop      */
ATOM_(bytes_bd,bbytesd)
dsi = dsi + Size ;
Size = 1 ;
dsi = dsi - Size ;
NEXT


 /* =============================== */

/* bcellsd	bump sizeof(int)->Size drop	 */
ATOM_(cells_bd,bcellsd)
dsi = dsi + Size ;
Size = CELLSIZE ;
dsi = dsi - Size ;
NEXT


 /* =============================== */

/* cells		sizeof(int) -> Size		*/
ATOM_(cells,cells)
Size = CELLSIZE ;
NEXT


  /*============================================= */

/* drop		( pyte --- )			*/
ATOM_(drop,drop)
dsi = dsi - Size ;
NEXT


 /*============================================= */

/* dup		( pytea ||| ---	 pytea )  i.e.	  ( a --- a a )	   */
ATOM_(dup,dup)
BUMP
for (i = 0; i < Size; i++)
	ds[dsi+i]=ds[dsi+i-Size];
NEXT


 /*============================================= */

/* downshift	( shiftee amount --- shifted ) down-significance bitshift*/
ATOM_(dshift,downshift)
DROP
switch (Size){

case 4 :
	*(int *)(ds0+dsi) = *(int *)(ds0+dsi) >> *(char *)(ds0+dsi+Size);
	break;
case 1 :
	*(char *)(ds0+dsi) = *(char *)(ds0+dsi) >> *(char *)(ds0+dsi+Size);
	break;
case 2 :
	*(short *)(ds0+dsi) = *(short *)(ds0+dsi) >> *(char *)(ds0+dsi+Size);
	break;
case 3 :
	*(int *)(ds0+dsi) = *(int *)(ds0+dsi) >> *(char *)(ds0+dsi+Size);
	break;
default:
	*(int *)(ds0+dsi) = *(int *)(ds0+dsi) >> *(char *)(ds0+dsi+Size);
	break;
}
NEXT


 /*============================================= */

/* double		up-roll Size by 1, > 256 wraps	*/
ATOM_(dubble,double)

convert.i = Size << 1 ;
Size = (int)(convert.b[0] | convert.b[1]) ;
NEXT


 /*============================================= */

/* doHNC		(P &HNC	 --- ) (R; --- RET|null) execute word given &HNC */
ATOM_(doHNC,doHNC)

 /* both cases below do an inline TOcode, but there's an extra degree of
	indirection with a thread CFA, which is a pointer to code.
	An atom's CFA *is* executable machine code.			*/

if ( !	(*(int *)ps[psi] & 0x00800000))	  /* if atomic bit not set....	*/
	{
	rs[++rsi] = (int )ip ;		/* push a return addy		*/

	/*  contentsof.. |<-&HNC->| + |<--- offset to CFA	     --->| */
	ip = (int *)	 (ps[psi]  +  ((*(byte *)ps[psi] + 3)  & 0xfc) + 8) ;

	/* pdrop */
	psi--;
	NEXT
	}

 /*	|<-&HNC->| + |<--- offset to CFA		-->| */
goto *	(ps[psi--]   + ((*(byte *)ps[psi] + 3 ) & 0xfc) + 8 ) ;


 /*============================================= */

/* emit		(pyte --- )  ascii print lsB. not buffered.    */
ATOM_(emit,emit)
__asm__	 ("int $0x80"
	: "=a" (convert.i)
	: "0" (4),"b" (1),"c" (&ds[dsi]),
	  "d" (1) );
DROP
NEXT


 /*============================================= */

/* ell		unconditional branch to address in next thread cell */
ATOM_(ell,ell)
ip = (int *)*ip ;	  /*  put the int following this instr. in ip */
NEXT


 /*============================================= */

/* false		( --- 0flagpyte )  fast false lsB  */
ATOM_(false,false)

BUMP
ds[dsi]= 0;
NEXT


 /*============================================= */

/* @		(P ptr ||| --- ) ( --- pyte ) fetch pyte at ptr at Size */
ATOM_(fetch,@)

BUMP
for ( i = 0 ; i < Size ; i++)
	{ ds[dsi + i] = *(byte *)(ps[psi]+i) ;
	}
NEXT


 /*============================================= */

/* @+		(P ptr --- ptr+Size ) ( --- pyte )		 */
ATOM_(fetchplus,@+)
				/* Bubb^H^H^H Chuck likes it	*/
BUMP
for ( i = 0 ; i < Size ; i++)
	{ ds[dsi + i] = *(byte *)(ps[psi]+i)  ;
	}
ps[psi] = ps[psi] + Size;
NEXT


 /*============================================= */

/* getSize	(P --- Size )	 */
ATOM_(getSize,getSize)
ps[++psi] = Size ;
NEXT


 /*============================================= */

/* gap		(P a b ||| ) ( --- a-b ) bytes between addresses */
ATOM_(gap,gap)
BUMP
convert.i =  ps[psi - 1] - ps[psi]  ;
for ( i = 0 ; i < CELLSIZE ; i++ )
	{ ds[dsi +i] = convert.b[i] ;
	}
NEXT

 /*============================================= */

/* halve		down-roll Size by 1 bit, i.e. Size=Size/2 usually*/
ATOM_(halve,halve)

convert.i = Size << 7 ;
Size = convert.b[0] | convert.b[1] ;
NEXT


 /*============================================= */

/* H3sm		no-op. No action besides increment VM instruction pointer */
ATOM_(H3sm,H3sm)
NEXT


 /*============================================= */

/* if		( pyte --- flagpyte ) OR pyte into lsB, make it a flag */
ATOM_(flag,if)
bite = 0 ;
for ( i= 0 ; i < Size ; i++ )
	{ if ( ds[dsi + i] )
		{ bite = 255 ;
		   break ;
		}
	}
ds[dsi] = bite ;
NEXT


 /*============================================= */

/* ifcontents=	(P &a &b ||| ) ( ---  flag ) compare pointed-to pytes	*/
ATOM_(ifcontentsequal,ifcontents=)
			/* HAS been seen to produce 2 different flags */
BUMP
bite = 255 ;
for ( i = 0 ; i < Size ; i++ )
	{ ds[dsi + i] = 0;
	if (  *(byte *)(ps[psi-1]+i) != *(byte *)(ps[psi]+i)   )
		{ bite = 0 ;
		}
	}
ds[dsi] = bite ;
NEXT


 /*============================================= */

/* if=		( a b --- flagpyte ) 0xXX..ff (true) if a = b  */
ATOM_(ifequal,if=)
			/* are top two pytes equal?   flag for ifbranch/tee */
bite = 255;			     /* boolean accum set to true */
DROP
for ( i = dsi ; i < dsi + Size ; i++ )
	{ if ( ds[i] != ds[i +	Size] )
		{  bite = 0;	    /* not =, set to false and exit loop */
		break;
		}
	}
ds[dsi] = bite;		      /* flagbyteTOS set to result boolean */
NEXT


 /*============================================= */

/* ifpositive	( a  --- flagpyte )  0 considered positive  */
ATOM_(ifpositive,ifpositive)

if ((byte)ds[dsi+Size-1] & (byte)0x80 )
	{ ds[dsi] = 0 ;
	}
else	{ ds[dsi] = 0xff ;
	}
NEXT


 /*============================================= */

/* ip+		( ip_index --- ) execution-array mechanism, computed goto */
ATOM_(ipplus,ip+)
e = Size;
if ( Size > CELLSIZE ) e = CELLSIZE ;
convert.i = 0;
while (e)
	{ e--;
	convert.b[e] = ds[dsi+e];
	}
ip = (int *)*(ip + convert.i) ;
DROP
NEXT	/* CASE BRANCH */


  /* ============================================= */

/* literal	( --- pyte )  in-thread literal pyte number to ds
	works at Size 4 and 1 */
ATOM_(literal,literal)

 /* put a pyte from the thread onto the data stack, runtime action of
a literal number in a thread. Literals have a size cell, but are pushed
at *current* Size. ip is a pointer to int, so we use convert.i/b.

This word should generalize to big pytes with an int loop if we clobber
the undrop area of the stack if litsize > Size, thus avoiding a different
big_literal word.
*/

j = *ip++ ;			/* j = lit size */
convert.i = *ip;		/* convert.i = lit value */
ip ++ ;				/* skip size cell and cell literal itself */
BUMP
ds[dsi	] =  convert.b[0];
ds[dsi+1] =  convert.b[1];
ds[dsi+2] =  convert.b[2];
ds[dsi+3] =  convert.b[3];
NEXT

  /*  something like...
j = (*ip++/CELLSIZE)+1;
i = 0;
while (j--)
	{ convert.i = *ip++;
	ds[dsi+i++] = convert.b[0]
	ds[dsi+i++] = convert.b[1]
	ds[dsi+i++] = convert.b[2]
	ds[dsi+i++] = convert.b[3]
	}
NEXT
*/


 /*============================================= */

/* max		( a b --- maxab ) Min's hubby.			*/
ATOM_(max,max)

					/* neg = 128, pos = 0 */
signA = ds[dsi + Size - 1] & 128 ;
DROP
signB = ds[dsi + Size - 1] & 128 ;

if ( signA > signB )			/* negative was dropped, done. */
	{ NEXT }
if ( signA < signB )			/* positive was dropped */
	{ MASH	NEXT }
i = Size;				/* if we're here signs are equal */
while (i--)		/* walk the bytes from msB till they differ */
	{ if ( ds[dsi + i] > ds[dsi + i + Size])
		{ NEXT }
	  if ( ds[dsi + i] < ds[dsi + i + Size])
		{ MASH NEXT
		}
	}	/* bytes equal at latest magnitude, try next lower byte */
NEXT		/* no bytes differ, numbers equal, finito. */


 /*============================================= */

/* min		( a b --- min_ab) Max's better half.		*/
ATOM_(min,min)
					/* neg = 128, pos = 0		*/
signA = ds[dsi + Size - 1] & 128 ;
DROP
signB = ds[dsi + Size - 1] & 128 ;

if ( signA < signB )			/* negative was dropped, done.	*/
	{ NEXT }
if ( signA > signB )			/* positive was dropped		*/
	{ MASH	NEXT }
i = Size;				/* if we're here signs are equal */
while (i--)		/* walk the bytes from msB till they differ */
	{ if ( ds[dsi + i] < ds[dsi + i + Size])
		{ NEXT }
	  if ( ds[dsi + i] > ds[dsi + i + Size])
		{ MASH NEXT
		}
	}	/* bytes equal at latest magnitude, try next lower byte */
NEXT		/* no bytes differ, numbers equal, finito. */


 /*============================================= */

/* maskbyte	( a --- a&0x00...00ff ) mask off all but lsB   */
ATOM_(maskbyte,maskbyte)
	       /* a violation of my at_least_3_component_words factoring rule.
			This is a just pyte constant and an AND, but it seems
			to make sense as one word, perhaps even in silicon.
			For one thing, this gets used a lot. */
ds[dsi] = ds[dsi] & 255 ;
for ( i = 1 ; i < Size ; i++ )
	{ ds[dsi +i] = 0 ;
	}
NEXT


 /*============================================= */

/* move		(P from to |||) (cnt ---)  move cnt bytes, overlaps are OK.
			You can't use this with the input buffer and 'this' */
ATOM_(move,move)

convert.i = 0 ;
for ( i = 0 ; (i < CELLSIZE) & (i < Size) ; i++)
	{ convert.b[i] = ds[dsi+i];
	}
DROP
if ( ps[psi] > ps[psi -1] )
	{  for (i = convert.i-1 ; i >= 0 ; i--)
		{ *(byte *)(ps[psi]+i) = *(byte *)(ps[psi-1]+i) ;
		}
	}
else	{  for (i = 0 ; i < convert.i ; i++)
		{ *(byte *)(ps[psi -1]+i) = *(byte *)(ps[psi]+i) ;
		}
	}
NEXT


 /*============================================= */

/* -?r		( --- flagpyte )  (R c --- c-1) is TOR nonzero before decrement?*/
ATOM_(minusaskr,-?r)

BUMP
if( rs[rsi]-- )
	{ *(char *)(ds0+dsi) = 255;
	}
else	{ *(char *)(ds0+dsi) = 0 ;
	}
NEXT


 /*============================================= */

/* NOT		( pyte --- !pyte )   bitwise NOT of all bits	*/
ATOM_(NOT,NOT)

i = Size;
while (i-- )
	{ ds[dsi +i] = ~ ds[dsi +i];
	}
NEXT


 /*============================================= */

/* negate		( a --- 2's_complement_negative_a )	*/
ATOM_(negate,negate)
bite = 1 ;
for ( i = dsi ; i < dsi + Size ; i++ )
	{ if ( ds[i]==0 && bite ) bite |= 2 ;
	ds[i] = ((byte)0xff - ds[i]) + (bite&1) ;
	bite = bite>>1 ;
	}
NEXT


 /*============================================= */

/* no		( flagpyte --- ) branch to address in ip (the next cell) if 0  */
ATOM_(no,no)
if ( ds[dsi] )		/* conditional on low-order byte of current pyte */
	{ ip++ ;		/* skip branch target addy */
	}
else
	{ ip = (int *)*ip;	/* put the int following this instr. in ip */
	}
DROP
NEXT


 /*============================================= */

/* over		( a b --- a b a ) the Forth usual OVER, but on pytes.	*/
ATOM_(over,over)
BUMP
e = Size << 1 ;			      /* 2x Size */
for (i = 0  ; i < Size	; i++ )
	{ ds[dsi + i]=ds[dsi + i - e];
	}
NEXT


 /*============================================= */

/* onbits		( --- -1 )  all_ones pyte constant, 2's compl. -1 */
ATOM_(onbits,onbits)
BUMP
i = Size ;
while (i-- )
	{ ds[dsi + i ] = 255 ;
	}
NEXT

 /*============================================= */

/* one		( --- 1	 ) 1 as a pyte constant	  */
ATOM_(one,one)
BUMP
ds[dsi] = 1 ;
for ( i = 1 ; i < Size ; i++ )
	{ ds[dsi + i] = 0 ;
	}
NEXT

 /*============================================= */

/* OR		( pytea pyteb --- pyteaORb ) bitwise Booolean OR    */
ATOM_(OR,OR)
DROP
i = Size ;
while (i-- )
      {	 j = dsi + i ;
	  ds[j] = ds[j + Size] | ds[j] ;
	}
NEXT


 /*============================================= */

/* pdrop		(P ptr --- )  decrement pointer stack index */
ATOM_(pdrop,pdrop)
--psi;
NEXT


 /*============================================= */

/* p@		(P ptr1	 ---  ptr2 ) ptr1 overwritten */
ATOM_(pfetch,p@)
				/* Forth @, if param stack is ptr stack */
ps[psi] = *(int *)ps[psi]   ;
NEXT


 /*============================================= */

/* pdup		(P ptra --- ptra ptra )	 */
ATOM_(pdup,pdup)
ps[++psi] = ps[psi -1 ] ;
NEXT


 /*============================================= */

/* pliteral	(P --- lit )	next cell in thread to P.
		pointless from interpreter, needs a threading wrapper. */
ATOM_(pliteral,pliteral)

ps[++psi] = *ip++ ;
NEXT


 /*============================================= */

/* +		( a b --- a+b )	 2's-complement addition of pytes  */
ATOM_(plus,+)
DROP
bite = 0 ;
for ( i = dsi ; i < dsi + Size	; i++ )
	{ if ( (~ds[i]&0xff)<ds[i+Size] || ((~ds[i]&0xff)==ds[i+Size]&&bite) )
 /* COMMENT THIS. OPTIMIZE THIS.  */
	     bite |= 2 ;
	ds[i] += ds[i+Size] + (bite&1) ; bite = bite>>1 ;
	}
NEXT


 /*============================================= */

/* pover		`pea over'  (P a b --- a b a ) pointer-stack OVER */
ATOM_(pover,pover)
ps[++psi] = ps[psi -2 ] ;
NEXT


 /*============================================= */

/* p+		( pyte --- ) (P a --- a+(int_part_or_less_of)pyte ) */
ATOM_(plusp,p+)
convert.i = 0;
j = Size;
if ( Size > CELLSIZE )
	j = CELLSIZE;
for (i=0 ; i < j ; i++ )
	{ convert.b[i] = ds[dsi+i];
	}
ps[psi] = ps[psi] + convert.i ;
DROP
NEXT


 /*============================================= */

/* p+s		(P a --- a+Size ) index a pointer by Size	*/
ATOM_(ppluss,p+s)
ps[psi] = ps[psi] + Size;
NEXT


 /*============================================= */

/* p+1		(P a --- a+1 )	index a pointer by one		*/
ATOM_(pplusb,p+1)
ps[psi] = ps[psi] + 1 ;
NEXT


 /*============================================= */

/* p+c		(P a --- a+cellsize ) index a pointer by cellsize (x86 is 4) */
ATOM_(pplusc,p+c)
ps[psi] = ps[psi] + CELLSIZE ;
NEXT


 /*============================================= */

/* p-c		(P a --- a-cellsize ) decrement pointer by cellsize (4 on x86) */
ATOM_(pminusc,p-c)
ps[psi] = ps[psi] - CELLSIZE ;
NEXT


 /*============================================= */

/* p-1		(P ptr --- ptr+1 ) decrement a pointer			*/
ATOM_(pminus1,p-1)
ps[psi] = ps[psi] - 1 ;
NEXT


 /*============================================= */

/* p->		(P a --- ) ( --- a_low[a_hi] ) if (Size > cellsize) then 0-pad	*/

ATOM_(pTO,p->)
BUMP
for ( i = CELLSIZE ; i < Size ; i++ )	/* do an in-line zero first maybe */
	{	ds[dsi + i] = 0;
	}
*(int *)(ds0+dsi) = ps[psi--] ;
NEXT


 /*============================================= */

/* p->r		(P a --- ) (R; --- a ) */
ATOM_(pTOr,p->r)
rs[++rsi] = ps[psi--] ;
NEXT


 /*============================================= */

/* p->S		(P Size --- )  !Size   superceeded?	*/
ATOM_(pTOs,p->s)
Size = ps[psi]	& 0x1ff;	/* 19991225 */
psi--;
NEXT


 /*============================================= */

/* p!		`pea store' (P p  store	 |||  ) p goes in store, no pdrops  */
ATOM_(pstore,p!)

*(int*)ps[psi] = ps[psi-1] ;
NEXT


 /*============================================= */

/* pswap		(P a b --- b a )	*/
ATOM_(pswap,pswap)
scratch = ps[psi] ;
ps[psi] = ps[psi - 1] ;
ps[psi - 1] = scratch ;
NEXT


 /*============================================= */

/* pup		(P ---	oldptr )		       */
ATOM_(pup,pup)
++psi;
NEXT


 /*============================================= */

/* return		(R; xt	--- )  VMST rts to calling thread   */
ATOM_(Return,return)
ip = (int *)rs[rsi--];
NEXT				/* goto **ip++; */


 /*============================================= */

/* rdrop		(R; a --- ) */
ATOM_(rdrop,rdrop)
rsi-- ;
NEXT


 /*============================================= */

/* rpcopy		(R; a ||| ) (P --- a ) dup r to p   */
ATOM_(rpcopy,rpcopy)
ps[++psi] = rs[rsi] ;
NEXT


 /*============================================= */

 /* r-1		(R: val --- val-1 )  decrement TOR
ATOM_(rminus1,r-1)
rs[rsi]--;
NEXT */


 /*============================================= */

/* <-r		(R; val --- ) ( --- 0000val )  4 live bytes written to ds  */
ATOM_(rTO,<-r)
BUMP
for ( i = CELLSIZE ; i < Size ; i++ )	/* zero out bytes > CELLSIZE  */
	{	ds[dsi + i] = 0;
	}
*(int *)(ds0+dsi) = rs[rsi--] ;
NEXT


 /*============================================= */

/* r->p		(R; ptr --- ) (P --- ptr ) symmetrical with p->r. */
ATOM_(rTOp,r->p)
ps[++psi] =  rs[rsi--] ;
NEXT


 /*============================================= */

/* r->s		(R; size --- )	!SIZE */
ATOM_(rTOs,r->s)
Size = rs[rsi--] & 0x1ff ;	/* 19991225 */
NEXT


 /* ============================================= */

/* swap		( pytea pyteb --- pyteb pytea ) */
ATOM_(swap,swap)

j = dsi - Size ;
for ( i = 0; i < Size  ; i++ )
	{ bite = ds[dsi + i] ;
	ds[dsi + i] = ds[dsi -Size + i] ;
	ds[dsi - Size  + i] = bite ;
	}
NEXT


 /*============================================= */

/* setSize	( Size --- )  Silently refuses to set Size to 0. */
ATOM_(setSize,setSize)
if ( ds[dsi] & 0xff )
Size = ds[dsi] ;	/* 19991225 */
DROP
NEXT


 /*============================================= */

/* s->r		(R; --- Size ) Size to return stack		*/
ATOM_(sTOr,s->r)
rs[++rsi] = Size ;
NEXT


 /*============================================= */

/* s->p		(P --- Size )  Size to pointer stack		*/
ATOM_(sTOp,s->p)
ps[++psi] = Size ;
NEXT


 /*============================================= */
					/* Got milk? */

/* !		(P ptr ||| ) ( pyte --- ) pointer is not dropped */
ATOM_(store,!)
 /* OPTIMIZE ME. Why? p! is fast. */
for ( i = 0 ; i < Size ; i++ )
	{ *(byte *)(ps[psi]+i) = ds[dsi+i];
	}
DROP
NEXT


 /* ============================================= */

/* sub		(R; --- ip+ ) ip!   go subthread, other uses. Essence of VMST	*/
ATOM_(sub,sub)
				/* recall that ip has been incremented by
					NEXT already */
rs[++rsi] = (int)(ip + 1 ) ;	/* push cell after callee cell to rs  */
ip = (int *)*ip;		/* ip is (callee cell), NEXT will jsr */
NEXT				/*  goto **ip++ */


 /* ============================================= */

/* ->r		(R; --- val ) ( val --- ) Forth >r, ish. 4 bytes moved. */
ATOM_(TOr,->r)
rs[++rsi] = *(int *)(ds0+dsi) ;
DROP
NEXT


 /*============================================= */

/* ->code		(P &HNC --- Code_Body_Cell ) */
ATOM_(TOcode,->code)
ps[psi] = ps[psi] +  ((*(byte *)ps[psi] + 3)  & 0xfc) + CELLSIZE + CELLSIZE  ;
NEXT


 /*============================================= */

/* ->link		(P &HNC --- Link_Cell ) */
ATOM_(TOlink,->link)

ps[psi] = ps[psi] + ((*(byte *)ps[psi] + 3)  & 0xfc ) + CELLSIZE ;
NEXT


 /*============================================= */

/* ->p		(P --- CELL ) ( a --- ) CELLSIZE worth of a is moved  */
ATOM_(TOp,->p)

ps[++psi]= *(int *)(ds0 + dsi );
DROP
NEXT


 /*============================================= */

/* true		( --- true_flagpyte ) 0xXXX...XXff, true flag pyte constant  */
ATOM_(true,true)
BUMP
ds[dsi] = 0xff ;
NEXT


 /*============================================= */

/* 2pdrop		(P  A B --- )  drop 2 pointers. */
ATOM_(twopdrop,2pdrop)
psi-- ;
psi-- ;			/* this one compiles to one instruction as is.
				So leave it. */
NEXT

 /*============================================= */

/* upshift	( shiftee amount ---  up-shifted-lo [up-shifted-high] ) */
ATOM_(upshift,upshift)

cells = ds[dsi] >> 3 ;			/* cellshift value */
net = ds[dsi] - (cells << 3);
for ( i = 0 ; i < cells ; i++ )
	{ accum[i]=0;			/* leftpad 0-cells */
	}				/* otherwise there will be junk */
DROP					/* dsi is shiftee */
for ( i = 0 ; i < Size ; i++ )		/* cell&bit shift to accum */
	{ accum[cells + i] = ds[dsi + i] << net ;
	}
ds[dsi] = accum[0]  ;			/* avoid accum underrun	 below */
for ( i = 1 ; i < Size ; i++ )
	{ ds[dsi + i] =
	    (accum[i] & 0x00ff ) | ((accum[i-1] & 0xff00)>> 8 ) ;
	}
NEXT

  /*============================================= */

/* x		( pyte --- ) print & drop a pyte, Forth . but hex only	  */
ATOM_(printhex,x)
i = 0;
bite = 32;	/* ascii space */

	/*				build number string */
while(i < Size )
{
j= dsi + Size - 1  - i ;
	numberString[i << 1]	   = digitOut[	ds[j] >> 4  ];
	numberString[(i << 1)+ 1 ] = digitOut[	ds[j] & 15  ];
	i++;
}

				 /* print number string */
__asm__	 ("int $0x80"
	: "=a" (convert.i)
	: "0" (4),"b" (1),"c" (numberString),
	  "d" (Size << 1 ) );

				 /* print space		*/
__asm__	 ("int $0x80"
	: "=a" (convert.i)
	: "0" (4),"b" (1),"c" (&bite),
	  "d" (1) );
DROP
NEXT


  /*============================================= */

/* XOR		( pytea pyteb --- pyteaXORb )		*/
ATOM_(XOR,XOR)
DROP
for ( i = 0 ; i < Size ; i++ )
	ds[dsi + i]=ds[dsi + Size + i] ^ ds[dsi+i];
NEXT


 /*=============================================		*/

/* yes		( flagpyte --- )  branch if lsB of TOS is true	*/
ATOM_(yes,yes)
if ( ds[dsi] )		   /* conditional on low-order byte of current pyte */
	{ ip = (int *)*ip ;	   /* put the int following this instr. in ip */
	}
else	{ ip++ ;		  /* skip branch target addy */
	}
DROP
NEXT


 /*============================================= */

/* zero		( --- 0 )   0 as a fast pyte-constant  */
ATOM_(zero,zero)

BUMP
for ( i = 0 ; i < Size ; i++ )
	{	ds[dsi + i] = 0;
	}
NEXT

	/* cheap docs	*/

/* */
/*	SYSCALLS ...

see Linux asm/unistd.h, man syscalls, man 2 intro

No errno handling; Just one return value. errno is a derived value from
the natural low-level return value anyway, and you have H3m sitting in
front of you to play with it.

No C subroutine wrappers, so no name scoping. args
(inputs) are C expressions ( see gcc.info ).

Syscalls slam ints on and off the data data stack. This is noticably
smaller than using convert.i and/or testing Size, and I want to get a lot
of syscalls in here for cheap.	*/

 /* ==========sssssssssssssssssssssssssssssssss==== */


ATOM_(thxtebhtxxio,<<<SYSCALLS)



/* Sbecome	(P  path argv envp ||| ) ( --- GONE|fail=-1) unix execve  */
HATOM_(Sbecome,Sbecome)
BUMP
__asm__	 ("int $0x80"
	: "=a" (*(int *)(ds0+dsi))
	: "0" (11),"b" ((char *)(ps[psi-2])),"c" ((char *)(ps[psi-1])),
	  "d" ((char *)(ps[psi]))  );
NEXT
	/* only returns on failure	*/


/* close		( FD --- ret )	lose and release a file descriptor */
ATOM_(close,close)
__asm__	 ("int $0x80"
	: "=a" (*(int *)(ds0+dsi))
	: "0" (6),"b" (*(int *)(ds0+dsi))  );
NEXT


/* Schroot	(P  path |||) ( --- ret) change apparent root directory */
HATOM_(Schroot,Schroot)
BUMP
__asm__	 ("int $0x80"
	: "=a" (*(int *)(ds0+dsi))
	: "0" (61),"b" ((char *)(ps[psi]))  );
NEXT


/* dupFD		(old_FD --- new_FID|-1)	  unix dup()	*/
ATOM_(dupFD,dupFD)
__asm__	 ("int $0x80"
	: "=a" (*(int *)(ds0+dsi))
	: "0" (41),"b" (*(int *)(ds0+dsi)) );
NEXT


/* dirents	( FD  count --- red|-1|0 )  (P	buff ||| ) unix getdents()  */
HATOM_(dirents,dirents)
DROP
__asm__	 ("int $0x80"
	: "=a" (*(int *)(ds0+dsi))
	: "0" (141),"b" ((char *)(ps[psi])),"c" (*(int *)(ds0+dsi+Size)),
	  "d" (*(int *)(ds0+dsi))  );
NEXT


/* FDcontrol	( FD CMD  --- ret )  (P [arg] |||)  unix fcntl()
		multimode, more args given than used, ordered so
		that options are lower on stack	 */
HATOM_(FDcontrol,FDcontrol)
DROP
__asm__	 ("int $0x80"
	: "=a" (*(int *)(ds0+dsi))
	: "0" (55),"b" (*(int *)(ds0+dsi+Size)),
	  "c" (*(int *)(ds0+dsi)),
	  "d" ((char *)(ps[psi]))  );
NEXT


/* fork		parent.. ( ---PID_of_child_or-1)	child.. (--- 0)*/
ATOM_(fork,fork)
BUMP
__asm__	 ("int $0x80"
	: "=a" (*(int *)(ds0+dsi))
	: "0" (2)  );
NEXT


/* fflush		( FD --- flag )	 unix fsync()		*/
HATOM_(fflush,fflush)
__asm__	 ("int $0x80"
	: "=a" (*(int *)(ds0+dsi))
	: "0" (118), "b" (*(int *)(ds0+dsi))  );
NEXT


/* flush		( --- 0 )	unix sync()	*/
HATOM_(flush,flush)
BUMP
__asm__	 ("int $0x80"
	: "=a" (*(int *)(ds0+dsi))
	: "0" (36)  );
NEXT


/* Sgettimeofday	(P timeval |||) ( --- flag)  simplified */
HATOM_(Sgettimeofday,Sgettimeofday)
BUMP
__asm__	 ("int $0x80"
	: "=a" (*(int *)(ds0+dsi))
	: "0" (78),"b" (*(int *)(ps[psi])),"c" (0)  );
NEXT


/* link		(P  old new ||| )   ( --- flag )   unix link()	*/
ATOM_(link,link)
BUMP
__asm__	 ("int $0x80"
	: "=a" (*(int *)(ds0+dsi))
	: "0" (9),"b" ((char *)(ps[psi])),
		  "c" ((char *)(ps[psi-1]))  );
NEXT


/* ioctl		( FD  ioctl --- ret) (P	 argp --- ) note the pdrop */
ATOM_(ioctl,ioctl)
DROP
__asm__	 ("int $0x80"
	: "=a" (*(int *)(ds0+dsi))
	: "0" (54),"b" (*(int *)(ds0+dsi+Size)),
	  "c" (*(int *)(ds0+dsi)),
	  "d" ((char *)(ps[psi]))  );
psi--;
NEXT


/* ioperm		( level --- flag )	Linux iopl()	*/
ATOM_(ioperm,ioperm)
__asm__	 ("int $0x80"
	: "=a" (*(int *)(ds0+dsi))
	: "0" (110), "b" (*(int *)(ds0+dsi))  );
NEXT


/* makedir	(P name ||| )	( --- flag)	unix mkdir(), perms==0	*/
ATOM_(makedir,makedir)
BUMP
__asm__	 ("int $0x80"
	: "=a" (*(int *)(ds0+dsi))
	: "0" (39),"b" ((char *)(ps[psi])),"c" (0) );
NEXT


/* mount		(P special dir fstype|NULL data |||) (rwflags --- flag) */
ATOM_(mount,mount)
i = ps[psi-3];			/* special file		*/
j = ps[psi-2];			/* mountpoint		*/
k = ps[psi-1];			/* fstype|NULL		*/
K = ps[psi];			/* r/w flags		*/
e = *(int *)(ds0 + dsi);	/* data			*/
__asm__	 ("int $0x80"
	: "=a" (*(int *)(ds0+dsi))
	: "0" (21),"b" (i),"c" (j),"d" (k),"D" (e),
		"S" (K )  );
NEXT


/* nanosleep	(P  timespec remaining ||| )	( --- flag )  */
ATOM_(nanosleep,nanosleep)
BUMP
__asm__	 ("int $0x80"
	: "=a" (*(int *)(ds0+dsi))
	: "0" (162),"b" ((char *)(ps[psi-1])),
		    "c" ((char *)(ps[psi]))  );
NEXT


/* owner		(P path |||)   ( UID  GID --- ret)  unix chown() */
HATOM_(owner,owner)
DROP
__asm__	 ("int $0x80"
	: "=a" (*(int *)(ds0+dsi))
	: "0" (182),"b" ((char *)(ps[psi])),
	  "c" (*(int *)(ds0+dsi+Size)),
	  "d" (*(int *)(ds0+dsi))  );
NEXT


/* permit		(P path |||)   ( mode --- ret)	 unix chmod()	*/
ATOM_(permit,permit)
__asm__	 ("int $0x80"
	: "=a" (*(int *)(ds0+dsi))
	: "0" (15),"b" ((char *)(ps[psi])),
		   "c" (*(int *)(ds0+dsi)) );
NEXT


/* pause		( --- -1 )	wait for a signal */
ATOM_(pause,pause)
BUMP
__asm__	 ("int $0x80"
	: "=a" (*(int *)(ds0+dsi))
	: "0" (29) );
NEXT


/* pipe		(P ptr_to_int[2] |||)  ( --- flag) 2 FD's in given array */
ATOM_(pipe,pipe)
BUMP
__asm__	 ("int $0x80"
	: "=a" (*(int *)(ds0+dsi))
	: "0" (42),"b" ((char *)(ps[psi])) );
NEXT
 /* do something handy with ptr_to_int[2] */


/* parent		( --- parent_PID )	unix getppid()		*/
ATOM_(parent,parent)
BUMP
__asm__	 ("int $0x80"
	: "=a" (*(int *)(ds0+dsi))
	: "0" (64)	);
NEXT


/* quit		unix exit(), Forth bye, H3m quit. q. works. */
ATOM_(quit,quit)
__asm__	 ("int $0x80"
	: "=a" (*(int *)(ds0+dsi))
	: "0" (1),"b" (ds[dsi]) );
NEXT
 /* NEXT would never happen, but it seems to be needed here to keep the
	dictionary linking wholesome or something.
	DISTURBING. It does seem to be limited to exit though, which is
		semi-OK.  */


/* read		( FD --- red ) (P buf ||| )  always requests 2048 bytes	 */
ATOM_(read,read)
__asm__	 ("int $0x80"
	: "=a" (*(int *)(ds0+dsi))
	: "0" (3),"b" (*(int *)(ds0+dsi)),"c" ((char *)(ps[psi])),
	  "d" (2048) );
NEXT


/* rename		(P old new |||) ( --- flag ) basis of mv     */
ATOM_(rename,rename)
BUMP
__asm__	 ("int $0x80"
	: "=a" (*(int *)(ds0+dsi))
	: "0" (38),"b" ( (char *)(ps[psi-1]) ),
		   "c" ( (char *)(ps[psi]) )
	);
NEXT


/* resize		(P end_data_segment ) ( --- ret )   unix brk(), basis of malloc */
ATOM_(resize,resize)
BUMP
__asm__	 ("int $0x80"
	: "=a" (*(int *)(ds0+dsi))
	: "0" (45),"b" ((char *)(ps[psi]))  );
NEXT


/* reboot		(P btparm --*POW!!* REBOOT LINUX. With EXTREME prejudice. */
HATOM_(reboot,``reboot'')
i = ps[psi];		/* address of bootparams string */

__asm__	 ("int $0x80"
	: "=a" (*(int *)(ds0+dsi))
	: "0" (88), "b" (0xfee1dead), "c" (672274793),"d" ( 0xa1b2c3d4 ),
		"D" (i)	    );
NEXT


/* sys_open	(P name |||)  ( flags perms --- FD ) see open thread  */
HATOM_(sys_open,sys_open)
DROP
__asm__	 ("int $0x80"
	: "=a" (*(int *)(ds0+dsi))
	: "0" (5),"b" ((char *)(ps[psi])),
	  "c" (*(int *)(ds0+dsi+Size)),
	  "d" (*(int *)(ds0+dsi))  );
NEXT


/* todir		(P path --- ) (--- ret)	 unix chdir(), cd  */
ATOM_(todir,todir)
BUMP
__asm__	 ("int $0x80"
	: "=a" (*(int *)(ds0+dsi))
	: "0" (12),"b" ((char *)(ps[psi]))  );
NEXT


/* rmdir		(P name ||| )	( --- flag )  remove empty dir	*/
HATOM_(rmdir,rmdir)
BUMP
__asm__	 ("int $0x80"
	: "=a" (*(int *)(ds0+dsi))
	: "0" (40), "b" ( (char *)(ps[psi]) ) );
NEXT


/* readlink	(P name buff ||| ) ( bufsize --- flag )	 unix readlink	*/
HATOM_(readlink,readlink)
__asm__	 ("int $0x80"
	: "=a" (*(int *)(ds0+dsi))
	: "0" (85) ,"b" ((char *)(ps[psi-1])),"c" ((char *)(ps[psi])),
		"d" ( *(int *)(ds0+dsi) )  );
NEXT


/* stat		(P name buff ||| ) ( --- flag)	get a file's stat data */
ATOM_(stat,stat)

BUMP
__asm__	 ("int $0x80"
	: "=a" (*(int *)(ds0+dsi))
	: "0" (106),"b" (*(int *)(ps[psi-1])),
		"c" (*(int *)(ps[psi])) );
NEXT


/* seek		( FD o/s whence --- o/s0 ) unix lseek(), Forth reposition-file */
ATOM_(seek,seek)
DROP DROP
__asm__	 ("int $0x80"
	: "=a" (*(int *)(ds0+dsi))
	: "0" (19),"b" (*(int *)(ds0+dsi)),
		   "c" (*(int *)(ds0+dsi+Size)),
		   "d" ( *(int *)(ds0+dsi+Size+Size) )	      );
NEXT


/* settimeofday	(P timeval |||) ( --- flag)   simplified	*/
HATOM_(settimeofday,settimeofday)
BUMP
__asm__	 ("int $0x80"
	: "=a" (*(int *)(ds0+dsi))
	: "0" (79),"b" (*(int *)(ps[psi])),"c" (0)  );
NEXT


/* sigaction	( sig# --- flag ) (P action old |||) install a signal handler */
HATOM_(sigaction,sigaction)

i = (ps[psi-1]);
j = (ps[psi]);

__asm__	 ("int $0x80"
	: "=a" (*(int *)(ds0+dsi))
	: "0" (67),"b" (* (int*)(ds0+dsi) ),
		   "c" (i),
		   "d" (j) );
NEXT


/* socketcall	( call --- flag )  (P args ||| )  Linux socket calls entry */
HATOM_(socketcall,socketcall)
__asm__	 ("int $0x80"
	: "=a" (*(int *)(ds0+dsi))
	: "0" (102), "b" (*(int *)(ds0+dsi)),
		     "c" (ps[psi])		);
NEXT


/* statfs		(P name buff ||| ) ( --- flag)	get a filesys stat data */
HATOM_(statfs,statfs)

BUMP
__asm__	 ("int $0x80"
	: "=a" (*(int *)(ds0+dsi))
	: "0" (99),"b" (*(int *)(ps[psi-1])),
		"c" (*(int *)(ps[psi])) );
NEXT


/* settime	(P timestruct ||| )   ( --- flag) set sec. elapsed in epoch */
HATOM_(stime,settime)
BUMP
__asm__	 ("int $0x80"
	: "=a" (*(int *)(ds0+dsi))
	: "0" (25),"b" (*(int *)(ps[psi]))  );
NEXT


/* swapoff	(P name ||| )	( --- flag )	*/
HATOM_(swapoff,swapoff)
BUMP
__asm__	 ("int $0x80"
	: "=a" (*(int *)(ds0+dsi))
	: "0" (115),"b" (*(int *)(ps[psi]))  );
NEXT


/* swapon		(P name ||| )	( --- flag )	*/
HATOM_(swapon,swapon)
BUMP
__asm__	 ("int $0x80"
	: "=a" (*(int *)(ds0+dsi))
	: "0" (87),"b" (*(int *)(ps[psi])), "c" (0)  );
NEXT


/* special	(P name |||)	( mode dev --- flag )	unix mknod()	*/
ATOM_(special,special)
DROP
__asm__	 ("int $0x80"
	: "=a" (*(int *)(ds0+dsi))
	: "0" (14),"b" (*(int *)(ps[psi])),"c" (*(int *)(ds0+dsi)),
		"d" (*(int *)(ds0+dsi+Size)) );
NEXT


/* signal		( PID signal --- ret)	unix kill	*/
ATOM_(signal,signal)
DROP
__asm__	 ("int $0x80"
	: "=a" (*(int *)(ds0+dsi))
	: "0" (37),"b" (*(int *)(ds0+dsi+Size)),"c" (0),
	  "d" (*(int *)(ds0+dsi)) );
NEXT


/* symlink	(P exists new |||)  ( --- flag )	*/
ATOM_(symlink,symlink)
__asm__	 ("int $0x80"
	: "=a" (*(int *)(ds0+dsi))
	: "0" (83),"b" (*(int *)(ps[psi-1])),
		"c" (*(int *)(ps[psi])) );
NEXT


/* syslog		( type	len --- flag )	(P buf ||| ) read/tweak kbuffer */
HATOM_(syslog,syslog)

DROP
__asm__	 ("int $0x80"
	: "=a" (*(int *)(ds0+dsi))
	: "0" (103),"b" (*(int *)(ds0+dsi)),"c" ((char *)(ps[psi])),
		"d" (*(int *)(ds0+dsi+Size)) );
NEXT


/* truncate	(P fname || )  ( len --- flag ) truncate fname to len  */
ATOM_(truncate,truncate)
__asm__	 ("int $0x80"
	: "=a" (*(int *)(ds0+dsi))
	: "0" (92), "b" ((char *)(ps[psi])), "c" (*(int *)(ds0+dsi)) );
NEXT


/* trace		( request PID addr data --- flag)  unix ptrace() */
HATOM_(trace,trace)
DROP	DROP	DROP
i = *(int *)(ds0+dsi+Size+Size+Size);
j = *(int *)(ds0+dsi+Size+Size);
k = *(int *)(ds0+dsi+Size);
e = *(int *)(ds0+dsi);
__asm__	 ("int $0x80"
	: "=a" (*(int *)(ds0+dsi))
	: "0" (26),"b" (i),"c" (j),
	  "d" (k),"D" (e) );
NEXT


/* unlink		(P name ||| ) ( --- flag) rm a name, maybe the data
			inode */
			/* a hardlink is a name of an inode. unlink
				the last one and unix frees the inode  */
ATOM_(unlink,unlink)
BUMP
__asm__	 ("int $0x80"
	: "=a" (*(int *)(ds0+dsi))
	: "0" (10), "b" ((char *)(ps[psi])) );
NEXT


/* unmount	(P name ||| )	( --- flag) unix umount() */
HATOM_(unmount,unmount)
__asm__	 ("int $0x80"
	: "=a" (*(int *)(ds0+dsi))
	: "0" (22), "b" ((char *)(ps[psi])) );
NEXT


/* write		( FDbyte  request --- red )   (P name ||| )  */
ATOM_(write,write)
DROP
__asm__	 ("int $0x80"
 /* return */	: "=a" ( *(int *)(ds0+dsi)  )
 /* call # */	: "0" (4),
 /* FD */	"b" ( *(int *)(ds0+dsi) ),
 /* buffer */	"c" ( (char *)(ps[psi]) ),
 /* size */	"d" ( *(int *)(ds0+dsi+Size) )	 );
NEXT


/* waitpid	(pid options --- ret )	simplified	*/
ATOM_(waitpid,waitpid)
DROP
__asm__	 ("int $0x80"
	: "=a" (*(int *)(ds0+dsi))
	: "0" (7),"b" (*(int *)(ds0+dsi+Size)),"c" (0),
	  "d" (*(int *)(ds0+dsi)) );
NEXT



ATOM_(thxbtixio,<<<THREADS)

 /* 7777777777777777777777777777777777777777777777777777 */
 /* end of dictionary build section for fundamentals/atoms/primitives.
Begin derived words; threads, named noun instances. The above is the
virtual machine, The non-syscall atoms are the virtual CPU.  the following
are some things you can do with said machine. Compiled-in threads are
written in the assembly language of the VM. Note that some of this
proto-H3m code is very un-Forth-like, doing many things wrong. That's
because H3m doesn't really exist yet, just the VM. So, it's nasty
tortuous virtual assembly. As far as examples of using the H3m
interpreter, Note the opcodes used, but ignore the coding style. Very
important in Virtual Machine Subroutine Threading, above here (by default)
words have the atomic bit set in the Head Name Interface Cell.
m4m4m4m4m4m4m4m4m4m4m4m4m4m4m4m4m4m4m4m4m4m4m4

m4 macros for all the standard build_a_thread stuff.		*/

 /* contents of this int is given by  arg			*/
define(CELL,	asm	(" .int `$1'	");
)

 /* this cell contains CFA of word named as argument		*/
define(OP,	asm	(" .int `$1'CFA ");
)

 /* VMST jsr, takes a whole cell, plus the callee's cell
This doesn't have the OP folded into it to keep branch offset counting
1:1, except for branch targets. ___o___				*/
define(SUB,    asm	(" .int subCFA	");
)

 /* build a relative branch offset with integer arg,
$1 is +/-, $2 is #   +/- needs a comma */
define(BRANCH,	asm	(" .int	 .  `$1' `$2' *4  ");
)

 /* we are at a branch target, set label symbols for here.
targets take no thread space themselves.
The graphicoid name is to emphasize that a cell is not created.	 */
define(___o___,	 asm	("	.equ `$1'_one, .	");
)

 /* back-branch address of labels. arg-less macro. */
define(BACK,  asm	("	.int `$1'_one	");
)

/* */
/*	NAMED DATA... */
 /* ddddddddddddddddddddddddddddddd============			*/

/* block		(P --- begin_buffer) object data buffer(s) */
THREAD_(block,block)
OP(address)
CELL(0)
asm	("	.org . + 1024 ");


/* buffer		(P --- begin_buffer) "file" input buffer */
THREAD_(buffer,buffer)
OP(address)
CELL(0)
asm	("	.org . + 2048 ");


/* bsi		counter for branches to resolve		*/
NON_USER(bsi,bsi)
OP(address)
CELL(0)


/* branchstack	space for 16 branches to resolve	*/
NON_USER(branchstack,branchstack)
OP(address)
CELL(0)
asm	("	.org . + 128 ");
	/* allot for a maximal pyte */


/* digits		(P  ---	 address_of_array ) ascii vals to hex vals map	*/
THREAD_(digits,digits)
OP(address)
CELL( 0 ) CELL( 0 ) CELL( 0 ) CELL( 0 ) 
CELL( 0 ) CELL( 0 ) CELL( 0 ) CELL( 0 )
CELL( 0 ) CELL( 0 ) CELL( 0 ) CELL( 0 )
ENDIANCELL(0x00,0x01,0x02,0x03)
ENDIANCELL(0x04,0x05,0x06,0x07)
ENDIANCELL(0x08,0x09,0x00,0x00)
CELL( 0 )
CELL( 0 ) CELL( 0 ) CELL( 0 ) CELL( 0 )
CELL( 0 ) CELL( 0 ) CELL( 0 ) CELL( 0 )
ENDIANCELL(0x00,0x0a,0x0b,0x0c)
ENDIANCELL(0x0d,0x0e,0x0f,0x00)
CELL( 0 ) CELL( 0 ) CELL( 0 ) CELL( 0 )
CELL( 0 ) CELL( 0 ) CELL( 0 ) CELL( 0 )
CELL( 0 ) CELL( 0 ) CELL( 0 ) CELL( 0 )
CELL( 0 ) CELL( 0 ) CELL( 0 ) CELL( 0 )


/* dp		(P --- dictionary_free-point_pointer ) */
THREAD_(dp,dp)
OP(address)
dpaddy:		/* we have to poke a number in here at init time */
CELL(0)


/* epa		(P --- &epa )  End Parse Area		*/
THREAD_(epa,epa)
 /*  can't just keep these on a stack because of doHNC	  */
OP(address)
epal:
CELL(0)


/* hexdigits	(P  ---	 &array )  ascii val is/not a hex digit	  */
THREAD_(hexdigits,hexdigits)
       /* could be dual-aligned for unicode. someday. word-size dependant? */
OP(address)
CELL( 0 ) CELL( 0 ) CELL( 0 ) CELL( 0 )
CELL( 0 ) CELL( 0 ) CELL( 0 ) CELL( 0 )
CELL( 0 ) CELL( 0 ) CELL( 0 ) CELL( 0 )
ENDIANCELL(0xff,0xff,0xff,0xff)
ENDIANCELL(0xff,0xff,0xff,0xff)
ENDIANCELL(0xff,0xff,0x00,0x00)
CELL( 0 )
CELL( 0 ) CELL( 0 ) CELL( 0 ) CELL( 0 )
CELL( 0 ) CELL( 0 ) CELL( 0 ) CELL( 0 )
ENDIANCELL(0x00,0xff,0xff,0xff)
ENDIANCELL(0xff,0xff,0xff,0x00)
CELL( 0 ) CELL( 0 ) CELL( 0 ) CELL( 0 )
CELL( 0 ) CELL( 0 ) CELL( 0 ) CELL( 0 )
CELL( 0 ) CELL( 0 ) CELL( 0 ) CELL( 0 )
CELL( 0 ) CELL( 0 ) CELL( 0 ) CELL( 0 )

/* latest		(P --- &HNC )  &HNC of most recent definition  */
THREAD_(latest,latest)
OP(address)		/* data word, does it's own Return.  */
latest:			/* C needs this address for init code	 */
CELL(0)

/* pvar		(P --- &pvar)	scratch pointer for thread resolver  */
NON_USER(pvar,pvar)
OP(address)
 CELL(0)

/* source		(P --- &input_FD) FD of source of interpreter input */
THREAD_(source,source)
OP(address)
CELL(0)
asm	("	.org . + 256 ");


/* thispointer	(P --- &this ) current address in buffered parse area	*/
THREAD_(thispointer,thispointer)
OP(address)
thisl:
CELL(0)


/* toklen		token length	*/
THREAD_(toklen,toklen)
OP(address)
CELL(0)


/* targetstack	space for 8 addresses to resolve branches to */
NON_USER(targetstack,targetstack)
OP(address)
CELL(0)
asm	("	.org . + 32 ");
	/* allot for a maximal pyte */


/* tb		(P --- &token ) where we stash an input token		*/
THREAD_(tb,tb)
OP(address)
CELL(0)
asm	("	.org . + 1024 ");


/* tsi		counter for branches to resolve */
NON_USER(tsi,tsi)
OP(address)
CELL(0)


/* USize		(P --- &USize ) offstack Size store for interpreter
					fetch as a pointer	  */
NON_USER(USize,USize)
OP(address)
CELL(4)				/* x86 cell size */


/* */
/*	THREADS...
*/
 /* TTTTTTTTTTTTTTTTTTTTTTTT============				*/

/* &		( a --- )  !dp	 `append' a into dictionary at &dp at Size  */
THREAD_(append,``&'')
SUB
 OP(dp)			/*  (P &dp)		( a )	*/
OP(pdup)		/*  (P &dp &dp)		( a )	*/
OP(pfetch)		/*  (P &dp dp)		( a )	*/
OP(store)		/*  (P &dp dp)		()	*/
OP(ppluss)		/*  (P &dp dp')		()	*/
OP(pswap)		/*  (P dp' &dp)			*/
OP(pstore)		/*  (P dp' &dp)		!dp	*/
OP(twopdrop)		/*  (P;)			*/
OP(Return)


 /* ttttttttttttttttttttttt============ */

/* &literal	`append literal'  ( # --- )   !dp  */

THREAD_(appendlit,``&literal'')

OP(literal)
 CELL(4)
 OP(literal)
OP(TOp)
SUB
 OP(appendp)
OP(getSize)		/* ( # )	(P Size )		*/
OP(align)		/* ( # )	(P alignedSize)		*/
SUB
 OP(appendp)		/* ( # )	(P )		!dp	*/
SUB
 OP(append)		/* ( )		(P )		!dp	*/
OP(Return)


 /* ttttttttttttttttttttttt============ */

/* &word		(P &HNC ||| )  append a word's CFA.   */
THREAD_(appendword,&word)
SUB
 OP(ifatom)		/* (P &HNC )	( flag)		*/
OP(no)
	BRANCH(+,7)
			/*		  is an atom	*/
OP(pdup)		/* (P &HNC &HNC)		*/
OP(TOcode)		/* (P &HNC CFA)			*/
SUB			/* (P &HNC CFA)			*/
 OP(appendp)		/* (P &HNC CFA)			*/
OP(pdrop)		/* (P &HNC )			*/
OP(Return)

			/* (P &HNC )	is a thread	*/
	OP(literal)
	  CELL(4)		/* sub's CFA as literal. Hmmmmm.	*/
	  OP(sub)		/* (P &HNC )	( subCFA )		*/
	OP(TOp)			/* (P &HNC subCFA )			*/
	SUB
	 OP(appendp)		/* (P &HNC subCFA )			*/
	OP(pdrop)		/* (P &HNC )			*/
	OP(pdup)		/* (P &HNC &HNC )		*/
	OP(TOcode)		/* (P &HNC CFA )		*/
	SUB
	 OP(appendp)
	OP(pdrop)		/* (P &HNC )			*/
	OP(Return)


 /* ttttttttttttttttttttttt============ */

/* &pliteral	thread-time -> "&pliteral lit# " THREADING	 */
THREADING(appendpliteral,&pliteral)

OP(sTOr)
OP(cells_bd)
OP(literal)
  CELL(4)		/* pliteral's CFA as literal. Hmmmmm.	*/
  OP(pliteral)		/* (  plitCFA )				*/
OP(TOp)			/* (P plitCFA )				*/
SUB
 OP(appendp)		 /* (P plitCFA )				*/
OP(pdrop)		/*					*/
SUB
  OP(token)
SUB
  OP(hexnumber)
SUB
  OP(append)
OP(rTOs)
OP(Return)


 /* ttttttttttttttttttttttt============ */

/* &p		(P bla |||  )	append pointer bla to dictionary  !dp	*/
THREAD_(appendp,&p)

SUB
 OP(dp)			/*	(P bla &dp)			*/
OP(pdup)		/*	(P bla &dp &dp)			*/
OP(pTOr)		/*	(P bla &dp)	(R; &dp)	*/
OP(pfetch)		/*	(P bla	dp)	(R; &dp)	*/
OP(pstore)		/*	(P bla	dp)	(R; &dp)   !HERE*/
OP(pplusc)		/*	(P bla	dp')	(R; &dp)	*/
OP(rTOp)		/*	(P bla	dp' &dp)		*/
OP(pstore)		/*	(P bla	dp' &dp)    !dp		*/
OP(twopdrop)
OP(Return)



 /* TTTTTTTTTTTTTTTTTTTTTTTT============		*/

/* abs		( A --- |A| )			*/
THREAD_(abs,abs)
OP(dup)			/* (A A)		*/
 OP(ifpositive)	       /* (A flag)	       */
OP(yes)
 BRANCH(+,2)
OP(negate)
OP(Return)


 /* tttttttttttttttttttttt============ */

/* allot		( o/s --- )  move dp up o/s bytes. iffy at > 256*/
THREAD_(allot,allot)
SUB
  OP(dp)
OP(pdup)
OP(pfetch)
OP(plusp)
OP(pswap)
OP(pstore)
OP(Return)





 /* tttttttttttttttttttttt============ */

/* ascii->digit	( --- nybble )	(P char	 ||| )	  */
THREAD_(asciiTOdigit,ascii->digit)
OP(fetch)		/*   ( pyte		(P		*/
OP(maskbyte)		/*   ( byte		(P		*/
SUB
 OP(digits)		/*   ( byte		(P  array	*/
OP(plusp)		/*   (			(P indexed	*/
OP(fetch)		/*   ( nybblepyte	(P		*/
OP(pdrop)
OP(maskbyte)		/*   ( nybble		(P		*/
OP(Return)


  /* ttttttttttttttttttttttttttttttttttttttttttttttttttt============ */
/* beep		emit a 7, ASCII `bel', C \a		*/
THREAD_(beep,beep)
OP(literal) CELL(4) CELL(7) OP(emit) OP(Return)


 /* ttttttttttttttttttttttt============ */

/* bench		bogoloop, 100,000 empty loop iterations.  */
THREAD_(bench,bench)	/*  (P &dp &dp)		( a )	*/

OP(literal)
 CELL(4)
 CELL(100000)
OP(TOr)

___o___(bogo)
	OP(minusaskr)
     OP(no)
	 BRANCH(+,3)
OP(ell)
 BACK(bogo)

OP(rTOp)
OP(pdrop)
OP(Return)


 /* ttttttttttttttttttttttt============ */
/* blank		emit a blank character, 0x20, a space  */
THREAD_(blank,blank)
OP(literal) CELL(4) CELL(32) OP(emit) OP(Return)


 /* tttttttttttttttttttt============ */

/* :		": ccc H3sm.. ; " name/link ccc, set target 0, start threader */
THREAD_(colon,:)
SUB			/* wipe branch-resolver stacks		*/
  OP(initresolve)
SUB
 OP(header)
SUB
 OP(link)
SUB			/* stash newguy's CFA as target0	*/
  OP(target)
OP(drop)
SUB
 OP(threadloop)
OP(Return)


  /* ttttttttttttttttttttttt============			*/
/* cr		emit a (unix) newline				*/
THREAD_(cr,cr)
OP(literal) CELL(4) CELL(10) OP(emit) OP(Return)


  /* ttttttttttttttttttttttt============ */

/* dofile		STUB					*/
NON_USER(dofile,dofile)
OP(Return)


   /* ttttttttttttttttttttttttttttttttttttttt============ */
/* dump		(P start --- end ) hexdump 256 bytes, continuable  */
THREAD_(dump,dump)

OP(literal)
 CELL(4)
 CELL(16)
OP(TOr)
___o___(dump)
	SUB
	  OP(dumpline)		/*  (P	a'' )		*/
	OP(literal)
	 CELL(4)
	 CELL(124)
	OP(emit)
	OP(minusaskr)
	OP(no)
		BRANCH(+,3)
OP(ell)
   BACK(dump)
		OP(rdrop)
		SUB
		  OP(cr)
		OP(Return)


  /* ttttttttttttttttttttttttttttttttttt=========== */

/* dumpline	(P a --- a+16 )	 display 16 bytes from a    */
NON_USER(dumpline,dumpline)

OP(sTOr)
OP(cells)
OP(pdup)
SUB
 OP(cr)
SUB
 OP(printp)
SUB	OP(blank)
SUB	OP(blank)
OP(bytes)
OP(fetchplus)	OP(printhex) OP(fetchplus)	OP(printhex)
OP(fetchplus)	OP(printhex) OP(fetchplus)	OP(printhex)
OP(fetchplus)	OP(printhex) OP(fetchplus)	OP(printhex)
OP(fetchplus)	OP(printhex) OP(fetchplus)	OP(printhex)
OP(fetchplus)	OP(printhex) OP(fetchplus)	OP(printhex)
OP(fetchplus)	OP(printhex) OP(fetchplus)	OP(printhex)
OP(fetchplus)	OP(printhex) OP(fetchplus)	OP(printhex)
OP(fetchplus)	OP(printhex) OP(fetchplus)	OP(printhex)
			/* (P  a  a+16)		*/
SUB	OP(blank) SUB	OP(blank)

OP(literal)
  CELL(4)
  CELL(124)
OP(emit)
OP(pswap)				/* (P a+16 a )		*/

OP(literal)
 CELL(4)
 CELL(15)
SUB
 OP(printchars)
OP(rTOs)
OP(pdrop)				/* (P a+16)		*/
OP(Return)


  /* ttttttttttttttttttttttt============ */

/* dpdump		(P --- dp+0xc0 )   dump from dp - 0x80	*/
THREAD_(dpdump,dpdump)
SUB
 OP(dp)
OP(pfetch)
OP(literal)
 CELL(4)
 CELL(0x80)
OP(negate)
OP(plusp)
OP(literal)
 CELL(4)
 CELL(7)
OP(TOr)

___o___(mdump)
	SUB
	  OP(dumpline)		/*  (P	a'' )		*/
	OP(literal)
	 CELL(4)
	 CELL(124)
	OP(emit)
	OP(minusaskr)
	OP(no)
    BRANCH(+,3)
OP(ell)
   BACK(mdump)
OP(rdrop)
SUB
 OP(cr)
OP(literal)
 CELL(4)
 CELL(8)
OP(TOr)

___o___(mdump2)
	SUB
	  OP(dumpline)		/*  (P	a'' )		*/
	OP(literal)
	 CELL(4)
	 CELL(124)
	OP(emit)
	OP(minusaskr)
	OP(no)
    BRANCH(+,3)
OP(ell)
   BACK(mdump2)
OP(rdrop)
SUB
  OP(cr)
OP(Return)


 /* ttttttttttttttttttttttt============ */

/* delimit	(P dest |||) ( delimiter --- count did ) stash input */
THREAD_(delimit,delimit)
OP(pdup)			/* (P dest0 dest')  ( delim )		*/
___o___(while_this_isnt_delim)
	SUB
	  OP(this)		/* (P dest0 dest')  (delim this)	*/
	SUB
	  OP(step)		/* (P dest0 dest')  (delim this EOI)	*/
		OP(yes)
		BRANCH(+,11)
	OP(over)
	OP(over)		/* (P dest0 dest')  (delim this del ths)*/
	OP(maskbyte)			
 	OP(ifequal)		/* (P dest0 dest')  (delim this =)	*/	
			OP(yes) 	/* (P dest0 dest') (delim this )*/
			BRANCH(+,12)
	OP(store)		/* (P dest0 dest')  (delim )		*/
	OP(pplusb)		/* (P dest0 dest++) (delim )		*/
OP(ell)
BACK(while_this_isnt_delim)
		OP(drop)
		OP(drop)
		OP(gap)
		OP(negate)
		OP(pdrop)
		OP(false)
		OP(Return)
			OP(drop)
			OP(drop)
			OP(gap)
			OP(negate)
			OP(pdrop)
			OP(true)
			OP(Return)
			

 /* ttttttttttttttttttttttt============ */

/* drowod		(P HNC --- ???) (???)  (R ?????) !USize	 Interpreter only*/
NON_USER(drowod,drowod)
SUB
 OP(USize)
OP(pfetch)
OP(bump)
OP(pTOs)
OP(drop)
OP(doHNC)		/*U (P ???) (???) (R???)			*/
 /* we may have changed Size, so we save it for the next time we reenter
user context. */

OP(sTOp)		/*  (P ??? USize) (???) (R???)			*/
SUB
 OP(USize)		/*  (P ??? USize &USize) (???) (R???)		*/
OP(pstore)		/*  (P ??? USize &USize) (???) (R???)		*/
OP(twopdrop)		/*  (P ???) (???) (R???)			*/
OP(cells_bd)		   /*	4 !Size				   */
OP(Return)


  /* ttttttttttttttttttttttt ============			*/

/* finish		( --- EOI) !toklen !tb !this	get rest of token */
THREAD_(finish,finish)
				/* we come in on a nonwhite from snug	*/
SUB
  OP(tb)			/* (P tokenbuffer)		*/
SUB
  OP(this)			/*  (P tb)	( this )		*/
OP(store)			/*  (P tb) <-- ()			*/
OP(pplusb)			/*  (P tokenbuf_next) ()		*/
OP(one)				/*  (P tokenbuf_next) (initial_toklen=1)*/
___o___(while_nonwhite)
	SUB
	  OP(step)		/* this++ (P tb) (toklen EOI)		*/
	OP(no)			/* (P tb)   ( toklen )			*/
	BRANCH(+,5)
		OP(drop)	/* ran out of input			*/
		OP(pdrop)
		OP(true)	/* ( EOI=true )				*/
		OP(Return)
	SUB
	  OP(thispointer)	/*  (P tb' &this ) ( toklen )		*/
	OP(pfetch)		/*  (P tb' this )  ( toklen )		*/
	SUB
	  OP(ifchar)		/*  (P tb' )	(toklen	 ischar)
				ifchar does a pdrop. Doh! BAD!		*/
		OP(no)		/*  (P tb' ) ( toklen )		*/
		BRANCH(+,9)
	OP(one)			/* (P tb)   ( toklen 1 )		*/
	OP(plus)		/* (P tb)   ( toklen'  )		*/
	SUB
	  OP(this)		/*  (P tb )  (toklen' this )		*/
	OP(store)		/*  (P !tb )  <--  (toklen' )		*/
	OP(pplusb)		/*  (P tokenbuf_next)	(toklen' )	*/
OP(ell)
BACK(while_nonwhite)
		SUB
		  OP(toklen)	/* (P tb' toklen)     (toklen)	*/
		OP(store)	/* (P tb' !toklen) <--/		*/
		OP(twopdrop)	/* (P tb' !toklen)		*/
		OP(false)	/* ( EOI=false)			*/
		OP(Return)



 /* ttttttttttttttttttttttt============ */

/* <-code		`fromcode' (P CFA --- HNC )  ( --- found_flag )
				`see' needs this.			*/
THREAD_(fromcode,<-code)

OP(pminusc)		/* (P lfa_of_sought)				*/
SUB
  OP(latest)		/* (P sought &HNC)				*/
OP(pfetch)		/* (P sought HNC)
OP(pdup)
OP(pTOr)		/* (P sought HNC) (R HNC)			*/
OP(TOlink)		/* (P sought lfa) (R HNC)			*/

___o___(fromcfa)
	OP(rdrop)	/* (P sought lfa) (R)				*/
	OP(pfetch)	/* (P sought HNCp) (R)				*/
	OP(fetch)
	OP(no)		/* yes, name has length				*/
	BRANCH(+,12)	/* AARDVARK!					*/
	OP(pdup)
	OP(pTOr)	/* (P sought HNC) (R HNC)			*/
	OP(TOlink)	/* (P sought lfa) (R HNC)			*/
	OP(gap)		/* (P sought lfa) (R HNC) ( same?)		*/
	OP(flag)
       OP(yes)		/* (P sought lfa) (R HNC) () yup. Found it.	*/
	  BACK(fromcfa) /* yes, different. try again.			*/

OP(true)		/* found					*/
OP(twopdrop)		/* (P)	 (R HNC)				*/
OP(rTOp)		/* (P HNC)	(R)				*/
OP(Return)

OP(false)		/* no word found with that "CFA"		*/
OP(twopdrop)		/* (P)	 (R HNC)				*/
OP(rTOp)		/* (P HNC)	(R)				*/
OP(Return)


 /* ttttttttttttttttttttttt============ */
/* H3m		no-op thread, simplifies commandline handling  */
THREAD_(H3m,H3m)
OP(Return)


 /* tttttmttttttttttttttttttttttttttttttttttt============ */

/* hexnumber	( --- # )  from current token			*/
THREAD_(hexnumber,hexnumber)
SUB
 OP(toklen)			/*			(P &toklen)	*/
OP(fetch)			/* ( len )		(P )		*/
OP(pdrop)
SUB
 OP(tb)				/* ( len )		(P tb )		*/
OP(zero)			/* ( len  accum0)	(P bt)		*/
___o___(while_hexchar)
	OP(over)		/* ( len accum len)	(P char)	*/
	OP(no)			/* ( len accum)		(P char)	*/
		BRANCH(+,15)
	OP(literal)		/* ( len  accum)	(P char)	*/
	CELL(4)			/* ( len  accum)	(P char)	*/
	CELL(4)			/* ( len  accum	 4)	(P char)	*/
	OP(upshift)		/* ( len  accum<4)	(P char)	*/
	SUB
	  OP(asciiTOdigit)	/* ( len  accum< dig)	(P char)	*/
	OP(OR)			/* ( len  accum<+)	(P char)	*/
	OP(swap)		/* ( accum  cnt)	(P char)	*/
	OP(onbits)		/* ( accum  cnt -1)	(P  char)	*/
	OP(plus)		/* ( accum  cntd)	(P  char)	*/
	OP(swap)		/* ( cntdn  accum)	(P  char)	*/
	OP(pplusb)		/* ( cntdn  accum)	(P char')	*/
OP(ell)
  BACK(while_hexchar)
				/* ( len accum)		(P char)	*/
		OP(pdrop)	/* ( len accum)		(P )		*/
		OP(swap)	/* ( accu  len)		(P )		*/
		OP(drop)	/* ( accu)		(P )		*/
		   OP(Return)


 /* ttttttttttttttttttttttt============ */

/* ifchar		(p; str --- )  ( --- flag )  true if byte > 32	*/
THREAD_(ifchar,ifchar)
OP(fetch)		/* (P str )   ( char )	(R: ParentSize ) !Size */
OP(pdrop)
OP(maskbyte)
OP(literal)
  CELL(4)
  CELL(32)		/* ( byte  32  )		*/
OP(negate)		/* ( byte  -32)			*/
OP(plus)		/* ( byte-32)			*/
OP(zero)		/* ( byte-32 0 )		*/
OP(max)			/* ( 0_or_ischar)		*/
OP(flag)		/* ( flag ) true if non-white	*/
OP(Return)


 /* tttttttttttttttttttttttt  ============ */

/* ifword		(P ---	HNC|null) ( --- flag )	*/
THREAD_(ifword,ifword)
SUB
   OP(tb)		/*   (P tb )				*/
SUB
   OP(toklen)		/*   (P bt toklen)		(R oS
				this limits toklen to 255.		*/
OP(fetch)		/*   (P bt )  ( toklen)		(R oS		*/
OP(pdrop)
OP(maskbyte)
SUB
   OP(latest)
OP(pfetch)		/*   (P bt latest ) ( toklen )	(R oS		*/
___o___(while_dictionary)
	OP(fetch)		/*   (P bt latest ) ( len  namebyte )	*/
	OP(maskbyte)
	OP(yes)			/*   (P bt latest ) ( len)		*/
	BRANCH(+,5)
		OP(drop)	/*   (P bt latest )	()		*/
		OP(false)	/*   (P bt latest )	( false )	*/
		OP(twopdrop)	/*   (P) = NULL		(false )	*/
		OP(Return)
	OP(fetch)		/*   (P tbt  last) ( toklen  namelen  ) */
	OP(maskbyte)	
	OP(over)		/*   (P tb  last ) ( toklen  namelen toklen*/
	OP(ifequal)		/*   (P tb  last ) ( toklen  flag )	*/
	OP(no)			/*   (P tb  last ) ( toklen )		*/
		BRANCH(+,13)	/* not the same length as this name	*/
					/* same length	*/
	OP(pplusc)		/*   (P begintoken  name ) ( toklen )	*/
	SUB
	  OP(ifbytesegmentsequal)	/*   (P tb name ) ( toklen  flag )*/
	OP(no)
			BRANCH(+,7)	/* not this word		*/
	
	OP(pswap)		/*   (P name tb)	( toklen )	*/
	OP(pdrop)		/*   (P name)		( toklen )	*/	
	OP(pminusc)		/*   (P HNC )		( toklen )	*/
	OP(drop)		/*   (P HNC ) ()			*/
	OP(true)		/*   (P HNC ) ( TRUE )			*/
	OP(Return)
						/*from asksegmentsequal */
			OP(pminusc)	/*   (P begintok this_HNC)  (toklen )*/ 
					/*   from askequal		*/
		OP(TOlink)		/*   "previous"			*/
		OP(pfetch)		/*   (P bt HNC' ) (toklen )	*/
OP(ell)
BACK(while_dictionary)


 /* tttttttttttttttttttttttt============ */

/* ifabbreviation	(P --- HNC|NULL)  ( --- flag ) "'abbreviation toke. "*/
THREAD_(ifabbreviation,ifabbreviation)

SUB
   OP(tb)		/*   (P &bt)					*/
OP(sTOr)		/*   (P bt )			(R Size		*/
OP(bytes_bd)		/* Size = 1	!!!bytes			*/
SUB
   OP(toklen)		/*   (P bt toklen)			(R oS	*/
OP(fetch)		/*   (P bt toklen)	( len)		(R oS	*/
OP(pdrop)		/*   (P bt )		( len)		(R oS	*/
			/* is it period-terminated?			*/
OP(pdup)		/*   (P bt bt)	( len)		(R oS)		*/
OP(one)
SUB
 OP(minus)
OP(dup)			/*   (P bt )	( len-1 len)	(R oS)		*/
OP(plusp)		/*   (P bt et)	( len-1)	(R oS)		*/
OP(fetch)		/*   (P bt et)	( len lastchar) (R oS)		*/
OP(literal)		/*   (P bt et)	( len lastchar) (R oS)		*/
  CELL(4)
  CELL(46)		/*   (P bt et)	( len lastchar .) (R oS)	*/
OP(ifequal)	       /*   (P bt et)  ( len flag)	(R oS)	       */
OP(yes)			/*   (P bt et)	( len)		 (R oS)		*/
 BRANCH(+,6)
OP(drop)	       /* NOT AN ABBREVIATION, exuent			*/
OP(false)		/*   (P bt et)	(false)		(R oS)		*/
OP(twopdrop)
OP(rTOs)
OP(Return)		/* (false)					*/
		       /* TOKEN IS AN ABBREVIATION	(R oS)		*/
OP(pdrop)		/*   (P bt )	(len-1)		(R oS)		*/
SUB
   OP(latest)
OP(pfetch)		/*   (P bt latest ) (len )  (R oS)		*/
			/* seed ds ?hit and rs ?HNC			*/
OP(false)
OP(swap)		/*   (P bt latest ) (?hit  len) (R oS)		*/
OP(pdup)
OP(pTOr)		/*   (P bt latest ) (?hit  len) (R ?HNC oS)	*/

___o___(ifabbr)

OP(fetch)		/*   (P bt latest ) (hit? toklen  namebyte )	*/
OP(yes)			/* is namelen byte <>0?				*/
   BRANCH(+,12)		/* yes. more dictionary to do.			*/
			/* no. aardvark. Finish up.			*/
OP(twopdrop)		/*   (P )		(hit? toklen)		*/
OP(drop)		/*   (P )		(hit? )			*/
OP(dup)			/*   (P )		(hit? hit?)		*/
OP(no)			/*   (P )		(hit?)			*/
 BRANCH(+,4)
			/* was a word					*/
OP(rTOp)		/*   (P &HNC)		(true)			*/
OP(rTOs)		/*	(P &HNC)	(true)			*/
OP(Return)
			/* wasn't a word				*/
OP(rdrop)		/*   (P) = NULL		(false)			*/
OP(rTOs)
OP(Return)
			/*   (P bt  last ) (hit? len )			*/
			/* substring comparison, hop over to name	*/
OP(pplusc)		/*   (P bt name ) (hit? len )			*/
SUB		/*  {{{(P beg.	beg. ||| --- ) ( len ||| --- flag}}}	*/
   OP(ifsegmentsequal) /*   (P bt  name ) (hit? len  flag )	       */
	OP(no)		/* sub-match?					*/
	BRANCH(+,13)	/* nope.					*/
			/* yup. this is one possible completion		*/
OP(pminusc)		/*   (P bt  &HNC_hit )	(hit? len)		*/
OP(rdrop)		/* overwrite rs?HNC				*/
OP(pdup)
OP(pTOr)		/*    "	     "					*/
			/* overwrite ?hit with true			*/
OP(swap)		/* (P bt &HNC_hit )	(len ?hit)		*/
OP(drop)		/* (P bt &HNC_hit )	(len)			*/
OP(true)		/* (P bt &HNC_hit )	(len true)		*/
OP(swap)		/* (P bt &HNC_hit )	(true len)		*/
OP(TOlink)		/* (P bt LFA  )		(true len)		*/
OP(pfetch)		/* (P bt HNC' )		(true len)		*/
OP(ell)
   BACK(ifabbr)
	OP(pminusc)
	OP(TOlink)		/* (P bt LFA  ) (?hit len )		*/
	OP(pfetch)		/* (P bt HNC' ) (?hit len )		*/
	OP(ell)
	   BACK(ifabbr)


 /* ttttttttttttttttttttttttttttttttttttttttttttt============ */

/* ifatom		(P &HNC |||)   ( --- flag ) true if HNC is an atom */
THREAD_(ifatom,ifatom)
OP(pdup)		/* (P &HNC ||| &HNC			*/
OP(pfetch)		/* (P &HNC ||| HNC			*/
OP(pTO)			/* (P HNC |||) ( HNC )			*/
OP(literal)
 CELL(4)
 CELL(0x00800000)	/* (P HNC |||) ( HNC abit)		*/
OP(AND)			/* (P HNC |||) ( ?atom )		*/
OP(flag)		/* (P HNC |||) ( flag )			*/
OP(Return)

 /* ttttttttttttttttttttttt============ */

/* ifhexnumber	( --- flag )  @'s toklen and tb */
THREAD_(ifhexnumber,ifhexnumber)
SUB
   OP(tb)
SUB
   OP(toklen)
OP(fetch)			/*  (toklen )	(P bt )		*/
OP(pdrop)
OP(one)				/*  (toklen 1)	(P bt )		*/
OP(plus)			/*  (pre-count) (P bt )		*/
___o___(ifhexnum)
	OP(onbits)		/*   ( count -1 )   (P bt )	*/
	OP(plus)		/*   ( count')		(P bt ) */
	OP(dup)			/*   ( count' count')	(P bt ) */
	OP(no)			/*   ( count')		(P bt ) */
		BRANCH(+,8)
	SUB
	OP(ifhex)		/*   ( count' flag )	(P bt )		*/
	OP(pplusb)		/*   ( count' flag )	(P cur.char )	*/
	OP(no)			/*   ( count' )		(P cur.char )	*/
	BRANCH(+,7)
OP(ell)				/* is hex digit. ( count') (P cur.char )*/
BACK(ifhexnum)
		OP(drop)	/* done, is number   () (Pbeg.tok)	*/
		OP(pdrop)	/*   ()		(P)			*/
		OP(true)	/*   (xxxff)	(P)			*/
		OP(Return)
	OP(drop)		/* not a number (count	(P array )	*/
	OP(pdrop)		/*   (	(P)				*/
	OP(false)		/*   (	xxx00 )		(P)		*/
	OP(Return)


 /* tttttttttttttttttttttttttttttttttttttttt============ */

/* iffile		STUB ( --- flag ) "iffile  token "	*/
NON_USER(iffile,iffile)
OP(false)
OP(Return)

 /* ttttttttttttttttttttttt============ */

/* ifthreader	(P &HNC |||) ( --- flag ) true if threader word */
THREAD_(ifthreader,ifthreader)
OP(pdup)		/* (P &HNC ||| &HNC			*/
OP(pfetch)		/* (P &HNC ||| HNC			*/
OP(pTO)			/* (P HNC |||) ( HNC )			*/
OP(literal)
 CELL(4)
 CELL(0x00000100)	/* (P HNC |||) ( HNC abit)		*/
OP(AND)			/* (P HNC |||) ( ?atom )		*/
OP(flag)		/* (P HNC |||) ( flag )			*/
OP(Return)

 /* ttttttttttttttttttttttttttttttttttttttttttttttttttttt============ */

/* ifpending	(--- flag) true if not finished refill	  @this @epa	*/
THREAD_(ifpending,ifpending)
SUB
  OP(thispointer)
OP(pfetch)
SUB
  OP(epa)
OP(pfetch)
OP(gap)
OP(flag)
OP(twopdrop)
OP(Return)

 /* ttttttttttttttttttttttttttttttttttttttttttttttttttttt============ */

/* if$=		(P beg.	 beg. ||| --- ) ( len ||| --- flag ) are memory segments =? */
THREAD_(ifsegmentsequal,if$=)

OP(dup)				/* ( len )				*/
OP(one)
OP(plus)			/* ( downcounter )			*/
SUB
 OP(p2dup)			/* ( downcounter )   (P str str		*/

___o___(stringsequal)

	OP(onbits)		/* ( dc -1		(P str str	*/
	OP(plus)		/* ( dc-1		(P str str	*/
	OP(dup)			/* ( dc-1 dc-1		(P str str	*/
	OP(no)			/* ( dc-1		(P str str	*/
		BRANCH( +, 10 )
	OP(ifcontentsequal)    /* ( dc-1 flag		(P str str	*/
	SUB
	 OP(p2pluss)		/* ( dc-1 flag		(P str' str'	*/
OP(yes)				/* ( dc-1		(P str' str'	*/
BACK(stringsequal)

	OP(twopdrop)		/* ( dc-1		(P.)		*/
	OP(drop)		/* ( )					*/
	OP(false)		/* ( false)				*/
	OP(Return)

		OP(twopdrop)	/* ( false		(P )		*/
		OP(drop)	/* ( )					*/
		OP(true)	/* ( true)				*/
		OP(Return)


  /* ttttttttttttttttttttttt============		*/

/* ifbyte$=	(P beg.	 beg. ||| --- ) ( len ||| --- flag )  255 max len */
THREAD_(ifbytesegmentsequal,ifbyte$=)

OP(dup)				/* ( len )				*/
OP(sTOr)
OP(bytes)		/* bytes context */
OP(one)				/* ( len 1 )				*/
OP(plus)			/* ( downcounter )			*/
SUB
 OP(p2dup)			/* ( downcounter )   (P str str		*/

___o___(bytestringsequal)

	OP(onbits)		/* ( dc -1		(P str str	*/
	OP(plus)		/* ( dc-1		(P str str	*/
	OP(dup)			/* ( dc-1 dc-1		(P str str	*/
	OP(no)			/* ( dc-1		(P str str	*/
		BRANCH(+,11)
	OP(ifcontentsequal)    /* ( dc-1 flag		(P str str	*/
	SUB
	 OP(p2pluss)		/* ( dc-1 flag		(P str' str'	*/
OP(yes)				/* ( dc-1		(P str' str'	*/
BACK(bytestringsequal)

OP(twopdrop)			/* ( dc-1		(P.)		*/
OP(rTOs)
OP(drop)
OP(false)			/* ( false)				*/
OP(Return)

		OP(twopdrop)	/* ( dc-1=0		(P )		*/
		OP(rTOs)
		OP(drop)
		OP(true)	/* ( true)				*/
		OP(Return)



 /* ttttttttttttttttttttttt =========== */

/* ifhex		( --- flag ) (P char ||| )   */
NON_USER(ifhex,ifhex)
OP(fetch)		       /*   (...   char	    (P... char |||	  */
OP(maskbyte)		       /*   (...  charbyte  (P... char |||
					CHARSIZE ASSUMPTION */
SUB
OP(hexdigits)			/*   (...  charbyte  (P... char ||| array  */
OP(plusp)			/*   (...	     (P... char ||| index  */
OP(fetch)			/*   (... flag	     (P... char ||| index  */
OP(pdrop)
OP(maskbyte)
OP(Return)


  /* ttttttttttttttttttttttt============		*/

/* include 	"incl. relative_pathname "	*/
THREAD_(include,include)
OP(zero)
OP(zero)
SUB
  OP(open)
SUB
  OP(input)
OP(Return)


  /* ttttttttttttttttttttttt============		*/

/* input		( FD --- ) interpret input on FD til exhausted */
THREAD_(input,input)
SUB
  OP(source)
OP(store)
OP(pdrop)
SUB
  OP(refill)		/* (--was_some) @source !this !buffer !epa */ 
		OP(no)
		BRANCH(+,9)
___o___(while_input)
	SUB
	  OP(token)		/* (EOI)			*/
		OP(yes)		/* ()				*/
		BRANCH(+,5)
	SUB
	  OP(interpret)		/*   user context  ????????	*/
OP(ell)
BACK(while_input)
		OP(zero)
		SUB
		  OP(source)
		OP(store)
		OP(pdrop)
		SUB
		  OP(refill)
		OP(drop)
		OP(Return)


  /* ttttttttttttttttttttttt============			*/

/* interpret	interpret one token. Unknown stack effects. EVAL basically. */
THREAD_(interpret,interpret)
SUB
 OP(ifword)			/* (P HNC/NULL ) ( flag)		*/
	OP(no)			/* (P HNC/NULL ) ()			*/
	BRANCH(+,4)
SUB	
 OP(drowod)			/* user context ??????????????????	*/
OP(Return)
	SUB
	 OP(ifabbreviation)	/* (P HNC/NULL ) ( flag)	*/
		OP(no)		/* (P HNC/NULL ) ()			*/
		BRANCH(+,4)
	SUB	
	 OP(drowod)		/* user context ??????????????????	*/
	OP(Return)
		SUB 
		 OP(ifhexnumber)
			OP(no)
			BRANCH(+,4)
		SUB
		  OP(rebmunxeh)
		OP(Return)
SUB OP(cr)
SUB
  OP(tb)
SUB 
  OP(toklen)
OP(fetch)
OP(pdrop)
SUB
  OP(printstring)
SUB
  OP(beep)
OP(pdrop)
OP(Return)


  /* ttttttttttttttttttttttt============		*/

/* initresolve	init branch resolver stacks */
NON_USER(initresolve,initresolve)
SUB
 OP(branchstack)		/* (P &bs)		*/
SUB
 OP(bsi)			/* (P &bs &bsi)		*/
OP(pstore)			/* (P &bs &bsi)		*/
OP(twopdrop)
SUB
 OP(targetstack)		/* (P &bs)		*/
SUB
 OP(tsi)			/* (P &bs &bsi)		*/
OP(pstore)			/* (P &bs &bsi)		*/
OP(twopdrop)
OP(Return)


  /* ttttttttttttttttttttttt============ */

/* link		!dp   !latest	  link a word to the dictionary */
THREAD_(link,link)

SUB
 OP(latest)		/*	(P  &latest)			*/
OP(pfetch)		/*	(P  latest)			*/
SUB
 OP(appendp)		/*	(P  latest)   !dp !HERE		*/
OP(pdrop)		/*	(P)				*/
SUB
 OP(pvar)
OP(pfetch)
SUB
 OP(latest)
OP(pstore)
OP(twopdrop)
OP(Return)


  /* tttttttttttttttttttttt===========				*/

/* -		( a b ---  a-b )  minus		*/
THREAD_(minus,-)
OP(negate)
OP(plus)
OP(Return)


 /* ttttttttttttttttttttttt============ */

/* name		"name newname "	   part of :			*/
THREAD_(header,name)
			/* ENDIANISM THANG */
OP(sTOr)
SUB
 OP(dp)
OP(pfetch)
SUB
 OP(pvar)
OP(pstore)		/* link uses the value in pvar. Fugly.		*/
OP(twopdrop)
SUB
 OP(token)		/* (flag)			*/
OP(drop)		/* ()				*/
OP(bytes_bd)
SUB
 OP(toklen)		/*		(P  &toklen)			*/
OP(fetch)		/*		(P  &toklen)  ( toklen )	*/
SUB
 OP(append)		/*		(P  &toklen)			*/
OP(pdrop)		/*		(P )				*/
OP(zero)		/* (0)						*/
SUB
 OP(append)		/* ()						*/
OP(literal)
 CELL(4)
 CELL(0)		/* (0)		non-atomic			*/
SUB
OP(append)		/* ()						*/
OP(zero)		/* (0)						*/
SUB
 OP(append)		/* ()						*/
OP(rTOs)
SUB
 OP(tb)			/* ()		(P tb )		    */
SUB
 OP(toklen)		/* ()		(P tb	&toklen)      */
OP(fetch)		/* (len)	(P itb	&toklen)      */
OP(pdrop)
OP(dup)			/* (len len)	(P itoken)		*/
SUB
 OP(dp)			/* (len len)	(P itoken &dp)		*/
OP(pfetch)		/* (len len)	(P itoken dp)		*/
OP(move)		/* (len)	(P itoken dp)		*/
OP(plusp)		/* ()		(P itoken dp')		*/
SUB
 OP(dp)			/* ()		(P itoken dp' &dp)	*/
OP(pstore)		/* ()		(P itoken dp' &dp)	*/
OP(pdrop)
OP(align)		/* ()		(P itoken dp_al)	*/
SUB
 OP(dp)
OP(pstore)
OP(twopdrop)
OP(twopdrop)			SUSPECT
   OP(Return)


  /* ttttttttttttttttttttttt============			*/

/* open		( flags perms --- FD|err )  "open  filename " @!tb	*/
THREAD_(open,open)
SUB
  OP(TO_C)		/* (P tb )	(flags perms)		*/
OP(sys_open)		/* (P tb )	(FD)			*/
OP(pdrop)		/* (P)		(FD)			*/
OP(Return)


  /* ttttttttttttttttttttttt============				*/

/* postpone 	"postpone bla " CFA of bla will be appended by child 
		SUSPECT
		DOESN'T WORK FROM AN INCLUDE FILE	*/
THREADING(postpone,postpone)
SUB 
  OP(tick)		/* (P HNCbla|null )	(flag)	*/
OP(drop)		/* assume word			*/
OP(TOcode)		/* (P CFAbla )			*/
OP(pliteral)		
OP(pliteral)		/* (P CFAbla CFAplit ) 		*/		
SUB
  OP(appendp)
OP(pdrop)		/* (P CFAbla)			*/
SUB
  OP(appendp)
OP(pdrop)		/* (P)				*/
OP(pliteral)
SUB
SUB			/* (P CFAsub)			*/
  OP(appendp)
OP(pdrop)		/* (P)				*/
OP(pliteral)
OP(appendp)		/* (P CFA&p )			*/
SUB
  OP(appendp)		
OP(pdrop)		/* (P)				*/
OP(pliteral)		
OP(pdrop)		/* (P CFApdrop )		*/
SUB
  OP(appendp)		
OP(pdrop)		/* (P)				*/
OP(true)		/* ( true ) 			*/
OP(Return)


  /* ttttttttttttttttttttttt============				*/

/* p2dup		(P a b ||| --- a b ) dup 2 pointers in-phase	*/
THREAD_(p2dup,p2dup)
OP(pover)
OP(pover)
OP(Return)


  /* ttttttttttttttttttttttt============			*/

/* p2+s		(P  ptr	 ptr  --- ptr+s	 ptr+s )		*/
THREAD_(p2pluss,p2+s)
OP(ppluss)
OP(pdrop)
OP(ppluss)
OP(pup)
OP(Return)

/*		see x for Forth "." until H3sm gets BASE			*/


  /* ttttttttttttttttttttttt============			*/
/* .p		print pointer  non-destructively		*/
THREAD_(printp,.p)
OP(pdup)
OP(pTO)		/*  ( --- p ) 4 bytes moved regardless		*/
OP(printhex)	/*  ( --- )					*/
OP(Return)


   /* ttttttttttttttttttttttt============			*/
/* .r		print TOR nondestructively			*/
THREAD_(printr,.r)
OP(rpcopy)
OP(printhex)
OP(Return)


  /* ttttttttttttttttttttttt============			*/
/* .string	(P begin  ||| ) ( length --- ) print a string	*/
THREAD_(printstring,.string)
OP(pdup)
OP(TOr)
___o___(prints)
	OP(fetch)
	OP(emit)
	OP(minusaskr)
	OP(pplusb)
	OP(yes)
BACK(prints)
OP(pdrop)
OP(rdrop)
OP(Return)


  /* ttttttttttttttttttttttt============			*/

/* .chars		(P begin  ||| ) ( length --- ) prt 126 > chars > 32*/
THREAD_(printchars,.chars)
OP(TOr)
OP(pdup)			/* (P str) (R len )		*/
___o___(printchars)
	OP(fetch)		/* ( c )			*/
	OP(literal)
	 CELL(4)
	 CELL(32)		/* ( c blank)			*/
	OP(max)			/* ( c|blank)			*/
	OP(literal)
	 CELL(4)
	 CELL(126)		/* ( c|blank  ~)		*/
	OP(min)			/* ( c|blank|~)			*/
	OP(emit)		/* ()				*/
	OP(minusaskr)		/* ( flag )		(R n-1) */
	OP(pplusb)		/*  ( flag ) (P str')	(R n-1) */
	OP(yes)			/*  () (P str')	  (R n-1)	*/
BACK(printchars)

OP(rdrop)			/*  () (P str')			*/
OP(pdrop)
OP(Return)


 /* |||||||||||||||||||||||||||||||||============		*/

/* .name		(P   HNC ||| )	print a word's H3m name */
THREAD_(printname,.name)
OP(pdup)
OP(fetch)
OP(maskbyte)
OP(literal)
 CELL(4)
 CELL(4)
OP(plusp)
OP(onbits)
OP(plus)
SUB
  OP(printstring)
OP(pdrop)
SUB
  OP(blank)
OP(Return)


  /* ttttttttttttttttttttttt============			*/
/* resolve_one	resolve one branch in thread being threaded */
NON_USER(resolve_one,resolve_one)
SUB
  OP(bsi)	/* (P  &bsi)				*/
OP(pfetch)		/* (P  bsi )				*/
OP(pminusc)		/* (P  bsi-)				*/
OP(pdup)		/* (P  bsi-  bsi-)			*/
OP(pfetch)		/* (P  bsi-  targ.stck.addy)	pop	*/
OP(pfetch)		/* (P  bsi-  targ.addy)			*/
OP(pswap)		/* (P  targ.addy bsi-)			*/
OP(pminusc)		/* (P  targ.addy bsi--)			*/
OP(pdup)		/* (P  targ.addy bsi-- bsi--)		*/
OP(pfetch)		/* (P  targ.addy bsi-- poke.loc )	*/
OP(pswap)		/* (P targ.addy poke.loc bsi--)		*/
OP(pTOr)		/* (P targ.addy poke.loc bsi--) (R bsi--)	*/
OP(pstore)		/*  (P targ.addy poke.loc) (R bsi--) RESOLVED!*/
OP(twopdrop)		/* (P ) (R bsi--)			*/
OP(rTOp)		/* (P bsi--)				*/
SUB
  OP(bsi)	/* (P bsi-- &bsi)			*/
OP(pstore)
OP(twopdrop)
OP(Return)


  /* ttttttttttttttttttttttt============ */

/* refill		( --- got ) @source !this !epa !buffer   buffered more input*/

THREAD_(refill,refill)
SUB
  OP(source)		/* (p &source)  	 			*/
OP(fetch)		/* (P)			(fd)			*/
OP(pdrop)
SUB	
  OP(buffer)		/* (P buffer)		(fd)			*/
OP(read)		/* (P buffer)		( got)			*/ 
OP(dup)			/* (P buffer)		( got got)		*/
SUB	
  OP(thispointer)	/* (P buffer tp)	( got got)		*/	
OP(pstore)		/* (P buffer->tp)	( got got )		*/
OP(pdrop)		/* (P buffer)		( got got )		*/
OP(plusp)		/* (P buffer+)		( got )			*/
SUB
  OP(epa)		/* (P buffer+ &epa)	( got )			*/
OP(pstore)		/* (P buffer+->&epa)	( got )			*/
OP(twopdrop)		/* (P)			( got )			*/
OP(Return)


  /* ttttttttttttttttttttttt============			*/

/* resolve	(--- true) @bs @ts, thread all pending branches THREADer
			resolve uses bs decr.-pop style		*/
THREADING(resolve,resolve)

___o___(resolve)
	SUB
	  OP(branchstack)
	SUB
	  OP(bsi)		/* (P  &bs &bsi)		*/
	OP(pfetch)		/* (P  &bs bsi )		*/
	OP(gap)			/* (P  &bs bsi )  (gap)		*/
	OP(twopdrop)		/* (gap)			*/
	OP(no)			/* a go# is pending		*/
		BRANCH(+,5)	/* no branches pending		*/
	SUB			/* resolve a pending branch	*/
	  OP(resolve_one)	/* ()				*/
OP(ell)
BACK(resolve)
		OP(Return)


  /* tttttttttttttttttttttttttttttttttttttttt============ */

/* rebmunxeh	(  --- #_in_user_data_stack_context ) The Dreaded Rebmunxeh. */
NON_USER(rebmunxeh,rebmunxeh)
SUB
 OP(USize)
OP(pfetch)
OP(bump)
OP(pTOs)
OP(drop)
SUB
  OP(toklen)
OP(fetch)			/*   (len)				*/
OP(pdrop)
SUB
  OP(tb)			/*	(len)		(P tb)		*/	
OP(zero)			/*   ( len  accum0	(P  bt		*/
___o___(rebmunx)
	OP(over)		/*   ( len accum len	(P char		*/
	OP(no)			/*   ( len accum	(P char		*/
		BRANCH(+,15)
	OP(literal)		/*   ( len  accum  4	(P char		*/
	CELL(4)			/*   ( len  accum<	(P char		*/
	CELL(4)
	OP(upshift)
	SUB
	  OP(asciiTOdigit)	/*  ( len  accum< dig	(P char		*/
	OP(OR)			/*  ( len  accum<+	(P char		*/
	OP(swap)		/*  ( accum  cnt	(P char		*/
	OP(onbits)		/*  ( accum  cnt   -1	(P char		*/
	OP(plus)		/*  ( accum  cntdn			*/
	OP(swap)		/*  ( cntdn  accum			*/
	OP(pplusb)		/*  ( cntdn  accum	(P char'	*/
OP(ell)
  BACK(rebmunx)
				/*  ( len accum (P char			*/
		OP(pdrop)	/*  ( len accum				*/
		OP(swap)	/*  ( accu  len				*/
		OP(drop)	/*  ( accu ) leave this in user context */

		OP(cells_bd)
		OP(Return)


  /* ttttttttttttttttttttttt============			*/

/* ;		( --- stop_THREADer) set a target, resolve, & a return. */
THREADING(semicolon,;)
				/* (O) for to# = ;		*/
SUB
 OP(target)		/* (P &dp)				*/
OP(drop)		/* (P dp)				*/
SUB			/* resolve branches			*/
  OP(resolve)
OP(pliteral)	/* THREAD  a return				*/
  OP(Return)		/* (P )		( ReturnCFA )		*/
SUB
 OP(appendp)		 /* (P )				*/
OP(pdrop)		SUSPECT
OP(false)		/* tell : to stop threading		*/
OP(Return)


 /* ttttttttttttttttttttttt============ */

/* spaces		( N --- )  emit N spaces	*/
THREAD_(spaces,spaces)
OP(TOr)
___o___(spaces)
      SUB
	OP(blank)
	OP(minusaskr)
	OP(yes)
	BACK(spaces)
OP(rdrop)
OP(Return)


  /* ttttttttttttttttttttttt ============	*/

/* step		( --- EOI) true if End Of Input on this		*/
THREAD_(step,step)
SUB
  OP(thispointer)
OP(pdup)		/* increment *thispointer	*/
OP(pfetch)
OP(pplusb)
OP(pswap)
OP(pstore)
OP(twopdrop)
SUB
  OP(ifpending)		/* is there more buffer?  */
	OP(yes)
	BRANCH(+,6)
SUB
  OP(refill)		/* refill checks for more input */
OP(flag)
OP(aint)
OP(Return)
	OP(false)
	OP(Return)


 /* ttttttttttttttttttttttt============			 */

/* snug		( --- EOI) eat whitespace. snug+finish=token. Buffered. */
THREAD_(snug,snug)

___o___(while_white)
	SUB
	  OP(thispointer)		/*  (P str )			*/
	OP(pfetch)
	SUB
	  OP(ifchar)			/*  ( --- ischar) does a pdrop	*/
	OP(no)
	BRANCH(+,3)
		OP(false)
		    OP(Return)
	SUB
	  OP(step)			/* ( --- EOI )			*/
	OP(no)
		BRANCH(+,3)
	OP(true)
	    OP(Return)
OP(ell)
   BACK(while_white)


  /* tttttttttttttttttttttttttttttttttttttttttttttttttttt============ */

/* this		( --- current_input_buffer_byte ) interpreter part. */
THREAD_(this,this)
SUB
  OP(thispointer)
OP(pfetch)
OP(fetch)
OP(pdrop)
OP(Return)


 /* tttttttttttttttttttttttttttttttttttttttt============ */

/* token		( --- End_Of_Input ) ?!tb !this		*/
THREAD_(token,token)
SUB
  OP(snug)		/* (EOI)		*/
	OP(yes)		/* ()			*/
	BRANCH(+,6)
SUB
  OP(finish)		/* (EOI)		*/
OP(drop)		/* ()			*/
OP(false)
OP(Return)
	OP(true)
	OP(Return)


 /* ttttttttttttttttttttttt============ */

/* to:		( --- keep_THREADer) set branch to resolve to start of word
				stack and make dict. room for br. */
THREADING(tocolon,to:)
SUB
 OP(dp)			/* (P &dp)					*/
OP(pfetch)		/* (P dp)					*/
SUB
 OP(bsi)	/* (P dp  &bsi)					*/
OP(pfetch)		/* (P dp   bsi)					*/
OP(pstore)		/* (P dp   bsi)		!branchstackcell	*/
OP(pplusc)		/* (P dp   bsi')				*/
SUB
 OP(targetstack)	/* (P dp   bsi' &ts0)	target spec 0		*/
OP(pswap)		/* (P dp   &ts0 bsi')				*/
OP(pstore)		/* (P dp   &ts0 bsi')	!branchstackcell	*/
OP(pswap)		/* (P dp   bsi' &ts0)				*/
OP(pdrop)		/* (P dp   bsi')				*/
OP(pplusc)		/* (P dp   bsi'')				*/
SUB
 OP(bsi)   /* (P dp   bsi'' &bsi)				*/
OP(pstore)		/* (P dp   bsi'' &bsi)	 double-incr index	*/
OP(twopdrop)		/* (P dp )					*/
OP(pplusc)		/* (P dp')					*/
SUB
  OP(dp)		/* (P dp' &dp)					*/
OP(pstore)		/* (P dp' &dp)		dp+c			*/
OP(twopdrop)		/* (P )						*/
OP(true)		/* (true)	say "keep going"		*/
OP(Return)


 /* ttttttttttttttttttttttt============ */

/* to1		( --- keep_THREADing) set branch to first (O) to resolve
				stack and make dict. room for br. */
THREADING(to1,to1)
SUB
 OP(dp)			/* (P &dp)					*/
OP(pfetch)		/* (P dp)					*/
SUB
 OP(bsi)	/* (P dp  &bsi)					*/
OP(pfetch)		/* (P dp   bsi)					*/
OP(pstore)		/* (P dp   bsi)		!branchstackcell	*/
OP(pplusc)		/* (P dp   bsi')				*/
SUB
 OP(targetstack)	/* (P dp   bsi' &ts0)				*/
OP(pplusc)		/* (P dp   bsi' &ts1)	target spec 1		*/
OP(pswap)		/* (P dp   &ts1 bsi')				*/
OP(pstore)		/* (P dp   &ts1 bsi')	!branchstackcell	*/
OP(pswap)		/* (P dp   bsi' &ts1)				*/
OP(pdrop)		/* (P dp   bsi')				*/
OP(pplusc)		/* (P dp   bsi'')				*/
SUB
 OP(bsi)   /* (P dp   bsi'' &bsi)				*/
OP(pstore)		/* (P dp   bsi'' &bsi)	 double-incr index	*/
OP(twopdrop)		/* (P dp )					*/
OP(pplusc)		/* (P dp')					*/
SUB
  OP(dp)		/* (P dp' &dp)					*/
OP(pstore)		/* (P dp' &dp)		dp+c			*/
OP(twopdrop)		/* (P )						*/
OP(true)		/* (true)	keep threading			*/
OP(Return)


 /* ttttttttttttttttttttttt============ */

/* to2		( --- keep_THReding) set branch to second (O) to resolve
				stack and make dict. room for br. */
THREADING(to2,to2)
SUB
 OP(dp)			/* (P &dp)					*/
OP(pfetch)		/* (P dp)					*/
SUB
 OP(bsi)	/* (P dp  &bsi)					*/
OP(pfetch)		/* (P dp   bsi)					*/
OP(pstore)		/* (P dp   bsi)		!branchstackcell	*/
OP(pplusc)		/* (P dp   bsi')				*/
SUB
 OP(targetstack)	/* (P dp   bsi' &ts0)				*/
OP(pplusc)
OP(pplusc)		/* (P dp   bsi' &ts2)	target spec 2		*/
OP(pswap)		/* (P dp   &ts2 bsi')				*/
OP(pstore)		/* (P dp   &ts2 bsi')	!branchstackcell	*/
OP(pswap)		/* (P dp   bsi' &ts2)				*/
OP(pdrop)		/* (P dp   bsi')				*/
OP(pplusc)		/* (P dp   bsi'')				*/
SUB
 OP(bsi)   /* (P dp   bsi'' &bsi)				*/
OP(pstore)		/* (P dp   bsi'' &bsi)	 double-incr index	*/
OP(twopdrop)		/* (P dp )					*/
OP(pplusc)		/* (P dp')					*/
SUB
  OP(dp)		/* (P dp' &dp)					*/
OP(pstore)		/* (P dp' &dp)		dp+c			*/
OP(twopdrop)		/* (P )						*/
OP(true)		/* (true)	keep threading			*/
OP(Return)


/* to3		( --- keep_THREDING) as above, reserve a cell
				stack and make dict. room for br. */
THREADING(to3,to3)
SUB
 OP(dp)			/* (P &dp)					*/
OP(pfetch)		/* (P dp)					*/
SUB
 OP(bsi)	/* (P dp  &bsi)					*/
OP(pfetch)		/* (P dp   bsi)					*/
OP(pstore)		/* (P dp   bsi)		!branchstackcell	*/
OP(pplusc)		/* (P dp   bsi')				*/
SUB
 OP(targetstack)	/* (P dp   bsi' &ts0)				*/
OP(pplusc)
OP(pplusc)
OP(pplusc)		/* (P dp   bsi' &ts3)	target spec 3		*/
OP(pswap)		/* (P dp   &ts0 bsi')				*/
OP(pstore)		/* (P dp   &ts0 bsi')	!branchstackcell	*/
OP(pswap)		/* (P dp   bsi' &ts0)				*/
OP(pdrop)		/* (P dp   bsi')				*/
OP(pplusc)		/* (P dp   bsi'')				*/
SUB
 OP(bsi)   /* (P dp   bsi'' &bsi)				*/
OP(pstore)		/* (P dp   bsi'' &bsi)	 double-incr index	*/
OP(twopdrop)		/* (P dp )					*/
OP(pplusc)		/* (P dp')					*/
SUB
  OP(dp)		/* (P dp' &dp)					*/
OP(pstore)		/* (P dp' &dp)		dp+c			*/
OP(twopdrop)		/* (P )						*/
OP(true)		/* (true)	keep threading			*/
OP(Return)


/* to4		( --- keep_THREDING) as above. Max (O) + 1 is at ;
				stack and make dict. room for br. */
THREADING(to4,to4)
SUB
 OP(dp)			/* (P &dp)					*/
OP(pfetch)		/* (P dp)					*/
SUB
 OP(bsi)		/* (P dp  &bsi)					*/
OP(pfetch)		/* (P dp   bsi)					*/
OP(pstore)		/* (P dp   bsi)		!branchstackcell	*/
OP(pplusc)		/* (P dp   bsi')				*/
SUB
 OP(targetstack)	/* (P dp   bsi' &ts0)				*/
OP(pplusc)
OP(pplusc)
OP(pplusc)
OP(pplusc)		/* (P dp   bsi' &ts0)	target spec 4		*/
OP(pswap)		/* (P dp   &ts0 bsi')				*/
OP(pstore)		/* (P dp   &ts0 bsi')	!branchstackcell	*/
OP(pswap)		/* (P dp   bsi' &ts0)				*/
OP(pdrop)		/* (P dp   bsi')				*/
OP(pplusc)		/* (P dp   bsi'')				*/
SUB
 OP(bsi)		/* (P dp   bsi'' &bsi)				*/
OP(pstore)		/* (P dp   bsi'' &bsi)	 double-incr index	*/
OP(twopdrop)		/* (P dp )					*/
OP(pplusc)		/* (P dp')					*/
SUB
  OP(dp)		/* (P dp' &dp)					*/
OP(pstore)		/* (P dp' &dp)		dp+c			*/
OP(twopdrop)		/* (P )						*/
OP(true)		/* (true)	keep threading			*/
OP(Return)


 /* ttttttttttttttttttttttt============ */

/* tab		emit a tab, ASCII 9		*/
THREAD_(tab,tab)
OP(literal)
 CELL(4)
 CELL(9)
OP(emit)
OP(Return)


  /* ttttttttttttttttttttttt============ */

/* (O)		`target' ( --- keep_THREDING) set branch target 1 2 3 or 4*/
THREADING(target,(O))
SUB
 OP(dp)				/* (P &dp)				*/
OP(pfetch)			/* (P dp)				*/
SUB
 OP(tsi)			/* (P dp &tsi)				*/
OP(pfetch)			/* (P dp tsi)				*/
OP(pstore)			/* (P dp tsi)	    target stashed	*/
OP(pplusc)			/* (P dp tsi')				*/
SUB
 OP(tsi)			/* (P dp tsi' &tsi)			*/
OP(pstore)			/* (P dp tsi' &tsi)  ts index incr'd	*/
OP(pdrop)			/* (P dp tsi')				*/
OP(twopdrop)
OP(true)			/* (true)   keep threading		*/
OP(Return)


 /* ttttttttttttttttttttttt============ */

/* threadtoken	( --- keep_going? )  called after "token"	*/
NON_USER(threadtoken,threadtoken)
SUB
 OP(ifword)	       /* (P ---  &HNC|null) ( --- flag )      */
OP(no)			/* (P ---  &HNC|null) ()		*/
 BRANCH(+,10)
SUB
 OP(ifthreader)		/* (P ---  &HNC) ( --- flag )	       */
	OP(yes)		/* (P ---  &HNC) ()		       */
	BRANCH(+,63)
SUB
 OP(appendword)		/* (P ---  &HNC) ()			*/
OP(true)		/* (P ---  &HNC) ( --- true)		*/
OP(pdrop)		/* (P) ( --- true)			*/
OP(Return)		/* (P) ( --- true)			*/

SUB			/* (P;NULL)				*/
 OP(ifabbreviation)	/*				       */
	OP(no)		/*  is it an abbrev. word?		*/
	BRANCH(+,10)	/* no. not a word at all.	       */
SUB			/* yes, so it's a word.			*/
 OP(ifthreader)
	OP(yes)		/* threader (immediate) word?		*/
	BRANCH(+,50)	/* yes. go do it now.		       */
SUB			/* no. thread it.			*/
 OP(appendword)
OP(pdrop)
OP(true)
OP(Return)

SUB
 OP(ifhexnumber)
	OP(no) 
	BRANCH(+,12)	   
SUB
 OP(hexnumber)
SUB
 OP(appendlit)
OP(true)
OP(Return)

SUB			/* stub			*/
 OP(iffile)
	OP(no)
	BRANCH(+,5)
SUB
 OP(H3m)
OP(true)
OP(Return)	
	SUB
	  OP(beep)
	SUB
	 OP(toklen)
	OP(fetch)
	OP(pdrop)
SUB 
 OP(tb) 

SUB OP(cr) SUB OP(cr) SUB OP(tab) SUB OP(tab)

SUB
OP(printstring)

SUB OP(cr) SUB OP(cr) SUB OP(cr)

OP(pdrop)
OP(Return)
			/* token is threader word */
OP(doHNC)
OP(Return)


  /* ttttttttttttttttttttttt============ */

/* threadloop	called by :. Build the body of a thread. Stops after ;.	*/
NON_USER(threadloop,threadloop)

___o___(threadtokens)
	SUB
	 OP(token)
		OP(yes)
		BRANCH(+,7)
	SUB
	 OP(threadtoken)
		OP(no)
		BRANCH(+,3)	/* if keep-going is false	*/
OP(ell)				/* keep-going was true		*/
BACK(threadtokens)
		OP(Return)


  /* TTTTTTTTTTTTTTTTTTTTTTTT============ */

/* '		(P --- HNC|null)  (--- flag) "' wordname "  Forth `tick'   */
THREAD_(tick,`'')
SUB
 OP(token)
		OP(yes)
		BRANCH(+,13)
SUB
 OP(ifword)
	OP(no)
	BRANCH(+,3)
OP(true)
OP(Return)
	SUB
	  OP(ifabbreviation)
		OP(no)
		BRANCH(+,3)
	OP(true)
	OP(Return)
		OP(false)
		OP(Return)


  /* tttttttttttttttttttttttt============ */

/* '&		"'& word "  HNCword -> dictionary   !dp	THREDING */
THREADING(ticappend, `''&)
			/* put HNC of "word" in thread		*/
SUB
  OP(tick)
SUB
  OP(appendp)
OP(pdrop)
OP(true)		/* tell threader "keep going"		*/
OP(Return)


 /* tttttttttttttttttttttttt============ */

/* '&code		"'&code  word " CFAword->dictionary !dp	 THREDING */
THREADING(ticappendcode, `''&code)
			/* put CFA  of "word" in thread		*/
SUB
  OP(tick)
OP(TOcode)
SUB
  OP(appendp)
OP(pdrop)
OP(true)		/* tell threader "keep going"		*/
OP(Return)


 /* ttttttttttttttttttttttt============ */

/* 'p&		"'p& word " thread does ->  (P --- HNCword ) !dp THREDING */
THREADING(ticpappend, `''p&)

OP(pliteral)		/* put pliteral xt in thread		*/
  OP(pliteral)		/* pliteral's CFA as arg to pliteral	*/
SUB
  OP(appendp)
OP(pdrop)

SUB			/* put HNC of "word" in thread		*/
  OP(ticappend)
OP(Return)


 /* ttttttttttttttttttttttt============				*/

/* ->C		(P --- tb ) "->C string " 0-term. str. in situ */
THREAD_(TO_C,->C)
SUB
  OP(token)		/* (got_one) 
OP(drop)		/* () 					*/


SUSPECT

SUB
  OP(zeroterminate)	/* ()					*/ 
SUB
  OP(tb)		/* (P tb)				*/
OP(Return)


 /* ttttttttttttttttttttttt============			*/

/* words		( cnt --- ) print cnt wordnames from latest */
THREAD_(words,words)
		/* put downcounter on rs and enter dictionary
		have to size up to cells for un-used bit check	*/
OP(sTOr)
OP(cells_bd)
SUB
   OP(latest)			/* (P &latest ) (count)		*/
OP(pfetch)			/* (P latest )	 (count)	*/
OP(TOr)				/* (P latest )	 (R;  count )	*/
___o___(nwords)
	OP(fetch)		/* (P &HNC')	(R;  count ) (*HNC)	*/
		OP(no)			/* (P &HNC')   (R;  count ) ()	*/
		BRANCH(+,17)	/* aardvark	*/
	OP(fetch)		/* (P &HNC')   (R;  count ) (*HNC)	*/
	OP(literal)
	 CELL(4)
	 CELL(0x01000000)
	OP(AND)			/* (P &HNC')   (R;  count ) (userflag)	*/
	OP(flag)		/* (P &HNC')   (R;  count ) (userflag)	*/
	OP(aint)
		OP(no)		/* (P &HNC')   (R;  count ) ()		*/
		BRANCH(+,5)	/*  NON-USER thread	*/
				/* regular word */
	SUB
	   OP(printname)
	SUB
	  OP(blank)	
		OP(TOlink)
		OP(pfetch)	/* (P &HNC')	(R;  count )		*/
		OP(minusaskr)	/* (P &HNC')   (R;  count' )	(flag)	*/
OP(yes)				/* (P &HNC')   (R;  count' )()		*/
BACK(nwords)			/*  not done with count			*/

OP(rdrop)			/* count is 0, ciao	*/
OP(pdrop)
OP(rTOs)
SUB
 OP(cr)
OP(Return)


 /* ttttttttttttttttttttttt============ */

/* 0-terminate	() 	C-ify a token in tb.  !tb	*/
THREAD_(zeroterminate,0-terminate)
OP(sTOr)
OP(bytes)
SUB
 OP(tb)				/* (P tb )			*/
SUB
  OP(toklen)			/* (P tb tl)			*/
OP(fetch)			/* (P tb tl)	(toklen)	*/
OP(pdrop)			/* (P tb )	(toklen)	*/
OP(plusp)			/* (P tb+tl)	()		*/		
OP(zero)			/* (P tb+tl)	( 0 ) 		*/
OP(store)			/* (P tb+tl)<--/		*/
OP(pdrop)			/* (P )				*/
OP(rTOs)
OP(Return)


 /* ||||||| zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz||============ */

/* zygote		top endless loop, do argv[], then loop over input */
initial_LATEST:		/* label at HNC for dist. init. */
NON_USER(zygote,zygote)
		/* Head execution address, CFA, H3m square zero.
		The C init code set up the "commandline args" as
		the interpreter input.	 */
zygote:

OP(onbits)

___o___(top_loop_of_H3sm)
	SUB
	  OP(token)		/* (EOI)			*/
		OP(yes)		/* ()				*/
		BRANCH(+,5)
	SUB
	  OP(interpret)		/*   user context  ????????	*/
OP(ell)
BACK(top_loop_of_H3sm)
		SUB		/* file redirections on stdin must be quitted */
		  OP(source)	/* could maybe switch to stdaux, 					or close/open 0/tty */
		OP(zero)
		OP(store)
		OP(pdrop)
		SUB
		  OP(cr)
		SUB
		  OP(refill)
		OP(drop)
OP(ell)
BACK(top_loop_of_H3sm)


 /* ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc	*/

initial_HERE:

NEXT			/* NEXT ourself to the interpreter... */

} /* ...and C is gone. That's my final comment ---> */
