コミット: e3d3fdd0c266ab07f87ee1d11898005423c0b6e7 - fig_sh (git)

Implementing figFORTH on SH3 assembler

コミットメタ情報

• リビジョン: e3d3fdd0c266ab07f87ee1d11898005423c0b6e7 (tree)
• 日時: 2014-03-11 23:10:21
• 作者: Joel Matthew Rees <reiisi@user...>
• コミッター: Joel Matthew Rees

ログメッセージ

Up through about definition 60, some of the compiling words (shimmed) and the first few CONSTANTS.

変更サマリ

• add: compiler.inc
• modified: context.inc
• modified: driver.inc
• modified: evaluator.inc
• modified: initialize.inc
• modified: inout.inc
• modified: main.src
• modified: parser.inc
• modified: primitive.inc
• modified: symbol.inc
• add: teststuff.inc

差分

--- /dev/null
+++ b/compiler.inc
@@ -0,0 +1,161 @@
+	.list ON, EXP
+	
+; Compiling definitions and their primitives for fig-FORTH for SH-3
+; Joel Matthew Rees, Hyougo Polytec Center
+; 2014.03.11
+
+; Licensed extended under GPL v. 2 or 3, or per the following:
+; ------------------------------------LICENSE-------------------------------------
+;
+; Copyright (c) 2009, 2010, 2011 Joel Matthew Rees
+;
+; Permission is hereby granted, free of charge, to any person obtaining a copy
+; of this software and associated documentation files (the "Software"), to deal
+; in the Software without restriction, including without limitation the rights
+; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+; copies of the Software, and to permit persons to whom the Software is
+; furnished to do so, subject to the following conditions:
+;
+; The above copyright notice and this permission notice shall be included in
+; all copies or substantial portions of the Software.
+;
+; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
+; THE SOFTWARE.
+;
+; --------------------------------END-OF-LICENSE----------------------------------
+
+; Monolithic, not separate assembly:
+; context.inc must be included before this file.
+;	.include	"context.inc"
+;
+;	.section	compiler, code
+
+
+; :       ( --- )                                                 P
+;         { : name sundry-stuff ; } typical input
+;
+;         If executing, record the data stack mark in CSP, CREATE a
+;         header, compile a call to DOCOL, and set state to compile. 
+;
+;         The interpreter will remain in a compiling state, 
+;         compiling as literals the characteristic addresses 
+;         of all non-IMMEDIATE symbols (words) it scans, 
+;         until it scans a terminating (IMMEDIATE) symbol such as 
+;         ";" or ";CODE".
+;
+;         CONTEXT (interpretation) vocabulary is set to CURRENT.
+;
+; DOCOL   ( *** IP )
+;         Characteristic of a colon (:) definition.  Begins execution of a
+;         high-level definition, i. e., nests the definition and begins
+;         processing icodes. 
+;
+;         In the low-level description, it pushes the IP
+;         and loads the Parameter Field Address of the definition which
+;         called it into the IP.
+;
+;         SEMIS un-nests out of list interpretation.
+;         DOCOL nests in.
+;         This is the way that lists get interpreted.
+;
+;         Should DOCOL have a header? 
+;         -- The fig model for 6800 does not give it one.
+;
+;         See NEXT loop.
+;
+	HIHEADER	":", COLON, DOCOL, MIMM
+	.data.l	QEXEC,SCSP,CURENT,AT,CONTXT,STORE
+	.data.l	CREATE,RBRAK
+	.data.l	PSCODE
+DOCOL:
+_fDOCOL:
+	mov.l	fIP, @-fRP	; Remember where we were.
+	mov 	fW, fIP		; fW is still pointing at the characteristic (CFA).
+	rts
+	add 	#NATURAL_SIZE, fIP	; bump it before we start
+
+
+; ;       ( --- )                                                 P
+;         { : name sundry-stuff ; } typical input
+;         ERROR check data stack against mark in CSP, compile ;S, unSMUDGE
+;         LATEST definition, and set state to interpretation.
+;
+	HIHEADER	";", SEMI, DOCOL
+	.data.l	QCSP,COMPIL,SEMIS,SMUDGE,LBRAK
+	.data.l	SEMIS
+
+
+; CONSTANT        ( n --- )
+;         { value CONSTANT name } typical input
+;         CREATE a header, compile a call to DOCON, 
+;         compile the constant value.
+;
+; DOCON   ( --- n ) 
+;         Characteristic of a CONSTANT.  A CONSTANT simply loads its value
+;         from its parameter field and pushes it on the stack.
+;
+	HIHEADER	CONSTANT, CON, DOCOL
+	.data.l	CREATE,SMUDGE,COMMA,PSCODE
+DOCON:
+_fDOCON:
+	mov.l	@(NATURAL_SIZE,fW), r0
+	rts
+	mov.l	r0, @-fSP
+
+
+; VARIABLE        ( init --- )
+;         { init VARIABLE name } typical input
+;         CREATE a header, compile a call to XVAR, compile the initial
+;         value init.
+;
+; DOVAR   ( --- vadr )    jsr <XVAR (bif.m, bifdp.a)
+;         Characteristic of a VARIABLE.  A VARIABLE pushes its PFA address
+;         on the stack.  The parameter field of a VARIABLE is the actual
+;         allocation of the variable, so that pushing its address allows
+;         its contents to be @ed (fetched).  Ordinary arrays and strings
+;         that do not subscript themselves may be allocated by defining a
+;         variable and immediately ALLOTting the remaining space.
+;         VARIABLES are global to all users, and thus should have been
+;         hidden in resource monitors, but aren't.
+;
+	HIHEADER	VARIABLE, VAR, DOCOL
+	.data.l	CON,PSCODE
+DOVAR:
+_fDOVAR:
+	add 	#NATURAL_SIZE, fW
+	rts
+	mov.l	fW, @-fSP
+
+
+; USER    ( u --- )
+;         { uoffset USER name } typical input
+;         CREATE a header, compile a call to DOUSER, 
+;         compile the unsigned offset.
+;         The offset is treated by DOUSER as an offset into the 
+;         per-user variable table. 
+;
+;         The HUMAN user is entirely responsible for maintaining allocation!
+;
+; DOUSER  ( --- vadr ) 
+;         Characteristic of a per-USER variable. USER variables are
+;         similiar to VARIABLEs, but are allocated (by hand!) in the
+;         per-user table.  A USER variable's parameter field contains its
+;         offset in the per-user table.
+;
+;         DOUSER adds the compiled offset to the base of the per-user table
+;         and pushes the resulting address.
+;
+	HIHEADER	USER, USER, DOCOL
+	.data.l	CON,PSCODE
+DOUSER:
+_fDOUSER:
+	mov.l	@(NATURAL_SIZE,fW), r0
+	add 	fUP, r0
+	rts
+	mov.l	r0, @-fSP	
+

--- a/context.inc
+++ b/context.inc
@@ -33,9 +33,14 @@
 
 	.cpu	sh3
 
-; For huge things, like U/ (USLASH)
+; For huge things, like U/ (USLASH) might be cut in half and repeated or something.
 PRIORITY_SIZE:	.DEFINE	"1"
 
+; Comment this out when all forward references are resolved,
+; and test stuff is no longer needed.
+SHIMMED:		.DEFINE	"1"	
+TESTING:		.DEFINE	"1"
+
 
 NATURAL_SIZE:	.equ	4	; 4 byte word
 HALF_SIZE:		.equ	( NATURAL_SIZE / 2 )
