anchor.diff:  \	+3	undefined
   \	+4	Reason code (non-zero)
   
  -sub: findTag
  -	2 +fp@, -1 #, xor, 1 #, +,  1 +fp@, +, $8000 #, and,
  -	if,	1 +fp@, 0 #, +, @,
  -		1 +fp@, 2 #, +, @, +,
  -		1 +fp@, 4 #, +, @, +,
  -		1 +fp@, 6 #, +, @, +,
  +int, fndtagend
  +int, fndtagsta
  +
  +:, findTag
  +	fndtagend @, -1 #, xor, 1 #, +,  fndtagsta @, +, $8000 #, and,
  +	if,	fndtagsta @, 0 #, +, @,
  +		fndtagsta @, 2 #, +, @, +,
  +		fndtagsta @, 4 #, +, @, +,
  +		fndtagsta @, 6 #, +, @, +,
   		$FFFF #, xor,
  -		if,  1 +fp@, 2 #, +, 1 +fp!,  ' findTag >BODY @ #, go,
  -		then,
  -
  -		1 +fp@, @,  $C0DE #, xor,
  -		if,  1 +fp@, 2 #, +, 1 +fp!,  ' findTag >BODY @ #, go,
  -		then,
  -
  -		1 +fp@, 2 #, +, @,  1 +fp@,  xor,
  -		if,  1 +fp@, 2 #, +, 1 +fp!,  ' findTag >BODY @ #, go,
  -		then,
  -
  -		1 +fp@, 4 #, +, @,  $DA7A #, xor,
  -		if,  1 +fp@, 2 #, +, 1 +fp!,  ' findTag >BODY @ #, go,
  -		then,
  -
  -		1 +fp@, 3 +fp!,  0 #, 4 +fp!,
  -		rfs,
  -	then,
  -	0 #, 3 +fp!,  ENOTFOUND 4 +fp!,
  -	rfs,
  +		if,  fndtagsta @, 2 #, +, fndtagsta !,  again,
  +		then,
  +
  +		fndtagsta @, @,  $C0DE #, xor,
  +		if,  fndtagsta @, 2 #, +, fndtagsta !,  again,
  +		then,
  +
  +		fndtagsta @, 2 #, +, @,  fndtagsta @,  xor,
  +		if,  fndtagsta @, 2 #, +, fndtagsta !,  again,
  +		then,
  +
  +		fndtagsta @, 4 #, +, @,  $DA7A #, xor,
  +		if,  fndtagsta @, 2 #, +, fndtagsta !,  again,
  +		then,
  +
  +		0 #, rsn !,
  +		exit,
  +	then,
  +	ENOTFOUND rsn !, ;,
   
   \ fmtmem formats a memory pool with the required metadata to support allocation requests.
   \ Arguments:
  