@@ -248,23 +253,23 @@ TAILMASK:	.equ ( H'FF & ~TAILFLAG )	; Expose the tail character.
 
 _PREVNAME:	.assign	0	; allocation/dictionary link (terminated by zero)
 
-	.macro	HEADER	name, characteristic, mode=0
+	.macro	HIHEADER	name, characteristic, inherited, mode=0
 ; Symbol name length and mode (Too much stuff in one byte, really.)
 	.data.b	(.len("\name")&H'1f)|\mode|H'80
 ; Symbol name
 _s\characteristic:	.sdata	.substr("\name", 0, .len("\name")-1)
 ; Terminate the name with high bit set (bad news for multi-byte names).
 	.data.b	.substr("\name", .len("\name")-1, 1)+H'80
-; Symbol names float, yes this is a bit awkward.
+; Symbol names float a little, yes this is a little awkward.
 	.align	NATURAL_SIZE
-; Link to previously defined symbol's header.
+; (Allocation) link to previously defined symbol's header.
 	.data.l	_PREVNAME
 ; Use the SH-3 assembler to track the last symbol. 
 ; (This is not always a good idea.)
 _PREVNAME:	.assign _s\characteristic
 ; Point to the characteristic code for this Word (symbol) to execute.
 \characteristic	.equ	$
-	.data.l	_f\characteristic
+	.data.l	_f\inherited
 ; Point to the "parameter" area of the symbol.
 _f\characteristic	.equ $
 ; This area will contain executable code for primitive (leaf) definitions.
@@ -274,6 +279,10 @@ _f\characteristic	.equ $
 ; And so (ahem) forth.
 	.endm
 
+	.macro	HEADER	name, characteristic, mode=0
+	HIHEADER	"\name", \characteristic, \characteristic, \mode
+	.endm
+
 
 ; More as an example than to be actually used:
 	.macro	fSAFECALL	cfa

--- a/driver.inc
+++ b/driver.inc
@@ -2,83 +2,83 @@
 	
 ; Actual driver definitions for fig-FORTH for SH-3
 ; Joel Matthew Rees, Hyougo Polytec Center
-; 2014.03.05
-
-; Licensed extended under GPL v. 2 or 3, or per the following:
-; ------------------------------------LICENSE-------------------------------------
-;
-; Copyright (c) 2009, 2010, 2011 Joel Matthew Rees
-;
-; Permission is hereby granted, free of charge, to any person obtaining a copy
-; of this software and associated documentation files (the "Software"), to deal
-; in the Software without restriction, including without limitation the rights
-; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
-; copies of the Software, and to permit persons to whom the Software is
-; furnished to do so, subject to the following conditions:
-;
-; The above copyright notice and this permission notice shall be included in
-; all copies or substantial portions of the Software.
-;
-; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
-; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
-; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
-; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
-; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
-; THE SOFTWARE.
-;
-; --------------------------------END-OF-LICENSE----------------------------------
-
+; 2014.03.05
+
+; Licensed extended under GPL v. 2 or 3, or per the following:
+; ------------------------------------LICENSE-------------------------------------
+;
+; Copyright (c) 2009, 2010, 2011 Joel Matthew Rees
+;
+; Permission is hereby granted, free of charge, to any person obtaining a copy
+; of this software and associated documentation files (the "Software"), to deal
+; in the Software without restriction, including without limitation the rights
+; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+; copies of the Software, and to permit persons to whom the Software is
+; furnished to do so, subject to the following conditions:
+;
+; The above copyright notice and this permission notice shall be included in
+; all copies or substantial portions of the Software.
+;
+; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
+; THE SOFTWARE.
+;
+; --------------------------------END-OF-LICENSE----------------------------------
+
 ; This is where you put the drivers for your hardware.
-
-; Monolithic, not separate assembly:
-; context.inc must be included before this file.
-;	.include	"context.inc"
-;
+
+; Monolithic, not separate assembly:
+; context.inc must be included before this file.
+;	.include	"context.inc"
+;
 ;	.section	driver, code
-
-
-; Not sure whether to make headers for these.
-; See screens 21 and around 63 in the fig model.
-
-
-; (EMIT)    ( c --- )
-;           Low level details of outputting a character 
-;           to the current output device.
-;
-	HEADER	(EMIT), PEMIT
-	mov.l	@fSP+, r0
-	rts
-	nop	
-
-
-; (KEY)    ( --- c )
-;           Low level details of getting a key 
-;           from the current input device.
-;
-	HEADER	(KEY), PKEY
-	mov.l	r0, @-fSP
-	rts
-	nop	
-
-
-; (?TERMINAL)    ( --- f )
-;           Low level details of checking the break key.
-;
-	HEADER	(?TERMINAL), PQTER
-	mov 	#6, r0
-	mov.l	r0, @-fSP
-	rts
-	nop	
-
-
-; (CR)    ( --- )
-;           Low level details of performing carriage return/line feed 
-;           on the current output device.
-;
-	HEADER	(CR), PCR
-	mov.l	@fSP+, r0
-	rts
-	nop	
-
-
+
+
+; Not sure whether to make headers for these.
+; See screens 21 and around 63 in the fig model.
+
+
+; (EMIT)    ( c --- )
+;           Low level details of outputting a character 
+;           to the current output device.
+;
+	HEADER	"(EMIT)", PEMIT
+	mov.l	@fSP+, r0
+	rts
+	nop	
+
+
+; (KEY)    ( --- c )
+;           Low level details of getting a key 
+;           from the current input device.
+;
+	HEADER	"(KEY)", PKEY
+	mov.l	r0, @-fSP
+	rts
+	nop	
+
+
+; (?TERMINAL)    ( --- f )
+;           Low level details of checking the break key.
+;
+	HEADER	"(?TERMINAL)", PQTER
+	mov 	#6, r0
+	mov.l	r0, @-fSP
+	rts
+	nop	
+
+
+; (CR)    ( --- )
+;           Low level details of performing carriage return/line feed 
+;           on the current output device.
+;
+	HEADER	"(CR)", PCR
+	mov.l	@fSP+, r0
+	rts
+	nop	
+
+

--- a/evaluator.inc
+++ b/evaluator.inc
@@ -3,271 +3,570 @@
 ; Expression evaluator definitions for fig-FORTH for SH-3
 ; Joel Matthew Rees, Hyougo Polytec Center
 ; 2014.03.01
+
+; Licensed extended under GPL v. 2 or 3, or per the following:
+; ------------------------------------LICENSE-------------------------------------
+;
+; Copyright (c) 2009, 2010, 2011 Joel Matthew Rees
+;
+; Permission is hereby granted, free of charge, to any person obtaining a copy
+; of this software and associated documentation files (the "Software"), to deal
+; in the Software without restriction, including without limitation the rights
+; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+; copies of the Software, and to permit persons to whom the Software is
+; furnished to do so, subject to the following conditions:
+;
+; The above copyright notice and this permission notice shall be included in
+; all copies or substantial portions of the Software.
+;
+; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
+; THE SOFTWARE.
+;
+; --------------------------------END-OF-LICENSE----------------------------------
+
 
-; Licensed extended under GPL v. 2 or 3, or per the following:
-; ------------------------------------LICENSE-------------------------------------
-;
-; Copyright (c) 2009, 2010, 2011 Joel Matthew Rees
-;
-; Permission is hereby granted, free of charge, to any person obtaining a copy
-; of this software and associated documentation files (the "Software"), to deal
-; in the Software without restriction, including without limitation the rights
-; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
-; copies of the Software, and to permit persons to whom the Software is
-; furnished to do so, subject to the following conditions:
-;
-; The above copyright notice and this permission notice shall be included in
-; all copies or substantial portions of the Software.
-;
-; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
-; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
-; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
-; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
-; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
-; THE SOFTWARE.
-;
-; --------------------------------END-OF-LICENSE----------------------------------
-
-
-; Monolithic, not separate assembly:
-; context.inc must be included before this file.
-;	.include	"context.inc"
-;
+; Monolithic, not separate assembly:
+; context.inc must be included before this file.
+;	.include	"context.inc"
+;
 ;	.section	evaluator, code
 
+
+; Not in the 6800 fig model, I've just re-factored it for fun.
+; (ALIGN)  ( ptr1 --- ptr2 )
+;         Adjust ptr1 to the nearest aligned address not lower.
+;         In other words, if ptr1 is aligned at a NATURAL_SIZE boundary, do nothing.
+;         Otherwise, adjust it up until it is aligned.
+;
+	HEADER ALIGN, xPALIGN
+	mov.l	@fSP, r0
+	mALIGNr0
+	rts
+	mov.l	r0, @fSP
+
+
 
-; Not in the 6800 fig model, I've just re-factored it for fun.
-; (ALIGN)  ( ptr1 --- ptr2 )
-;         Adjust ptr1 to the nearest aligned address not lower.
-;         In other words, if ptr1 is aligned at a NATURAL_SIZE boundary, do nothing.
-;         Otherwise, adjust it up until it is aligned.
-;
-	HEADER ALIGN, xPALIGN
-	mov.l	@fSP, r0
-	mALIGNr0
-	rts
-	mov.l	r0, @fSP
-
-
-
-; It's tempting to put I in a dedicated register, 
-; but we don't want to optimize too early.
-;
-; I       ( --- index )           ( limit index *** limit index )
-;         Copy the loop index from the return stack.  Synonym for R, here.
+; It's tempting to put I in a dedicated register, 
+; but we don't want to optimize too early.
 ;
+; I       ( --- index )           ( limit index *** limit index )
+;         Copy the loop index from the return stack.  Synonym for R, here.
+;
+;         It's convenient to have the current return address 
+;         out-of-the-way in PR
+;
 	HEADER	I, I
 	mov.l	@fRP, r0	; I (loop counter)
 	rts
 	mov.l	r0, @-fSP	
-
-
-; U*      ( u1 u2 --- ud )
-;         Multiplies the top two unsigned integers, yielding a double
-;         integer product.
-;
-;         Rejoice, there is a double unsigned multiply! 
-;
-;         ***** FORTH order for double wide is most-significant-first!
-;
-	HEADER	U*, USTAR
-	mov.l	@fSP+, r1
-	mov.l	@fSP+, r0
-	dmulu.l	r1, r0
-	sts.l	macl, @-fSP
-	rts
-	sts.l	mach, @-fSP
+
+
+; U*      ( u1 u2 --- ud )
+;         Multiplies the top two unsigned integers, yielding a double
+;         integer product.
+;
+;         Rejoice, there is a double unsigned multiply! 
+;
+;         ***** FORTH order for double wide is most-significant-first!
+;
+	HEADER	"U*", USTAR
+	mov.l	@fSP+, r1
+	mov.l	@fSP+, r0
+	dmulu.l	r1, r0
+	sts.l	macl, @-fSP
+	rts
+	sts.l	mach, @-fSP
+	
+
+; Put this close to the test, so that we don't worry about the .AREPEAT length
+PUDIVover:
+	mov.b	#-1, r0		; Or we could trap this, if we take the time to define traps.
+	mov.l	r0, @fSP
+	rts
+	mov.l	r0, @(NATURAL_SIZE,fSP)
+;
+; (UDIV)  ( ud u --- uquotient )
+;         Divides the top unsigned integer into the second and third words
+;         on the stack as a single unsigned double integer, 
+;         leaving only the quotient as an unsigned integer.
+; 
+;		  The smaller the divisor, the more likely dropping the high word 
+;		  of the quotient loses significant bits.
+;
+;         The SH3 manual seems to indicate that we can't trust the remainder
+;         to remain a true remainder to the end.
+;         It strongly recommends using multiply-subtract instead, 
+;         to get the remainder.
+;
+;         ***** FORTH order for double wide is most-significant-first!
+;
+; Using a loop that messes with the carry won't work.
+;	.AIFDEF	PRIORITY_SIZE
+;DIVIDELENGTH:	.DEFINE	"16"		; repeat count * 2 cycles * count in r3
+;	.AELSE
+DIVIDELENGTH:	.DEFINE	"32"		; repeat count * 2 cycles
+;	.AENDI
+;
+	HEADER	"(UDIV)", PUDIV
+	mov.l	@fSP+, r2	; divisor
+	mov.l	@fSP+, r0	; dividend high part
+	cmp/hs	r2, r0		; zero divide or overflow?
+	bt  	PUDIVover
+	mov.l	@fSP, r1	; dividend low part
+;	.AIFDEF	PRIORITY_SIZE
+;	mov.b	#2, r3		; Trade speed for size
+;	.AENDI
+	div0u	; Get the flags ready
+;PUDIVloop:
+	.AREPEAT	DIVIDELENGTH
+	rotcl	r1
+	div1	r2, r0
+	.AENDR
+;	.AIFDEF	PRIORITY_SIZE
+;	dt		r3			; + 4 cycles * count in r3
+;	bf  	PUDIVloop
+;	.AENDI
+	rotcl	r1
+	rts
+	mov.l	r1, @fSP
+
+
+; U/      ( ud u --- uremainder uquotient )
+;         Divides the top unsigned integer into the second and third words
+;         on the stack as a single unsigned double integer, leaving the
+;         remainder and quotient (quotient on top) as unsigned integers.
+;		
+;		  The smaller the divisor, the more likely dropping the high word 
+;		  of the quotient loses significant bits.
+;
+;         ***** FORTH order for double wide is most-significant-first!
+;
+	HEADER	"U/", USLASH
+	sts.l	pr, @-fRP
+	mov.l	@(2*NATURAL_SIZE,fSP), r0
+	mov.l	r0, @-fSP
+	mov.l	@(2*NATURAL_SIZE,fSP), r0
+	mov.l	r0, @-fSP
+	mov.l	@(2*NATURAL_SIZE,fSP), r0
+	bsr 	_fPUDIV
+	mov.l	r0, @-fSP		; Push the divisor as we go.
+; 
+	mov.l	@fSP+, r0	; grab the quotient
+	mov.l	@fSP+, r1	; grab the divisor (unsigned double dividend still on stack)
+	mov 	r0, fW		; hold the quotient
+	and 	r1, r0
+	cmp/eq	#-1, r0		; both max unsigned? (fW == r0 == max unsigned)
+	bf  	USLASHremainder
+	bra  	USLASHexitstore
+	mov.l	r0, @(NATURAL_SIZE,fSP)	; remainder (max) as we go
+;
+; The SH-3 manual recommends this approach
+USLASHremainder:
+	mov 	fW, r0
+	dmulu.l	r1, r0		; multiply quotient by divisor
+	sts.l	macl, @-fSP
+	bsr 	_fDSUB
+	sts.l	mach, @-fSP	; Store most significant as we go.
+; The low part is in the right place for the remainder.
+; 
+USLASHexitstore:
+	lds.l	@fRP+, pr
+	rts
+	mov.l	fW, @fSP	; Store the quotient as we go
+
+
+; AND     ( n1 n2 --- n )
+;         Bitwise and the top two integers.
+;
+	HEADER	AND, AND
+	mov.l	@fSP+, r1
+	mov.l	@fSP, r0
+	and 	r1, r0
+	rts
+	mov.l	r0, @fSP
+
+
+; OR      ( n1 n2 --- n )
+;         Bitwise or.
+;
+	HEADER	OR, OR
+	mov.l	@fSP+, r1
+	mov.l	@fSP, r0
+	or 	r1, r0
+	rts
+	mov.l	r0, @fSP
+
+
+; XOR     ( n1 n2 --- n )
+;         Bitwise exclusive or.
+;
+	HEADER	XOR, XOR
+	mov.l	@fSP+, r1
+	mov.l	@fSP, r0
+	xor 	r1, r0
+	rts
+	mov.l	r0, @fSP
+
+
+; LEAVE   ( limit index *** index index )
+;         Force the terminating condition for the innermost loop by
+;         copying its index to its limit.  Termination is postponed until
+;         the next LOOP or +LOOP instruction is executed.  The index
+;         remains available for use until the LOOP or +LOOP instruction is
+;         encountered.
+;
+;         It's convenient to have the current return address 
+;         out-of-the-way in PR
+;
+	HEADER	LEAVE, LEAVE
+	mov.l	@fSP, r0
+	rts
+	mov.l	r0, @(NATURAL_SIZE,fSP)
+
+
+; >R      ( n --- )               ( *** n )                       C
+;         Move top of parameter stack to top of return stack.
+;
+;         It's convenient to have the current return address 
+;         out-of-the-way in PR
+;
+	HEADER	">R", TOR
+	mov.l	@fSP+, r0
+	rts
+	mov.l	r0, @-fRP
+
+
+; R>      ( --- n )               (n *** )                        C
+;         Move top of return stack to top of parameter stack.
+;
+;         It's convenient to have the current return address 
+;         out-of-the-way in PR
+; 
+	HEADER	"R>", FROMR
+	mov.l	@fRP+, r0
+	rts
+	mov.l	r0, @-fSP
+
+
+; R       ( --- n )               ( n *** n )
+;         Copy the top of return stack to top of parameter stack.  A
+;         synonym for I.
+;
+;         It's convenient to have the current return address 
+;         out-of-the-way in PR
+;
+	HIHEADER	R, R, I
+;	mov.l	@fRP, r0
+;	rts
+;	mov.l	r0, @-fSP
+
+
+; 0=      ( n --- n=0 )
+;         Logically invert top of stack; or flag true if top is zero,
+;         otherwise false.
+;
+	HEADER	"0=", ZEQU
+	mov.l	@fSP, r0
+	cmp/eq	#0, r0		; Bit inversion leaves an incomplete flag.
+	bt  ZEQUequal
+	mov 	#0, r0
+	rts
+	mov.l	r0, @fSP
+ZEQUequal:
+	mov 	#-1, r0		; not r0, r0 would also work, but why bother?
+	rts
+	mov.l	r0, @fSP	
+
+
+;0<      ( n --- n<0 )
+;       Flag true if top is negative (MSbit set), otherwise false.
+;
+	HEADER	"0<", ZLESS
+	mov.l	@fSP, r0
+	shal	r0			; Sign bit to T (and why are shal and shll different opcodes?)
+	bt  ZLESSneg
+	mov 	#0, r0
+	rts
+	mov.l	r0, @fSP
+ZLESSneg:
+	mov 	#-1, r0		; not r0, r0 would also work, but why bother?
+	rts
+	mov.l	r0, @fSP	
+
+
+; +       ( n1 n2 --- n1+n2 )
+;         Add top two words.
+;
+	HEADER	"+", PLUS
+	mov.l	@fSP+, r1
+	mov.l	@fSP, r0
+	add 	r1, r0
+	rts
+	mov.l	r0, @fSP
 	
 
-; Put this close to the test, so that we don't worry about the .AREPEAT length
-PUDIVover:
-	mov.b	#-1, r0		; Or we could trap this, if we take the time to define traps.
-	mov.l	r0, @fSP
-	rts
-	mov.l	r0, @(NATURAL_SIZE,fSP)
-;
-; (UDIV)  ( ud u --- uquotient )
-;         Divides the top unsigned integer into the second and third words
-;         on the stack as a single unsigned double integer, 
-;         leaving only the quotient as an unsigned integer.
-; 
-;		  The smaller the divisor, the more likely dropping the high word 
-;		  of the quotient loses significant bits.
-;
-;         The SH3 manual seems to indicate that we can't trust the remainder
-;         to remain a true remainder to the end.
-;         It strongly recommends using multiply-subtract instead, 
-;         to get the remainder.
-;
-;         ***** FORTH order for double wide is most-significant-first!
-;
-; Using a loop that messes with the carry won't work.
-;	.AIFDEF	PRIORITY_SIZE
-;DIVIDELENGTH:	.DEFINE	"16"		; repeat count * 2 cycles * count in r3
-;	.AELSE
-DIVIDELENGTH:	.DEFINE	"32"		; repeat count * 2 cycles
-;	.AENDI
-;
-	HEADER	(UDIV), PUDIV
-	mov.l	@fSP+, r2	; divisor
-	mov.l	@fSP+, r0	; dividend high part
-	cmp/hs	r2, r0		; zero divide or overflow?
-	bt  	PUDIVover
-	mov.l	@fSP, r1	; dividend low part
-;	.AIFDEF	PRIORITY_SIZE
-;	mov.b	#2, r3		; Trade speed for size
-;	.AENDI
-	div0u	; Get the flags ready
-;PUDIVloop:
-	.AREPEAT	DIVIDELENGTH
-	rotcl	r1
-	div1	r2, r0
-	.AENDR
-;	.AIFDEF	PRIORITY_SIZE
-;	dt		r3			; + 4 cycles * count in r3
-;	bf  	PUDIVloop
-;	.AENDI
-	rotcl	r1
-	rts
-	mov.l	r1, @fSP
-
-
-; U/      ( ud u --- uremainder uquotient )
-;         Divides the top unsigned integer into the second and third words
-;         on the stack as a single unsigned double integer, leaving the
-;         remainder and quotient (quotient on top) as unsigned integers.
-;		
-;		  The smaller the divisor, the more likely dropping the high word 
-;		  of the quotient loses significant bits.
-;
-;         ***** FORTH order for double wide is most-significant-first!
-;
-	HEADER	U/, USLASH
-	sts.l	pr, @-fRP
-	mov.l	@(2*NATURAL_SIZE,fSP), r0
-	mov.l	r0, @-fSP
-	mov.l	@(2*NATURAL_SIZE,fSP), r0
-	mov.l	r0, @-fSP
-	mov.l	@(2*NATURAL_SIZE,fSP), r0
-	bsr 	_fPUDIV
-	mov.l	r0, @-fSP		; Push the divisor as we go.
-; 
-	mov.l	@fSP+, r0	; grab the quotient
-	mov.l	@fSP+, r1	; grab the divisor (unsigned double dividend still on stack)
-	mov 	r0, fW		; hold the quotient
-	and 	r1, r0
-	cmp/eq	#-1, r0		; both max unsigned? (fW == r0 == max unsigned)
-	bf  	USLASHremainder
-	bra  	USLASHexitstore
-	mov.l	r0, @(NATURAL_SIZE,fSP)	; remainder (max) as we go
-;
-; The SH-3 manual recommends this approach
-USLASHremainder:
-	mov 	fW, r0
-	dmulu.l	r1, r0		; multiply quotient by divisor
-	sts.l	macl, @-fSP
-	bsr 	_fDSUB
-	sts.l	mach, @-fSP	; Store most significant as we go.
-; The low part is in the right place for the remainder.
-; 
-USLASHexitstore:
-	lds.l	@fRP+, pr
-	rts
-	mov.l	fW, @fSP	; Store the quotient as we go
-
-
-; AND     ( n1 n2 --- n )
-;         Bitwise and the top two integers.
-;
-	HEADER	AND, AND
-	mov.l	@fSP+, r1
-	mov.l	@fSP, r0
-	and 	r1, r0
-	rts
-	mov.l	r0, @fSP
-
-
-; OR      ( n1 n2 --- n )
-;         Bitwise or.
-;
-	HEADER	OR, OR
-	mov.l	@fSP+, r1
-	mov.l	@fSP, r0
-	or 	r1, r0
-	rts
-	mov.l	r0, @fSP
-
-
-; XOR     ( n1 n2 --- n )
-;         Bitwise exclusive or.
-;
-	HEADER	XOR, XOR
-	mov.l	@fSP+, r1
-	mov.l	@fSP, r0
-	xor 	r1, r0
-	rts
-	mov.l	r0, @fSP
-
+; D+       ( d1 d2 --- d1+d2 )
+;         Add top two double words, leaving the double sum.
+;
+;         ***** FORTH order for double wide is most-significant-first!
+;
+	HEADER	"D+", DPLUS
+	mov.l	@fSP+, r2	; high part
+	mov.l	@fSP+, r3	; low part
+	mov.l	@(NATURAL_SIZE,fSP), r1	; high part
+	mov.l	@fSP, r0	; low part
+	clrt
+	addc	r3, r1
+	addc	r2, r0
+	mov.l	r1, @(NATURAL_SIZE,fSP)
+	rts
+	mov.l	r0, @fSP
+	
 
+;MINUS   ( n --- -n )
+;        Negate (two's complement) top of stack. 
+;        (NOT the the opposite of PLUS!)
+;
+	HEADER	MINUS, MINUS
+	mov.l	@fSP, r0
+	neg 	r0, r0
+	rts
+	mov.l	r0, @fSP
+
+
+;DMINUS  ( d --- -d )
+;        Negate (two's complement) top two words on stack as a double
+;        integer.
+;        (NOT the the opposite of DPLUS!)
+;
+	HEADER	DMINUS, DMINUS
+	mov.l	@(NATURAL_SIZE,fSP), r1
+	mov.l	@fSP, r0
+	clrt
+	negc	r1, r1
+	negc	r0, r0
+	mov.l	r1, @(NATURAL_SIZE,fSP)
+	rts
+	mov.l	r0, @fSP
+
+
+; OVER    ( n1 n2 --- n1 n2 n1 )
+;         Push a copy of the second word on stack.
+; 
+	HEADER	OVER, OVER
+	mov.l	@(NATURAL_SIZE,fSP), r0
+	rts
+	mov.l	r0, @-fSP
+
+
+; DROP    ( n --- )
+;         Discard the top word on stack.
+;
+	HEADER	DROP, DROP
+	rts
+	add 	#NATURAL_SIZE, fSP
+
+
+; SWAP    ( n1 n2 --- n2 n1 )
+;         Swap the top two words on stack.
+;
+	HEADER	SWAP, SWAP
+	mov.l	@(NATURAL_SIZE,fSP), r0
+	mov.l	@fSP, r1
+	mov.l	r1, @(NATURAL_SIZE,fSP)
+	rts
+	mov.l	r0, @fSP
+
 
+; DUP     ( n1 --- n1 n1 )
+;         Push a copy of the top word on stack.
+;
+	HEADER	DUP, DUP
+	mov.l	@fSP, r0
+	rts
+	mov.l	r0, @-fSP
+
+
+; +!      ( n adr --- )
+;         Add the second word on stack to the word at the adr on top of
+;         stack.
+;
+	HEADER	"+!", PSTORE
+	mov.l	@fSP+, r2
+	mov.l	@r2, r0
+	mov.l	@fSP+, r1
+	add 	r1, r0
+	rts
+	mov.l	r0, @r2
+
+
+myTOGGLE:	.DEFINE "1"
 
-; +       ( n1 n2 --- n1+n2 )
-;         Add top two words.
-;
-	HEADER	+, PLUS
-	mov.l	@fSP+, r1
-	mov.l	@fSP, r0
-	add 	r1, r0
-	rts
-	mov.l	r0, @fSP
-	
+; TOGGLE  ( adr b --- )
+;         Exclusive or byte at adr with low byte of top word.
+;
+	.AIFDEF	myTOGGLE
+	HEADER	TOGGLE, TOGGLE
+	mov.l	@fSP+, r1
+	mov.l	@fSP+, r2
+	mov.b	@r2, r0
+	xor 	r1, r0
+	rts
+	mov.b	r0, @r2
+	.AELSE	; It makes a good example, so I'll keep it here.
+	HIHEADER	TOGGLE, TOGGLE, DOCOL
+	.data.l	OVER,CAT,XOR,SWAP,CSTORE
+	.data.l	SEMIS
+	.AENDI
+
+
+; @       ( adr --- n )
+;         Replace address on stack with the word at the address.
+;
+	HEADER	"@", AT
+	mov.l	@fSP, r1 
+	mov.l	@r1, r0		; Would mov.l @r0, r0 cause a stall?
+	rts
+	mov.l	r0, @fSP
+
 
-; D+       ( d1 d2 --- d1+d2 )
-;         Add top two double words, leaving the double sum.
-;
-;         ***** FORTH order for double wide is most-significant-first!
-;
-	HEADER	D+, DPLUS
-	mov.l	@fSP+, r2	; high part
-	mov.l	@fSP+, r3	; low part
-	mov.l	@(NATURAL_SIZE,fSP), r1	; high part
-	mov.l	@fSP, r0	; low part
-	clrt
-	addc	r3, r1
-	addc	r2, r0
-	mov.l	r1, @(NATURAL_SIZE,fSP)
-	rts
-	mov.l	r0, @fSP
-	
+; C@      ( adr --- b )
+; CFEH    Replace address on top of stack with the byte at the address.
+;         High byte of result is clear.
+;
+	HEADER	"C@", CAT
+	mov.l	@fSP, r1 
+	mov.b	@r1, r0		; Would mov.b @r0, r0 cause a stall?
+	rts
+	mov.l	r0, @fSP
+
+
+; !       ( n adr --- )
+;         Store second word on stack at address on top of stack.
+;
+	HEADER	"!", STORE
+	mov.l	@fSP+, r1
+	mov.l	@fSP+, r0
+	rts
+	mov.l	r0, @r1
+
 
-; -       ( n1 n2 --- n1-n2 )
-;         Subtract top word from second, leaving the difference.
-;
-	HEADER	-, SUB
-	mov.l	@fSP+, r1
-	mov.l	@fSP, r0
-	sub 	r1, r0
-	rts
-	mov.l	r0, @fSP
+; C!      ( b adr --- )
+; CSTO    Store low byte of second word on stack at address on top of
+;        stack.  High byte is ignored.
+;
+	HEADER	"C!", CSTORE
+	mov.l	@fSP+, r1
+	mov.l	@fSP+, r0
+	rts
+	mov.b	r0, @r1
+
+
+; Numeric constants mapping to themselves is primarily for speed.
+; 
+; 0       ( --- 0 )
+	HIHEADER	"0", ZERO, DOCON
+	.data.l	0
+
+; 1       ( --- 1 )
+	HIHEADER	"1", ONE, DOCON
+	.data.l	1
+
+; 2       ( --- 2 )
+	HIHEADER	"2", TWO, DOCON
+	.data.l 1
+
+; 3       ( --- 3 )
+	HIHEADER	"3", THREE, DOCON
+	.data.l	3
+
+; 4       ( --- 4 )
+;         Not part of the fig-FORTH model.
+	HIHEADER	"4", FOUR, DOCON
+	.data.l	4
+
+; NWIDTH  ( --- u )
+;         Not part of the fig-FORTH model, should have been.
+	HIHEADER	NWIDTH, NWIDTH, DOCON
+	.data.l	NATURAL_SIZE
+
+; PTRWIDTH  ( --- u )
+;           Not part of the fig-FORTH model, should have been.
+	HIHEADER	PTRWIDTH, PTRWIDTH, DOCON
+	.data.l	NATURAL_SIZE
+
+; BL      ( --- u )
+	HIHEADER	BL, BL, DOCON
+	.data.l	" "	; ascii blank
+
+
+
+
+; -       ( n1 n2 --- n1-n2 )
+;         Subtract top word from second, leaving the difference.
+;
+	HEADER	"-", SUB
+	mov.l	@fSP+, r1
+	mov.l	@fSP, r0
+	sub 	r1, r0
+	rts
+	mov.l	r0, @fSP
 	
 
-; D-       ( d1 d2 --- d1+d2 )
-;         Subtract top double from second, leaving the double difference.
-;
-;         ***** FORTH order for double wide is most-significant-first!
-;
-	HEADER	D-, DSUB
-	mov.l	@fSP+, r2	; high part
-	mov.l	@fSP+, r3	; low part
-	mov.l	@(NATURAL_SIZE,fSP), r1	; high part
-	mov.l	@fSP, r0	; low part
-	clrt
-	subc	r3, r1
-	subc	r2, r0
-	mov.l	r1, @(NATURAL_SIZE,fSP)
-	rts
-	mov.l	r0, @fSP
-
-
+; D-       ( d1 d2 --- d1+d2 )
+;         Subtract top double from second, leaving the double difference.
+;
+;         ***** FORTH order for double wide is most-significant-first!
+;
+	HEADER	"D-", DSUB
+	mov.l	@fSP+, r2	; high part
+	mov.l	@fSP+, r3	; low part
+	mov.l	@(NATURAL_SIZE,fSP), r1	; high part
+	mov.l	@fSP, r0	; low part
+	clrt
+	subc	r3, r1
+	subc	r2, r0
+	mov.l	r1, @(NATURAL_SIZE,fSP)
+	rts
+	mov.l	r0, @fSP
+
+
+
+
+
+
+;=       ( n1 n2 --- n1=n2 )
+;        Flag true if n1 and n2 are equal, otherwise false.
+;
+	HEADER	"=", EQU
+	mov.l	@fSP+, r1
+	mov.l	@fSP, r0
+	cmp/eq	r1, r0		; Subtraction leaves an incomplete flag.
+	bt  	EQUequal
+	mov 	#0, r0
+	rts
+	mov.l	r0, @fSP
+EQUequal:
+	mov 	#-1, r0
+	rts
+	mov.l	r0, @fSP	
+
+
+;<       ( n1 n2 --- n1<n2 )
+;        Flag true if n1 is less than n2, otherwise false.
+;
+
+
+
+
+;>       ( n1 n2 --- n1>n2 )
+;        Flag true if n1 is greater than n2, false otherwise.
+;
+
+
 

--- a/initialize.inc
+++ b/initialize.inc
@@ -59,56 +59,56 @@ WENT:
 
 
 
-;COLD	FDB	*+2
-;CENT	LDS	#REND-1	top of destination
-;	LDX	#ERAM	top of stuff to move
-;COLD2	DEX
-;	LDA A	0,X
-;	PSH A		move TASK & FORTH to ram
-;	CPX	#RAM
-;	BNE	COLD2
-;*
-;	LDS	#XFENCE-1	put stack at a safe place for now
-;	LDX	COLINT
-;	STX	XCOLUM
-;	LDX	DELINT
-;	STX	XDELAY
-;	LDX	VOCINT
-;	STX	XVOCL
-;	LDX	DPINIT
-;	STX	XDP
-;	LDX	FENCIN
-;	STX	XFENCE
-;
-;
-;WENT	LDS	#XFENCE-1	top of destination
-;	LDX	#FENCIN		top of stuff to move
-;WARM2	DEX
-;	LDA A	0,X
-;	PSH A
-;	CPX	#SINIT
-;	BNE	WARM2
-;*
-;	LDS	SINIT
-;	LDX	UPINIT
-;	STX	UP		init user ram pointer
-;	LDX	#ABORT
-;	STX	IP
-;	NOP		Here is a place to jump to special user
-;	NOP		initializations such as I/0 interrups
-;	NOP
-;*
-;* For systems with TRACE:
-;	LDX	#00
-;	STX	TRLIM	clear trace mode
-;	LDX	#0
-;	STX	BRKPT	clear breakpoint address
-;	JMP	RPSTOR+2 start the virtual machine running !
-;*
-;* Here is the stuff that gets copied to ram :
-;* at address $140:
-;*
-;* Thus, MAGIC numbers that initialize USE and PREV, magically! (JMR)
-;* RAM	FDB	$3000,$3000,0,0
-;RAM	FDB	$4000+132,$4000+132,0,0
-;	
+;COLD	FDB	*+2
+;CENT	LDS	#REND-1	top of destination
+;	LDX	#ERAM	top of stuff to move
+;COLD2	DEX
+;	LDA A	0,X
+;	PSH A		move TASK & FORTH to ram
+;	CPX	#RAM
+;	BNE	COLD2
+;*
+;	LDS	#XFENCE-1	put stack at a safe place for now
+;	LDX	COLINT
+;	STX	XCOLUM
+;	LDX	DELINT
+;	STX	XDELAY
+;	LDX	VOCINT
+;	STX	XVOCL
+;	LDX	DPINIT
+;	STX	XDP
+;	LDX	FENCIN
+;	STX	XFENCE
+;
+;
+;WENT	LDS	#XFENCE-1	top of destination
+;	LDX	#FENCIN		top of stuff to move
+;WARM2	DEX
+;	LDA A	0,X
+;	PSH A
+;	CPX	#SINIT
+;	BNE	WARM2
+;*
+;	LDS	SINIT
+;	LDX	UPINIT
+;	STX	UP		init user ram pointer
+;	LDX	#ABORT
+;	STX	IP
+;	NOP		Here is a place to jump to special user
+;	NOP		initializations such as I/0 interrups
+;	NOP
+;*
+;* For systems with TRACE:
+;	LDX	#00
+;	STX	TRLIM	clear trace mode
+;	LDX	#0
+;	STX	BRKPT	clear breakpoint address
+;	JMP	RPSTOR+2 start the virtual machine running !
+;*
+;* Here is the stuff that gets copied to ram :
+;* at address $140:
+;*
+;* Thus, MAGIC numbers that initialize USE and PREV, magically! (JMR)
+;* RAM	FDB	$3000,$3000,0,0
+;RAM	FDB	$4000+132,$4000+132,0,0
+;	

--- a/inout.inc
+++ b/inout.inc
@@ -3,116 +3,116 @@
 ; FORTH input/output definitions for fig-FORTH for SH-3
 ; Joel Matthew Rees, Hyougo Polytec Center
 ; 2014.03.05
-
-; Licensed extended under GPL v. 2 or 3, or per the following:
-; ------------------------------------LICENSE-------------------------------------
-;
-; Copyright (c) 2009, 2010, 2011 Joel Matthew Rees
-;
-; Permission is hereby granted, free of charge, to any person obtaining a copy
-; of this software and associated documentation files (the "Software"), to deal
-; in the Software without restriction, including without limitation the rights
-; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
-; copies of the Software, and to permit persons to whom the Software is
-; furnished to do so, subject to the following conditions:
-;
-; The above copyright notice and this permission notice shall be included in
-; all copies or substantial portions of the Software.
-;
-; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
-; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
-; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
-; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
-; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
-; THE SOFTWARE.
-;
-; --------------------------------END-OF-LICENSE----------------------------------
-
-; Monolithic, not separate assembly:
-; context.inc must be included before this file.
-;	.include	"context.inc"
-;
+
+; Licensed extended under GPL v. 2 or 3, or per the following:
+; ------------------------------------LICENSE-------------------------------------
+;
+; Copyright (c) 2009, 2010, 2011 Joel Matthew Rees
+;
+; Permission is hereby granted, free of charge, to any person obtaining a copy
+; of this software and associated documentation files (the "Software"), to deal
+; in the Software without restriction, including without limitation the rights
+; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+; copies of the Software, and to permit persons to whom the Software is
+; furnished to do so, subject to the following conditions:
+;
+; The above copyright notice and this permission notice shall be included in
+; all copies or substantial portions of the Software.
+;
+; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
+; THE SOFTWARE.
+;
+; --------------------------------END-OF-LICENSE----------------------------------
+
+; Monolithic, not separate assembly:
+; context.inc must be included before this file.
+;	.include	"context.inc"
+;
 ;	.section	inputoutput, code
-
-
-; EMIT, KEY, QTERM, and CR are assumed to be the focus 
-; of porting to new hardware.
-
-; These are stubs which call real drivers defined in driver.inc
-; In the fig-FORTH model, you see the stubs around screen 21.
-; And you see the drivers around screen 63.
-
-; Contrary to usual practice, I am assuming the drivers 
-; use the stack instead of registers to pass results.
-; No particular reason not use the registers, of course.
-
-
-; EMIT    ( c --- )
-;         Write c to the terminal device, whatever that may be.
-;         Increment the OUT per USER variable.
-;
-	HEADER	EMIT, EMIT
-	sts.l	PR, @-fRP
-	mov.l	#_fPEMIT, r1	; May be within range of absolute call?
-	jsr 	@r1
-	nop
-	mov.l	#XOUT, r0	; We defined XOUT as the offset itself.
-	mov.l	@(r0,fUP), r1
-	add 	#1, r1
-	lds.l	@fRP+, PR
-	rts
-	mov.l	r1, @(r0,fUP)
-	
-
-; KEY     ( --- c )
+
+
+; EMIT, KEY, QTERM, and CR are assumed to be the focus 
+; of porting to new hardware.
+
+; These are stubs which call real drivers defined in driver.inc
+; In the fig-FORTH model, you see the stubs around screen 21.
+; And you see the drivers around screen 63.
+
+; Contrary to usual practice, I am assuming the drivers 
+; use the stack instead of registers to pass results.
+; No particular reason not use the registers, of course.
+
+
+; EMIT    ( c --- )
+;         Write c to the terminal device, whatever that may be.
+;         Increment the OUT per USER variable.
+;
+	HEADER	EMIT, EMIT
+	sts.l	PR, @-fRP
+	mov.l	#_fPEMIT, r1	; May be within range of absolute call?
+	jsr 	@r1
+	nop
+	mov.l	#XOUT, r0	; We defined XOUT as the offset itself.
+	mov.l	@(r0,fUP), r1
+	add 	#1, r1
+	lds.l	@fRP+, PR
+	rts
+	mov.l	r1, @(r0,fUP)
+	
+
+; KEY     ( --- c )
 ;         Leave the ascii value of the next terminal key struck.
-;
-	HEADER	KEY, KEY
-	sts.l	PR, @-fRP
-	mov.l	#_fPKEY, r1	; May be within range of absolute call?
-	jsr 	@r1
-	nop
-	mov.l	@fSP, r1
-	mov.l	#H'000000ff, r0
-	and 	r1, r0
-	lds.l	@fRP+, PR
-	rts
-	mov.l	r0, @fSP
-
-
+;
+	HEADER	KEY, KEY
+	sts.l	PR, @-fRP
+	mov.l	#_fPKEY, r1	; May be within range of absolute call?
+	jsr 	@r1
+	nop
+	mov.l	@fSP, r1
+	mov.l	#H'000000ff, r0
+	and 	r1, r0
+	lds.l	@fRP+, PR
+	rts
+	mov.l	r0, @fSP
+
+
 ; ?TERMINAL       ( --- f )
 ;        Perform a test of the terminal keyboard for actuation of the break
 ;        key. A true flag indicates actuation.
-;        In other words, scan keyboard, but do not wait.  
-;        Return true if break key currently pressed, 0 otherwise.
-;        Ignores any keys buffered up, in theory.
-;        But this definition is installation dependent,
+;        In other words, scan keyboard, but do not wait.  
+;        Return true if break key currently pressed, 0 otherwise.
+;        Ignores any keys buffered up, in theory.
+;        But this definition is installation dependent,
 ;        and may not give exactly these results.
-;
-	HEADER	?TERMINAL, QTERM
-	sts.l	PR, @-fRP
-	mov.l	#_fPQTER, r1	; May be within range of absolute call?
-	jsr 	@r1
-	nop		; Might need to filter results?
-	lds.l	@fRP+, PR
-	rts
-	nop
-
-
-; CR      ( --- )
+;
+	HEADER	"?TERMINAL", QTERM
+	sts.l	PR, @-fRP
+	mov.l	#_fPQTER, r1	; May be within range of absolute call?
+	jsr 	@r1
+	nop		; Might need to filter results?
+	lds.l	@fRP+, PR
+	rts
+	nop
+
+
+; CR      ( --- )
 ;         Transmit a carriage return and line feed to the selected output
 ;         device.
-;
-	HEADER	CR, CR
-	sts.l	PR, @-fRP
-	mov.l	#_fPCR, r1	; May be within range of absolute call?
-	jsr 	@r1
-	nop		; Might push a CR and EMIT, then a LF and EMIT?
-	lds.l	@fRP+, PR
-	rts
-	nop
-
-
-
-
+;
+	HEADER	CR, CR
+	sts.l	PR, @-fRP
+	mov.l	#_fPCR, r1	; May be within range of absolute call?
+	jsr 	@r1
+	nop		; Might push a CR and EMIT, then a LF and EMIT?
+	lds.l	@fRP+, PR
+	rts
+	nop
+
+
+
+

--- a/main.src
+++ b/main.src
@@ -1,4 +1,4 @@
-; Assembly language sourcec code text for SH3 version of fig-FORTH.
+; Assembly language source code text for SH3 version of fig-FORTH.
 	.list ON, EXP
 	
 ; Primitive (kernel) definitions for fig-FORTH for SH-3
@@ -37,126 +37,65 @@
 
 	.org	$
 
+;***************************
+;**  C O L D   E N T R Y  **
 ;***************************
-;**  C O L D   E N T R Y  **
-;***************************
-; 0 offset into the ROMmable code
-ORIG:
+; 0 offset into the ROMmable code
+ORIG:
 	mov.l	#_fCENT, r0
-	jmp 	@r0
-;***************************
-;**  W A R M   E N T R Y  **
+	jmp 	@r0
+;***************************
+;**  W A R M   E N T R Y  **
 ;***************************
 ; 
-; 4 offset into the ROMmable code
-	nop 	; Conveniently left over from the COLD entry point.
+; 4 offset into the ROMmable code
+	nop 	; Conveniently left over from the COLD entry point.
 	mov.l	#WENT, r0	; warm-start code, keeps current dictionary intact
 	jmp 	@r0
-	nop
-;
-;*
-;******* startup parmeters **************************
+	nop
+;
+;*
+;******* startup parmeters **************************
 ;*
 ; All of this is essentially place-holder values:
-COLD_PARAMETERS:
+COLD_PARAMETERS:
 	.data.l	"SH-3"	; cpu
 	.data.l 0		; revision 
-	.data.l	0		; topmost word in FORTH vocabulary
+	.data.l	0		; topmost word in FORTH vocabulary
 BACKSP:
-	.data.l	h'7f	; backspace character for editing
+	.data.l	h'7f	; backspace character for editing
 UPINIT:
-	.data.l	PER_USER	; UORIG	; initial user area
+	.data.l	PER_USER	; UORIG	; initial user area
 SINIT:
-	.data.l	fSP_BASE	; ORIG-$210	; initial top of data stack
+	.data.l	fSP_BASE	; ORIG-$210	; initial top of data stack
 RINIT:
-	.data.l	fRP_BASE	; ORIG-$10	; initial top of return stack
-	.data.l	fSP_LIMIT-h'200	; ORIG-$200	; terminal input buffer
-	.data.l	31	; initial name field width
-	.data.l	0	; initial warning mode (0 = no disc)
+	.data.l	fRP_BASE	; ORIG-$10	; initial top of return stack
+	.data.l	fSP_LIMIT-h'200	; ORIG-$200	; terminal input buffer
+	.data.l	31	; initial name field width
+	.data.l	0	; initial warning mode (0 = no disc)
 FENCIN:
-	.data.l	fSP_LIMIT-h'400	; REND	; initial fence
+	.data.l	fSP_LIMIT-h'400	; REND	; initial fence
 DPINIT:
-	.data.l	fSP_LIMIT-h'400	; REND	; cold start value for DP
+	.data.l	fSP_LIMIT-h'400	; REND	; cold start value for DP
 VOCINT:
-	.data.l	fSP_LIMIT-h'400	; FORTH+8	
+	.data.l	fSP_LIMIT-h'400	; FORTH+8	
 COLINT:
-	.data.l	132	; initial terminal carriage width
+	.data.l	132	; initial terminal carriage width
 DELINT:
 	.data.l	4	; initial carriage return delay
-;****************************************************
-;*
-
+;*
+;****************************************************
+;*
 
 
-	
-TEST_THINGY:
-	.data.l	LIT, 1
-	.data.l	LIT, -1
-	.data.l BRAN
-	mTARGET BRAN_THINGY
-	.data.l 4, 3, 2, 1, 0	; should branch over these
-BRAN_THINGY:
-	.data.l	PLUS
-	.data.l ZBRAN
-	mTARGET ZBRAN_THINGY0
-	.data.l 0, 1, 2, 3	; should branch over these
-ZBRAN_THINGY0:
-	.data.l LIT, 20
-	.data.l LIT, 19
-	.data.l SUB
-	.data.l ZBRAN
-	mTARGET ZBRAN_THINGY0
-	.data.l LIT, 15
-	.data.l	LIT, 10
-	.data.l XDO
-LOOP_THINGY:
-	.data.l LIT, "*"
-	.data.l EMIT
-	.data.l XLOOP
-	mTARGET LOOP_THINGY
-	.data.l LIT, h'f0f0f0f0
-	.data.l LIT, h'0f0f0f0f
-	.data.l USTAR
-	.data.l	LIT, h'6A4C2E10, LIT, h'E2C4A68, DSUB, OR
-	.data.l ZBRAN
-	mTARGET UPRODUCTOK
-	.data.l	-5
-UPRODUCTOK:
-	.data.l LIT, h'10010000
-	.data.l LIT, h'10011001
-	.data.l LIT, h'10010
-	.data.l USLASH
-	.data.l AND, LIT, -1, SUB
-	.data.l ZBRAN
-	mTARGET UOVERFLOWOK
-	.data.l -1
-UOVERFLOWOK:
-	.data.l LIT, h'1000fe76
-	.data.l LIT, h'00000100
-	.data.l LIT, h'00010010
-	.data.l USLASH
-	.data.l LIT, H'01000000
-	.data.l SUB
-	.data.l ZBRAN
-	mTARGET UQUOTIENTOK
-	.data.l 1
-UQUOTIENTOK:
-	.data.l LIT, H'fe76
-	.data.l SUB
-	.data.l ZBRAN
-	mTARGET UREMAINDEROK
-	.data.l 3
-UREMAINDEROK:
-	.data.l	BRAN
-	mTARGET TEST_THINGY
-
-	
 ; For various reasons, including the above "locate" declaration, 
 ; this will be assembled monolithically, rather than separately.
 ; Thus:
 ;
+	.include	"teststuff.inc"
 	.include	"initialize.inc"
 	.include	"primitive.inc"
+	.include	"compiler.inc"
 	.include	"parser.inc"
 	.include	"evaluator.inc"
 	.include	"symbol.inc"
@@ -187,4 +126,4 @@ OUTERSPACE:	.equ $
 
 
 
-	.end
+	.end
\ No newline at end of file

--- a/parser.inc
+++ b/parser.inc
@@ -3,124 +3,125 @@
 ; Parser definitions for fig-FORTH for SH-3
 ; Joel Matthew Rees, Hyougo Polytec Center
 ; 2014.03.01
+
+; Licensed extended under GPL v. 2 or 3, or per the following:
+; ------------------------------------LICENSE-------------------------------------
+;
+; Copyright (c) 2009, 2010, 2011 Joel Matthew Rees
+;
+; Permission is hereby granted, free of charge, to any person obtaining a copy
+; of this software and associated documentation files (the "Software"), to deal
+; in the Software without restriction, including without limitation the rights
+; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+; copies of the Software, and to permit persons to whom the Software is
+; furnished to do so, subject to the following conditions:
+;
+; The above copyright notice and this permission notice shall be included in
+; all copies or substantial portions of the Software.
+;
+; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
+; THE SOFTWARE.
+;
+; --------------------------------END-OF-LICENSE----------------------------------
+
 
-; Licensed extended under GPL v. 2 or 3, or per the following:
-; ------------------------------------LICENSE-------------------------------------
-;
-; Copyright (c) 2009, 2010, 2011 Joel Matthew Rees
-;
-; Permission is hereby granted, free of charge, to any person obtaining a copy
-; of this software and associated documentation files (the "Software"), to deal
-; in the Software without restriction, including without limitation the rights
-; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
-; copies of the Software, and to permit persons to whom the Software is
-; furnished to do so, subject to the following conditions:
-;
-; The above copyright notice and this permission notice shall be included in
-; all copies or substantial portions of the Software.
-;
-; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
-; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
-; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
-; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
-; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
-; THE SOFTWARE.
-;
-; --------------------------------END-OF-LICENSE----------------------------------
-
-; Monolithic, not separate assembly:
-; context.inc must be included before this file.
-;	.include	"context.inc"
-;
+; Monolithic, not separate assembly:
+; context.inc must be included before this file.
+;	.include	"context.inc"
+;
 ;	.section	parser, code
 
 
-; DIGIT   ( c base --- ff )
-;         ( c base --- n tf )
-;         Translate C in base, yielding a translation valid flag.  If the
-;         translation is not valid in the specified base, only the false
-;         flag is returned.
-;
+; DIGIT   ( c base --- ff )
+;         ( c base --- n tf )
+;         Translate C in base, yielding a translation valid flag.  If the
+;         translation is not valid in the specified base, only the false
+;         flag is returned.
+;
 	HEADER	DIGIT, DIGIT
-	mov.l	@(NATURAL_SIZE,fSP), r0	; ７ビット文字
+	mov.l	@(NATURAL_SIZE,fSP), r0	; ７ビット文字
 	mov.b	#"0", r1
-	cmp/ge	r1, r0 		; character (r0) >= "0"
-	bf	DIGITno
-	add 	#-"0", r0
-	mov.b	#9, r1
-	cmp/gt	r1, r0		; digit (r0) > 9
-	bf	DIGITbase
-	mov.b	#"A"-"0", r1
-	cmp/ge	r1, r0		; was it between "9" and "A"?
-	bf	DIGITno
-	add 	#"9"-"A"+1, r0
-DIGITbase:
-	mov.l	@fSP, r1
-	cmp/ge	r1, r0		; digit (r0) >= base
-	bt DIGITno
-	mov.l	r0, @(NATURAL_SIZE,fSP)
-	mov.b	#-1, r0 	; store the converted digit
-	rts
+	cmp/ge	r1, r0 		; character (r0) >= "0"
+	bf	DIGITno
+	add 	#-"0", r0
+	mov.b	#9, r1
+	cmp/gt	r1, r0		; digit (r0) > 9
+	bf	DIGITbase
+	mov.b	#"A"-"0", r1
+	cmp/ge	r1, r0		; was it between "9" and "A"?
+	bf	DIGITno
+	add 	#"9"-"A"+1, r0
+DIGITbase:
+	mov.l	@fSP, r1
+	cmp/ge	r1, r0		; digit (r0) >= base
+	bt DIGITno
+	mov.l	r0, @(NATURAL_SIZE,fSP)
+	mov.b	#-1, r0 	; store the converted digit
+	rts
 	mov.l	r0, @fSP	; set the flag on our way out
 ;
-DIGITno:
-	mov.b	#0, r0
-	add 	#NATURAL_SIZE, fSP
-	rts
-	mov.l	r0, @fSP	; set the flag on our way out
-
-
-; ENCLOSE ( buffer c --- buffer off1 off2 off3 )
-;         Scan buffer for a symbol delimited by c or ASCII NUL; 
-;         return the offsets to the first character of the symbol,
-;         the last character of the symbol,
-;         and the next character after the symbol.
-;         Walks all over r0-r3 and fW.
-;
-	HEADER	ENCLOSE, ENCLOS
-	mov.l	@fSP, r2	; delimiter
-	mov.l	@(NATURAL_SIZE,fSP), r1		; point to start in the buffer
-	mov 	#0, r3		; count
-ENCLOSleadloop:
-	mov.b	@r1+, r0
-	cmp/eq	#0, r0		; NUL character before symbol?
-	bt  	ENCLOSnone
-	cmp/eq	r2, r0		; leading delimiter? (Usually SPACE.)
-	bt  	ENCLOSword
-	bra 	ENCLOSleadloop
-	add 	#1, r1		; Count it as we go.
-;
-ENCLOSword:
-	mov.l	r3, @fSP	; Save offset to symbol or NUL.
-	mov.l	@r1+, r0	; get the next one
-ENCLOSwordloop:
-	cmp/eq	#0, r0		; NUL?
-	bt/s  	ENCLOSnulterm
-	add 	#1, r3		; count the one before
-	cmp/eq	r2, r0		; delimiter
-	bf/s  	ENCLOSwordloop
-	mov.l	@r1+, r0	; Get the next one, but not beyond NUL.
-;
-; The pointer and character don't matter, just the count.
-	mov.l	r3, @-fSP	; Count to non-NUL delimiter.
-	add 	#1, r3		; Next character that might be part of a symbol.
-	rts
-	mov.l	r3, @-fSP	; Save it as we go.
-	
+DIGITno:
+	mov.b	#0, r0
+	add 	#NATURAL_SIZE, fSP
+	rts
+	mov.l	r0, @fSP	; set the flag on our way out
+
+
+; ENCLOSE ( buffer c --- buffer off1 off2 off3 )
+;         Scan buffer for a symbol delimited by c or ASCII NUL; 
+;         return the offsets to the first character of the symbol,
+;         the last character of the symbol,
+;         and the next character after the symbol.
+;         Walks all over r0-r3 and fW.
+;
+	HEADER	ENCLOSE, ENCLOS
+	mov.l	@fSP, r2	; delimiter
+	mov.l	@(NATURAL_SIZE,fSP), r1		; point to start in the buffer
+	mov 	#0, r3		; count
+ENCLOSleadloop:
+	mov.b	@r1+, r0
+	cmp/eq	#0, r0		; NUL character before symbol?
+	bt  	ENCLOSnone
+	cmp/eq	r2, r0		; leading delimiter? (Usually SPACE.)
+	bt  	ENCLOSword
+	bra 	ENCLOSleadloop
+	add 	#1, r1		; Count it as we go.
+;
+ENCLOSword:
+	mov.l	r3, @fSP	; Save offset to symbol or NUL.
+	mov.l	@r1+, r0	; get the next one
+ENCLOSwordloop:
+	cmp/eq	#0, r0		; NUL?
+	bt/s  	ENCLOSnulterm
+	add 	#1, r3		; count the one before
+	cmp/eq	r2, r0		; delimiter
+	bf/s  	ENCLOSwordloop
+	mov.l	@r1+, r0	; Get the next one, but not beyond NUL.
+;
+; The pointer and character don't matter, just the count.
+	mov.l	r3, @-fSP	; Count to non-NUL delimiter.
+	add 	#1, r3		; Next character that might be part of a symbol.
+	rts
+	mov.l	r3, @-fSP	; Save it as we go.
+	
 ; found NUL before non-delimiter, therefore there is no word
-ENCLOSnone:
-	mov.l	r3, @fSP	; Save offset to NUL.
-	add 	#1, r3
-	mov.l	r3, @-fSP	; Make the symbol at least one char long.
-	add 	#-1, r3
-	rts
-	mov.l	r3, @-fSP	; But keep us stopped at the NUL.
-; delimited by NUL
-ENCLOSnulterm:
-	mov.l	r3, @-fSP	; Delimiter is NUL.
-	rts
-	mov.l	r3, @-fSP	; No next character included, keep us at the NUL.
-
-
+ENCLOSnone:
+	mov.l	r3, @fSP	; Save offset to NUL.
+	add 	#1, r3
+	mov.l	r3, @-fSP	; Make the symbol at least one char long.
+	add 	#-1, r3
+	rts
+	mov.l	r3, @-fSP	; But keep us stopped at the NUL.
+; delimited by NUL
+ENCLOSnulterm:
+	mov.l	r3, @-fSP	; Delimiter is NUL.
+	rts
+	mov.l	r3, @-fSP	; No next character included, keep us at the NUL.
+
+
 

--- a/primitive.inc
+++ b/primitive.inc
@@ -50,13 +50,15 @@ NEXTloop:
 ; 3 cycles to get back to the top of the loop.
 	nop	
 	bra		NEXTloop
-	mov.l	@fIP+, fW	; grab the next pointer as we go.
+	mov.l	@fIP+, fW	; grab the next pointer as we loop back.
 ; Note that, since jumps to absolute addresses have limits in constant-width instruction sets,
 ; using the subroutine call mode for the virtual machine is not as much a penalty as it might seem.
 ; It also has the advantage of being more compatible with more conventional code.
 ; Ways to make an absolute jump work might include 
 ; * the address of next in a table of constants (and reserving a register for the table base), or
 ; * reserving a register for the address of next.
+;
+; See DOCOL ( _fDOCOL ).
 
 
 ; LIT     ( --- n )                                               C
@@ -98,7 +100,7 @@ BRANCHgo:
 ; 0BRANCH ( f --- )                                               C
 ;         BRANCH if flag is zero.
 ;
-	HEADER	0BRANCH, ZBRAN
+	HEADER	"0BRANCH", ZBRAN
 	mov.l	@fSP+, r0
 	cmp/eq	#0, r0	
 	bt/s	BRANCHgo
@@ -124,7 +126,7 @@ BRANCHgo:
 ;         does not occur, and the index and limit are dropped from the
 ;         return stack.
 ;
-	HEADER	(LOOP), XLOOP
+	HEADER	"(LOOP)", XLOOP
 	mov.l	@fRP, r0	; I (loop counter)
 	add 	#1, r0
 	mov.l	r0, @fRP	; update I
@@ -144,7 +146,7 @@ BRANCHgo:
 ;         limit.  A negative n must cause the index to become less than
 ;         the limit to cause loop termination.
 ;
-	HEADER	(+LOOP), XPLOOP
+	HEADER	"(+LOOP)", XPLOOP
 	mov.l	@fSP+, r1	; increment
 	mov.l	@fRP, r0	; I (loop counter)
 	add 	r1, r0
@@ -176,7 +178,7 @@ XPLOOPminus:
 ; (DO)    ( limit index --- )     ( *** limit index )
 ;         Move the loop parameters to the return stack.  Synonym for D>R, here.
 ; 
-	HEADER	(DO), XDO
+	HEADER	"(DO)", XDO
 	mov.l	@fSP+, r0
 	mov.l	@fSP+, r1
 	add 	#-2*NATURAL_SIZE, fRP
@@ -211,7 +213,7 @@ CMOVEdone:
 	rts
 	add 	#3*NATURAL_SIZE, fSP	; Drop the parameters as we go.
 
-
+
 ; SP@     ( --- adr )
 ; SPAT    Fetch the parameter stack pointer (before it is pushed).
 ;
@@ -224,7 +226,7 @@ CMOVEdone:
 ; SPSTOR  Initialize the parameter stack pointer from the USER variable
 ;         S0.  Effectively clears the stack.
 ;
-	HEADER	SP!, SPSTOR
+	HEADER	"SP!", SPSTOR
 	mov.l	@(XSPZER,fUP), r0
 	rts
 	mov.l	r0, fSP
@@ -238,7 +240,7 @@ CMOVEdone:
 ;         Deferring to the glossary, rather than the 6800 model, 
 ;         and getting the initializer from the PER_USER table.
 ;
-	HEADER	RP!, RPSTOR
+	HEADER	"RP!", RPSTOR
 	mov.l	@(XRZERO,fUP), r0	
 	rts
 	mov.l	r0, fSP
@@ -254,3 +256,16 @@ CMOVEdone:
 
 
 
+
+
+; NOOP  ( --- )
+;       For stuffing no-operation placeholders into code.
+;       Useful for temporarily resolving forward definitions, among other things.
+;
+;       This is part of the 6800 model, but not in the fig-FORTH glossary.
+;
+	HEADER	NOOP, NOOP
+	rts
+	nop
+
+

--- a/symbol.inc
+++ b/symbol.inc
@@ -3,145 +3,145 @@
 ; Symbol table definitions for fig-FORTH for SH-3
 ; Joel Matthew Rees, Hyougo Polytec Center
 ; 2014.03.01
-
-; Licensed extended under GPL v. 2 or 3, or per the following:
-; ------------------------------------LICENSE-------------------------------------
-;
-; Copyright (c) 2009, 2010, 2011 Joel Matthew Rees
-;
-; Permission is hereby granted, free of charge, to any person obtaining a copy
-; of this software and associated documentation files (the "Software"), to deal
-; in the Software without restriction, including without limitation the rights
-; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
-; copies of the Software, and to permit persons to whom the Software is
-; furnished to do so, subject to the following conditions:
-;
-; The above copyright notice and this permission notice shall be included in
-; all copies or substantial portions of the Software.
-;
-; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
-; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
-; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
-; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
-; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
-; THE SOFTWARE.
-;
-; --------------------------------END-OF-LICENSE----------------------------------
-
-; Monolithic, not separate assembly:
-; context.inc must be included before this file.
-;	.include	"context.inc"
-;
-;	.section	evaluator, code
-
-
-; Not in the 6800 fig model, I've just re-factored it for fun.
-; (NAME-SCAN)  ( ptr1 --- ptr2 )
-;         Scan ptr1 to a byte with the high bit set,
-;         leave ptr2 pointing to the next byte.
-;         Walks all over r0 and r1. Must leave fW untouched.
-;
-	HEADER	(NAME-SCAN), PNAMESCAN
-	mov.l	@fSP, r1 
-	mov.b	@r1+, r0
-PNAMESCANloop:
-	and 	#CTFLAG, r0
-	cmp/eq	#CTFLAG, r0
-	bf/s 	PNAMESCANloop
-	mov.b	@r1+, r0
-;
-	add 	#-1, r1
-	mov 	r1, r0
-	mALIGNr0
-	rts
-	mov.l	r0, @fSP
+
+; Licensed extended under GPL v. 2 or 3, or per the following:
+; ------------------------------------LICENSE-------------------------------------
+;
+; Copyright (c) 2009, 2010, 2011 Joel Matthew Rees
+;
+; Permission is hereby granted, free of charge, to any person obtaining a copy
+; of this software and associated documentation files (the "Software"), to deal
+; in the Software without restriction, including without limitation the rights
+; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+; copies of the Software, and to permit persons to whom the Software is
+; furnished to do so, subject to the following conditions:
+;
+; The above copyright notice and this permission notice shall be included in
+; all copies or substantial portions of the Software.
+;
+; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
+; THE SOFTWARE.
+;
+; --------------------------------END-OF-LICENSE----------------------------------
+
+; Monolithic, not separate assembly:
+; context.inc must be included before this file.
+;	.include	"context.inc"
+;
+;	.section	symbol, code
+
+
+; Not in the 6800 fig model, I've just re-factored it for fun.
+; (NAME-SCAN)  ( ptr1 --- ptr2 )
+;         Scan ptr1 to a byte with the high bit set,
+;         leave ptr2 pointing to the next byte.
+;         Walks all over r0 and r1. Must leave fW untouched.
+;
+	HEADER	"(NAME-SCAN)", PNAMESCAN
+	mov.l	@fSP, r1 
+	mov.b	@r1+, r0
+PNAMESCANloop:
+	and 	#CTFLAG, r0
+	cmp/eq	#CTFLAG, r0
+	bf/s 	PNAMESCANloop
+	mov.b	@r1+, r0
+;
+	add 	#-1, r1
+	mov 	r1, r0
+	mALIGNr0
+	rts
+	mov.l	r0, @fSP
+	
+
+
+; Not in the 6800 fig model, I've just re-factored it for fun.
+; (CHK-NAME)  ( name nfa --- name link f )
+;         Compare a name in a buffer to a name in the symbol table.
+;         Leave an equality flag and a pointer to the link field for the next name.
+;         Names in the dictionary are terminated with the high bit set. 
+;         (Names only save 3 significant characters in some FORTHs.)
+;         Walks all over r0 - r3. Must leave fW untouched.
+;
+	HEADER	"(CHK-NAME)", PCHKNAME
+	sts.l	pr, @-fRP	; so we can call stuff
+	mov.l	@fSP, r2	; name in dictionary
+	mov.l	@(NATURAL_SIZE, fSP), r3	; name in buffer
+	mov.b	@r2+, r0	; count byte in dictionary, plus flags
+	and 	#CTMASK, r0	; Extract the actual count.
+	mov.b	@r3+, r1	; count byte in buffer
+	cmp/eq	r0, r1
+	bf  	PCHKNAMEno
+PCHKNAMEloop:
+	mov.b	@r2+, r0	; character in dictionary
+	tst 	#TAILFLAG, r0
+	bt  	PCHKNAMElast
+	mov.b	@r3+, r1	; character in buffer
+	cmp/eq	r0, r1
+	bt  	PCHKNAMEloop
+;
+PCHKNAMEno:
+	mov 	#0, r3		; r3 is not touched by xNAMESCAN
+PCHKNAMEret:
+	bsr 	_fPNAMESCAN
+	mov.l	r2, @fSP	; save it as we go
+	lds.l	@fRP+, pr	; Gotta have that return address!
+	rts
+	mov.l	r3, @-fSP	; flag it as we go
+;
+PCHKNAMElast:	
+	mov.b	@r3+, r1	; last character in buffer
+	and		#TAILMASK, r0
+	cmp/eq	r0, r1
+	bf  	PCHKNAMEno
+;
+	bra 	PCHKNAMEret	
+	mov 	#ALL_BITS8, r3	; Set the flag as we go.
+	
 	
-
-
-; Not in the 6800 fig model, I've just re-factored it for fun.
-; (CHK-NAME)  ( name nfa --- name link f )
-;         Compare a name in a buffer to a name in the symbol table.
-;         Leave an equality flag and a pointer to the link field for the next name.
-;         Names in the dictionary are terminated with the high bit set. 
-;         (Names only save 3 significant characters in some FORTHs.)
-;         Walks all over r0 - r3. Must leave fW untouched.
-;
-	HEADER	(CHK-NAME), PCHKNAME
-	sts.l	pr, @-fRP	; so we can call stuff
-	mov.l	@fSP, r2	; name in dictionary
-	mov.l	@(NATURAL_SIZE, fSP), r3	; name in buffer
-	mov.b	@r2+, r0	; count byte in dictionary, plus flags
-	and 	#CTMASK, r0	; Extract the actual count.
-	mov.b	@r3+, r1	; count byte in buffer
-	cmp/eq	r0, r1
-	bf  	PCHKNAMEno
-PCHKNAMEloop:
-	mov.b	@r2+, r0	; character in dictionary
-	tst 	#TAILFLAG, r0
-	bt  	PCHKNAMElast
-	mov.b	@r3+, r1	; character in buffer
-	cmp/eq	r0, r1
-	bt  	PCHKNAMEloop
-;
-PCHKNAMEno:
-	mov 	#0, r3		; r3 is not touched by xNAMESCAN
-PCHKNAMEret:
-	bsr 	_fPNAMESCAN
-	mov.l	r2, @fSP	; save it as we go
-	lds.l	@fRP+, pr	; Gotta have that return address!
-	rts
-	mov.l	r3, @-fSP	; flag it as we go
-;
-PCHKNAMElast:	
-	mov.b	@r3+, r1	; last character in buffer
-	and		#TAILMASK, r0
-	cmp/eq	r0, r1
-	bf  	PCHKNAMEno
-;
-	bra 	PCHKNAMEret	
-	mov 	#ALL_BITS8, r3	; Set the flag as we go.
-	
-	
-; (FIND)  ( name nfa --- pfa b tf )
-;         ( name nfa --- ff )
-;         Search vocabulary for a symbol called name.  
-;         name is a pointer to a counted string.
-;         nfa is the NFA of the last entry in the vocabulary to be searched.
-;         Walks all over r0 - r3, and fW.
-;
-	HEADER	(FIND), PFIND
-	sts.l	pr, @-fRP	; so we can call stuff
-	mov.l	@fSP, r0
-PFINDloop:
-	mov.b	@r0, fW		; We aren't using fW anyway, and it doesn't get walked in.
-	bsr 	_fPCHKNAME
-	mov.l	@fSP+, r0	; Did we find it?
-	cmp/eq	#0, r0
-	bf/s  	PFINDfound	; Use the true flag in r0
-	mov.l	@fSP, r1	; LFA needed either way
-;
-	mov.l	@r1, r0
-	cmp/eq	#0, r0
-	bt  	PFINDnot
-	bra 	PFINDloop
-	mov.l	r0, @fSP	; Store the next one to check as we go.
-;
-PFINDnot:
-;	mov 	#0, r0		; use the NULL pointer as a false flag
-	bra 	PFINDret
-	add 	#2*NATURAL_SIZE, fSP	; bump as we go
-;
-PFINDfound:
-	add 	#2*NATURAL_SIZE, r1		; pfa
-	mov.l	r1, @(NATURAL_SIZE,fSP)
-	mov.l	fW, @fSP	; Store the saved count byte, with mode bits.
-;	mov 	#ALL_BITS8, r0	; We can reuse the flag that sent us here.
-PFINDret:
-	lds.l	@fRP+, pr	; Gotta have that return address!
-	rts
-	mov.l	r0, @-fSP	; Flag it as we go.
-
-
-; *** Sometime check whether there are extra (unused) instructions in the 6800 code about here.
-
+; (FIND)  ( name nfa --- pfa b tf )
+;         ( name nfa --- ff )
+;         Search vocabulary for a symbol called name.  
+;         name is a pointer to a counted string.
+;         nfa is the NFA of the last entry in the vocabulary to be searched.
+;         Walks all over r0 - r3, and fW.
+;
+	HEADER	"(FIND)", PFIND
+	sts.l	pr, @-fRP	; so we can call stuff
+	mov.l	@fSP, r0
+PFINDloop:
+	mov.b	@r0, fW		; We aren't using fW anyway, and it doesn't get walked in.
+	bsr 	_fPCHKNAME
+	mov.l	@fSP+, r0	; Did we find it?
+	cmp/eq	#0, r0
+	bf/s  	PFINDfound	; Use the true flag in r0
+	mov.l	@fSP, r1	; LFA needed either way
+;
+	mov.l	@r1, r0
+	cmp/eq	#0, r0
+	bt  	PFINDnot
+	bra 	PFINDloop
+	mov.l	r0, @fSP	; Store the next one to check as we go.
+;
+PFINDnot:
+;	mov 	#0, r0		; use the NULL pointer as a false flag
+	bra 	PFINDret
+	add 	#2*NATURAL_SIZE, fSP	; bump as we go
+;
+PFINDfound:
+	add 	#2*NATURAL_SIZE, r1		; pfa
+	mov.l	r1, @(NATURAL_SIZE,fSP)
+	mov.l	fW, @fSP	; Store the saved count byte, with mode bits.
+;	mov 	#ALL_BITS8, r0	; We can reuse the flag that sent us here.
+PFINDret:
+	lds.l	@fRP+, pr	; Gotta have that return address!
+	rts
+	mov.l	r0, @-fSP	; Flag it as we go.
+
+
+; *** Sometime check whether there are extra (unused) instructions in the 6800 code about here.
+

--- /dev/null
+++ b/teststuff.inc
@@ -0,0 +1,132 @@
+	.list ON, EXP
+	
+; Temporary test stuff for fig-FORTH for SH-3
+; Joel Matthew Rees, Hyougo Polytec Center
+; 2014.03.11
+
+; Licensed extended under GPL v. 2 or 3, or per the following:
+; ------------------------------------LICENSE-------------------------------------
+;
+; Copyright (c) 2009, 2010, 2011 Joel Matthew Rees
+;
+; Permission is hereby granted, free of charge, to any person obtaining a copy
+; of this software and associated documentation files (the "Software"), to deal
+; in the Software without restriction, including without limitation the rights
+; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+; copies of the Software, and to permit persons to whom the Software is
+; furnished to do so, subject to the following conditions:
+;
+; The above copyright notice and this permission notice shall be included in
+; all copies or substantial portions of the Software.
+;
+; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
+; THE SOFTWARE.
+;
+; --------------------------------END-OF-LICENSE----------------------------------
+
+; Monolithic, not separate assembly:
+; context.inc must be included before this file.
+;	.include	"context.inc"
+;
+;	.section	test, code
+
+
+	.AIFDEF	SHIMMED
+
+; Temporary forward definitions --
+; Added here as they are used, 
+; commented out as they are defined.
+;
+; These aren't magic, just shims for the assembler.
+;
+QEXEC:	.define	"NOOP"	; used in COLON
+SCSP:	.define	"NOOP"	; used in COLON
+CURENT:	.define	"NOOP"	; used in COLON
+CONTXT:	.define	"NOOP"	; used in COLON
+CREATE:	.define	"NOOP"	; used in COLON
+RBRAK:	.define	"NOOP"	; used in COLON
+PSCODE:	.define	"NOOP"	; used in COLON
+QCSP:	.define	"NOOP"	; used in SEMI
+COMPIL:	.define	"NOOP"	; used in SEMI
+SMUDGE:	.define	"NOOP"	; used in SEMI
+LBRAK:	.define	"NOOP"	; used in SEMI
+COMMA:	.define	"NOOP"	; used in CONSTANT
+; :	.define	"NOOP"
+
+
+
+	.AENDI
+
+
+	.AIFDEF	TESTING
+
+; test code
+;	
+TEST_THINGY:
+	.data.l	LIT, 1
+	.data.l	LIT, -1
+	.data.l BRAN
+	mTARGET BRAN_THINGY
+	.data.l 4, 3, 2, 1, 0	; should branch over these
+BRAN_THINGY:
+	.data.l	PLUS
+	.data.l ZBRAN
+	mTARGET ZBRAN_THINGY0
+	.data.l 0, 1, 2, 3	; should branch over these
+ZBRAN_THINGY0:
+	.data.l LIT, 20
+	.data.l LIT, 19
+	.data.l SUB
+	.data.l ZBRAN
+	mTARGET ZBRAN_THINGY0
+	.data.l LIT, 15
+	.data.l	LIT, 10
+	.data.l XDO
+LOOP_THINGY:
+	.data.l LIT, "*"
+	.data.l EMIT
+	.data.l XLOOP
+	mTARGET LOOP_THINGY
+	.data.l LIT, h'f0f0f0f0
+	.data.l LIT, h'0f0f0f0f
+	.data.l USTAR
+	.data.l	LIT, h'6A4C2E10, LIT, h'E2C4A68, DSUB, OR
+	.data.l ZBRAN
+	mTARGET UPRODUCTOK
+	.data.l	-5
+UPRODUCTOK:
+	.data.l LIT, h'10010000
+	.data.l LIT, h'10011001
+	.data.l LIT, h'10010
+	.data.l USLASH
+	.data.l AND, LIT, -1, SUB
+	.data.l ZBRAN
+	mTARGET UOVERFLOWOK
+	.data.l -1
+UOVERFLOWOK:
+	.data.l LIT, h'1000fe76
+	.data.l LIT, h'00000100
+	.data.l LIT, h'00010010
+	.data.l USLASH
+	.data.l LIT, H'01000000
+	.data.l SUB
+	.data.l ZBRAN
+	mTARGET UQUOTIENTOK
+	.data.l 1
+UQUOTIENTOK:
+	.data.l LIT, H'fe76
+	.data.l SUB
+	.data.l ZBRAN
+	mTARGET UREMAINDEROK
+	.data.l 3
+UREMAINDEROK:
+	.data.l	BRAN
+	mTARGET TEST_THINGY
+
+	.AENDI
+