positive.code:  4 const, /node
   3 const, roundup
  
  int, poolbase
  int, p
  
  sub: fmtmem
  	1 +fp@, 1 +fp@, !,
  	2 +fp@, -/node and, -/node +, 1 +fp@, 2 #, +, !,
  	rfs,
  
  \ getmem allocates a block of memory from a formatted memory pool.  The poolbase
  \ variable must point to the pool to allocate from.
  \ Arguments:
  \	+0	Return PC
  \	+1	Size to allocate, in bytes
  \ If successful, it returns:
  \	+2	Pointer to allocated block of memory
  \	+3	0
  \ Otherwise:
  \	+2	undefined
  \	+3	non-zero reason code.
  
  :, gm2
  	-1 +fp@, /node +, 1 +fp@, +, p !,  -1 +fp@, @,  p @, !,
  	-1 +fp@, /node +, 1 +fp@, +,   -1 +fp@, !,
  	1 +fp@, /node +, -1 #, xor, 1 #, +,  -1 +fp@, 2 #, +, @, +,  -1 +fp@, @, 2 #, +, !,
  	1 +fp@, 1 #, xor, -1 +fp@, 2 #, +, !,
  	-1 +fp@, /node +, 2 +fp!,  0 #, 3 +fp!,
  	rfs,
  
  :, gmCombine
  	-1 +fp@, @, 2 #, +, @, 1 #, and, if, exit, then,
  	-1 +fp@, @, poolbase @, xor, if,
  		-1 +fp@, 2 #, +, -3 +fp!,
  		-1 +fp@, @, 2 #, +, @, /node +, -3 +fp@, @, +, -3 +fp@, !,
  		-1 +fp@, @, @, -1 +fp@, !,
  	then, ;,
  
  :, gm1
  	-1 +fp@, 2 #, +, @, -2 +fp!,
  
  	-2 +fp@,  1 #, and,
  	if,	-1 +fp@, @, -1 +fp!,
  		-1 +fp@, poolbase @, xor, if, again, then,
  		0 #, 2 +fp!,  ESIZE $100 #, +, 3 +fp!, rfs,
  	then,
  
  	gmCombine
  
  	-1 +fp@, 2 #, +, @, -2 +fp!,
  
  	1 +fp@,  -1 #, xor, 1 #, +,  -2 +fp@, +,  $8000 #, and,
  	if,	-1 +fp@, @, -1 +fp!,
  		-1 +fp@, poolbase @, xor, if, again, then,
  		0 #, 2 +fp!,  ESIZE $500 #, +, 3 +fp!, rfs,
  	then,
  
  	/node /node +, 1 +fp@, +, -1 #, xor, 1 #, +,  -2 +fp@, +, $8000 #, and, $8000 #, xor,
  	if,	gm2
  	then,
  
  	-2 +fp@, 1 #, xor, -1 +fp@, 2 #, +, !,
  	-1 +fp@, /node +, 2 +fp!,  0 #, 3 +fp!,
  	rfs, ;,
  
  sub: getmem
  	poolbase @,
  	if,	poolbase @, -1 +fp!,
  		1 +fp@, roundup +, -/node and, 1 +fp!,
  		gm1
  	then,
  	0 #, 2 +fp!,  EBASE 3 +fp!,
  	rfs,
  
  \ relmem is used to release previously allocated memory, as returned by getmem.
  \ Arguments:
  \	+0	Return PC
  \	+1	Block of memory to release, as returned by getmem.
  \ Nothing is returned.
  
  sub: relmem
  	1 +fp@,  -/node +,  1 +fp!,
  	1 +fp@, 2 #, +, @,  -/node and,  1 +fp@, 2 #, +, !,
  	rfs,
  
  \ First instruction of STS starts here.  coldstart vectors here.
  
  :, cold		$4000 #, %fp !,			( Initialize the STS frame pointer )
  		-8 fp+!,			( Let user know we're running )
  			$C000 #, 1 +fp!,
  			40 #, 2 +fp!,
  			80 #, 3 +fp!,
  			100 #, 4 +fp!,
  			$0000 #, 5 +fp!,
  			fillRect
  
  			0 #, 1 +fp!,		( locate free memory pool )
  			$3000 #, 2 +fp!,
  			findTag
  			4 +fp@, if,		( If not found... )
  				$C000 #, 1 +fp!,	( indicate error to user and halt )
  				40 #, 2 +fp!,
  				0 #, 3 +fp!,
  				200 #, 4 +fp!,
  				$FFFF #, 5 +fp!,
  				fillRect
  				halt,
  			then,
  			3 +fp@, $C000 #, +, 1 +fp!,
  			3 +fp@, $C000 #, +, poolbase !,
  			3 +fp@, -1 #, xor, 1 #, +, $4000 #, +, 2 +fp!,
  			fmtmem
  
  \			$C000 #, 1 +fp!,	( Memory pool updated.  Time to mount our filesystem. )
  
negative.code: $0400 origin
  defer, coldstart
  
  \ Global state for all OS services.
  
  int, rsn
  
  :, halt,	again, ;,
  :, crash	$C000 #, !,  $C000 #, @, -1 #, xor, $C050 #, !,  $AAAA #, $C0A0 #, !, ;,
  :, 0=		if, 0 #, exit, then, -1 #, ;,
  
  \ fillRect draws very simple rectangular patterns on the screen.
  \ This can be used to clear the screen, or to let the user in on the current progress of something.
  \ This procedure does not return anything.
  
  int, bitmapptr
  int, wrdperrow
  int, rowendres
  int, rowperbox
  int, bitmapdat
  int, wrdctr		( internal )
  int, rowctr		( internal )
  
  :, fillrow
  	wrdctr @,
  	if,	bitmapdat @, bitmapptr @, !,
  		bitmapptr @, 2 #, +, bitmapptr !,
  		wrdctr @, -1 #, +, wrdctr !,
  		again,
  	then,
  	rowendres @, bitmapptr @, +, bitmapptr !, ;,
  
  :, fillrows
  	rowctr @,
  	if,	wrdperrow @, wrdctr !,
  		fillrow
  		rowctr @, -1 #, +, rowctr !,
  		again,
  	then, ;,
  
  :, fillRect
  	rowperbox @, rowctr !, fillrows  ;,
  
  \ findTag can be used to locate a Tag structure anywhere in RAM.
  \ A Tag structure consists of several fields designed to help it stand out from random data and program data.
  