ace3nokbsafe.asm
flypie_Ace-2019/NewROM/ace3nokbsafe.asm
; Disassembly of the file "C:\ACE\JupiterAce.rom"
;
; CPU Type: Z80
;
; Created with dZ80 1.50
;
; on Monday, 21 of January 2002 at 07:11 PM
;
; last updated 02-NOV-2002
;
; Cross-assembles to an 16K ROM file.
;
; Note. A Low-level Assembly Listing only.

	INCLUDE "iodefs.inc"

	CPU = Z180

;RAMSTARTLOC equ  03C00h
RAMSTARTLOC equ	04000h

	ORG	0000H

	.DEFINE ACEROM
	.SECTION ACEROM

	PUBLIC	IM1INTHANDLER

	PUBLIC	FRAMES
; -------------------
; THE 'START' RESTART
; -------------------

L0000:
	DI								; disable interrupts.
	LD		HL,RAMSTART				; start of 'User' RAM
	LD		A,0FCh					; a test byte and 1K masking byte.
	JR		L0028					; forward to continue at Part 2. //ontobus
;	JP		NEWROMSTART

; -------------------
; THE 'PRINT' RESTART
; -------------------

L0008:  EXX								; preserve main registers.
	BIT		3,(IX+03Eh)				; test FLAGS for print destination.
	JP		L03EE					; forward to

; ---------------------------
; THE 'STACK WORD DE' RESTART
; ---------------------------

;L0010:  LD		HL,(SPARE)				; SPARE
L0010:  LD		HL,(SPARE)				; SPARE
	LD		(HL),E
	INC		HL
	JP		L085F					;

; -------------------------
; THE 'POP WORD DE' RESTART
; -------------------------


L0018:  LD		HL,(SPARE)				; SPARE
	DEC		HL
	LD		D,(HL)
	JP		L0859					;

; -------------------
; THE 'ERROR' RESTART
; -------------------

L0020:  POP		HL
	LD		A,(HL)
	LD		(ERR_NO),A				; ERR_NO
	JP		L00AD					;

; ------------------------------------
; THE 'INITIALIZATION ROUTINE' Part 2.
; ------------------------------------

L0028:  INC		H						; increase high byte
	LD		(HL),A					; insert A value
	CP		(HL)					; compare to expected
	JR		Z,L0028					; loop back while RAM is populated.

	AND		H						; limit to nearest 1K segment.
	LD		H,A						; place back in H.
;		LD		(RAMSTART+018h),HL				; set system variable RAMTOP.
	LD		(RAMTOP),HL					; set system variable RAMTOP.
	LD		SP,HL					; initialize the stack pointer.

; the Z80 instructions CALL, PUSH and POP can now be used.

	LD		HL,L010D				; prepare to copy the system variables
					; initial state from ROM.
	JR		L003B					; skip past the fixed-position restart.

; -----------------------
; THE 'INTERRUPT' RESTART
; -----------------------

L0038:  JP		IM1INTHANDLER					; jump to somewhere more convenient.

;------------------------------------------------------------------------------
;
; MEMORY MAP
;
; 00000h +======================================================+
;		|														|
;		|					ROM 8K								|
;		|										v 02300h			|
; 02000h +======================================================+ - - - - - -
;		|		copy of 02400h					|0|<  cassette  >|
; 02400h +-------------------------------------+-+--------------+
;		|		VIDEO MEMORY 768 bytes		|0| PAD 254 bytes| 1K RAM
; 02800h +-------------------------------------+-+--------------+
;		|		copy of 02c00h					^ 02700h			|
; 02C00h +------------------------------------------------------+
;		|		CHARACTER SET - Write-Only						| 1K RAM
; 03000h +------------------------------------------------------+
;		|		ROM 4K										|
; 04000h +-------+----------------------------------------------+
;		|SYSVARS| DICT {12} DATA STACK ->			<- RET STACK | 1K RAM
;		+=======+==============================================+
;		|														|
;						48K AVAILABLE FOR EXPANSION.
;		|														|
; 0FFFFh +======================================================+
;
; The Ace had an 8K ROM and was sold with 3K of RAM each byte of which had
; at least two addresses and sometimes four addresses so the mapping of the
; 3K of RAM was as above.
; The 768 bytes of video memory is accessed by the ROM using addresses
; 02400h - 026FFh. This gives priority to the video circuitry which also needs
; this information to build the TV picture. The byte at 02700h is set to zero
; so that it is easy for the ROM to detect when it is at the end of the screen.
; The 254 bytes remaining are the PAD - the workspace used by FORTH.
; This same area is used by the tape recorder routines to assemble the tape
; header information but since, for accurate tape timing, the FORTH ROM needs
; priority over the video circuitry, then the ROM uses addresses 02301h - 023FFh.
;
; Similarly the Character Set is written to by the ROM (and User) at the 1K
; section starting at 02C00h. The video circuitry accesses this using addresses
; 02800h - 02BFFh to build the TV picture. It is not possible for the ROM or User
; to read back the information from either address so this precludes the saving
; of character sets and writing a driver for a device like the ZX Printer.
;
;
; Then comes the User Dictionary, the first word of which is "FORTH" which links
; to the Dictionary in ROM. Next a gap of 12 bytes to allow for Data Stack
; underflow and then the Data Stack itself which grows upwards.
; At the opposite end of free memory is the Return Stack (machine stack) which
; grows downwards.

; ------------------------------------
; THE 'INITIALIZATION ROUTINE' Part 3.
; ------------------------------------

L003B:  LD		DE,L_HALF				; destination system variable L_HALF
	LD		BC,0002Dh				; number of bytes.
	LDIR							; copy initial state from ROM to RAM.

	LD		IX,FP_WS				; set IX to index the system variables.
	LD		IY,L04C8				; set IY to the SLOW return address.

L004B:  CALL	L0A24					; routine CLS.

	XOR		A						; clear accumulator.

	LD		(02700h),A				; make location after screen zero.

; There are 128 bit-mapped 8x8 characters.
; Define the 8 Battenberg graphics (010h to 017h) from low byte of address.
; This routine also sets the other characters 000h to 00Fh and 018h to 01Fh
; to copies of this range. The inverse form of character 017h is used as the
; normal cursor - character 097h.

L0052:  LD		HL,02C00h				; point to the start of the 1K write-
					; only Character Set RAM.

L0055:  LD		A,L						; set A to low byte of address
	AND		0BFh						; AND %10111111
	RRCA							; rotate
	RRCA							; three times
	RRCA							; to test bit 2
	JR		NC,L005F				; forward if not set.

	RRCA							; else rotate
	RRCA							; twice more.

L005F:  RRCA							; set carry from bit (3) or (6)

	LD		B,A

	SBC		A,A						; 000h or 0FFh
	RR		B
	LD		B,A
	SBC		A,A
	XOR		B
	AND		0F0h
	XOR		B
	LD		(HL),A					; insert the byte.
	INC		L						; increment low byte of address
	JR		NZ,L0055				; loop back until the first 256 bytes
					; have been filled with 32 repeating
					; characters.

; Now copy the bit patterns at the end of this ROM to the last 768 bytes of
; the Character RAM, filling in some blank bytes omitted to save ROM space.
; This process starts at high memory and works downwards.

L006E:  LD		DE,02FFFh				; top of destination.
	LD		HL,L1FFB				; end of copyright character.
	LD		BC,00008h				; 8 characters

	LDDR							; copy the  �  character

	EX		DE,HL					; switch pointers.

	LD		A,05Fh					; set character counter to ninety five.
					; i.e. %0101 1111
					; bit 5 shows which 32-character sector
					; we are in.

; enter a loop for the remaining characters supplying zero bytes as required.

L007C:  LD		C,007h					; set byte counter to seven.

	BIT		5,A						; test bit 5 of the counter.
	JR		Z,L0085					; forward if not in middle section
					; which includes "[A-Z]"

	LD		(HL),B					; else insert a zero byte.
	DEC		HL						; decrement the destination address.
	DEC		C						; and the byte counter.

L0085:  EX		DE,HL					; switch pointers.

	LDDR							; copy the 5 or 6 characters.

	EX		DE,HL					; switch pointers.

	LD		(HL),B					; always insert the blank top byte.
	DEC		HL						; decrement the address.

	DEC		A						; decrement the character counter.

	JR		NZ,L007C				; back for all 95 characters.

;	IM		1						; Select Interrupt Mode 1
;	JR		L009B					; and then jump into the code for the

	.EXTERN	NEWROMSTART
	JP	NEWROMSTART
					; QUIT word.


; ---------------
; THE 'QUIT' WORD
; ---------------
; (  --  )
; Clears return stack, empties input buffer and returns control to the
; keyboard.

L0092:  DEFM	"QUI"					; 'name field'
	DEFB	'T'+080h

L0096:  DEFW	00000h					; 'link field' - end of linked list.

L0098:  DEFB	004h						; 'name length field'

L0099:  DEFW	L009B					; 'code field' 
					; address of machine code for routine.

; ---
	PUBLIC L009B
;L009B:  LD		SP,(RAMSTART+018h)				; set stack-pointer to RAMTOP.
L009B:  
	LD		SP,(RAMTOP)				; set stack-pointer to RAMTOP.

	EI								; Enable Interrupts.

	JP		L04F2					; jump forward to the main execution 
					; loop.

; ----------------
; THE 'ABORT' WORD
; ----------------
; Clears the data and return stacks, deletes any incomplete definition
; left in the dictionary, prints 'ERROR' and the byte from address ERR_NO
; if the byte is non-negative, empties the input buffer, and returns
; control to the keyboard.


L00A3:  DEFM	"ABOR"					; 'name field' 
	DEFB	'T'+080h				

	DEFW	L0098					; 'link field' to previous word QUIT.

L00AA:  DEFB	005h						; 'name length field'

L00AB:  DEFW	L00AD					; 'code field'

; ---

; -> also continuation of the error restart.

L00AD:  PUSH	IY						; preserve current IY value slow/fast.

	LD		IY,L04B9				; set IY to FAST
					; now empty the data stack
	LD		HL,(STKBOT)				; STKBOT
	LD		(SPARE),HL				; SPARE
	LD		HL,FLAGS				; address FLAGS
	LD		A,(HL)					; fetch status from FLAGS.
	AND		0B3h						; AND %10110011
					; reset bit 2 - show definition complete
					; reset bit 3 - output to screen.
					; reset bit 6 - show in interpreter mode
	BIT		2,(HL)					; was there an incomplete definition ?
	LD		(HL),A					; update FLAGS
	JR		Z,L00DE					; forward if no incomplete word.

L00C4:  CALL	L04B9					; do forth

	DEFW	L0490					; dict			address of sv DICT
	DEFW	L08B3					; @				value of sv DICT (d).
	DEFW	L104B					; stk_data		d.			length field
	DEFB	005h						; five			d, 5.
	DEFW	L0DD2					; +				d+5.		code field
	DEFW	L086B					; dup			d+5, d+5.
	DEFW	L1610					; prvcur		d+5.
	DEFW	L15B5					; namefield		n.
	DEFW	L1011					; stackwrd		n.
	DEFW	STKBOT					; (stkbot)		n, stkbot.
	DEFW	L08C1					; !				.
	DEFW	L1A0E					; end-forth.	.

; at this stage the system variable STKBOT holds the address of the
; obsolete name field and the system variable CURRENT points to the
; address of the previous complete word - obtained from the old link field.

L00DE:  BIT		7,(IX+03Dh)				; test ERR_NO for normal value 255.
	JR		NZ,L00FF				; set-min then main-loop if OK.

	CALL	L1808					; else pr-inline

; ---

L00E7:  DEFM	"ERRO"					; the message "ERROR" with the last
	DEFB	'R'+080h				; character inverted.

; ---

L00EC:  CALL	L04B9					; forth

	DEFW	L1011					; stack next word
	DEFW	ERR_NO					; -> system variable ERR_NO
	DEFW	L0896					; C@			- fetch content byte
	DEFW	L09B3					; .				- print it
	DEFW	L0A95					; CR
	DEFW	L1A0E					; end-forth.

	LD		(IX+03Dh),0FFh			; set ERR_NO to 'No Error'

L00FF:  LD		HL,(STKBOT)				; fetch STKBOT
	LD		BC,0000Ch				; allow twelve bytes for stack underflow
	ADD		HL,BC					; add the extra
	LD		(SPARE),HL				; set SPARE
	POP		IY						; restore previous state of IY

	JR		L009B					; rejoin main loop

; -------------------------
; THE 'DEFAULT ENVIRONMENT'
; -------------------------
; This is the default environment that is copied from ROM to RAM as part of
; the initialization process. This also contains the FORTH word FORTH definition

L010D:  DEFW	026E0h					; L_HALF

	DEFB	000h						; KEYCOD
	DEFB	000h						; KEYCNT copy the 32 bytes.
	DEFB	000h						; STATIN
	DEFW	00000h					; EXWRCH
	DEFB	000h						; FRAMES
	DEFB	000h						; FRAMES
	DEFB	000h						; FRAMES
	DEFB	000h						; FRAMES
	DEFB	000h						; XCOORD
	DEFB	000h						; YCOORD
	DEFW	RAMSTART+04Ch					; CURRENT
	DEFW	RAMSTART+04Ch					; CONTEXT
	DEFW	RAMSTART+04Fh					; VOCLNK
	DEFW	RAMSTART+051h					; STKBOT
	DEFW	RAMSTART+045h					; DICT
	DEFW	RAMSTART+05Dh					; SPARE
	DEFB	0FFh						; ERR_NO
	DEFB	000h						; FLAGS
	DEFB	00Ah						; BASE

; FORTH

	DEFM	"FORT"					; The 'name field'
	DEFB	'H'+080h				; FORTH


	DEFW	00000h					; length field - filled when next word
					; is defined.
	DEFW	L1FFF					; link field copied to RAMSTART+049h.
	DEFB	005h						; name length field
	DEFW	L11B5					; code field
	DEFW	RAMSTART+049h					; address of parameters
	DEFB	000h						; VOCLNK						[RAMSTART+04Fh]
	DEFB	000h						; - link to next vocabulary.
	DEFB	000h						; last byte to be copied.	to [RAMSTART+051h]

; -----------------------------------------------
; THE 'CONTINUATION OF THE Z80 INTERRUPT' ROUTINE
; -----------------------------------------------
; The destination of the jump at 00038h.
; Begin by saving both accumulators and the 3 main registers.

IM1INTHANDLER:
	PUSH	AF						; preserve both accumulators
	EX		AF,AF'					;
	PUSH	AF						;

	PUSH	BC						; and main registers.
	PUSH	DE						;
	PUSH	HL						;

; Now wait for 62 * 12 clock cycles. ( To avoid flicker perhaps? ).

	LD		B,03Eh					; delay counter.

L0142:  DJNZ	L0142					; self loop for delay

; Increment the 4-byte frames counter for use as a system clock.

	LD		HL,FRAMES				; FRAMES1

L0147:
	INC		(HL)					; increment timer.
	INC		HL						; next significant byte of four.
	JR		Z,L0147					; loop back if the value wrapped back
					; to zero.

; Note. as manual points out, there is no actual check on this and if
; you leave your Ace switched on for 2.75 years it will advance to the
; following system variables although it takes several millennia to advance
; through the screen coordinates.

; Now read the keyboard and if no new key then exit after restoring the
; preserved registers.

	CALL	L0310					; routine KEYBOARD.

	LD		HL,STATIN				; address system variable STATIN

	BIT		0,(HL)					; new key?
	JR		Z,L0176					; forward if not to RESTORE/EXIT

	AND		A						; zero key code ?
	JR		Z,L0176					; forward if so to EXIT.

	CP		020h						; compare to SPACE
	JR		C,L0170					; forward if less as an Editing Key.

	BIT		1,(HL)					; CAPS shift?
	CALL	NZ,L0807				; routine TO_UPPER

	BIT		2,(HL)					; GRAPHICS mode?
	JR		Z,L0167					; skip forward if not

	AND		09Fh						; convert to one of 8 mosaic characters

L0167:  BIT		3,(HL)					; INVERSE mode?
	JR		Z,L016D					; forward if not.

	OR		080h						; set bit 7 to make character inverse.

L016D:  CALL	L0196					; routine pr_buffer

L0170:  CALL	L01E6					; routine EDIT_KEY
	CALL	L0282					; routine pr_cursor

; Before exiting restore the preserved registers.

L0176:  POP		HL						;
	POP		DE						;
	POP		BC						;
	POP		AF						;
	EX		AF,AF'					;
	POP		AF						;

	EI								; Enable Interrupts

	RET								; return.

; -----------------------------------
; THE 'PRINT to LOWER SCREEN' ROUTINE
; -----------------------------------

L017E:  CP		00Dh						; carriage return?
	JR		NZ,L0196				; forward if not

; a carriage return to input buffer i.e. lower screen memory.

	LD		HL,02700h				; set pointer to location after the
					; input buffer.

	LD		(ENDSUF),HL				; set ENDBUF - end of logical line
	LD		(CURSOR),HL				; set the CURSOR

	XOR		A						; clear A

	CALL	L0198					; print character zero.

	LD		HL,026E0h				; left hand position of bottom line.
	LD		(INSCRN),HL				; set INSCRN to this position.
	RET								; return.

; ---------------------------------------
; THE 'PRINT CHARACTER TO BUFFER' ROUTINE
; ---------------------------------------

L0196:  AND		A						; check for zero character
	RET		Z						; return if so.

; => also called from previous routine only to print a zero skipping above test.

L0198:  EX		AF,AF'					; preserve the output character.

	LD		HL,(ENDSUF)				; fetch ENDBUF end of logical line
	LD		A,(HL)					; fetch character from position
	AND		A						; is it zero ?
	JR		Z,L01A6					; skip forward if so.

; else lower screen scrolling is required.

	LD		DE,0D900h				; 00000h - 02700h
	ADD		HL,DE					; test if position is within video RAM
	JR		NC,L01CE				; forward if < 026FFh

; now check that the limit of 22 lines in lower screen is not exceeded.

L01A6:  LD		DE,(L_HALF)				; fetch start of buffer from L_HALF
	LD		HL,0DBA0h				; 00000h - 02460h
	ADD		HL,DE					;
	JR		NC,L01E4				; forward to exit if buffer full.


	LD		HL,(SCRPOS)				; fetch position SCRPOS for upper screen
	LD		BC,00020h				; allow an extra 32 characters - 1 line.
	ADD		HL,BC					;
	SBC		HL,DE					; subtract the start of input buffer
	PUSH	DE						; and save the L_HALF value

	CALL	NC,L0421				; routine to scroll upper display.

	CALL	L02B0					; find zerobyte loc in HL

	POP		DE						; retrieve the L_HALF value

	CALL	L042F					; routine scroll and blank

; The four system variables INSCRN, CURSOR, ENDBUF and L_HALF are each
; reduced by 32 bytes a screen line.

	LD		HL,INSCRN				; address INSCRN the left-hand location
					; of the current input line.

	LD		B,004h					; four system variables to update

L01C9:  CALL	L0443					; routine SCR-PTRS

	DJNZ	L01C9					; repeat for all four pointers.

; ok to print

L01CE:  CALL	L0302					; routine find characters to EOL.

	LD		D,H						; HL is end of line
	LD		E,L						; transfer to DE register.
	INC		HL						; increment
	LD		(ENDSUF),HL				; update ENDBUF
	DEC		HL						; decrement
	DEC		HL						; so HL = DE -1

	JR		Z,L01DD					; skip if BC zero.

	LDDR							; else move the characters.

L01DD:  EX		AF,AF'					; restore the output character.
	LD		(DE),A					; insert at screen position.
					; (a zero if CR lower)
	INC		DE						; next character position
	LD		(CURSOR),DE				; update CURSOR

L01E4:  XOR		A						; ?
	RET								; return.

; -------------------------
; THE 'EDIT KEY' SUBROUTINE
; -------------------------

L01E6:  LD		HL,L01F0				; address the EDIT KEYS table.

	LD		D,000h					; prepare to index by one byte.
	LD		E,A						; character code to E.
	ADD		HL,DE					; index into the table.

	LD		E,(HL)					; pick up required offset to the
					; handling routine.

	ADD		HL,DE					; add to the current address.
	JP		(HL)					; exit via the routine.

; ---------------------
; THE 'EDIT KEYS' TABLE
; ---------------------

L01F0:  DEFB	020h				; L0210			000h		- RET
L01F1:  DEFB	013h				; L0204			001h		- LEFT
L01F2:  DEFB	00Ch				; L01FE			002h		- CAPS
L01F3:  DEFB	01Eh				; L0211			003h		- RIGHT
L01F4:  DEFB	00Ah				; L01FE			004h		- GRAPH
L01F5:  DEFB	037h				; L022C			005h		- DEL
L01F6:  DEFB	01Ah				; L0210			006h		- RET
L01F7:  DEFB	050h				; L0247			007h		- UP
L01F8:  DEFB	006h				; L01FE			008h		- INV
L01F9:  DEFB	09Ch				; L0295			009h		- DOWN
L01FA:  DEFB	0C9h				; L02C3			00Ah		- DEL LINE
L01FB:  DEFB	015h				; L0210			0h		- RET
L01FC:  DEFB	014h				; L0210			00Ch		- RET
L01FD:  DEFB	0D3h				; L02D0			00Dh		- KEY-ENTER

; -------------------------------
; THE 'TOGGLE STATUS BIT' ROUTINE
; -------------------------------
; The keycodes have been cleverly mapped to individual bits of the STATIN
; system variable so this simple routine maintains all three status bits.
; KEY '2' - CAPS SHIFT, '4' - GRAPHICS, '8' - INVERSE VIDEO.

L01FE:  LD		HL,STATIN				; system variable STATIN
	XOR		(HL)					; toggle the single relevant bit.
	LD		(HL),A					; put back.
	RET								; return.

; ----------------------------
; THE 'CURSOR LEFT' SUBROUTINE
; ----------------------------
; this subroutine moves the cursor to the left unless the character at that
; position is zero.

L0204:  LD		HL,(CURSOR)				; fetch CURSOR.
	DEC		HL						; decrement value.
	LD		A,(HL)					; fetch character at new position.
	AND		A						; test for zero. (cr)
	RET		Z						; return if so.					>>

	LD		(CURSOR),HL				; else update CURSOR
	INC		HL						; step back
	LD		(HL),A					; and put character that was at new
					; cursor position where cursor is now.

L0210:  RET								; return.

; Note. various unallocated keys in the EDIT KEYS table point to the 
; above RET instruction.

; -----------------------------
; THE 'CURSOR RIGHT' SUBROUTINE
; -----------------------------

L0211:  LD		HL,(CURSOR)				; fetch CURSOR position
	INC		HL						; and increment it.

	LD		DE,(ENDSUF)				; fetch ENDBUF - end of current line.
	AND		A						; prepare to subtract.
	SBC		HL,DE					; test
	RET		Z						; return if zero - CURSOR is at ENDBUF

	ADD		HL,DE					; else reform the pointers.
	LD		(CURSOR),HL				; update CURSOR
	LD		A,(HL)					; fetch character at new position.
	DEC		HL						; decrement
	LD		(HL),A					; and insert where cursor was.
	RET								; ret.

; ---------------------------
; THE 'DELETE CURSOR' ROUTINE
; ---------------------------
; Moves cursor position to right and then continues into DEL-CHAR

L0225:  LD		HL,(CURSOR)				; fetch CURSOR
	INC		HL						; increment position.
	LD		(CURSOR),HL				; update CURSOR


; ------------------------------
; THE 'DELETE CHARACTER' ROUTINE
; ------------------------------

L022C:  CALL	L0302					; routine finds characters to EOL.

	LD		H,D						; transfer CURSOR position DE to HL.
	LD		L,E						;
	DEC		DE						; decrement DE
	LD		A,(DE)					; fetch character to left of original
					; cursor.
	AND		A						; test for zero.
	RET		Z						; return if so.					>>

	LD		(CURSOR),DE				; else update CURSOR
	LD		A,B						; check for count of characters
	OR		C						; being zero
	JR		Z,L023F					; skip if so.

L023D:  LDIR							; else shift characters to left.

L023F:  DEC		HL						; decrement HL so that points to end -
					; last position on the logical line.
	LD		(HL),020h				; insert a space.
	LD		(ENDSUF),HL				; set ENDBUF
	INC		C						; reset zero flag??
	RET								; return.

; -----------------------
; THE 'CURSOR UP' ROUTINE
; -----------------------
; When the cursor is moved up while editing a multi-line word definition,
; then the cursor is first moved to the left of the screen abutting the
; character zeros at the leftmost position.
; These zero characters appear as spaces but mark the beginning of each logical
; line. A logical line may, for instance if it contains a text item, extend over
; several physical screen lines.

L0247:  CALL	L0204					; routine CURSOR-LEFT
	JR		Z,L0254					; skip forward if not possible.

; else move left by thirty two positions. This may achieve a vertical move if
; attempted when a word is first being entered. Alternatively if one of the
; calls to cursor left fails having encountered a zero, then all subsequent
; calls will fail. The routine will return with the cursor adjacent to the zero.

	LD		B,01Fh					; count 31 decimal
L024E:  CALL	L0204					; move cursor left thirty one times.
	DJNZ	L024E					; makes thirty two moves counting first

	RET								; return.

; ---

L0254:  LD		HL,(INSCRN)				; fetch INSCRN start of current line.
	LD		DE,(L_HALF)				; fetch L_HALF start of buffer.
	AND		A						; reset carry for
	SBC		HL,DE					; true subtraction.
	RET		Z						; return if at beginning of input buffer

	CALL	L0225					; routine DEL-CURSOR

	LD		HL,(INSCRN)				; fetch INSCRN leftmost location of
					; current line.
	LD		DE,0FFE0h				; make DE minus thirty two.
	XOR		A						; clear accumulator to zero.

L0269:  ADD		HL,DE					; subtract 32
	CP		(HL)					; compare contents to zero
					; ( i.e. prev (cr) or buffer start?)
	JR		NZ,L0269				; loop back until HL holds zero.

	LD		(INSCRN),HL				; update INSCRN

	CALL	L02F4					; find endbuf

	LD		(CURSOR),HL				; set CURSOR

; ----------
; PR_CURSOR
; ----------

L0276:  LD		A,0A0h					; inverse space - so solid square

	CALL	L017E					; routine PR_LOWER

	LD		HL,(CURSOR)				; CURSOR
	DEC		HL
	LD		(CURSOR),HL				; CURSOR

; -> from interrupt
L0282:  LD		HL,(CURSOR)				; CURSOR

	LD		A,(STATIN)				; STATIN
	RRA								; ignore bit 0
	LD		(HL),097h				; pixel cursor.
	RRA								; test bit 1 - CAPS
	JR		NC,L0290				; forward if no CAPS SHIFT

	LD		(HL),0C3h				; inverse [C] cursor.

L0290:  RRA								; test bit 2 - GRAPHICS.
	RET		NC						; return if not

L0292:  LD		(HL),0C7h				; inverse [G] cursor.
	RET								; return

; -------------------------
; THE 'CURSOR DOWN' ROUTINE
; -------------------------


L0295:  CALL	L0211					; routine CURSOR RIGHT
	JR		Z,L02A2					; forward if not possible.

	LD		B,01Fh					; set counter to thirty one.

L029C:  CALL	L0211					; routine CURSOR RIGHT
	DJNZ	L029C					; thirty two moves altogether.
	RET								; return.

; ---

L02A2:  CALL	L02B0					; find zerobyte
	RET		PO						; return if	found

	PUSH	HL						; save position
	CALL	L0225					; routine DEL-CURSOR
	POP		HL						; retrieve position.
	CALL	L02ED					; set logical line
	JR		L0276					; back to exit via pr_cursor.

; ---
; find zerobyte
; ---
; -> called 5 times

L02B0:  LD		HL,02700h				; this location is always zero.
					; the byte following video RAM.
	LD		DE,(INSCRN)				; INSCRN		e.g. 026E0h

	AND		A						; prepare for true subtraction

	SBC		HL,DE					; subtract to give number of chars

	LD		B,H						; transfer count to
	LD		C,L						; the BC register pair.

	EX		DE,HL					; transfer INSCR value to HL.

	INC		HL						; start next location
	XOR		A						; search for a zero character.

	CPIR							; at most BC locations.
					; sets P/O flag if BC!=0

	DEC		HL						; step back to last non-zero
	RET								; return.

; -------------------------
; THE 'DELETE LINE' ROUTINE
; -------------------------
; CHR0h 10

L02C3:  LD		HL,(ENDSUF)				; ENDBUF
	DEC		HL						;
	LD		(CURSOR),HL				; CURSOR

L02CA:  CALL	L022C					; KEY-DEL
	JR		NZ,L02CA				; repeat

	RET								; return.

; --------------------------
; THE 'KEY-ENTER' SUBROUTINE
; --------------------------

L02D0:  LD		HL,STATIN				; STATIN
	SET		5,(HL)					; signal new key.
	RES		0,(HL)					; reset new key flag
	RET								; return.


; ------------------------
; THE 'SET BUFFER' ROUTINE
; ------------------------
; called by LIST, QUERY

L02D8:  LD		HL,02700h				; one past end of screen.
	LD		DE,(L_HALF)				; fetch start of buffer from L_HALF

	CALL	L07FA					; routine SPACE_FILL

	LD		HL,026E0h				; first location of bottom line.
	LD		(L_HALF),HL				; set L_HALF

	LD		(HL),000h				; insert a ZERO.

; -> called by retype
L02EA:  LD		HL,(L_HALF)				; fetch L_HALF

; -> from cursor down
L02ED:  LD		(INSCRN),HL				; set INSCRN
	INC		HL						; step past the zero
	LD		(CURSOR),HL				; set CURSOR

; => from cursor up.
L02F4:  CALL	L02B0					; find zerobyte

	LD		A,020h					; prepare a space

L02F9:  DEC		HL						; move to the left.
	CP		(HL)					; compare to space.
	JR		Z,L02F9					; back while spaces exist.

	INC		HL						; point to last space encountered.
	LD		(ENDSUF),HL				; set ENDBUF - end of logical line.
	RET								; return.

; ----------------------------------
; THE 'COUNT TO END OF LINE' ROUTINE
; ----------------------------------
; Find the number of characters to the end of the logical line.

L0302:  LD		HL,(ENDSUF)				; system variable ENDBUF
	LD		DE,(CURSOR)				; system variable CURSOR
	AND		A						; prepare to subtract.
	SBC		HL,DE					; subtract to give character places
	LD		B,H						; transfer result
	LD		C,L						; to the BC register pair.
	ADD		HL,DE					; reform the pointers.

	RET								; return with zero flag set if cursor
					; at EOL.

; ----------------------
; THE 'KEYBOARD' ROUTINE
; ----------------------

L0310:  CALL	L0336					; routine KEY_SCAN

	LD		B,A						; save key in B

	LD		HL,(KEYCOD)				; load L with KEYCOD - last key pressed
					; load H with KEYCNT - debounce counter

	XOR		L						; compare to previous key.
	JR		Z,L0325					; forward if a match.

	XOR		L						; reform original
	JR		Z,L0320					; forward if zero - no key.

	XOR		A						; else clear accumulator.

	CP		L						; compare with last.
	RET		NZ						; return if not zero.

L0320:  LD		L,B						; set L to original keycode
	LD		H,020h					; set counter to thirty two.
	JR		L0332					; forward to store values and exit
					; returning zero.

; ---

; Key is same as previously accepted key.
; It repeats after two interrupts

L0325:  DEC		H						; decrement the counter.
	LD		A,H						; fetch counter to A.
	CP		01Eh						; compare to thirty.
	JR		Z,L0331					; forward if so to return key in A.

	XOR		A						; clear accumulator.
	CP		H						; is counter zero?
	JR		NZ,L0332				; forward if not to keep counting.

	LD		H,004h					; else set counter to four.

L0331:  LD		A,L						; pick up previous key.

L0332:  LD		(KEYCOD),HL				;  update KEYCOD/KEYCNT

	RET								; return.

;----------------------------------------------------------------------------
;							LOGICAL VIEW OF KEYBOARD
;
;			0		1		2		3		4 -Bits-  4		3		2		1		0
; PORT																	PORT
;
; F7FE  [ 1 ] [ 2 ] [ 3 ] [ 4 ] [ 5 ]  |  [ 6 ] [ 7 ] [ 8 ] [ 9 ] [ 0 ]   EFFE
;  ^									|									v
; FBFE  [ Q ] [ W ] [ E ] [ R ] [ T ]  |  [ Y ] [ U ] [ I ] [ O ] [ P ]   DFFE
;  ^									|									v
; FDFE  [ A ] [ S ] [ D ] [ F ] [ G ]  |  [ H ] [ J ] [ K ] [ L ] [ ENT ] BFFE
;  ^									|									v
; FEFE  [SHI] [SYM] [ Z ] [ X ] [ C ]  |  [ V ] [ B ] [ N ] [ M ] [ SPC ] 7FFE
;  ^			v												^			v
; Start			+------------>--------------------->-------------+		End
;
;
;----------------------------------------------------------------------------


; ----------------------------------
; THE 'KEYBOARD SCANNING' SUBROUTINE
; ----------------------------------
; This routine is called by the KEYBOARD routine 50 times a second and
; by the ACE FORTH 'INKEY' WORD.
; The above diagram shows the logical view of the Keyboard and PORTS.
; The physical view is similar except that the symbol shift key is to the
; left of the space key.


L0336:  LD		BC,0FEFEh				; port address - B is also an 8 counter

	IN		D,(C)					; read from port to D.
					; when a key is pressed, the
					; corresponding bit is reset.

	LD		E,D						; save in E

	SRL		D						; read the outer SHIFT key.

	SBC		A,A						; 000h if SHIFT else 0FFh.
	AND		0D8h						; 000h if SHIFT else 0D8h.

	SRL		D						; read the symbol shift bit
	JR		C,L0347					; skip if not pressed.

	LD		A,028h					; load A with 40 decimal.

L0347:  ADD		A,057h					; gives 07Fh SYM, 057h SHIFT, or 02Fh

; Since 8 will be subtracted from the initial key value there are three
; distinct ranges 0 - 39, 40 - 79, 80 - 119.

	LD		L,A						; save key range value in L
	LD		A,E						; fetch the original port reading.
	OR		003h						; cancel the two shift bits.

	LD		E,0FFh					; set a flag to detect multiple keys.

; KEY_LINE the half-row loop.

L034F:  CPL								; complement bits

	AND		01Fh						; mask off the rightmost five key bits.
	LD		D,A						; save a copy in D.
	JR		Z,L0362					; forward if no keys pressed to do the
					; next row.

	LD		A,L						; else fetch the key value
	INC		E						; test E for 0FFh
	JR		NZ,L036B				; forward if not now zero to quit

L0359:  SUB		008h						; subtract 8 from key value

	SRL		D						; test next bit affecting zero and carry

	JR		NC,L0359				; loop back until the set bit is found.

	LD		E,A						; transfer key value to E.
	JR		NZ,L036B				; forward to abort if more than one key
					; is pressed in the row.

L0362:  DEC		L						; decrement the key value for next row.

	RLC		B						; rotate the 8 counter and port address

	JR		NC,L036D				; skip forward when all 8 rows have
					; been read.

	IN		A,(C)					; else read the next half-row.
	JR		L034F					; and back to KEY_LINE.

; ---
; ABORTKEY

L036B:  LD		E,0FFh					; signal invalid key.

; the normal exit checks if E holds a key and not 0FFh.

L036D:  LD		A,E						; fetch possible key value.
	INC		A						; increment
	RET		Z						; return if was 0FFh as original.

	LD		HL,L0376				; else address KEY TABLE
	ADD		HL,DE					; index into table.
					; (D is zero)

	LD		A,(HL)					; pick up character.

	RET								; return with translated character.



; ---------------
; THE 'KEY TABLE'
; ---------------

; -----------------------
; THE '40 UNSHIFTED KEYS'
; -----------------------

L0376:  DEFB	076h						; V - v
	DEFB	068h						; H - h
	DEFB	079h						; Y - y
	DEFB	036h						; 6 - 6
	DEFB	035h						; 5 - 5
	DEFB	074h						; T - t
	DEFB	067h						; G - g
	DEFB	063h						; C - c
	DEFB	062h						; B - b
	DEFB	06Ah						; J - j
	DEFB	075h						; U - u
	DEFB	037h						; 7 - 7
	DEFB	034h						; 4 - 4
	DEFB	072h						; R - r
	DEFB	066h						; F - f
	DEFB	078h						; X - x
	DEFB	06Eh						; N - n
	DEFB	06Bh						; K - k
	DEFB	069h						; I - i
	DEFB	038h						; 8 - 8
	DEFB	033h						; 3 - 3
	DEFB	065h						; E - e
	DEFB	064h						; D - d
	DEFB	07Ah						; Z - z
	DEFB	06Dh						; M - m
	DEFB	06Ch						; L - l
	DEFB	06Fh						; O - o
	DEFB	039h						; 9 - 9
	DEFB	032h						; 2 - 2
	DEFB	077h						; W - w
	DEFB	073h						; S - s
	DEFB	000h						; SYMBOL
	DEFB	020h						; SPACE
	DEFB	00Dh						; ENTER
	DEFB	070h						; P - p
	DEFB	030h						; 0 - 0
	DEFB	031h						; 1 - 1
	DEFB	071h						; Q - q
	DEFB	061h						; A - a
	DEFB	000h						; SHIFT

; ---------------------
; THE '40 SHIFTED KEYS'
; ---------------------

	DEFB	056h						; V - V
	DEFB	048h						; H - H
	DEFB	059h						; Y - Y
	DEFB	007h						; 6 - 7 KEY-UP
	DEFB	001h						; 5 - 1 KEY-LEFT
	DEFB	054h						;
	DEFB	047h
	DEFB	043h
	DEFB	042h
	DEFB	04Ah
	DEFB	055h
	DEFB	009h						; 7 - 9 KEY-DOWN
	DEFB	008h						; 4 - 8 INV-VIDEO
	DEFB	052h
	DEFB	046h
	DEFB	058h
	DEFB	04Eh
	DEFB	04Bh
	DEFB	049h
	DEFB	003h						; 8 - 3 KEY-RIGHT
	DEFB	033h						; 3 - 3
	DEFB	045h
	DEFB	044h
	DEFB	05Ah
	DEFB	04Dh
	DEFB	04Ch
	DEFB	04Fh
	DEFB	004h						; 9 - 4 GRAPH
	DEFB	002h						; 2 - 2 CAPS LOCK
	DEFB	057h						; W - W
	DEFB	053h						; S - S
	DEFB	000h						; SYMB
	DEFB	020h						; SPACE
	DEFB	00Dh						; ENTER
	DEFB	050h						; P - P
	DEFB	005h						; 0 - 5   DEL
	DEFB	00Ah						; 1 - 0A  DEL_LINE
	DEFB	051h						; Q - Q
	DEFB	041h						; A - A
	DEFB	000h						; SHIFT

; --------------------------
; THE '40 SYMBOL SHIFT KEYS'
; --------------------------

	DEFB	02Fh						; V - /
	DEFB	05Eh						; H - ^
	DEFB	05Bh						; Y - [
	DEFB	026h						; 6 - &
	DEFB	025h						; 5 - %
	DEFB	03Eh						; T - >
	DEFB	07Dh						;
	DEFB	03Fh
	DEFB	02Ah
	DEFB	02Dh
	DEFB	05Dh
	DEFB	027h
	DEFB	024h
	DEFB	03Ch
	DEFB	07Bh
	DEFB	060h
	DEFB	02Ch
	DEFB	02Bh
	DEFB	07Fh
	DEFB	028h
	DEFB	023h
	DEFB	045h
	DEFB	05Ch
	DEFB	03Ah
	DEFB	02Eh
	DEFB	03Dh
	DEFB	03Bh
	DEFB	029h
	DEFB	040h						; 2 - @
	DEFB	057h						; W - W
	DEFB	07Ch						; S
	DEFB	000h						; SYMB
	DEFB	020h						; SPACE
	DEFB	00Dh						; ENTER
	DEFB	022h						; P - "
	DEFB	05Fh						; 0 - _
	DEFB	021h						; 1 - !
	DEFB	051h						; Q - Q
	DEFB	07Eh						; A - ~
	DEFB	000h						; SHIFT

; end of key tables


; ---------------------------
; THE 'PRINT ROUTINE' Part 2.
; ---------------------------
; If output is not directed into the input buffer then jump forward else
; call the routine to output to lower screen.

L03EE:  JR		Z,L03F5					; forward to main screen print.

	CALL	L017E					; PR_LOWER

	EXX								; restore main set
	RET								; return.				>>

; the print output is not directed to the input buffer but first check that
; the user has not set up a vector to their own routine to print characters
; for instance to a printer.

L03F5:  LD		B,A						; save the character in the B register.

	LD		HL,(EXWRCH)				; fetch possible vector from EXWRCH
					; (normally 0)
	LD		A,H						; test for
	OR		L						; the value zero.
	LD		A,B						; fetch the character back to A.

	JR		Z,L03FF					; skip forward if no user-supplied
					; routine.

L03FE:  JP		(HL)					; else jump to user-supplied routine
					; which should finish with a JP (IY)

; ---
; PRINTING TO UPPER SCREEN
; ---

L03FF:  LD		HL,(SCRPOS)				; SCRPOS
	LD		DE,(L_HALF)				; L_HALF

	EX		DE,HL					; ??

	SCF								; inclusive byte.
	SBC		HL,DE					; subtract screen position+1 from
					; the start of input buffer.
	EX		DE,HL					; hl=scrpos

	CALL	C,L0421					; if no room then scroll upper display

	CP		00Dh						; carriage return?

	JR		Z,L0416					; skip forward if so.

	LD		(HL),A					; else insert the character.

	INC		HL						; point to next position.
	JR		L041C					; forward

; ---

; a carriage return

L0416:  INC		HL						; increment screen address.
	LD		A,L						; fetch low byte of address and mask.
	AND		01Fh						; a zero result indicates a line skip.
	JR		NZ,L0416				; loop until a new line of 32 columns
					; is started.

; both paths converge.

L041C:  LD		(SCRPOS),HL				; update SCRPOS

	EXX								; back to main set.

	RET								; return.

; -------------------------------------
; The 'UPPER DISPLAY SCROLLING' ROUTINE
; -------------------------------------

L0421:  PUSH	AF						; save character

	LD		HL,SCRPOS				; address the low order byte SCRPOS

	CALL	L0443					; routine cursor up
					; i.e. SCRPOS = SCRPOS - 32

	POP		AF						; restore character

; now calculate the number of characters to scroll in the upper display.

	LD		HL,(L_HALF)				; fetch L_HALF the start of input buffer
	LD		DE,02420h				; second line in video display

;
; => scroll lower display enters here
L042F:  AND		A						; prepare for true subtraction.
	SBC		HL,DE					; find number of characters to scroll.

	LD		B,H						; result to BC
	LD		C,L

	LD		HL,0FFE0h				; set HL to -32d
	ADD		HL,DE					; now HL = DE -32d
	EX		DE,HL					; switch so DE = HL - 32

	LDIR							; scroll the lines up.

	LD		B,020h					; blank a line of 32 characters

L043D:  DEC		HL						; decrement screen address.
	LD		(HL),020h				; insert a space character
	DJNZ	L043D					; and loop for all 32 characters

	RET								; return.

; --------------------------------
; THE 'SCREEN POINTERS' SUBROUTINE
; --------------------------------
;

L0443:  LD		A,(HL)					; fetch low byte of screen address
	SUB		020h						; subtract thirty two characters.
	LD		(HL),A					; and put back.

	INC		HL						; address high-order byte.
	JR		NC,L044B				; forward if low byte did not wrap

	DEC		(HL)					; else decrement the high byte as the
					; position has moved across a third of
					; the display.

L044B:  INC		HL						; address following System Variable
	RET								; return.

; -----------------------------------
; THE 'INDEX SYSTEM VARIABLE' ROUTINE
; -----------------------------------
; This routine is used by words CONTEXT, CURRENT, BASE etc. to index and then
; stack a system variable associated with a FORTH word. See shortly.
;
; It is a bit overblown considering the eventual position of the System
; Variables and ld d,03ch; rst 10h; jp (iy) could have been used instead of
; the long-winded addition below.

L044D:  EX		DE,HL					; HL addresses the offset byte.
	LD		E,(HL)					; fetch to E register
;
	LD		D,000h					; prepare to add.
	LD		HL,RAMSTART				; the address of start of SYSVARS
	ADD		HL,DE					; add the 8-bit offset
	EX		DE,HL					; location to DE.
	RST		10H						; push word DE

	JP		(IY)					; to 'next'.

; ---------------
; THE 'HERE' WORD
; ---------------
; ( -- address)
; Leaves the address of one past the end of the dictionary.

L0459:  DEFM	"HER"					; 'name field'
	DEFB	'E'+080h

	DEFW	L00AA					; 'link field'

L045F:  DEFB	004h						; 'name length field'

L0460:  DEFW	L0462					; 'code field'

; ---

L0462:  LD		DE,(STKBOT)				; system variable STKBOT.
	RST		10H						; push word DE

	JP		(IY)					; to 'next'.

; ------------------
; THE 'CONTEXT' WORD
; ------------------
; (  -- 15411 )
; A system variable pointing to the context vocabulary.
; CONTEXT CONTEXT

L0469:  DEFM	"CONTEX"				; 'name field'
	DEFB	'T'+080h

	DEFW	L045F					; 'link field'

L0472:  DEFB	007h						; 'name length field'

L0473:  DEFW	L044D					; 'code field'

; ---

L0475:  DEFB	033h						; low byte of system variable.

; ------------------
; THE 'CURRENT' WORD
; ------------------
; (  -- 15409 )
; A system variable pointing to the current vocabulary.
; CURRENT CURRENT

L0476:  DEFM	"CURREN"				; 'name field'
	DEFB	'T'+080h

	DEFW	L0472					; 'link field'

L047F:  DEFB	007h						; 'name length field'

L0480:  DEFW	L044D					; 'code field'

; ---

L0482:  DEFB	031h						; a single parameter low-byte of CURRENT.

; ---------------
; THE 'BASE' WORD
; ---------------
; ( -- 15423)
; A one-byte variable containing the system number base.
; RAMSTART+03Fh BASE

L0483:  DEFM	"BAS"					; 'name field'
	DEFB	'E'+080h

	DEFW	L047F					; 'link field'

L0489:  DEFB	004h						; 'name length field'

L048A:  DEFW	L044D					; 'code field'

; ---

L048C:  DEFB	03Fh						; low-byte of system variable BASE

; ---

; These two Internal Words are used to stack the value of FLAGS and DICT.

; -------------------------
; The 'flags' Internal Word
; -------------------------

L048D:  DEFW	L044D					; headerless 'code field'

; ---

L048F:  DEFB	03Eh						; low-order byte of FLAGS FLAGS

; -------------------------
; The 'dict' Internal Word
; -------------------------

L0490:  DEFW	L044D					; headerless 'code field'

; ---

L0492:  DEFB	039h						; low-order byte of DICT DICT


; --------------
; THE 'PAD' WORD
; --------------
; (  -- 9985 )
; Stacks the address of the 254-byte workpad.
; On most FORTH systems the PAD floats about in memory but on the Ace it is
; fixed in location and size. Its definition is simply a constant.

L0493:  DEFM	"PA"			; 'name field'
	DEFB	'D'+080h

	DEFW	L0489					; 'link field'

L0498:  DEFB	003h						; 'name length field'

L0499:  DEFW	L0FF5					; 'code field' - stack word

; ---

L049B:  DEFW	02701h					; parameter is 9985 decimal -
					; work pad address

; ------------
; THE ';' WORD
; ------------
; Terminates colon, DEFINER and COMPILER definitions.

L049D:  DEFB	';'+080h				; 'name field'

	DEFW	L0498					; 'link field'

L04A0:  DEFB	041h						; length 1+040h (immediate word)

L04A1:  DEFW	L1108					; 'code field' - compile

; ---

L04A3:  DEFW	L04B6					; exit

L04A5:  DEFW	L12D8					; check-for
	DEFB	00Ah						; ten					marker byte?
	DEFW	L1A0E					; end-forth.

; code gels

L04AA:  LD		HL,FLAGS				; address FLAGS
	LD		A,(HL)					; fetch FLAGS value.

	AND		0BBh						; AND %10111011
					; reset bit 2 - show definition complete
					; reset bit 6 - show in interpreter mode

	LD		(HL),A					; update FLAGS value.

	JP		(IY)					; to 'next'.

; ----
; Note. these backward links to the beginning of words will probably be less
; of a mystery when the syntax checking and listing modules are more fully
; explored. A value of 0FFFFh sometimes occurs.

x04b3:   DEFB	000h						;;

x04b4:   DEFB	0E8h						;;
x04b5:   DEFB	0FFh						;; 04b5 + ffe8 = 049d  = ';'

; ----------------------------------
; THE 'ADDRESS' INTERPRETER ROUTINES
; ----------------------------------

; ------------------------
; The 'Exit' Internal Word
; ------------------------
; Drops the 'Next Word' pointer from the Return Stack thereby ending a 
; subroutine and returning to next word in calling thread.

L04B6:  DEFW	L04B8					; headerless 'code field'

; ---

L04B8:  POP		HL						; discard the next word pointer.

; ------------------------------
; THE 'ADDRESS INTERPRETER' LOOP
; ------------------------------
; Sometimes known as the Sequencer.
;
; iy_fast

L04B9:  POP		HL						; word pointer.

; =====> from DOCOLON and BRANCH

L04BA:  LD		E,(HL)
	INC		HL
	LD		D,(HL)
	INC		HL

	PUSH	HL						; word pointer.

; ==>
;
L04BF:  EX		DE,HL
	LD		E,(HL)
	INC		HL
	LD		D,(HL)
	INC		HL
	EX		DE,HL

	JP		(HL)					; jump to machine code (4 clock cycles)
					; which will terminate with a JP (IY)
					; instruction (8 clock cycles).



; --------------------------------
; The 'Memory Check' Internal Word
; --------------------------------
; This internal word which also checks the BREAK key is only used from the 
; start of the LINE definition. However the machine code entry point is the 
; normal value of the IY register and so this code is executed at the end of
; every word. 

L04C6:  DEFW	L04C8					; headerless 'code field'

; iy_slow

L04C8:  LD		BC,0000Bh				; allow overhead of eleven bytes
	LD		DE,(SPARE)				; SPARE
	LD		HL,(STKBOT)				; STKBOT
	ADD		HL,BC					; add the overhead
	SBC		HL,DE					; subtract the SPARE value
	JR		C,L04D9					; forward if the original 12 byte gap
					; remains.

; else stack underflow has occurred.

L04D7:  RST		20H						; Error 2
	DEFB	002h						; Data stack underflow.

; ---

L04D9:  LD		BC,00000h				; allow no overhead.

	CALL	L0F8C					; check free memory
	CALL	L04E4					; check BREAK key.
	JR		L04B9					; back to iy_fast

; ------------------------------------
; THE 'CHECK FOR BREAK KEY' SUBROUTINE
; ------------------------------------
; Check for the key combination SHIFT/SPACE.

L04E4:  LD		A,0FEh					; read port 0FEFEh -
	IN		A,(0FEh)					; keys SPACE, SYMSHIFT, M, N, B.

	RRA								; test bit for outermost key
	RET		C						; return if not pressed.

	LD		A,07Fh					; read port 07FFEh -
	IN		A,(0FEh)					; keys SHIFT, Z, X, C, V.

	RRA								; test bit for outermost key
	RET		C						; return if not pressed.

L04F0:  RST		20H						; Error 3.
	DEFB	003h						; BREAK pressed.

; -------------------------
; THE 'MAIN EXECUTION' LOOP
; -------------------------
; The final part of the QUIT definition, as in all FORTH implementations,
; just loops through two FORTH words.

; The first call - to the Address Interpreter - does not return.
; The return address is the next word QUERY which the interpreter pops off
; the Return Stack and then before executing puts the address of the next word
; on Return Stack. The default action of the Address Interpreter is to execute
; words in turn until some word, such as branch, alters this default behaviour.

L04F2:  CALL	L04B9					; forth.

L04F5:  DEFW	L058C					; QUERY			- input buffer
	DEFW	L0506					; LINE			- interpret buffer
	DEFW	L0536					; prOK			- print OK
	DEFW	L1276					; branch		- relative jump

L04FD:  DEFW	0FFF7h					; back to L04F5

; ---
; the first high-level interpreted word.
; ---

; ---------------
; THE 'LINE' WORD
; ---------------
; Interprets input buffer as a normal FORTH line.

L04FF:  DEFM	"LIN"					; 'name field'
	DEFB	'E'+080h

	DEFW	L04A0					; 'link field'

L0505:  DEFB	004h						; 'name length field'

L0506:  DEFW	L0EC3					; 'code field' - docolon

; ---

L0508:  DEFW	L04C6					; check mem each time through loop
					; as dictionary could be expanding.

	DEFW	L063D					; FIND			- search the dictionary
	DEFW	L08EE					; ?DUP			- duplicate if found
	DEFW	L1283					; ?branch		- forward if not a 
L0510:  DEFW	00007h					; to L0518		- word.

	DEFW	L054F					; test and stack??
	DEFW	L1276					; branch
L0516:  DEFW	0FFF1h					; back to L0508

L0518:  DEFW	L06A9					; NUMBER
	DEFW	L08EE					; ?DUP
	DEFW	L1283					; ?branch		- forward if not a
L051E:  DEFW	00007h					; to L0526		- number.

	DEFW	L0564					; pop de with test
	DEFW	L1276					; branch
L0524:  DEFW	0FFE3h					; loop back to L0508

L0526:  DEFW	L061B					; stack-length
	DEFW	L0C1A					; 0=
	DEFW	L1283					; ?branch		- forward with anything 
L052C:  DEFW	00003h					; to L0530		- else

L052E:  DEFW	L04B6					; EXIT							>>>

; ---

L0530:  DEFW	L0578					; RETYPE		- [?] at relevant place
	DEFW	L1276					; branch		- once corrected back
L0534:  DEFW	0FFD3h					; to L0508		- to the loop.

; ----------------------------
; The 'Print OK' Internal Word
; ----------------------------
; prints the OK message after successful execution.

L0536:  DEFW	L0538					; headerless 'code field'

L0538:  LD		A,(FLAGS)				; fetch system variable FLAGS

	BIT		6,A						; test for 'COMPILER' mode.
	JR		NZ,L054D				; forward if so.

	BIT		4,A						; test for 'INVIS' mode.
	JR		NZ,L054D				; forward if so.

	CALL	L1808					; else print the inline string.

; ---

	DEFM	" OK"					; the OK message between two spaces.
	DEFB	" "+080h				; last one inverted.

; ---

L054A:  LD		A,00Dh					; prepare a carriage return.
	RST		08H						; and PRINT also.

L054D:  JP		(IY)					; to 'next'.

; ------------------------------
; The 'XXXXXXXXXX' Internal Word
; ------------------------------
; to handle a Word from LINE

L054F:  DEFW	L0551					; headerless 'code field'

; ---

L0551:  RST		18H						; pop address from Data Stack to DE

	DEC		DE						; point to the 'name length field'

	LD		A,(DE)					; fetch contents of the address.

	CPL								; complement.

	AND		(IX+03Eh)				; FLAGS

	AND		040h						; isolate BIT 6 of FLAGS, set if in 
					; compiler mode.

	INC		DE						; increment address to 'code field'

	JR		Z,L0561					; forward if not in compiling mode

	RST		10H						; push word DE			- add to dict
	LD		DE,L0F4E				; ','					- enclose 

L0561:  JP		L04BF					; next word.

; -----------------------
; The '???' Internal Word
; -----------------------
; after handling a number from LINE

L0564:  DEFW	L0566					; headerless 'code field'

; ---

L0566:  RST		18H						; pop word DE

	BIT		6,(IX+03Eh)				; test FLAGS - compiler mode ?

	JR		NZ,L0561				; loop back while in compiler mode.

	JP		(IY)					; to 'next'.

; -----------------
; THE 'RETYPE' WORD
; -----------------
; Allows user to edit the input line. Turns cursor to [?].

L056F:  DEFM	"RETYP"					; 'name field'
	DEFB	'E'+080h

	DEFW	L058B					; 'link field'

L0577:  DEFB	006h						; 'name length field'

L0578:  DEFW	L057A					; 'code field'

; ---

L057A:  CALL	L02EA					; routine sets logical line.

	CALL	L0276					; routine pr_cursor

	LD		(HL),0BFh				; the inverse [?] character

	JR		L0594					; forward to join the QUERY routine.

; ----------------
; THE 'QUERY' WORD
; ----------------
; Clears input buffer, then accepts characters until ENTER pressed.
; Buffer can be edited as usual and is limited to 22 lines.

L0584:  DEFM	"QUER"					; 'name field'
	DEFB	'Y'+080h

	DEFW	L0505					; 'link field'

L058B:  DEFB	005h						; 'name length field'

L058C:  DEFW	L058E					; 'code field'

; ---

L058E:  CALL	L02D8					; routine SETBUF

	CALL	L0276					; routine pr_cursor

; ->
L0594:  LD		HL,STATIN				; fetch STATIN
	SET		0,(HL)					;
	RES		5,(HL)					; (bit 5 set by interrupt when the user
					; presses the ENTER key)

L059B:  BIT		5,(HL)					; wait for interrupt to set the bit.
	JR		Z,L059B					; loop until.

	CALL	L0225					; routine DEL-CURSOR
	JP		(IY)					; to 'next'.

; ---------------
; THE 'WORD' WORD
; ---------------
; WORD text
; ( delimiter -- address )
; Takes text out of the input buffer up as far as a delimiter, and copies it
; to pad, starting at the second byte there. Puts the length (not including
; the delimiter) in the first byte of the pad, and stacks the address of the
; first byte of the pad.
; At most 253 characters are taken from the input buffer. If there are more
; left before the delimiter, then the first byte of the pad shows 254.
; Initial delimiters are ignored.

L05A4:  DEFM	"WOR"					; 'name field'
	DEFB	'D'+080h

	DEFW	L0577					; 'link field'

L05AA:  DEFB	004h						; 'name length field'

L05AB:  DEFW	L05AD					; 'code field'

; ---

L05AD:  RST		18H						; pop word DE
	LD		HL,027FEh				; set HL to penultimate byte of 'pad'.
	LD		B,0FDh					; the count is 253.

L05B3:  LD		(HL),020h				; insert a space in pad.
	DEC		HL						; decrement the address.
	DJNZ	L05B3					; repeat for the 253 locations.

	PUSH	DE						; save the delimiter.
	EX		DE,HL					; save in HL also, DE is start of pad.

	RST		10H						; stack data word DE
	POP		DE						; retrieve the delimiter.

	CALL	L05E1					;

	INC		B
	DEC		B
	JR		Z,L05C6					;

	LD		BC,000FFh

L05C6:  LD		HL,02701h
	LD		(HL),C
	INC		HL
	LD		A,0FCh
	CP		C
	JR		NC,L05D1				;

	LD		C,A

L05D1:  INC		C
	PUSH	DE
	PUSH	BC
	EX		DE,HL
	LDIR
	POP		BC
	POP		DE
	DEC		C
	CALL	L07DA					;
	JP		(IY)					; to 'next'.

; --------------------------------
; THE 'GET BUFFER TEXT' SUBROUTINE
; --------------------------------
; Called from FIND, NUMBER and XXXXX. Word may have leading spaces and is
; terminated by a space or newline (zero).
; It is also used to find the end of a comment delimited by ')'.
;
; =>
L05DF:  LD		E,020h					; set a space as the skip character.

; =>called with E holding delimiter.
;
L05E1:  LD		HL,(L_HALF)				; fetch L_HALF - start of screen buffer.
	LD		(INSCRN),HL				; make INSCRN start of logical line the
					; same.

	LD		BC,00000h				; initialize letter count to zero.

; -> loop
L05EA:  INC		HL						; increment screen address.
	LD		A,(HL)					; fetch character to A.
	CP		E						; compare to character in E.
	JR		Z,L05EA					; loop while character matches.

	AND		A						; test for zero (at 02700h?)
	JR		Z,L0600					; forward if so.

; a word has been found on the screen line.

	PUSH	HL						; save pointer to start of word.

L05F3:  INC		BC						; increment the letter count.
	INC		HL						; increment the screen pointer.

	LD		A,(HL)					; fetch new character
	AND		A						; test for zero.
	JR		Z,L05FC					; skip forward as at end of word.

	CP		E						; compare to the skip character.
	JR		NZ,L05F3				; loop back if still within a word.

L05FC:  POP		DE						; retrieve pointer to start of word.

	XOR		A						;; clear A
	CP		B						;; compare to B zero

	RET								; return. with carry reset for success.

; ---

L0600:  PUSH	DE						; save delimiter

	CALL	L02B0					; routine find zerobyte
	JP		PO,L0614				; jump if found to exit failure

	LD		DE,(L_HALF)				; else set DE from L_HALF
	CALL	L07FA					; routine SPACE_FILL (DE-HL)
	LD		(L_HALF),HL				; set L_HALF to next line

	POP		DE						; restore delimiter

	JR		L05E1					; loop back using new line.

; ---

; branch here if a word not found.

L0614:  EX		DE,HL					; DE addresses cursor.
	POP		BC						; discard saved delimiter
	LD		BC,00000h				; set BC, to zero
	SCF								; signal not found
	RET								; return.

; --------------------------------
; The 'stack length' Internal Word
; --------------------------------
; used once only from LINE to check for any extraneous text that is not a Word
; or a Number.

L061B:  DEFW	L061D					; headerless 'code field'

; ---

L061D:  CALL	L05DF					; get buffer

	LD		D,B						; transfer length of word
	LD		E,C						; from BC to DE
	RST		10H						; push word DE
	JP		(IY)					; to 'next'.


; ----------------
; THE 'VLIST' WORD
; ----------------
; List dictionary to screen, including words in ROM.
; (no pause after 18 lines)

L0625:  DEFM	"VLIS"					; 'name field'
	DEFB	'T'+080h

	DEFW	L05AA					; 'link field'

L062C:  DEFB	005h						; 'name length field'

L062D:  DEFW	L062F					; 'code field'

; ---

L062F:  LD		A,00Dh					; prepare a newline

	RST		08H						; print it.

	LD		C,000h					; set a flag for 'do all names'.

	JR		L0644					; forward to FIND.


; ---------------
; THE 'FIND' WORD
; ---------------
; ( -- compilation address )
; Leaves compilation address of first word in input buffer, if defined in
; context vocabulary; else 0.

L0636:  DEFM	"FIN"					; 'name field'
	DEFB	'D'+080h

	DEFW	L062C					; 'link field'

L063C:  DEFB	004h						; 'name length field'

L063D:  DEFW	L063F					; 'code field'

; ---

L063F:  CALL	L05DF					; get buffer word, gets length in C.

	JR		C,L068A					; back if null to stack word zero

; ->

L0644:  LD		HL,(CONTEXT)				; fetch value of system variable CONTEXT
	LD		A,(HL)					; extract low byte of address.
	INC		HL						; increment pointer.
	LD		H,(HL)					; extract high byte of address.
	LD		L,A						; address now in HL.

; The address points to the 'name length field' of the most recent word in the
; Dictionary.


L064B:  LD		A,(HL)					; fetch addressed byte.
	AND		03Fh						; discount bit 6, the immediate word
					; indicator, to give length 1-31

	JR		Z,L067F					; a 'zero' length indicates this is a
					; link like the example at the end of
					; this ROM.

	XOR		C						; match against C.
	JR		Z,L0657					; skip forward if lengths match.

	LD		A,C						; test flag C
	AND		A						; for value zero.
	JR		NZ,L067F				; forward if C not zero.

; else a name that matches the search length or all names are required - VLIST.


L0657:  PUSH	DE						; preserve DE
	PUSH	HL						; preserve 'name length field' pointer.

	CALL	L15E8					; routine WORDSTART finds start of name.
					; A is returned as zero.

	OR		C						; test C for zero
	JR		Z,L0676					; branch forward to print if in VLIST.

; else the search is for a specific word and a word with same length, at least,
; has been found.

	LD		B,C						; copy the length to counter B.

L0660:  LD		A,(DE)					; fetch first letter of match word.

	CALL	L0807					; routine UPPERCASE

	INC		DE						; update pointer (in lower screen)
	XOR		(HL)					; match against letter (in dictionary).
	AND		07Fh						; disregard any inverted bit.
	INC		HL						; increment dictionary pointer.

	JR		NZ,L067D				; exit loop to try next link if no match

	DJNZ	L0660					; else loop back for all letters.

; Oh Frabjous day - a match.

	POP		DE						; pop 'name length field' pointer.
	INC		DE						; increment to point to compilation
					; address.
	RST		10H						; stack date word DE.

; the remaining task is to clean up the input buffer in the lower screen.

	POP		DE						; pop the DE - screen pointer.

	CALL	L07DA					; clean up - backfill with spaces.

	JP		(IY)					; to 'next'.

; -----------------------
; THE 'PRINT NAME' BRANCH
; -----------------------
; This branch is taken from the above loop when all found words are to be
; printed by VLIST. It takes its time as if the user has expanded the
; dictionary then the list will scroll off the top of the screen. By waiting
; for an interrupt each time, it ensures that a standard listing takes about
; three seconds and there is ample opportunity to press BREAK to stop at a
; certain point.

L0676:  CALL	L17FB					; routine print string and space

	HALT							; wait for an interrupt.

	CALL	L04E4					; routine checks BREAK key.

L067D:  POP		HL						; restore 'name length field' pointer
	POP		DE						; restore DE

L067F:  DEC		HL						; point to high byte of 'link field'
	LD		A,(HL)					; hold it in A.
	DEC		HL						; point to low byte of 'link field'
	LD		L,(HL)					; transfer address of the new
	LD		H,A						; 'name length field' to HL pointer.

	OR		L						; test if address is zero - for the
					; last entry in the linked list.

	JR		NZ,L064B				; loop back while this is not the
					; last entry in the vocabulary.

L0687:  DEFB	0C3h						; A JP instruction i.e. JP L068A

; Note. The intention is to jump past the headerless code word for the internal
; word stk_zero. Since the word that would follow the first byte of the jump
; instruction would be identical to the word it is jumping over then the word
; can be omitted. Only saves one byte but this is back in 1983.

; ----------------------------
; The 'stk-zero' Internal Word
; ----------------------------
; (  -- 0 )

L0688:  DEFW	L068A					; headerless 'code field'

; ---

L068A:  LD		DE,00000h				; load DE with the value zero.
	RST		10H						; stack Data Word DE

	JP		(IY)					; to 'next'.

; ------------------
; THE 'EXECUTE' WORD
; ------------------
; ( compilation address --  )
; Executes the word with the given compilation address.

L0690:  DEFM	"EXECUT"				; 'name field'
	DEFB	'E'+080h

	DEFW	L063C					; 'link field'

L0699:  DEFB	007h						; 'name length field'

L069A:  DEFW	L069C					; 'code field'

; ---

L069C:  RST		18H

	JP		L04BF					;

; -----------------
; THE 'NUMBER' WORD
; -----------------
; Takes a number from the start of the input buffer. Leaves the number and
; a non-zero address on the stack. (The address is the compilation address
; of a literal compiler, so that if you then say EXECUTE, the literal compiler
; compiles the number into the dictionary as a literal - for an integer it
; is 4102, for a floating point number it is 4181).
; If no valid number then leaves just 0 on the stack.

L06A0:  DEFM	"NUMBE"					; 'name field'
	DEFB	'R'+080h

	DEFW	L0699					; 'link field'

L06A8:  DEFB	006h						; 'name length field'

L06A9:  DEFW	L06AB					; 'code field'

; ---

L06AB:  CALL	L05DF					; get buffer

	JR		C,L068A					; if empty stack word zero.

	PUSH	BC
	PUSH	DE

	CALL	L074C					;

	JR		NZ,L06BC				;

	LD		DE,01006h				; addr literal?
	JR		L0714					;

; ---

L06BC:  RST		18H						; pop word DE
	LD		DE,00000h
	RST		10H						; push word DE
	LD		DE,04500h
	POP		BC
	PUSH	BC
	LD		A,(BC)
	CP		02Dh						; is it '-' ?
	JR		NZ,L06CE				;

	LD		D,0C5h
	INC		BC
L06CE:  RST		10H						; push word DE
	LD		D,B
	LD		E,C
	DEC		HL
	DEC		HL

L06D3:  CALL	L0723					; routine GET_DECIMAL

	INC		HL
	INC		(HL)
	DEC		HL
	JR		NC,L06D3				;

	CP		0FEh
	JR		NZ,L071C				;

L06DF:  CALL	L0723					; routine GET_DECIMAL

	JR		NC,L06DF				;

	ADD		A,030h					; add '0' converting to letter.
	CALL	L077B					;
	JR		NZ,L06EF				;

	LD		E,000h
	JR		L06FD					;

L06EF:  AND		0DFh						;

	CP		045h						; is it 'E' - extended format?
	JR		NZ,L071C				;

	PUSH	HL

	CALL	L074C					;

	RST		18H						; pop word DE
	POP		HL
	JR		NZ,L071C				;

L06FD:  CALL	L0740					;
	JR		Z,L0711					;

	INC		HL
	LD		A,(HL)
	AND		07Fh
	ADD		A,E

	JP		M,L071C					; forward +->

	JR		Z,L071C					; forward +->

	XOR		(HL)
	AND		07Fh
	XOR		(HL)
	LD		(HL),A
L0711:  LD		DE,L1055				; stk_fp
L0714:  RST		10H						; push word DE
	POP		DE
	POP		BC
	CALL	L07DA					;
	JP		(IY)					; to 'next'.

; ---

; +->
L071C:  POP		HL
	POP		HL
	RST		18H						; pop word DE
	RST		18H						; pop word DE
	JP		L068A					;

; ----------------------------
; THE 'GET DECIMAL' SUBROUTINE
; ----------------------------
; Fetch character and return with carry set if after conversion is not in
; range 0 to 9.

L0723:  LD		A,(DE)
	INC		DE
	SUB		030h						; subtract '0'
	RET		C						; return if was less than '0'

	CP		00Ah						; compare to ten.
	CCF								; complement
	RET		C						; return - with carry set if over 9.

; ---------
; normalize?
; ---------
; => from below only.
L072C:  LD		C,A
	LD		A,(HL)
	AND		0F0h
	RET		NZ

	LD		A,C

; => (int/print_fp)
L0732:  DEC		HL
	DEC		HL
	LD		C,003h

L0736:  RLD								;  A = xxxx3210  <--   7654<-3210 (HL)

	INC		HL						;
	DEC		C
	JR		NZ,L0736				;

	DEC		(HL)					; decrement exponent
	DEC		HL						; point to start of BCD nibbles
	CP		A
	RET

; ---

; from ufloat to normalize 6-nibble mantissa

L0740:  LD		B,006h					; six nibbles

L0742:  XOR		A

	CALL	L072C					;

	RET		NZ

	DJNZ	L0742					;

	INC		HL
	LD		(HL),B

	RET

; ---------------------------
; THE 'GET NUMBER' SUBROUTINE
; ---------------------------
; can be called twice by the above code for the word 'NUMBER'.
; Once to get the first number encountered and sometimes, if in extended
; format, the exponent as well.

L074C:  RST		10H						; push word DE

	CALL	L04B9					; forth

L0750:  DEFW	L086B					; dup
	DEFW	L0896					; C@
	DEFW	L104B					; stk-data
	DEFB	02Dh						;  chr '-'
	DEFW	L0C4A					; =
	DEFW	L086B					; dup
	DEFW	L0DA9					; negate
	DEFW	L08D2					; >R
	DEFW	L0DD2					; +
	DEFW	L0E1F					; 1-
	DEFW	L0688					; stk-zero
	DEFW	L0688					; stk-zero
	DEFW	L08FF					; rot
L0769:  DEFW	L078A					; convert
	DEFW	L08FF					; rot
	DEFW	L08DF					; R>
	DEFW	L0D94					; pos
	DEFW	L08FF					; rot
	DEFW	L0879					; drop
	DEFW	L0885					; swap
	DEFW	L1A0E					; end-forth.

L0779:  RST		18H						; pop word DE
	LD		A,(DE)

L077B:  CP		020h
	RET		Z

	AND		A
	RET

; ------------------
; THE 'CONVERT' WORD
; ------------------
; (  ud1, addr1 -- ud2, addr2  )
; Accumulates digits from text into an unsigned double length
; number ud1: for each digit, the double length accumulator is
; multiplied by the system number base and the digit (converted
; from ASCII) is added on. The text starts at addr1 + 1. addr2 is
; the address of the first unconvertible character, ud2 is the
; final value of the accumulator.

L0780:  DEFM	"CONVER"				; 'name field'
	DEFB	'T'+080h

	DEFW	L06A8					; 'link field'

L0789:  DEFB	007h						; 'name length field'

L078A:  DEFW	L0EC3					; 'code field' - docolon

; ---

L078C:  DEFW	L0E09					; 1+
L078E:  DEFW	L086B					; dup
L0790:  DEFW	L08D2					; >R
L0792:  DEFW	L0896					; C@
L0794:  DEFW	L07B8					; stk_digit
L0796:  DEFW	L1283					; ?branch
L0798:  DEFW	0001Bh					; to 0799 + 1B = 007B4h

L079A:  DEFW	L0885					; swap
L079C:  DEFW	L048A					; get base
L079E:  DEFW	L0896					; C@
L07A0:  DEFW	L0CA8					; u*
L07A2:  DEFW	L0879					; drop
L07A4:  DEFW	L08FF					; rot
L07A6:  DEFW	L048A					; get base
L07A8:  DEFW	L0896					; C@
L07AA:  DEFW	L0CA8					; U*
L07AC:  DEFW	L0DEE					; D+
L07AE:  DEFW	L08DF					; R>
L07B0:  DEFW	L1276					; branch
L07B2:  DEFW	0FFD9h					; loop back to L078C

L07B4:  DEFW	L08DF					; R>
L07B6:  DEFW	L04B6					; exit

; -----------------------------
; The 'stk_digit' Internal Word
; -----------------------------

L07B8:  DEFW	L07BA					; headerless 'code field'

; ---

L07BA:  RST		18H						; pop word DE

	LD		A,E						; character to A

	CALL	L0807					; to_upper

	ADD		A,0D0h					; add to give carry with '0' and more.

	JR		NC,L07D7				; if less than '0' push byte 0 false.

	CP		00Ah						; compare to ten.
	JR		C,L07CD					; forward to stack bytes 0 - 9.

	ADD		A,0EFh					;
	JR		NC,L07D7				; push word false 0.

	ADD		A,00Ah

L07CD:  CP		(IX+03Fh)				; compare to BASE
	JR		NC,L07D7				; push word false 0.

; else digit is within range of number base

	LD		D,000h
	LD		E,A
	RST		10H						; push word DE
	SCF								; set carry to signal true

L07D7:  JP		L0C21					; push word 1 or 0

; ---
;		??
; ---

L07DA:  LD		H,D
	LD		L,E
	INC		BC
	ADD		HL,BC
	PUSH	HL
	BIT		4,(IX+03Eh)				; FLAGS
	CALL	Z,L097F					; pr_string

	CALL	L02B0					; curs?

	POP		DE
	AND		A
	SBC		HL,DE
	LD		B,H
	LD		C,L
	LD		HL,(INSCRN)				; INSCRN
	INC		HL
	EX		DE,HL
	JR		C,L07FB					;

	JR		Z,L07FA					; forward to SPACE_FILL.

	LDIR

; ------------------------
; The 'SPACE FILL' routine
; ------------------------
; -> from cls

L07FA:  AND		A						; prepare to subtract two screen
					; pointers.

L07FB:  SBC		HL,DE					; number of bytes in HL.
	EX		DE,HL					; now in DE, HL = start of area.

L07FE:  LD		A,D						; check if the
	OR		E						; counter is zero.
	RET		Z						; return if so.					>>

;	LD		(HL),020h				; insert a space character.
	LD		(HL),L				; insert a space character. //Ontobus

	INC		HL						; next address.
	DEC		DE						; decrement byte counter.
	JR		L07FE					; loop back to exit on zero.

; --------------------------
; THE 'UPPERCASE' SUBROUTINE
; --------------------------
; converts characters to uppercase.

L0807:  AND		07Fh						; ignore inverse bit 7
	CP		061h						; compare to 'a'
	RET		C						; return if lower

	CP		07Bh						; compare to 'z' + 1
	RET		NC						; return if higher than 'z'

	AND		05Fh						; make uppercase
	RET								; return.

; --------------
; THE 'VIS' WORD
; --------------
; Allows copy-up mechanism and 'OK'.

L0812:  DEFM	"VI"					; 'name field'
	DEFB	'S'+080h

	DEFW	L0789					; 'link field'

L0817:  DEFB	003h						; 'name length field'

L0818:  DEFW	L081A					; 'code field'

; ---

L081A:  RES		4,(IX+03Eh)				; update FLAGS signal visible mode.
	JP		(IY)					; to 'next'.

; ----------------
; THE 'INVIS' WORD
; ----------------
; Suppresses copy-up mechanism and 'OK'.

L0820:  DEFM	"INVI"					; 'name field'
	DEFB	'S'+080h

	DEFW	L0817					; 'link field'

L0827:  DEFB	005h						; 'name length field'

L0828:  DEFW	L082A					; 'code field'

; ---

L082A:  SET		4,(IX+03Eh)				; update FLAGS signal invisible mode.

	JP		(IY)					; to 'next'.


; ---------------
; THE 'FAST' WORD
; ---------------
; Fast mode - runs without error checks.
; Debugged programs run 25% faster.

L0830:  DEFM	"FAS"					; 'name field'
	DEFB	'T'+080h

	DEFW	L0827					; 'link field'

L0836:  DEFB	004h						; 'name length field'

L0837:  DEFW	L0839					; 'code field'

; ---

L0839:  LD		IY,L04B9				; miss memory checks on return

	JP		(IY)					; to 'next'.

; ---------------
; THE 'SLOW' WORD
; ---------------
; ( -- )
; Slow mode with error checking.
; Make IY point to a return routine that performs housekeeping.


L083F:  DEFM	"SLO"					; 'name field'
	DEFB	'W'+080h

	DEFW	L0836					; 'link field'

L0845:  DEFB	004h						; 'name length field'


L0846:  DEFW	L0848					; 'code field'

; ---

L0848:  LD		IY,L04C8				; set vector to memory checks each pass

	JP		(IY)					; to 'next'.

; ---------------------------------
; THE 'DATA STACK TO BC' SUBROUTINE
; ---------------------------------
; Called on twenty occasions to fetch a word from the Data Stack into the
; BC register pair. Very similar to RST 18H which does the same thing with the
; DE register pair as the destination on 73 occasions.
; In fact, as two Z80 restarts are unused, then 40 bytes of ROM code could have
; been saved by making this a restart also.

L084E:  LD		HL,(SPARE)				; fetch SPARE - start of Spare Memory.
	DEC		HL						; decrement to point to last stack item
	LD		B,(HL)					; load high byte to B.
	DEC		HL						; address low byte of word.
	LD		C,(HL)					; and load to C.
	LD		(SPARE),HL				; update the system variable SPARE to
					; a location two bytes less than it was.
	RET								; return.

; -----------------------------------------
; THE 'CONTINUATION OF THE RST 18H' RESTART
; -----------------------------------------
; complete the operation of popping a word to DE from the data stack.

L0859:  DEC		HL						;
	LD		E,(HL)					;
	LD		(SPARE),HL				; update SPARE
	RET								; return.

; -----------------------------------------
; THE 'CONTINUATION OF THE RST 10H' RESTART
; -----------------------------------------
; complete the operation of pushing a word in DE to the data stack.

L085F:  LD		(HL),D					;
	INC		HL						;
	LD		(SPARE),HL				; update SPARE
	RET								; return.

; --------------
; THE 'DUP' WORD
; --------------
; ( n -- n, n )
; Duplicates the top of the stack.

L0865:  DEFM	"DU"					; 'name field'
	DEFB	'P'+080h

	DEFW	L0845					; 'link field'

L086A:  DEFB	003h						; 'name length field'

L086B:  DEFW	L086D					; 'code field'

; ---

L086D:  RST		18H						; unstack Data Word DE
	RST		10H						; stack Data Word DE
	RST		10H						; stack Data Word DE

	JP		(IY)					; to 'next'.

; ---------------
; THE 'DROP' WORD
; ---------------
; ( n -- )
; Throws away the top of the stack.

L0872:  DEFM	"DRO"					; 'name field'
	DEFB	'P'+080h

	DEFW	L086A					; 'link field'

L0878:  DEFB	004h						; 'name length field'

L0879:  DEFW	L087B					; 'code field'

; ---

L087B:  RST		18H						; unstack Data Word DE 
	JP		(IY)					; to 'next'.

; ---------------
; THE 'SWAP' WORD
; ---------------
; (n1, n2 -- n2, n1)

L087E:  DEFM	"SWA"					; 'name field'
	DEFB	'P'+080h

	DEFW	L0878					; 'link field'

L0884:  DEFB	004h						; 'name length field'

L0885:  DEFW	L0887					; 'code field'

; ---

L0887:  RST		18H						; pop word DE
	CALL	L084E					; stk_to_bc
	RST		10H						; push word DE
	LD		D,B						;
	LD		E,C						;
	RST		10H						; push word DE

	JP		(IY)					; to 'next'.

; -------------
; THE 'C@' WORD
; -------------
; (address -- byte)
; Fetches the contents of a given address.

L0891:  DEFB	'C'						; 'name field'
	DEFB	'@'+080h

	DEFW	L0884					; 'link field'

L0895:  DEFB	002h						; 'name length field'

L0896:  DEFW	L0898					; 'code field'

; ---

L0898:  RST		18H						; pop word DE
	LD		A,(DE)
	LD		E,A
	LD		D,000h

	RST		10H						; push word DE

	JP		(IY)					; to 'next'.

; -------------
; THE 'C!' WORD
; -------------
; (n, address -- )
; Stores the less significant byte on n at a given address.

L08A0:  DEFB	'C'						; 'name field'
	DEFB	'!'+080h

	DEFW	L0895					; 'link field'

L08A4:  DEFB	002h						; 'name length field'

L08A5:  DEFW	L08A7					; 'code field'

; ---

L08A7:  RST		18H						; pop word DE
	CALL	L084E					; stk_to_bc
	LD		A,C
	LD		(DE),A

	JP		(IY)					; to 'next'.

; ------------
; THE '@' WORD
; ------------
; (address -- n)
; Leaves on stack the single length integer at the given address.

L08AF:  DEFB	'@'+080h				; 'name field'

	DEFW	L08A4					; 'link field'

L08B2:  DEFB	001h						; 'name length field'

L08B3:  DEFW	L08B5					; 'code field'

; ---

L08B5:  RST		18H						; pop word DE

	EX		DE,HL
	LD		E,(HL)
	INC		HL
	LD		D,(HL)

	RST		10H						; push word DE

	JP		(IY)					; to 'next'.

; ------------
; THE '!' WORD
; ------------
; (n,address --)
; Stores the single-length integer n at the given address in memory.

L08BD:  DEFB	'!'+080h				; 'name field'

	DEFW	L08B2					; 'link field'

L08C0:  DEFB	001h						; 'name length field'

L08C1:  DEFW	L08C3					; 'code field'

; ---

L08C3:  RST		18H						; pop word DE
	CALL	L084E					; stk_to_bc
	EX		DE,HL
	LD		(HL),C
	INC		HL
	LD		(HL),B

	JP		(IY)					; to 'next'.

; -------------
; THE '>R' WORD
; -------------
; (n -- )
; Transfers top entry on data stack to return stack.
; It can be copied back using 'I'.

L08CD:  DEFB	'>'						; 'name field'
	DEFB	'R'+080h

	DEFW	L08C0					; 'link field'

L08D1:  DEFB	002h						; 'name length field'

L08D2:  DEFW	L08D4					; 'code field'

; ---

L08D4:  RST		18H
	POP		BC
	PUSH	DE
	PUSH	BC
	JP		(IY)					; to 'next'.

; -------------
; THE 'R>' WORD
; -------------
; ( -- entry from return stack)
; Transfers top entry on return stack to data stack.

L08DA:  DEFB	'R'						; 'name field'
	DEFB	'>'+080h

	DEFW	L08D1					; 'link field'

L08DE:  DEFB	002h						; 'name length field'

L08DF:  DEFW	L08E1					; 'code field'

; ---

L08E1:  POP		BC
	POP		DE
	PUSH	BC
	RST		10H						; push word DE
	JP		(IY)					; to 'next'.

; ---------------
; THE '?DUP' WORD
; ---------------
; (n -- n, n)	if n!=0.
; (n -- n)		if n=0.

L08E7:  DEFM	"?DU"					; 'name field'
	DEFB	'P'+080h

	DEFW	L08DE					; 'link field'

L08ED:  DEFB	004h						; 'name length field'

L08EE:  DEFW	L08F0					; 'code field'

; ---


L08F0:  RST		18H						; fetch word DE
	RST		10H						; push it back
	LD		A,D						; test if fetched
	OR		E						; word is zero
	CALL	NZ,L0010				; push word DE if non-zero
	JP		(IY)					; to 'next'.

; --------------
; THE 'ROT' WORD
; --------------
; (n1, n2, n3 -- n2, n3, n1)

L08F9:  DEFM	"RO"					; 'name field'
	DEFB	'T'+080h

	DEFW	L08ED					; 'link field'

L08FE:  DEFB	003h						; 'name length field'

L08FF:  DEFW	L0EC3					; 'code field' - docolon

; ---

L0901:  DEFW	L08D2					; >R
L0903:  DEFW	L0885					; swap
L0905:  DEFW	L08DF					; R>
L0907:  DEFW	L0885					; swap
L0909:  DEFW	L04B6					; exit

; ---------------
; THE 'OVER' WORD
; ---------------
; (n1, n2 -- n1, n2, n1)

L090B:  DEFM	"OVE"					; 'name field'
	DEFB	'R'+080h

	DEFW	L08FE					; 'link field'

L0911:  DEFB	004h						; 'name length field'

L0912:  DEFW	L0EC3					; 'code field' - docolon

; ---

L0914:  DEFW	L08D2					; >R
L0916:  DEFW	L086B					; dup
L0918:  DEFW	L08DF					; R>
L091A:  DEFW	L0885					; swap
L091C:  DEFW	L04B6					; exit

; ---------------
; THE 'PICK' WORD
; ---------------
; (n1 -- n2)
; Copies the n1-th stack entry (after dropping n1 itself) to the top.
; Error 7 if n1 <= 0.

L091E:  DEFM	"PIC"					; 'name field'
	DEFB	'K'+080h

	DEFW	L0911					; 'link field'

L0924:  DEFB	004h						; 'name length field'

	DEFW	L0927					; 'code field'

; ---

L0927:  CALL	L094D					;
	JP		(IY)					; to 'next'.

; ---------------
; THE 'ROLL' WORD
; ---------------
; (n -- )
; Extracts the nth stack value to the top of the stack, after dropping n
; itself, and moves the remaining values down to fill the vacated position.
; Error 7 if n <= 0.

L092C:  DEFM	"ROL"					; 'name field'
	DEFB	'L'+080h

	DEFW	L0924					; 'link field'

L0932:  DEFB	004h						; 'name length field'

L0933:  DEFW	L0935					; 'code field'

; ---

L0935:  CALL	L094D					;
	EX		DE,HL
	LD		HL,(STKBOT)				; STKBOT
	SBC		HL,DE
	JP		NC,L04D7				; jump back to Error 2

	LD		H,D
	LD		L,E
	INC		HL
	INC		HL
	LDIR
	LD		(SPARE),DE				; SPARE
	JP		(IY)					; to 'next'.

; ---

L094D:  CALL	L084E					; stk_to_bc
	DEC		BC
	SLA		C
	RL		B
	INC		BC
	INC		BC
	JR		NC,L095B				; skip the error routine

	RST		20H						; Error 7
	DEFB	007h						; PICK or ROLL used with operand 0
					; or negative

; ---

L095B:  LD		HL,(SPARE)				; SPARE
	SBC		HL,BC
	PUSH	HL
	LD		E,(HL)
	INC		HL
	LD		D,(HL)
	RST		10H						; push word DE
	POP		HL
	RET

; ---------------
; THE 'TYPE' WORD
; ---------------
; (address, n -- )
; EMITs n characters from memory starting at the address.


L0967:  DEFM	"TYP"					; 'name field'
	DEFB	'E'+080h

	DEFW	L0932					; 'link field'

L096D:  DEFB	004h						; 'name length field'

L096E:  DEFW	L0970					; 'code field'

; ---

L0970:  CALL	L084E					; stk_to_bc
	RST		18H						; pop word DE
	CALL	L097F					; routine pr_string (below)

	JP		(IY)					; to 'next'.

; --------------------------
; THE 'PRINT STRING' ROUTINE
; --------------------------
; The first entry point prints strings embedded in the Dictionary with the 
; DE pointing to the preceding length word.
; 
; The second entry point prints a string with length in BC and start in DE.
; It is called by TYPE above and to print comment fields.

; ->

L0979:  LD		A,(DE)
	LD		C,A
	INC		DE
	LD		A,(DE)
	LD		B,A
	INC		DE

; -->
L097F:  LD		A,B
	OR		C
	RET		Z

	LD		A,(DE)
	INC		DE
	DEC		BC
	RST		08H						; print_ch

	JR		L097F					;

; -------------
; THE '<#' WORD
; -------------
; (  --  )
; Initiates formatted output.

L0988:  DEFB	'<'						; 'name field'
	DEFB	'#'+080h

	DEFW	L096D					; 'link field'

L098C:  DEFB	002h						; 'name length field'

L098D:  DEFW	L098F					; 'code field'

; ---

L098F:  LD		HL,027FFh				; end of pad
	LD		(HLD),HL				; update system variable HLD
	JP		(IY)					; to 'next'.

; -------------
; THE '#>' WORD
; -------------
; (ud -- address, n)
; Finishes formatted output, leaving the address and length (n) of the
; resultant string.

L0997:  DEFB	'#'						; 'name field'
	DEFB	'>'+080h

	DEFW	L098C					; 'link field'

L099B:  DEFB	002h						; 'name length field'

L099C:  DEFW	L099E					; 'code field'

; ---

L099E:  RST		18H						; pop word DE
	RST		18H						; pop word DE
	LD		DE,(HLD)				; HLD
	RST		10H						; push word DE (address)
	LD		HL,027FFh				; end of pad.
	AND		A						; prepare to subtract.
	SBC		HL,DE					; find length of string.
	EX		DE,HL					; transfer to DE
	RST		10H						; push word DE (n)

	JP		(IY)					; to 'next'.

; ------------
; THE '.' WORD
; ------------
;

L09AF:  DEFB	'.'+080h				; 'name field'

	DEFW	L0A49					; 'link field'

L09B2:  DEFB	001h						; 'name length field'

L09B3:  DEFW	L0EC3					; 'code field' - docolon

; ---

L09B5:  DEFW	L098D					; <#
	DEFW	L086B					; dup
	DEFW	L0C0D					; abs
	DEFW	L0688					; stk-zero
	DEFW	L09E1					; #s
	DEFW	L08FF					; rot
	DEFW	L0A4A					; sign

L09C3:  DEFW	L099C					; #>
	DEFW	L096E					; type
	DEFW	L0A73					; space
	DEFW	L04B6					; exit

; -------------
; THE 'U.' WORD
; -------------
; (un -- )
; Prints the unsigned single length integer 'un' to the television screen,
; followed by a space.

L09CB:  DEFB	'U'						; 'name field'
	DEFB	'.'+080h

	DEFW	L09B2					; 'link field'

L09CF:  DEFB	002h						; 'name length field'

L09D0:  DEFW	L0EC3					; 'code field' - docolon

; ---

L09D2:  DEFW	L0688					; stk-zero
L09D4:  DEFW	L098D					; <#
L09D6:  DEFW	L09E1					; #S
L09D8:  DEFW	L1276					; branch
L09DA:  DEFW	0FFE8h					; -> 09C3


; -------------
; THE '#S' WORD
; -------------
; (ud -- 0,0)
; Applies # repeatedly (at least once) until the double length number left
; on the stack is 0.

L09DC:  DEFB	'#'						; 'name field'
	DEFB	'S'+080h

	DEFW	L09CF					; 'link field'

L09E0:  DEFB	002h						; 'name length field'

L09E1:  DEFW	L0EC3					; 'code field' - docolon

; ---

L09E3:  DEFW	L09F7					; #
	DEFW	L0912					; over
	DEFW	L0912					; over
	DEFW	L0E36					; or
	DEFW	L0C1A					; 0=
	DEFW	L128D					; ?branch

L09EF:  DEFW	0FFF3h					; back to L09E3

	DEFW	L04B6					; exit

; ------------
; THE '#' WORD
; ------------
; (ud1 -- ud2)
; used in formatted output. Generates one digit from the unsigned double
; length integer ud1 and holds it in the pad. The unsigned double length
; integer ud2 is the quotient when ud1 is divided by the number base.

L09F3:  DEFB	'#'+080h				; 'name field'

	DEFW	L09E0					; 'link field'

L09F6:  DEFB	001h						; 'name length field'

L09F7:  DEFW	L0EC3					; 'code field' - docolon

; ---

L09F9:  DEFW	L048A					; get base
L09FB:  DEFW	L0896					; C@
L09FD:  DEFW	L0CC4					; div?
L09FF:  DEFW	L08FF					; rot
L0A01:  DEFW	L0A07					; stk-char
L0A03:  DEFW	L0A5C					; hold
L0A05:  DEFW	L04B6					; exit

; ----------------------------
; The 'stk-char' Internal Word
; ----------------------------
; used from above thread.

L0A07:  DEFW	L0A09					; headerless 'code field'

; ---

L0A09:  RST		18H						; data stack to DE
	LD		A,E						; character to A
	ADD		A,030h					; convert digit to ASCII
	CP		03Ah						; compare to '9'
	JR		C,L0A13					; forward if digit
	ADD		A,007h					; else add for hex

L0A13:  LD		E,A						; back to E
	RST		10H						; push ASCII on data stack.
	JP		(IY)					; to 'next'.

; --------------
; THE 'CLS' WORD
; --------------
; ( -- )
; Clears the screen and sets the print position to the top left of
; the screen.

L0A17:  DEFM	"CL"					; 'name field'
	DEFB	'S'+080h

	DEFW	L09F6					; 'link field'

L0A1C:  DEFB	003h						; 'name length field'

	DEFW	L0A1F					; 'code field'

; ---

L0A1F:  CALL	L0A24					; routine CLS below.

	JP		(IY)					; to 'next'.


; --------------------
; THE 'CLS' SUBROUTINE
; --------------------
; Called from the 'CLS' word definition above and also from the initialization
; routine.

L0A24:  LD		DE,026FFh				; point destination to end of video
					; memory.
	LD		HL,(L_HALF)				; set HL to first byte of input buffer
					; from system variable L_HALF.
					; (at initialization 026E0h).

	LD		BC,00020h				; set count to thirty two.

	ADD		HL,BC					; add to the low address.
	DEC		HL						; step back and
	LDDR							; copy the 32 bytes.

; while BC is zero, set the plotting coordinates.

	LD		(XCOORD),BC				; set XCOORD and YCOORD to zero.

; set the screen position to the start of video memory.

	LD		HL,02400h				; start of the 768 bytes of video RAM.
	LD		(SCRPOS),HL				; set system variable SCRPOS.

	INC		DE						; the byte before logical line.
	EX		DE,HL					; transfer to HL.
	LD		(L_HALF),HL				; set L_HALF.
	JP		L07FA					; jump back to fill the locations
					; from DE to HL -1 with spaces.

; ---------------
; THE 'SIGN' WORD
; ---------------
; (n -- )
; In formatted output, holds a minus sign in the pad if n is negative.


L0A43:  DEFM	"SIG"					; 'name field'
	DEFB	'N'+080h

	DEFW	L099B					; 'link field'

L0A49:  DEFB	004h						; 'name length field'

L0A4A:  DEFW	L0A4C					; 'code field'

; ---

L0A4C:  RST		18H						; pop word DE
	RL		D						; test sign bit
	LD		E,02Dh					; prepare a '-'
	JR		C,L0A5F					; forward if minus
	JP		(IY)					; to 'next'.

; ---------------
; THE 'HOLD' WORD
; ---------------
; (character -- )
; Used in formatted output to hold the character in the pad.

L0A55:  DEFM	"HOL"					; 'name field'
	DEFB	'D'+080h

L0A59:  DEFW	L0A1C					; 'link field'

L0A5B:  DEFB	004h						; 'name length field'

L0A5C:  DEFW	L0A5E					; 'code field'

; ---

L0A5E:  RST		18H						; data stack to DE

L0A5F:  LD		HL,(HLD)				; HLD
	DEC		L
	JR		Z,L0A69					; forward when full

	LD		(HLD),HL				; update HLD
	LD		(HL),E					; and place character in buffer

L0A69:  JP		(IY)					; to 'next'.

; ----------------
; THE 'SPACE' WORD
; ----------------
; (  --  )
; EMITs a space.

L0A6B:  DEFM	"SPAC"					; 'name field'
	DEFB	'E'+080h

	DEFW	L0A5B					; 'link field'

L0A72:  DEFB	005h						; 'name length field'

L0A73:  DEFW	L0A75					; 'code field'

; ---

L0A75:  LD		A,020h					; load accumulator with the ASCII
					; code for space.
	RST		08H						; print_ch

L0A78:  JP		(IY)					; to 'next'.

; -----------------
; THE 'SPACES' WORD
; -----------------
; (n -- )
; EMITs n spaces if n >= 1.

L0A7A:  DEFM	"SPACE"					; 'name field'
	DEFB	'S'+080h

	DEFW	L0A72					; 'link field'

L0A82:  DEFB	006h						; 'name length field'

	DEFW	L0A85					; 'code field'

; ---

L0A85:  RST		18H						; fetch stack data to DE

L0A86:  DEC		DE						; decrement the counter.
	BIT		7,D						; test for a negative value
	JR		NZ,L0A78				; back to a jp iy  when done	>>

	LD		A,020h					; prepare a space
	RST		08H						; print it
	JR		L0A86					; loop back for more.

; -------------
; THE 'CR' WORD
; -------------
; Outputs a carriage return character to the television.

L0A90:  DEFB	'C'						; 'name field'
	DEFB	'R'+080h

	DEFW	L0A82					; 'link field'

L0A94:  DEFB	002h						; 'name length field'

L0A95:  DEFW	L0A97					; 'code field'

; ---

L0A97:  LD		A,00Dh					; prepare a CR
	RST		08H						; print it.

	JP		(IY)					; to 'next'.

; ---------------
; THE 'EMIT' WORD
; ---------------
; (character -- )
; writes the character to the television screen.

L0A9C:  DEFM	"EMI"					; 'name field'
	DEFB	'T'+080h

	DEFW	L0A94					; 'link field'

L0AA2:  DEFB	004h						; 'name length field'

L0AA3:  DEFW	L0AA5					; 'code field'

; ---

L0AA5:  RST		18H						; pop de off data stack
	LD		A,E						; character to A
	RST		08H						; print it.

	JP		(IY)					; to 'next'.


; -------------
; THE 'F.' WORD
; -------------
; (f -- )
; print a floating point number.
; If 1.0E-4 <= f < 1.0E9, then f is printed without an exponent and with a
; decimal point in the appropriate place. If f is outside this range, then
; it is printed in standard form f'En where 0 <= f' < 10 and -64 <= n <= 62.
; Input may be either form, but only six significant digits are accepted -
; further digits are ignored.
; Floating point numbers are stored as 3 bytes of binary coded decimal
; mantissa and 1 byte for sign and decimal exponents.
;
; e.g. the number 123.456 on Data Stack would be two words, four bytes.
;
;		^		43				01000011   bits 5 - 0 are exponent
;		|		12		BCD		||
;		|		34		BCD		|sign of exponent 1=positive (bit 6)
;		|		56		BCD		sign of number 0=positive (bit 7)
;
; Zero 0. is a special case floating point number with all four bytes set 
; to zero.


L0AAA:  DEFB	'F'						; 'name field'
	DEFB	'.'+080h

	DEFW	00AA2h					; 'link field'

L0AAE:  DEFB	002h						; 'name length field'

L0AAF:  DEFW	00AB1h					; 'code field'

; ---

L0AB1:  LD		HL,(SPARE)				; set pointer from system variable SPARE
	DEC		HL						; now points to last byte of data stack.
	BIT		7,(HL)					; test sign of number.
	RES		7,(HL)					; reset the sign bit.
	JR		Z,L0ABE					; forward if initially positive.

	LD		A,02Dh					; prepare  the '-' character.
	RST		08H						; print the minus sign.

; The E register is initialized to zero to denote not E-FORMAT 

L0ABE:  LD		E,000h					; signal not scientific notation.

	LD		A,(HL)					; fetch exponent byte
	DEC		A						; adjust to make zero 0FFh

	CP		049h						; compare to +9   e.g.  123456000.
	JR		NC,L0ACA				; skip forward if out of range.

	CP		03Ch						; compare to -4   e.g  .000123456
	JR		NC,L0ACE				; skip forward if in range.

; else E format printing will be used with decimal point after first digit.

L0ACA:  LD		(HL),041h				; make Data Stack exponent +1
	INC		A						; restore true exponent byte
	LD		E,A						; transfer to E.

; the branch was here when within range for normal printing.

L0ACE:  LD		A,040h					; test value is plus zero.
	SUB		(HL)					; subtract signed exponent.
	JR		C,L0ADC					; forward if positive

; exponent is negative so decimal point comes first. e.g. .001

	LD		B,A						; result of subtraction to B.
	INC		B						; B is now one less than count of 
					; leading zeros.

	LD		A,02Eh					; prepare '.'

L0AD7:  RST		08H						; print decimal point or zero.

	LD		A,030h					; prepare a zero - '0'

	DJNZ	L0AD7					; loop back to print leading zeros 
					; unless the counter was 1.

; the branch was here with positive exponent (and zero)
; now enter a loop to print each of the leading BCD digits
; the loop will end when the exponent is <= +0 and all 6 nibbles contain zero. 

L0ADC:  LD		A,040h					; set accumulator to plus 0
	CP		(HL)					; compare to exponent on data stack.
	SBC		A,A						; 0FFh if more leading digits else 000h.
	DEC		HL						; address first two nibbles.
	OR		(HL)					; combine.
	DEC		HL						; address next two nibbles.
	OR		(HL)					; combine.
	DEC		HL						; address last two nibbles.
	OR		(HL)					; combine.

	INC		HL						; adjust the pointer to
	INC		HL						; the start of the mantissa.

	JR		Z,L0AFC					; forward if all digits have been 
					; printed.

; else print each binary coded decimal in turn.

	XOR		A						; prepare to feed a zero nibble in.

	CALL	L0732					; routine shift_fp extracts the most 
					; significant nibble from the 3 bytes
					; also decrementing the exponent.

	ADD		A,030h					; convert to ASCII
	RST		08H						; print digit

	INC		HL						; point to reduced exponent.
	LD		A,(HL)					; fetch to accumulator and
	CP		040h						; compare to zero.

	JR		NZ,L0ADC				; loop back while more digits.

; else this is the place to print the mid or trailing decimal point.

	LD		A,02Eh					; prepare '.'
	RST		08H						; print it.

	JR		L0ADC					; loop back for end test and any digits
					; following the decimal point.

; ---

; the branch was to here when all digits of the mantissa have been printed.

L0AFC:  LD		A,E						; fetch the exponent format flag - from
					; the E register appropriately.
	AND		A						; test for zero - normal format.
	JR		NZ,L0B05				; forward to E_FORMAT if not.

	LD		A,020h					; else prepare a space
	RST		08H						; print it

	JR		L0B10					; forward to delete the two words from 
					; the data stack and exit.

; ---

; this branch deals with scientific notation. The accumulator holds the
; original exponent. 001h-03Ch (negative) 049h-07Fh (positive).

L0B05:  SUB		041h						; convert to signed 8-bit.
	LD		L,A						; low order byte to L.
	SBC		A,A						; 0FFh negative or 000h positive
	LD		H,A						; set the high order byte.

	LD		A,045h					; prepare a 'E'
	RST		08H						; print it

	CALL	L180E					; routine pr_int_hl prints the signed 
					; integer followed by a space.

; finally delete the floating point number from the Data Stack.


L0B10:  RST		18H						; unstack word DE
	RST		18H						; unstack word DE

	JP		(IY)					; to 'next'.

; -------------
; THE 'AT' WORD
; -------------
; (line, column -- )
; Sets print position to line and column numbers on the stack.
; There are 23 lines (0 to 22) and 32 columns (0 to 31). The
; column number is taken modulo 32, and ERROR 9 if trying to print
; in the input buffer at the bottom.

L0B14:  DEFB	'A'						; 'name field'
	DEFB	'T'+080h

	DEFW	L0AAE					; 'link field'

L0B18:  DEFB	002h						; 'name length field'

	DEFW	L0B1B					; 'code field'

; ---

L0B1B:  RST		18H						; pop word DE

	CALL	L084E					; stk_to_bc

	LD		A,C

	CALL	L0B28					;

	LD		(SCRPOS),HL				; update system variable SCRPOS

	JP		(IY)					; to 'next'.

; ---

; plotsub

L0B28:  ADD		A,020h
	LD		L,A
	LD		H,001h
	ADD		HL,HL
	ADD		HL,HL
	ADD		HL,HL
	ADD		HL,HL
	ADD		HL,HL
	LD		D,000h
	LD		A,E
	AND		01Fh
	LD		E,A
	ADD		HL,DE
	LD		DE,(L_HALF)				; fetch start of lower half from L_HALF
	SBC		HL,DE
	ADD		HL,DE
	RET		C

;

	RST		20H						; Error 9
	DEFB	009h						; Erroneous 'AT' Command.

; ---------------
; THE 'PLOT' WORD
; ---------------
; (x, y, n -- )
; Plots pixel (x, y) with plot mode n.
; n =   0		unplot
;		1		plot
;		2		move
;		3		change
; If n>3, takes value modulo 4.

L0B43:  DEFM	"PLO"					; 'name field'
	DEFB	'T'+080h

	DEFW	L0B18					; 'link field'

L0B49:  DEFB	004h						; 'name length field'

	DEFW	L0B4C					; 'code field'

; ---

L0B4C:  CALL	L084E					; stk_to_bc

	RST		18H						; pop word DE
	LD		(IX+030h),E				; YCOORD
	SRL		E
	RL		C
	LD		A,016h					; 24
	SUB		E

	RST		18H						; pop word DE
	LD		(IX+02Fh),E				; XCOORD
	SRL		E
	RL		C

	CALL	L0B28					;

	LD		A,(HL)
	AND		078h						; 01111000
	CP		010h
	LD		A,(HL)
	JR		Z,L0B6F					;

	LD		A,010h

L0B6F:  LD		E,A
	LD		D,087h
	LD		A,C
	AND		003h
	LD		B,A
	JR		Z,L0B7F					;

	CPL

	ADD		A,002h
	ADC		A,003h
	LD		D,A
	LD		B,E
L0B7F:  LD		A,C
	RRCA
	RRCA
	RRCA
	SBC		A,A
	BIT		3,C
	JR		NZ,L0B8C				;
	XOR		E
	RLCA
	SBC		A,A
	XOR		B

L0B8C:  AND		D
	XOR		E
	LD		(HL),A
	JP		(IY)					; to 'next'.

; ---------------
; THE 'BEEP' WORD
; ---------------
; ( m, n --  )
; Plays a note on the loudspeaker. 8 * m = period in microseconds,
; n = time in milliseconds.

L0B91:  DEFM	"BEE"					; 'name field'
	DEFB	'P'+080h

	DEFW	L0B49					; 'link field'

L0B97:  DEFB	004h						; 'name length field'

	DEFW	L0EC3					; 'code field'  m, n.

; ---

L0B9A:  DEFW	L0912					; OVER			m, n, m.
	DEFW	L104B					; stk-data		m, n, m, 125.
	DEFB	07Dh						;  (125)
	DEFW	L0885					; SWAP			m, n, 125, m.
	DEFW	L0D7A					; */			m, (n*125)/m
	DEFW	L1A0E					; end

; ---

L0BA5:  RST		18H						; pop word DE

	CALL	L084E					; stk_to_bc

	LD		HL,000F9h				;
	ADD		HL,BC					;
	INC		L						;

	DI								; Disable Interrupts.

L0BAF:  LD		A,07Fh					; place 07FFEh on address bus and read
	IN		A,(0FEh)					; from port, pushing the loudspeaker
					; diaphragm in.

	RRCA							; test the read 'SPACE' key bit.

	JR		NC,L0BC7				; forward if BREAK pressed.

	CALL	L0BC9					; routine delay_HL

	DEC		DE						; decrement counter.

	LD		A,D						; all even addresses are reserved for 
					; Jupiter Ace so any value does for the
					; high order byte. 0FEh is low value.

	OUT		(0FEh),A					; push the loudspeaker diaphragm out.

	CALL	L0BC9					; routine delay_HL

	OR		E						; test for counter DE reaching zero.
	JP		NZ,L0BAF				; loop back if not.

	EI								; Enable Interrupts.

	JP		(IY)					; to 'next'.

; ---

L0BC7:  RST		20H						; Error 3
	DEFB	003h						; BREAK pressed.

; ---------------------------
; THE 'BEEP DELAY' SUBROUTINE
; ---------------------------
; called twice from the above BEEP routine.

L0BC9:  LD		B,L						; transfer the value of
	LD		C,H						; the HL register to BC.

L0BCB:  DJNZ	L0BCB					; self-loop for B times

	DEC		B						; set B to 0FFh for future loops
	DEC		C						; decrement outer loop counter C
	JP		NZ,L0BCB				; JUMP back if not zero			(10)

	RET								; return

; ----------------
; THE 'INKEY' WORD
; ----------------
; ( -- ASCII code)
; Reads the keyboard. Puts ASCII value on the stack if a key is pressed, 0
; otherwise.


L0BD3:  DEFM	"INKE"					; 'name field'
	DEFB	'Y'+080h

	DEFW	L0B97					; 'link field'

L0BDA:  DEFB	005h						; 'name length field'

L0BDB:  DEFW	L0BDD					; 'code field'

; ---

L0BDD:  CALL	L0336					; routine KEY-SCAN

	LD		E,A						; transfer the key code to E.
	LD		D,000h					; make high order byte zero.

	RST		10H						; stack Data Word DE

	JP		(IY)					; to 'next'.

; -------------
; THE 'IN' WORD
; -------------
; (port address -- data byte)
; Inputs a data byte from an I/O port.

L0BE6:  DEFB	'I'						; 'name field'
	DEFB	'N'+080h

	DEFW	L0BDA					; 'link field'

L0BEA:  DEFB	002h						; 'name length field'

	DEFW	L0BED					; 'code field'

; ---

L0BED:  CALL	L084E					; stk_to_bc
	LD		D,000h					; make high order byte zero.

	IN		E,(C)					; read the port to E.

	RST		10H						; stack Data Word DE.

L0BF5:  JP		(IY)					; to 'next'.

; --------------
; THE 'OUT' WORD
; --------------
; (data byte, port address -- )
; Outputs a data byte to an I/O port.

L0BF7:  DEFM	"OU"					; 'name field'
	DEFB	'T'+080h

	DEFW	L0BEA					; 'link field'

L0BFC:  DEFB	003h						; 'name length field'

	DEFW	L0BFF					; 'code field'

; ---

L0BFF:  CALL	L084E					; stk_to_bc
					; all 16 bits are placed on the
					; Z80A address bus.
	RST		18H						; pop word DE

	OUT		(C),E					; output byte to port address.

	JP		(IY)					; to 'next'.

; --------------
; THE 'ABS' WORD
; --------------
; (n -- absolute value of n)

L0C07:  DEFM	"AB"					; 'name field'
	DEFB	'S'+080h

	DEFW	L0BFC					; 'link field'

L0C0C:  DEFB	003h						; 'name length field'

L0C0D:  DEFW	L0EC3					; 'code field' - docolon

; ---

	DEFW	L086B					; DUP
	DEFW	L0D94					; pos
	DEFW	L04B6					; EXIT

; -------------
; THE '0=' WORD
; -------------
; (n -- flag)
; flag is 1 in n = 0.

L0C15:  DEFB	'0'						; 'name field'
	DEFB	'='+080h

	DEFW	L0C0C					; 'link field'

L0C19:  DEFB	002h						; 'name length field'

L0C1A:  DEFW	L0C1C					; 'code field'

; ---

L0C1C:  RST		18H						; pop word DE
	LD		A,D						; test for
	OR		E						; zero
	CP		001h						; sets carry if word is zero

; -> zero_or_one

L0C21:  LD		A,000h					; make accumulator zero.
	LD		D,A						; set D to zero
	RLA								; pick up carry (1/0)
	LD		E,A						; set DE to one or zero
	RST		10H						; push word DE

	JP		(IY)					; to 'next'.

; -------------
; THE '0<' WORD
; -------------
; (n -- flag)
; flag is 1 if n is negative

L0C29:  DEFB	'0'						; 'name field'
	DEFB	'<'+080h

	DEFW	L0C19					; 'link field'

L0C2D:  DEFB	002h						; 'name length field'

L0C2E:  DEFW	L0C30					; 'code field'

; ---

L0C30:  RST		18H						; pop word DE
	RL		D						; test the sign bit.

	JR		L0C21					; back to above routine to stack the
					; carry as one (true) or zero (false).

; -------------
; THE '0>' WORD
; -------------
; (n -- flag)
; flag is 1 if n is positive.


L0C35:  DEFB	'0'						; 'name field'
	DEFB	'>'+080h

	DEFW	L0C2D					; 'link field'

L0C39:  DEFB	002h						; 'name length field'

L0C3A:  DEFW	L0C3C					; 'code field'

; ---

L0C3C:  RST		18H						; pop word DE
	LD		A,D
	OR		E
	JR		Z,L0C21					; to stack word one or zero

	RL		D
	CCF
	JR		L0C21					; to stack word one or zero

; ------------
; THE '=' WORD
; ------------
; (n1, n2 -- flag)
; flag is 1 if n1=n2.

L0C46:  DEFB	'='+080h				; 'name field'

	DEFW	L0C39					; 'link field'

L0C49:  DEFB	001h						; 'name length field'

L0C4A:  DEFW	L0EC3					; 'code field' - docolon

; ---

L0C4C:  DEFW	L0DE1					; -
	DEFW	L0C1A					; 0=
	DEFW	L04B6					; exit

; ------------
; THE '>' WORD
; ------------
; (n1, n2 -- flag)
; flag is 1 if n1>n2.

L0C52:  DEFB	'>'+080h				; 'name field'

	DEFW	L0C49					; 'link field'

L0C55:  DEFB	001h						; 'name length field'

L0C56:  DEFW	L0C58					; 'code field'

; ---

L0C58:  RST		18H						; pop word DE
	PUSH	DE						;
	RST		18H						; pop word DE
	POP		HL						;

	CALL	L0C99					;

	JR		L0C21					; to stack word one or zero

; ------------
; THE '<' WORD
; ------------
; (n1, n2 -- flag)
; flag is 1 if n1 < n2.

L0C61:  DEFB	'<'+080h				; 'name field'

	DEFW	L0C55					; 'link field'

L0C64:  DEFB	001h						; 'name length field'

L0C65:  DEFW	L0EC3					; 'code field' - docolon

; ---

	DEFW	L0885					; swap
	DEFW	L0C56					; >
	DEFW	L04B6					; exit


; -------------
; THE 'U<' WORD
; -------------
; (un1, un2 -- flag)
; The flag is 1 if, of the two unsigned single length integers, un1 is less
; than un2.

L0C6D:  DEFB	'U'						; 'name field'
	DEFB	'<'+080h

	DEFW	L0C64					; 'link field'

L0C71:  DEFB	002h						; 'name length field'

L0C72:  DEFW	L0C74					; 'code field'

; ---

L0C74:  CALL	L084E					; stk_to_bc

L0C77:  RST		18H						; pop word DE
	EX		DE,HL
	AND		A
	SBC		HL,BC
	JR		L0C21					; to stack word one or zero

; -------------
; THE 'D<' WORD
; -------------
; (d1, d2 -- flag)
; flag is 1 if the signed double integer, d1 < d2.

L0C7E:  DEFB	'D'						; 'name field'
	DEFB	'<'+080h

	DEFW	L0C71					; 'link field'

L0C82:  DEFB	002h						; 'name length field'

L0C83:  DEFW	L0C85					; 'code field'

; ---

L0C85:  RST		18H						; pop word DE
	PUSH	DE
	CALL	L084E					; stk_to_bc
	RST		18H						; pop word DE
	POP		HL
	AND		A
	SBC		HL,DE
	JR		Z,L0C77					;

	ADD		HL,DE
	EX		DE,HL

	CALL	L0C99					;

	RST		18H						; pop word DE
	JR		L0C21					; to stack word one or zero

; ---
; THE 'sign?' SUBROUTINE
; ---

L0C99:  LD		A,H
	XOR		D
	JP		M,L0CA0					;

	SBC		HL,DE

L0CA0:  RL		H
	RET

; -------------
; THE 'U*' WORD
; -------------
; (un1, un2 -- double length(un1 * un2))
; Multiplies two unsigned single length integers to give an unsigned
; double length product.

L0CA3:  DEFB	'U'						; 'name field'
	DEFB	'*'+080h

	DEFW	L0C82					; 'link field'

L0CA7:  DEFB	002h						; 'name length field'

L0CA8:  DEFW	L0CAA					; 'code field'

; => mult

L0CAA:  RST		18H						; pop word DE
	CALL	L084E					; stk_to_bc
	LD		HL,00000h
	LD		A,010h
L0CB3:  ADD		HL,HL
	EX		DE,HL
	ADC		HL,HL
	EX		DE,HL
	JR		NC,L0CBE				;

	ADD		HL,BC
	JR		NC,L0CBE				;

	INC		DE

L0CBE:  DEC		A
	JR		NZ,L0CB3				;

	EX		DE,HL
	JR		L0CF3					;

; ---
; The 'div?' Internal Word
; ---

L0CC4:  DEFW	L0CC6

L0CC6:  RST		18H						; pop word DE
	EXX
	RST		18H						; pop word DE
	PUSH	DE
	RST		18H						; pop word DE
	POP		HL
	LD		A,H
	OR		L
	LD		A,021h					; 33
	JR		NZ,L0CD5				;

	EX		DE,HL
	LD		A,011h					; 17

L0CD5:  EXX
	LD		B,A
	XOR		A
	LD		H,A
	LD		L,A
	LD		C,A

L0CDB:  ADC		HL,HL
	SBC		A,A
	AND		A
	SBC		HL,DE
	SBC		A,C
	JR		NC,L0CE5				;
	ADD		HL,DE

L0CE5:  CCF
	EXX
	EX		DE,HL
	ADC		HL,HL
	EX		DE,HL
	ADC		HL,HL
	EXX
	DJNZ	L0CDB					;

	EX		DE,HL
	RST		10H						; push word DE
	EXX

L0CF3:  PUSH	HL
	RST		10H						; push word DE
	POP		DE
	RST		10H						; push word DE

	JP		(IY)					; to 'next'.

; ---------------
; THE '/MOD' WORD
; ---------------
; (n1, n2 -- remainder, quotient of n1/n2)
; The remainder has the same sign as the dividend n1.

L0CF9:  DEFM	"/MO"					; 'name field'
	DEFB	'D'+080h

	DEFW	L0CA7					; 'link field'

L0CFF:  DEFB	004h						; 'name length field'

L0D00:  DEFW	L0EC3					; 'code field' - docolon

; ---

L0D02:  DEFW	L0885					; swap
	DEFW	L08D2					; >R
	DEFW	L12E9					; I
	DEFW	L0C0D					; abs
	DEFW	L104B					; stk_data
	DEFB	000h						; zero
; ->
L0D0D:  DEFW	L08FF					; rot
	DEFW	L086B					; dup
	DEFW	L12E9					; I
	DEFW	L0E60					; xor
	DEFW	L08D2					; >R
	DEFW	L0C0D					; abs
	DEFW	L0D8C					; U/MOD
	DEFW	L08DF					; >R
	DEFW	L0D94					; pos
	DEFW	L0885					; swap
	DEFW	L08DF					; >R
	DEFW	L0D94					; pos
	DEFW	L0885					; swap
	DEFW	L04B6					; exit

; ----------------
; THE '*/MOD' WORD
; ----------------
; (n1, n2, n3 -- remainder, quotient of (n1 * n2)/n3)
; As in */, n1 * n2 is held to double length.

L0D29:  DEFM	"*/MO"					; 'name field'
	DEFB	'D'+080h

	DEFW	L0CFF					; 'link field'

L0D30:  DEFB	005h						; 'name length field'

L0D31:  DEFW	L0EC3					; 'code field' - docolon

; ---

	DEFW	L08FF					; rot
	DEFW	L08D2					; >R
	DEFW	L12E9					; I
	DEFW	L0C0D					; abs
	DEFW	L08FF					; rot
	DEFW	L086B					; dup
	DEFW	L08DF					; >R
	DEFW	L0E60					; xor
	DEFW	L08D2					; >R
	DEFW	L0C0D					; abs
	DEFW	L0CA8					; u*
	DEFW	L1276					; branch

L0D4B:  DEFW	0FFC1h					; back to L0D0D  (in /MOD)




; ------------
; THE '/' WORD
; ------------
; (n1, n2 -- n1/n2)
; Single length signed integer division.

L0D4D:  DEFB	'/'+080h				; 'name field'

	DEFW	L0D30					; 'link field'

L0D50:  DEFB	001h						; 'name length field'

L0D51:  DEFW	L0EC3					; 'code field' - docolon

; ---

L0D53:  DEFW	L0D00					; /MOD
	DEFW	L0885					; swap
	DEFW	L0879					; drop
	DEFW	L04B6					; exit

; --------------
; THE 'MOD' WORD
; --------------
; (n1, n2 -- remainder n1/n2)
; The remainder has the same sign as the dividend.

L0D5B:  DEFM	"MO"					; 'name field'
	DEFB	'D'+080h

	DEFW	L0D50					; 'link field'

L0D60:  DEFB	003h						; 'name length field'

L0D61:  DEFW	L0EC3					; 'code field' - docolon

; ---

	DEFW	L0D00					; /MOD
	DEFW	L0879					; drop
	DEFW	L04B6					; exit


; ------------
; THE '*' WORD
; ------------
; (n1, n2 -- n1*n2)

L0D69:  DEFB	'*'+080h				; 'name field'

	DEFW	L0D60					; 'link field'

L0D6C:  DEFB	001h						; 'name length field'

	DEFW	L0EC3					; 'code field' - docolon

; ---

	DEFW	L0CA8					; u*
	DEFW	L0879					; drop
	DEFW	L04B6					; exit


; -------------
; THE '*/' WORD
; -------------
; (n1, n2, n3 -- (n1*n2)/n3)
; The intermediate product n1*n2 is held to double length.

L0D75:  DEFB	'*'						; 'name field'
	DEFB	'/'+080h

	DEFW	L0D6C					; 'link field'

L0D79:  DEFB	002h						; 'name length field'

L0D7A:  DEFW	L0EC3					; 'code field' - docolon

; ---

	DEFW	L0D31					; */MOD
	DEFW	L0885					; swap
	DEFW	L0879					; drop
	DEFW	L04B6					; exit

; --------------
; THE 'U/MOD' WORD
; --------------
; (ud1, un2 -- un3, un4)
; In unsigned arithmetic throughout, divides the double length integer ud1
; by the single length integer un2 to give a single length remainder un3
; and a single length quotient un4.

L0D84:  DEFM	"U/MO"					; 'name field'
	DEFB	'D'+080h

	DEFW	L0D79					; 'link field'

L0D8B:  DEFB	005h						; 'name length field'

L0D8C:  DEFW	L0EC3					; 'code field' - docolon

; ---

L0D8E:  DEFW	L0CC4					; div?
	DEFW	L0879					; drop
	DEFW	L04B6					; exit

; ---

; make positive

L0D94:  DEFW	L0EC3					; 'code field' - docolon

; ---

L0D96:  DEFW	L0C2E					; 0<
	DEFW	L1283					; ?branch				(if false)
L0D9A:  DEFW	00003h					; to L0D9E

	DEFW	L0DA9					; negate

L0D9E:  DEFW	L04B6					; exit

; -----------------
; THE 'NEGATE' WORD
; -----------------
; (n -- -n)


L0DA0:  DEFM	"NEGAT"					; 'name field'
	DEFB	'E'+080h

	DEFW	L0D8B					; 'link field'

L0DA8:  DEFB	006h						; 'name length field'

L0DA9:  DEFW	L0DAB					; 'code field'

; ---

L0DAB:  LD		BC,00002h				; 
	JR		L0DBF					;

; ------------------
; THE 'DNEGATE' WORD
; ------------------
; (d -- -d)
; Double length integer negation.

L0DB0:  DEFM	"DNEGAT"				; 'name field'
	DEFB	'E'+080h

	DEFW	L0DA8					; 'link field'

L0DB9:  DEFB	007h						; 'name length field'

L0DBA:  DEFW	L0DBC					; 'code field'

; ---

L0DBC:  LD		BC,00004h

; NEGATE joins here with bc=2

L0DBF:  LD		HL,(SPARE)				; SPARE
	AND		A
	SBC		HL,BC

L0DC5:  LD		A,B
	SBC		A,(HL)
	LD		(HL),A
	INC		HL
	DEC		C
	JR		NZ,L0DC5				;

	JP		(IY)					; to 'next'.

; ------------
; THE '+' WORD
; ------------
; (n1, n2 -- n1 + n2)

L0DCE:  DEFB	'+'+080h				; 'name field'

	DEFW	L0DB9					; 'link field'

L0DD1:  DEFB	001h						; 'name length field'

L0DD2:  DEFW	L0DD4					; 'code field'

; ---

L0DD4:  RST		18H						; pop word DE
	PUSH	DE						; save on machine stack
	RST		18H						; pop word DE
	POP		HL						; first number to HL

	ADD		HL,DE					; the actual addition

	EX		DE,HL					; result to DE
	RST		10H						; push word DE

	JP		(IY)					; to 'next'.

; ------------
; THE '-' WORD
; ------------
; (n1, n2 -- n1-n2)
; flip the sign and do a plus.

L0DDD:  DEFB	'-'+080h				; 'name field'

	DEFW	L0DD1					; 'link field'

L0DE0:  DEFB	001h						; 'name length field'

L0DE1:  DEFW	L0EC3					; 'code field' - docolon

; ---

L0DE3:  DEFW	L0DA9					; negate
	DEFW	L0DD2					; +
	DEFW	L04B6					; exit

; -------------
; THE 'D+' WORD
; -------------
; (d1, d2 -- d1 + d2)
; double length integer addition.

L0DE9:  DEFB	'D'						; 'name field'
	DEFB	'+'+080h

	DEFW	L0DE0					; 'link field'

L0DED:  DEFB	002h						; 'name length field'

L0DEE:  DEFW	L0DF0					; 'code field'

; ---

L0DF0:  RST		18H						; pop word DE

	PUSH	DE
	CALL	L084E					; stk_to_bc
	RST		18H						; pop word DE
	PUSH	DE
	RST		18H						; pop word DE
	EX		DE,HL
	ADD		HL,BC
	EX		DE,HL
	RST		10H						; push word DE
	POP		BC
	POP		HL
	ADC		HL,BC
	EX		DE,HL
	RST		10H						; push word DE

	JP		(IY)					; to 'next'.

; -------------
; THE '1+' WORD
; -------------
; (n -- n+1)

L0E04:  DEFB	'1'						; 'name field'
	DEFB	'+'+080h

	DEFW	L0DED					; 'link field'

L0E08:  DEFB	002h						; 'name length field'

L0E09:  DEFW	L0E0B					; 'code field'

; ---

L0E0B:  RST		18H						; get word 'n' in DE
	JR		L0E17					; forward to increment and stack

; -------------
; THE '2+' WORD
; -------------
; (n -- n+2)

L0E0E:  DEFB	'2'						; 'name field'
	DEFB	'+'+080h

	DEFW	L0E08					; 'link field'

L0E12:  DEFB	002h						; 'name length field'

L0E13:  DEFW	L0E15					; 'code field'

; ---

L0E15:  RST		18H						; get word 'n' in DE.
	INC		DE						; increment n					(4)
; ->
L0E17:  INC		DE						; increment n					(4)
	JR		L0E2E					; forward to push word DE and exit

; -------------
; THE '1-' WORD
; -------------
; (n -- n-1)


L0E1A:  DEFB	'1'						; 'name field'
	DEFB	'-'+080h

	DEFW	L0E12					; 'link field'

L0E1E:  DEFB	002h						; 'name length field'

L0E1F:  DEFW	L0E21					; 'code field'

; ---

L0E21:  RST		18H						;
	JR		L0E2D					;

; -------------
; THE '2-' WORD
; -------------
; (n -- n-2)


L0E24:  DEFB	'2'						; 'name field'
L0E25:  DEFB	'-'+080h

L0E26:  DEFW	L0E1E					; 'link field'

L0E28:  DEFB	002h						; 'name length field'

L0E29:  DEFW	L0E2B					; 'code field'

; ---

;
L0E2B:  RST		18H
	DEC		DE

; ->
L0E2D:  DEC		DE

; ->
L0E2E:  RST		10H						; push word DE

	JP		(IY)					; to 'next'.

; -------------
; THE 'OR' WORD
; -------------
; (n1, n2 -- n1 OR n2)
; Bitwise Boolean operation.


L0E31:  DEFB	'O'						; 'name field'
	DEFB	'R'+080h

	DEFW	L0E28					; 'link field'

L0E35:  DEFB	002h						; 'name length field'

L0E36:  DEFW	L0E38					; 'code field'

; ---

L0E38:  RST		18H						; pop word DE
	CALL	L084E					; stk_to_bc

	LD		A,E						;
	OR		C						; OR low order bytes
	LD		E,A						;

	LD		A,D						;
	OR		B						; OR high order bytes
	LD		D,A						;

	RST		10H						; push word DE

	JP		(IY)					; to 'next'.

; --------------
; THE 'AND' WORD
; --------------
; (n1, n2 -- n1 AND n2)
; Bitwise Boolean operation.


L0E45:  DEFM	"AN"					; 'name field'
	DEFB	'D'+080h

	DEFW	L0E35					; 'link field'

L0E4A:  DEFB	003h						; 'name length field'

	DEFW	L0E4D					; 'code field'

; ---

L0E4D:  RST		18H
	CALL	L084E					; stk_to_bc

	LD		A,E						;
	AND		C						;
	LD		E,A						;

	LD		A,D						;
	AND		B						;
	LD		D,A						;

	RST		10H						; push word DE
	JP		(IY)					; to 'next'.

; --------------
; THE 'XOR' WORD
; --------------
; (n1, n2 -- n1 XOR n2)
; Bitwise Boolean XOR (exclusive or)

L0E5A:  DEFM	"XO"					; 'name field'
	DEFB	'R'+080h

	DEFW	L0E4A					; 'link field'

L0E5F:  DEFB	003h						; 'name length field'

L0E60:  DEFW	L0E62					; 'code field'

; ---

L0E62:  RST		18H
	CALL	L084E					; stk_to_bc

	LD		A,E						;
	XOR		C						;
	LD		E,A						;

	LD		A,D						;
	XOR		B						;
	LD		D,A						;

	RST		10H						; push word DE
	JP		(IY)					; to 'next'.

; --------------
; THE 'MAX' WORD
; --------------
; (n1, n2 -- max (n1, n2))
; Calculates the larger of two numbers.

L0E72:  DEFM	"MA"					; 'name field'
	DEFB	'X'+080h

	DEFW	L0E5F					; 'link field'

L0E74:  DEFB	003h						; 'name length field'

L0E75:  DEFW	L0EC3					; 'code field' - docolon

; ---

L0E77:  DEFW	L0912					; over
	DEFW	L0912					; over
	DEFW	L0C65					; <
	DEFW	L1271					; branch
L0E7F:  DEFW	0000Fh					; forward to L0E8F

; --------------
; THE 'MIN' WORD
; --------------
; (n1, n2 -- min (n1, n2))
; Calculates the smaller of two numbers.

L0E81:  DEFM	"MI"					; 'name field'
	DEFB	'N'+080h

	DEFW	L0E74					; 'link field'

L0E86:  DEFB	003h						; 'name length field'

	DEFW	L0EC3					; 'code field' - docolon

; ---

L0E89:  DEFW	L0912					; over
	DEFW	L0912					; over
	DEFW	L0C56					; >
; ->
L0E8F:  DEFW	L1283					; ?branch
L0E91:  DEFW	00003h					; forward to L0995

	DEFW	L0885					; swap

L0995:  DEFW	L0879					; drop
	DEFW	L04B6					; exit

; ------------------
; THE 'DECIMAL' WORD
; ------------------
; (  --  )
; Sets the system number base to ten.

L0E99:  DEFM	"DECIMA"				; 'name field'
	DEFB	'L'+080h

	DEFW	L0E86					; 'link field'

L0EA2:  DEFB	007h						; 'name length field'

	DEFW	L0EA5					; 'code field'

; ---

L0EA5:  LD		(IX+03Fh),00Ah			; update system variable BASE to 10

	JP		(IY)					; to 'next'.

; ------------
; THE ':' WORD
; ------------
; Introduces colon definitions.

L0EAB:  DEFB	':'+080h				; 'name field'

	DEFW	L0EA2					; 'link field'

L0EAE:  DEFB	001h						; 'name length field'

L0EAF:  DEFW	L1085					; 'code field' - create and enclose

; ---

L0EB1:  DEFW	L0EC3					; do_colon

	DEFW	L104B					; stk_data
	DEFB	00Ah						; ten					marker byte?
; ->
L0EB6:  DEFW	L1A0E					; end_forth

L0EB8:  LD		HL,FLAGS				; FLAGS

	LD		A,(HL)					; update bits 6 and 2.
	OR		044h						; signal in compile mode, definition
					; incomplete.
	LD		(HL),A					; update FLAGS.

	JP		(IY)					; to 'next'.

; ---

x0EC1:   DEFB	0E9h						;;
x0Ec2:   DEFB	0FFh						;; 0ec2 + ffe9 =  0eab = ':'

; -------------------------------
; THE 'ENTER' or 'DOCOLON' action
; -------------------------------
;

L0EC3:  EX		DE,HL					;
	JP		L04BA					;


; -----------------
; THE 'CREATE' WORD
; -----------------
; CREATE name
; (  --  )
; Defines a new word with a header and an empty parameter field.
; When executed, the new word stacks its parameter field address.

L0EC7:  DEFM	"CREAT"					; 'name field'
	DEFB	'E'+080h

	DEFW	L0EAE					; 'link field'

L0ECF:  DEFB	006h						; 'name length field'

L0ED0:  DEFW	L0EC3					; 'code field' - docolon

; ---

L0ED2:  DEFW	L104B					; stk_data
	DEFB	020h						; a space				delimiter
	DEFW	L05AB					; word to pad
	DEFW	L0EFB					; get-name				in dict
	DEFW	L0688					; stk-zero				link
	DEFW	L0F4E					; ,
	DEFW	L0480					; current
	DEFW	L08B3					; @
	DEFW	L086B					; dup
	DEFW	L08B3					; @
	DEFW	L0F4E					; ,
	DEFW	L0460					; here
	DEFW	L0885					; swap
	DEFW	L08C1					; !
	DEFW	L0499					; pad
	DEFW	L0896					; C@			fetch 1 byte
	DEFW	L0F5F					; C,
	DEFW	L1011					; stack next word
	DEFW	00FECh					; ???
	DEFW	L0F4E					; ,
L0EF9:  DEFW	L04B6					; exit

; ----------------------------
; The 'get_name' Internal Word
; ----------------------------
; Used only by the above CREATE thread.

L0EFB:  DEFW	L0EFD					; headerless 'code field'

; ---

L0EFD:  CALL	L0F2E					; blank stack

	RST		18H						; pop word DE

	LD		A,(DE)
	DEC		A						; zero becomes 0FFh
	CP		03Fh						; max length is 64
	JR		C,L0F09					; forward if n range 1 - 64.

	RST		20H						; Error 6
	DEFB	006h						; Name of new word too short or long.

; ---

L0F09:  ADD		A,008h					; allow for prev/len/addr 3 missing

	LD		C,A						;
	LD		B,000h					; length to BC

L0F0E:  CALL	L0F8C					; check free memory.

x0f11:   LD		A,(DE)					; true length to A
	LD		C,A						; and BC again

	LD		HL,(STKBOT)				; STKBOT

	PUSH	DE						;
	CALL	L0F9E					; routine MAKE ROOM
	POP		DE						;

	LD		A,(DE)					; length of word in pad
	LD		B,A						; transfer to counter.

L0F1D:  INC		DE						; increase source
	LD		A,(DE)					; fetch character

	CALL	L0807					; to_upper makes uppercase.

	LD		(HL),A					; store in dictionary
	INC		HL						; increase destination
	DJNZ	L0F1D					; loop back for all letters.

	LD		(DICT),HL				; store this location in SPARE
	DEC		HL						; step back to last letter of word.
	SET		7,(HL)					; and 'invert' it.
	JP		(IY)					; to 'next'.

; ---


L0F2E:  BIT		2,(IX+03Eh)				; test FLAGS incomplete definition ?
	JR		Z,L0F36					; forward if not.

	RST		20H						; Error 12
	DEFB	00Ch						; Incomplete definition in dictionary.

; ---

L0F36:  LD		HL,(STKBOT)				; fetch STKBOT
	LD		DE,(DICT)				; fetch SPARE

	XOR		A						; clear accumulator and carry flag

	SBC		HL,DE					; subtract

	EX		DE,HL					;
	LD		(HL),E					; place low byte at next STACK slot.
	INC		HL						;
	LD		(HL),D					; place high byte
	LD		H,A						; make HL zero
	LD		L,A						;
	LD		(DICT),HL				; update system variable SPARE to zero

	RET								; return

; ---------------------

; ------------
; THE ',' WORD
; ------------
; ( n --   )
; Encloses the single length integer in the dictionary.

L0F4A:  DEFB	","+080h				; 'name field'

	DEFW	L0ECF					; 'link field'

L0F4D:  DEFB	001h						; 'name length field'

L0F4E:  DEFW	L0EC3					; 'code field' - docolon

; ---

L0F50:  DEFW	L0F83					; allot2

	DEFW	L0460					; here
	DEFW	L0E29					; 2-
	DEFW	L08C1					; !
	DEFW	L04B6					; exit


; -------------
; THE 'C,' WORD
; -------------
; ( n --   )
; Encloses the less significant byte of n in the dictionary.

L0F5A:  DEFB	'C'						; 'name field'
	DEFB	","+080h

	DEFW	L0F4D					; 'link field'

L0F5E:  DEFB	002h						; 'name length field'

L0F5F:  DEFW	L0EC3					; 'code field' - docolon

; ---

L0F61:  DEFW	L104B					; stk-data
	DEFB	001h						; one
	DEFW	L0F76					; allot

x0f66:   DEFW	L0460					; here
	DEFW	L0E1F					; 1-
	DEFW	L08A5					; C!
	DEFW	L04B6					; exit

; ----------------
; THE 'ALLOT' WORD
; ----------------
; (n -- )
; Encloses n bytes in the dictionary, without initializing them.

L0F6E:  DEFM	"ALLO"					; 'name field'
	DEFB	'T'+080h

	DEFW	L0F5E					; 'link field'

L0F75:  DEFB	005h						; 'name length field'

L0F76:  DEFW	L0F78					; 'code field'

; ---

L0F78:  CALL	L084E					; stk_to_bc
	LD		HL,(STKBOT)				; STKBOT
	CALL	L0F9E					; routine MAKE ROOM
	JP		(IY)					; to 'next'.

; --------------------------
; The 'allot2' Internal Word
; --------------------------
; Encloses 2 bytes in the dictionary, without initializing them.

L0F83:  DEFW	L0EC3					; headerless 'code field' - docolon

; ---

L0F85:  DEFW	L104B					; stk_data
	DEFB	002h						; two bytes required
	DEFW	L0F76					; allot
	DEFW	L04B6					; exit

; ----------------------------------
; THE 'DEFAULT MEMORY CHECK' ROUTINE
; ----------------------------------
; called each cycle in slow mode to check free memory.

L0F8C:  LD		HL,0001Eh				; Allow a thirty byte overhead.

; ----------------------------------
; THE 'CHECK FREE MEMORY' SUBROUTINE
; ----------------------------------

L0F8F:  PUSH	BC						; save bytes to check.

	ADD		HL,BC					;
	LD		BC,(SPARE)				; SPARE
	ADD		HL,BC					; carry indicates error - past 65535

	POP		BC						; restore number of bytes
	JR		C,L0F9C					; forward with error

	SBC		HL,SP					; now check against the return stack
					; (machine stack)
	RET		C						; return if value is less

L0F9C:  RST		20H						; Error 1
	DEFB	001h						; Not enough memory

; --------------------------
; THE 'MAKE ROOM' SUBROUTINE
; --------------------------

L0F9E:  EX		DE,HL					; first new location to DE
	LD		HL,00028h				; overhead 40 bytes.

L0FA2:  CALL	L0F8F					; check free memory.

; now increase the two data stack pointers.

	LD		HL,(STKBOT)				; fetch value of STKBOT
	ADD		HL,BC					; add required room.
	LD		(STKBOT),HL				; update STKBOT.

	LD		HL,(SPARE)				; fetch value of SPARE
	PUSH	HL						; take a copy of 'old' value
	ADD		HL,BC					; add required room.
	LD		(SPARE),HL				; update SPARE.

	EX		(SP),HL					; new SPARE value to stack,
					; old SPARE value to HL.
	PUSH	HL						; push old SPARE value.
	AND		A						; clear carry.

	SBC		HL,DE					; get length of stack and 12
	LD		B,H						;
	LD		C,L						;
	POP		HL						; old spare
	POP		DE						; new spare
	RET		Z						; return if same.

; else new SPARE must be higher than old spare.

	DEC		HL						; point to end of data stack
	DEC		DE						; adjust destination.
	LDDR							; copy the Data Stack + gap upwards.

L0FC2:  INC		HL						; point to first new location.

	RET								; return.

; -------------------
; THE 'VARIABLE' WORD
; -------------------
; VARIABLE name
; (n -- )
; Sets up a variable with the given name, and initializes its value to n.

L0FC4:  DEFM	"VARIABL"				; 'name field'
	DEFB	'E'+080h

	DEFW	L0F75					; 'link field'

L0FCE:  DEFB	008h						; 'name length field'

	DEFW	L1085					; 'code field' - create and enclose

; ---

L0FD1:  DEFW	L0FF0					; push word DE
	DEFW	L0F4E					; ,

	DEFW	L04B6					; exit

; -------------------
; THE 'CONSTANT' WORD
; -------------------
; CONSTANT name
; (n -- )
; Defines a constant with the given name and value n.

L0FD7:  DEFM	"CONSTAN"				; 'name field'
	DEFB	'T'+080h

	DEFW	L0FCE					; 'link field'

L0FE1:  DEFB	008h						; 'name length field'

L0FE2:  DEFW	L1085					; 'code field' - create and enclose

; ---

L0FE4:  DEFW	L0FF5					; pad??
	DEFW	L0F4E					; ,
	DEFW	L04B6					; exit

; ---
; ???

x0fea:   DEFB	0DCh						;;
x0feb:   DEFB	0FEh						;;  0feb + fedc = 0Ec7 = CREATE

; ->
L0FEC:  JR		L0FF0					; skip forward

x0fee:  DEFB	0D5h						;;
x0fef:   DEFB	0FFh						;;  0fef + ffd5 = 0fc4 = VARIABLE

; ---

L0FF0:  RST		10H						; push word DE
	JP		(IY)					; to 'next'.

; ---

x0FF3:   DEFB	0E3h						;;
x0ff4:   DEFB	0FFh						;;  0ff4 + ffe3 = 0fd7 = CONSTANT

; --> pad

L0FF5:  EX		DE,HL
	LD		E,(HL)
	INC		HL
	LD		D,(HL)
	RST		10H						; push word DE
	JP		(IY)					; to 'next'.

; ------------------
; THE 'LITERAL' WORD
; ------------------
; (n -- )
; Compiles the top of the stack into a word definition as a literal.
; Compiles integers. decimal 4102 = 01006h. c.f. 01055h

L0FFC:  DEFM	"LITERA"				; 'name field'
	DEFB	'L'+080h

	DEFW	L0FE1					; 'link field'

L1005:  DEFB	047h						; 'name length field'

L1006:  DEFW	L1108					; 'code field' - compile

; ---

L1008:  DEFW	L1011					; stack next word
	DEFW	L0F4E					; ,
	DEFW	L04B6					; exit

; ---

x100E:  DEFB	002h						;;
x100f:   DEFB	0FFh						;; 100f + ff02 = 0f11 nah!
x1010:   DEFB	0FFh						;;

; -----------------------------------
; The 'Stack Next Word' Internal Word
; -----------------------------------

L1011:  DEFW	L1013					; headerless 'code field'

; ---

L1013:  LD		B,001h					; counter - one word to push

L1015:  POP		HL						; drop the 'Next Word' pointer.
	LD		E,(HL)					; low byte to E.
	INC		HL						; increment pointer.
	LD		D,(HL)					; high byte to D.

; -> E B=1 (one byte op)

L1019:  INC		HL						; increment the 'Next Word' pointer

L101A:  PUSH	HL						; the 'Next Word' pointer goes to
					; the Return Stack.
	RST		10H						; stack Data Word DE
	DJNZ	L1015					; loop back if more than one.

L101E:  JP		(IY)					; to 'next'.


; ----------------
; THE 'ASCII' WORD
; ----------------
; Takes the next word from the input buffer, and yields the ASCII code
; of its first character. If compiling, then compiles this as a literal.
;
; e.g.		:STARS 0 DO ASCII * EMIT LOOP ;
; (--ASCII code)			(if interpreting)
; (--)					(if compiling)

L1020:  DEFM	"ASCI"					; 'name field'
	DEFB	'I'+080h

	DEFW	L1005					; 'link field'

L1027:  DEFB	045h						; 'name length field' (immediate mode)

L1029:  DEFW	L0EC3					; 'code field' - docolon

; ----------------

L102A:  DEFW	L104B					; stk_data
	DEFB	020h						; space delimiter
	DEFW	L05AB					; word  to pad
	DEFW	L0E09					; 1+
	DEFW	L0896					; C@
	DEFW	L1A0E					; end-forth.

	BIT		6,(IX+03Eh)				; FLAGS
	JR		Z,L101E					; back to a jp (iy)

	CALL	L04B9					; forth

L103E:  DEFW	L1011					; stack next word
	DEFW	L104B					; (stk_data)
	DEFW	L0F4E					; ,
	DEFW	L0F5F					; c,
	DEFW	L04B6					; exit

; ---

x1048:   DEFB	001h						;; ?

x1049:   DEFB	0D6h						;; ?
x104a:   DEFB	0FFh						;; ?  104a + ffd6 = 1020 = ASCII

; ----------------------------
; The 'stk-data' Internal Word
; ----------------------------
; used succinctly to stack the following byte as a word.

L104B:  DEFW	L104D					; headerless 'code field'

; ---

L104D:  POP		HL						; retrieve the 'Next Word' pointer.

	LD		E,(HL)					; fetch the single byte from there.
	LD		D,000h					; set high order byte to zero.

	LD		B,001h					; set counter to 1.

	JR		L1019					; back to stack one word and
					; put the incremented pointer back on
					; the Return Stack.

; --------------------------
; The 'stk_fp' Internal Word
; --------------------------
; stack and enclose a floating point number - two words.

L1055:  DEFW	L1108					; headerless 'code field' - compile

; ---

	DEFW	L1064					; stack two words.
	DEFW	L0885					; swap
	DEFW	L0F4E					; ,
	DEFW	L0F4E					; ,
	DEFW	L04B6					; exit
; ---

x1061:   DEFB	004h						;;
x1062:   DEFB	0FFh						;; 1062 + ff04 = 0f66 XX
x1063:   DEFB	0FFh						;;

; -----------------------------------
; The 'STACK TWO WORDS' Internal Word
; -----------------------------------

L1064:  DEFW	L1066					; headerless 'code field'

; ---

L1066:  LD		B,002h					; set counter to two

	JR		L1015					; back to stack 2 words


; -----------------
; THE 'DEFINER' WORD
; -----------------
; Used with 'DOES>' to define new defining words. i.e. words that themselves
; define new words.
; The format is
; DEFINER name
;		defining routine
; DOES>
;		action routine
; ;
; name is the name of the new defining word; when executed it will set up
; the header of a new word and use its defining routine to set up the
; parameter field. When this new word in its turn is executed, its parameter
; field will be put on the stack and the action routine will be executed.

L106A:  DEFM	"DEFINE"				; 'name field'
	DEFB	'R'+080h

	DEFW	L1027					; 'link field'

L1073:  DEFB	007h						; 'name length field'

L1074:  DEFW	L1085					; 'code field' - create and enclose

; ---

L1076:  DEFW	L1085					; create and enclose
	DEFW	L0460					; here

	DEFW	L104B					; stk-data

	DEFB	00Ch						; 12					marker byte

	DEFW	L0F83					; allot2
	DEFW	L1276					; branch
L1081:  DEFW	0FE34h					; back to L0EB6

; ---

x1083:   DEFB	0E6h						;;
x1084:   DEFB	0FFh						;; 1084 + ffe6 = 106a = DEFINER

; ---
;; createe and fill
; ----
; used seven times as a code word.

L1085:  CALL	L0FF0					; push word DE (save addr nxt wrd on DS)

	DEFW	L0ED0					; create
	DEFW	L086B					; dup
	DEFW	L08B3					; @
	DEFW	L0460					; here
	DEFW	L0E29					; 2-
	DEFW	L08C1					; !

L1094:  DEFW	L0E13					; 2+
	DEFW	L109A					; pop DE
	DEFW	L04B6					; exit

; -----------
; pop word DE
; -----------
; branch to addr on stack???

L109A:  DEFW	L109C					; headerless 'code field'

; ---

L109C:  RST		18H						; unstack Data Word DE

	JP		L0EC3					; start new thread.

; ---------------
; THE 'CALL' WORD
; ---------------
; (address -- )
; Executes Z80 machine code at address on the stack. The code is terminated
; by a jp (iy)
; e.g. in hex
; DEFINER CODE DOES> CALL ;
; CODE EI FB C, FD C, E9 C,
; The word EI will enable interrupts.

L10A0:  DEFM	"CAL"					; 'name field'
	DEFB	'L'+080h

	DEFW	L1073					; 'link field'

L10A6:  DEFB	004h						; 'name length field'

L10A7:  DEFW	L10A9					; 'code field'

; ---

L10A9:  RST		18H
	EX		DE,HL

	JP		(HL)

; ----------------
; THE 'DOES>' WORD
; ----------------
; See DEFINER.

L10AC:  DEFM	"DOES"					; 'name field'
	DEFB	'>'+080h

	DEFW	L10F4					; 'link field'

L10B3:  DEFB	045h						; 'name length field' (immediate mode)

L10B4:  DEFW	L1108					; 'code field' - compile

L10B6:  DEFW	L10E8					; exit

	DEFW	L12D8					; check??

	DEFB	00Ch						; 12	

	DEFW	L10CD					;
	DEFW	L104B					; stk_data

	DEFB	0CDh						; data					call ?

	DEFW	L0F5F					; C,
	DEFW	L1011					; stack next word
	DEFW	L0FF0					; (push word DE)
	DEFW	L0F4E					; ,
	DEFW	L104B					; stk-data

	DEFB	00Ah						; ten					marker byte.

	DEFW	L04B6					; exit

; -----------------------
; The '???' Internal Word
; -----------------------

L10CD:  DEFW	L0EC3					; headerless 'code field' - docolon

; ---

	DEFW	L086B					; dup
	DEFW	L0E29					; 2-
	DEFW	L15B5					; namefield
	DEFW	L0460					; here
	DEFW	L0DE1					; -
	DEFW	L0E1F					; 1-
	DEFW	L0F4E					; ,
	DEFW	L0460					; here
	DEFW	L0885					; swap
	DEFW	L08C1					; !
	DEFW	L04B6					; exit

; ---

x10e5:   DEFB	005h						;;

x10e6:   DEFB	0C5h						;;
x10e7:   DEFB	0FFh						;; 10e7 + ffc5 = 10ac = DOES>

; ---

L10E8:  DEFW	L04B8					; exit?

; -------------------
; THE 'COMPILER' WORD
; -------------------
; Used with 'RUNS>' for defining new compiling words, i.e. words that are
; used within word definitions to give an immediate effect of compiling
; some information into the dictionary.
; (This is traditionally done with IMMEDIATE, but COMPILER...RUNS> works
; better with EDIT etc.)

L10EA:  DEFM	"COMPILE"				; 'name field'
	DEFB	'R'+080h

	DEFW	L10A6					; 'link field'

L10F4:  DEFB	008h						; 'name length field'

L10F5:  DEFW	L1085					; 'code field' - create and enclose

; ---

	DEFW	L1108					; compile
	DEFW	L1160					; immediate
	DEFW	L0460					; here
	DEFW	L104B					; stk_data

L10FF:  DEFB	00Bh						; 11					marker byte

	DEFW	L0F83					; allot2
	DEFW	L1276					; branch
L1104:  DEFW	0FDB1h					; back to L0EB6

; ---

x1106:   DEFB	0E3h						;;
x1107:   DEFB	0FFh						;; 1107 + ffe3 = 10ea = COMPILER

; ---------------------
; THE 'COMPILE' ROUTINE
; ---------------------
; Instead of executing code words as they are encountered, lay them down in
; the dictionary along with any parameters.

L1108:  BIT		6,(IX+03Eh)				; test FLAGS - compiler mode ?
	JR		NZ,L1110				; skip error if so.

	RST		20H						; Error 4.
	DEFB	004h						; Compiling word used in interpret mode.

L1110:  CALL	L0FF0					; push word DE (then jp (iy))

	DEFW	L086B					; dup
	DEFW	L08B3					; @
	DEFW	L0F4E					; ,
	DEFW	L1276					; branch
L111B:  DEFW	0FF78h					; to L1094 - definer code

; ----------------
; THE 'RUNS>' WORD
; ----------------
; See COMPILER

L111D:  DEFM	"RUNS"					; 'name field'
	DEFB	'>'+080h

	DEFW	L10B3					; 'link field'

L1124:  DEFB	045h						; 'name length field' (immediate mode)

L1125:  DEFW	L1108					; 'code field' - compile

; ---

L1127:  DEFW	L1140					; vv
	DEFW	L12D8					; check-for
	DEFB	00Bh						; 11					marker byte.
	DEFW	L0885					; swap
	DEFW	L0F5F					; c,
	DEFW	L10CD					; ?
	DEFW	L1011					; stack next word
	DEFW	L1142
	DEFW	L0F4E					; ,

	DEFW	L104B					; stk-data
	DEFB	00Ah						; ten.					marker byte.
	DEFW	L04B6					; exit

; ---

x113d:   DEFB	005h						;;

x113e:   DEFB	0DEh						;;
x113f:   DEFB	0FFh						;; 113f + ffde = 111d = RUNS>

; ---

L1140:  DEFW	L04B8

L1142:  POP		HL
	PUSH	DE
	EX		DE,HL

	RST		10H						; push word DE
	LD		B,D
	LD		C,E
	POP		DE
	PUSH	DE
	DEC		DE
	DEC		DE

	CALL	L159E					;

	POP		DE
	PUSH	BC
	JP		L0EC3					;

; --------------------
; THE 'IMMEDIATE' WORD
; --------------------
; (  --  )
; The most recent word in the current vocabulary is made immediate, so that
; it will execute even in compile mode.

L1154:  DEFM	"IMMEDIAT"				; 'name field'
	DEFB	'E'+080h

	DEFW	L1124					; 'link field'

L115F:  DEFB	009h						; 'name length field'

L1160:  DEFW	L0EC3					; 'code field' - docolon

; ---

L1162:  DEFW	L0480					; current
	DEFW	L08B3					; @
	DEFW	L08B3					; @
	DEFW	L1A0E					; end-forth.

L116A:  RST		18H						; pop word DE
	EX		DE,HL
	SET		6,(HL)
	JP		(IY)					; to 'next'.

; ---------------------
; THE 'VOCABULARY' WORD
; ---------------------
; (  --  )
; Defines a new vocabulary with the given name.

L1170:  DEFM	"VOCABULAR"				; 'name field'
	DEFB	'Y'+080h

	DEFW	L115F					; 'link field'

L117C:  DEFB	00Ah						; 'name length field'

L117D:  DEFW	L1085					; 'code field' - create and enclose

; ---

L117F:  DEFW	L11B5					; set context
	DEFW	L0480					; current
	DEFW	L08B3					; @
	DEFW	L0E13					; 2+
	DEFW	L0F4E					; ,
	DEFW	L0688					; stk-zero
	DEFW	L0F5F					; C,
	DEFW	L0460					; here
	DEFW	L1011					; stack next word
	DEFW	VOCLNK					; (VOCLNK)
	DEFW	L086B					; dup
	DEFW	L08B3					; @
	DEFW	L0F4E					; ,
	DEFW	L08C1					; !
	DEFW	L04B6					; exit

; ----------------------
; THE 'DEFINITIONS' WORD
; ----------------------
; (  --  )
; The CONTEXT vocabulary is made the CURRENT vocabulary as well.

L119D:  DEFM	"DEFINITION"			; 'name field'
	DEFB	'S'+080h

	DEFW	L117C					; 'link field'

L11AA:  DEFB	00Bh						; 'name length field'

L11AB:  DEFW	L11AD					; 'code field'

; ---

L11AD:  LD		HL,(CONTEXT)				; CONTEXT
	LD		(CURRENT),HL				; CURRENT
	JP		(IY)					; to 'next'.

; ---

L11B5:  LD		(CONTEXT),DE				; CONTEXT
	JP		(IY)					; to 'next'.

; ---

; -------------
; THE 'IF' WORD
; -------------
; (n -- )
; Used in the form
; IF ... THEN
; or
; IF ... ELSE ... THEN
; In the first form, if n is non-zero then the words between IF and THEN
; are executed; otherwise they are skipped over.
; In the second form, if n is non-zero then the words between IF and ELSE
; are executed and those between ELSE and THEN are skipped over, while if
; n is zero then the words between IF and ELSE are skipped over and those
; between ELSE and THEN are executed.

L11BB:  DEFB	'I'						; 'name field'
	DEFB	'F'+080h

	DEFW	L13E0					; 'link field'

L11BF:  DEFB	042h						; 'name length field' (immediate word)

	DEFW	L1108					; 'code field' - compile

; ---

	DEFW	L1283					; ?branch
	DEFW	L0460					; here

	DEFW	L104B					; stk_data
	DEFB	002h						; 2 locations required for jump length
	DEFW	L0F83					; allot2
	DEFW	L04B6					; exit

; ----------------
; THE 'WHILE' WORD
; ----------------
; (n -- )
; Used in BEGIN ... WHILE ... REPEAT. If n = 0 then skips over to just past
; REPEAT.

L11CD:  DEFM	"WHIL"					; 'name field'
	DEFB	'E'+080h

	DEFW	L11BF					; 'link field'

L11D4:  DEFB	045h						; 'name length field' (immediate mode)

L11D5:  DEFW	L1108					; 'code field' - compile

; ---

	DEFW	L1288					; ?branch

	DEFW	L12D8					; check-for
	DEFB	001h						;  1
	DEFW	L0460					; here
	DEFW	L104B					; stk-data
	DEFB	004h						;  four
	DEFW	L0F83					; allot
	DEFW	L04B6					; exit

; ---------------
; THE 'ELSE' WORD
; ---------------
; (  --  )
; Used with IF and THEN.

L11E5:  DEFM	"ELS"					; 'name field'
	DEFB	'E'+080h

	DEFW	L11D4					; 'link field'

L11EB:  DEFB	044h						; 'name length field' (immediate mode)

L11EC:  DEFW	L1108					; 'code field' - compile

; ---

	DEFW	L1271					; branch

	DEFW	L12D8					; check-for
	DEFB	002h						; two
	DEFW	L0F83					; allot2
	DEFW	L1225					; ?
	DEFW	L0460					; here
	DEFW	L0E29					; 2-
	DEFW	L104B					; stk-data
	DEFB	002h						; two
	DEFW	L04B6					; exit

; ---------------
; THE 'THEN' WORD
; ---------------
; Used with IF.

L1200:  DEFM	"THE"					; 'name field'
	DEFB	'N'+080h

	DEFW	L11EB					; 'link field'

L1206:  DEFB	044h						; 'name length field' (immediate mode)

L1207:  DEFW	L1108					; 'code field' - compile

; ---

	DEFW	L12A4					; end?

	DEFW	L12D8					; check-for
	DEFB	002h
	DEFW	L1225					; ?
	DEFW	L04B6					; exit

; ---------------
; THE 'BEGIN' WORD
; ---------------
; (  --  )
; Used with either UNTIL or WHILE...REPEAT.

L1212:  DEFM	"BEGI"					; 'name field'
	DEFB	'N'+080h

	DEFW	L1206					; 'link field'

L1219:  DEFB	045h						; 'name length field' (immediate mode)

L121A:  DEFW	L1108					; 'code field' - compile

; ---

	DEFW	L129F
	DEFW	L0460					; here
	DEFW	L104B					; stk_data
	DEFB	001h						; 1
	DEFW	L04B6					; exit

; -----------------------
; The '???' Internal Word
; -----------------------

L1225:  DEFW	L0EC3					; headerless 'code field' - docolon

; ---

	DEFW	L086B					; dup
	DEFW	L0460					; here
	DEFW	L0885					; swap
	DEFW	L0DE1					; -
	DEFW	L0E1F					; 1-
	DEFW	L0885					; swap
	DEFW	L08C1					; !
	DEFW	L04B6					; exit

; -----------------------
; The '???' Internal Word
; -----------------------

L1237:  DEFW	L0EC3					; headerless 'code field' - docolon

; ---

	DEFW	L0460					; here
	DEFW	L0DE1					; -
	DEFW	L0E1F					; 1-
	DEFW	L0F4E					; ,
	DEFW	L04B6					; exit


; -----------------
; THE 'REPEAT' WORD
; -----------------
; (  --  )
; Used in construction BEGIN ... WHILE .. REPEAT.
; Causes a jump back to just after BEGIN.


L1243:  DEFM	"REPEA"					; 'name field'
	DEFB	'T'+080h

	DEFW	L1219					; 'link field'

L124B:  DEFB	046h						; 'name length field' (immediate mode)

L124C:  DEFW	L1108					; 'code field' - compile

; ---

L124E:   DEFW	L1276					; branch
L1250:  DEFW	L12D8					; check_for
	DEFB	004h						; four
	DEFW	L0885					; swap
	DEFW	L1237					; ?
	DEFW	L1225					; ?
	DEFW	L04B6					; exit

; ----------------
; THE 'UNTIL' WORD
; ----------------
; (n -- )
; Used in BEGIN ... UNTIL.
; Loops back to BEGIN if n = 0

L125B:  DEFM	"UNTI"					; 'name field'
	DEFB	'L'+080h

	DEFW	L124B					; 'link field'

L1262:  DEFB	045h						; 'name length field' (immediate mode)

L1263:  DEFW	L1108					; 'code field' - compile

; ---

	DEFW	L128D					; ?branch
	DEFW	L12D8					; check_for
	DEFB	001h						;
	DEFW	L1237					; ?
	DEFW	L04B6					; exit

; ---

x126E:   DEFB	002h						;;

x126F:   DEFB	075h						;;
x1270:   DEFB	0FFh						;; 1270 + ff75 = 11e5 = ELSE

; ---


L1271:  DEFW	L1278					; ?

; ---
x1273:   DEFB	002h						;;

x1274:   DEFB	0CEh						;;
x1275:   DEFB	0FFh						;; 1275 + ffce = 1243 = REPEAT

; --------------------------
; The 'branch' Internal Word
; --------------------------

L1276:  DEFW	L1278					; headerless 'code field'

; ---

L1278:  POP		HL						; drop next word pointer
	LD		E,(HL)					; read the 16-bit offset
	INC		HL						; that is 
	LD		D,(HL)					; stored there.

L127C:  ADD		HL,DE					; add to current address.

	JP		L04BA					; jump back into address loop so that
					; a new address gets stacked as IP.

; ---

x1280:   DEFB	002h						;;

x1281:   DEFB	039h						;;
x1282:   DEFB	0FFh						;; 1282 + ff39 = 11bb = IF

; ---

L1283:  DEFW	L128F					; from IF, convert, line, min, etc.

; ---

x1285:   DEFB	002h						;;

x1286:   DEFB	046h						;;
x1287:   DEFB	0FFh						;; 1287 + ff46 = 11cd = WHILE

; ---

L1288:  DEFW	L128F					; from WHILE

; ---

x128A:  DEFB	002h						;;

x128B:   DEFB	0CFh						;;
x128C:   DEFB	0FFh						;; 128c + ffcf = 125b = UNTIL

; ---------------------------
; The '?branch' Internal Word
; ---------------------------

L128D:  DEFW	L128F					; headerless 'code field'

; ---

L128F:  CALL	L084E					; stk_to_bc

	LD		A,B						; test for
	OR		C						; zero

; -> from +loop
L1294:  JR		Z,L1278					; make the jump to "branch" if zero.

	POP		HL						; else drop the pointer.
	INC		HL						; step over.
	INC		HL						; the jump bytes
	JP		L04BA					; jump back into address loop so that
					; a new address gets stacked as IP.

; ---

x129C:   DEFB	000h						;;
x129D:   DEFB	074h						;;
x129E:   DEFB	0FFh						;; 129e + ff74 = 1212 = BEGIN

; ---

L129F:  DEFW	L04B9					; forth

; ---

x12A1:   DEFB	000h						;;
x12A2:   DEFB	05Dh						;;
x12A3:   DEFB	0FFh						;; 12a3 + ff5d = 1200 = THEN

; ---

L12A4:  DEFW	L04B9

; -------------
; THE 'DO' WORD
; -------------
; (limit, initial value -- )
; Sets up a DO loop, initializing the loop counter to the initial value.
; The limit and loop counter are stored on the return stack.
; See LOOP and +LOOP.

L12A6:  DEFB	'D'						; 'name field'
	DEFB	'O'+080h

	DEFW	L1262					; 'link field'

L12AA:  DEFB	042h						; 'name length field' (immediate mode)

L12AB:  DEFW	L1108					; 'code field' - compile

; ---

	DEFW	L1323					; shuffle
	DEFW	L0460					; here
	DEFW	L104B					; stk_data
	DEFB	003h						; 3						marker byte.
	DEFW	L04B6					; exit

; ---------------
; THE 'LOOP' WORD
; ---------------
; (  --  )
; Like +LOOP (below) but the number added onto the loop counter is 1.

L12B6:  DEFM	"LOO"					; 'name field'
	DEFB	'P'+080h

	DEFW	L12AA					; 'link field'

L12BC:  DEFB	044h						; 'name length field' (immediate mode)

L12BD:  DEFW	L1108					; 'code field' - compile

; ---

	DEFW	L1332					; shuffle more

L12C1:  DEFW	L12D8					; check-for
	DEFB	003h						; 3						marker byte
	DEFW	L1237					; ?
	DEFW	L04B6					; exit

; ----------------
; THE '+LOOP' WORD
; ----------------
; (n -- )
; Used with DO. Adds n to the loop counter, and loops back if the loop counter
; is now less than the limit (if n >= 0) or greater than the limit (if n < 0).

L12C8:  DEFM	"+LOO"					; 'name field'
	DEFB	'P'+080h

	DEFW	L12BC					; 'link field'

L12CF:  DEFB	045h						; 'name length field' (immediate mode)

L12D0:  DEFW	L1108					; 'code field' - compile

; ---

L12D2:  DEFW	L133C					; ?
	DEFW	L1276					; branch

L12D6:  DEFW	0FFEAh					; back to L12C1

; -----------------------------
; The 'check-for' Internal Word
; -----------------------------
; Checks for expected marker byte which indicates stack is balanced and that
; a previous mandatory word was present.

L12D8:  DEFW	L12DA					; headerless 'code field'

; ---

L12DA:  RST		18H						; pop word DE
	POP		HL						;
	LD		A,(HL)					;
	INC		HL						;
	PUSH	HL						;
	SUB		E						;
	OR		D						;

	JR		Z,L132D					; to next via jp (iy).

; else...

	RST		20H						; Error 5
	DEFB	005h						; Word is not properly structured.

; ------------
; THE 'I' WORD
; ------------
; ( -- loop counter)
; Copies the top of the return stack to the data stack. This will be either
; the loop counter for the innermost DO...LOOP, or the number most recently
; transferred by >R.


L12E5:  DEFB	'I'+080h				; 'name field'

	DEFW	L11AA					; 'link field'

L12E8:  DEFB	001h						; 'name length field'

L12E9:  DEFW	L12EB					; 'code field'

; ---

L12EB:  POP		BC						; pop return address
	POP		DE						; pop the loop counter to DE.
	PUSH	DE						; now restore the stack
	PUSH	BC						; exactly as it was.

	RST		10H						; push Data Word DE - inner loop counter

	JP		(IY)					; to 'next'.

; -------------
; THE 'I'' WORD
; -------------
; ( -- limit)
; Copies the second number down on the return stack to the data stack
; (so in a DO loop it copies  the limit of the loop).

L12F2:  DEFB	'I'						; 'name field'
	DEFB	0A7h						; "'"+080h

	DEFW	L12E8					; 'link field'

L12F6:  DEFB	002h						; 'name length field'

L12F7:  DEFW	L12F9					; 'code field'

; ---

L12F9:  LD		HL,00004h				; two bytes per entry.
	JR		L1307					; forward to use the 'J' indexing 
					; routine

; ------------
; THE 'J' WORD
; ------------
; ( -- loop counter)
; Copies the third entry on the return stack to the data stack.
; This will be either the loop counter for the second innermost DO loop
; or the number put on the return stack by the most recent >R.

L12FE:  DEFB	'J'+080h				; 'name field'

	DEFW	L12F6					; 'link field'

L1301:  DEFB	001h						; 'name length field'

L1302:  DEFW	L1304					; 'code field'

; ---

L1304:  LD		HL,00006h				; two bytes per entry

; -> I' joins here with HL=4

L1307:  ADD		HL,SP					; index the stack pointer.
	LD		E,(HL)					; low order byte to E
	INC		HL						; address high byte.
	LD		D,(HL)					; DE now holds a copy of the required
					; entry from the Return Stack

	RST		10H						; stack Data Word DE

	JP		(IY)					; to 'next'.

; ----------------
; THE 'LEAVE' WORD
; ----------------
; (  --  )
; Forces termination of a DO loop at the next LOOP or +LOOP by setting the
; loop counter equal to the limit.

L130E:  DEFM	"LEAV"					; 'name field'
	DEFB	'E'+080h

	DEFW	L1301					; 'link field'

L1315:  DEFB	005h						; 'name length field'

L1316:  DEFW	L1318					; 'code field'

; ---

L1318:  POP		BC						; pop return address to BC.
	POP		HL						; pop the loop counter.
	POP		HL						; now the limit.
	PUSH	HL						; push unaltered limit.
	PUSH	HL						; push counter - now limit.
	PUSH	BC						; restore return address.

	JP		(IY)					; to 'next'.

; ---


x1320:   DEFB	000h						;;
x1321:   DEFB	084h						;;
x1322:   DEFB	0FFh						;; 1322 + ff84 = 12a6 = DO

; -----------------------
; The '???' Internal Word
; -----------------------

L1323:  DEFW	L1325					; headerless 'code field'

; ---

L1325:  CALL	L084E					; stk_to_bc
	RST		18H						; pop word DE
	POP		HL
	PUSH	DE

L132B:  PUSH	BC
	PUSH	HL

L132D:  JP		(IY)					; to 'next'.

; ---

x132F:   DEFB	002h						;;
x1330:   DEFB	085h						;;
x1331:   DEFB	0FFh						;; 1331 + ff85 = 12b6 = LOOP

; -----------------------
; The '???' Internal Word
; -----------------------

L1332:  DEFW	L1334					; headerless 'code field'

; ---

L1334:  LD		DE,00001h
	JR		L133F					; forward =>

; ---

x1339:   DEFB	002h
x133A:   DEFB	08Dh
x133B:   DEFB	0FFh

; -----------------------
; The '???' Internal Word
; -----------------------
; loop counter + n
; Note. ADC HL,DE is used in preference to ADD HL,DE as affects P/O flag

L133C:  DEFW	L133E					; headerless 'code field'

; ---

L133E:  RST		18H						; pop word DE - number to be added (n)
; =>
L133F:  POP		BC						; pop return address to BC.
	POP		HL						; loop counter to HL.
	AND		A						; clear carry.
	ADC		HL,DE					; add the number specified.
	LD		A,D						; save MSB of (n) in A.
	POP		DE						; now pop the limit to DE.
	SCF								; set carry.
	JP		PE,L1358				; jump forward with overflow.

	PUSH	DE						; push limit 
	PUSH	HL						; push adjusted counter.
	RLCA							; now test sign of number (n)
	JR		NC,L1350				;

	EX		DE,HL

L1350:  CALL	L0C99					;

	CCF

	JR		NC,L1358				;

	POP		HL
	POP		HL

L1358:  PUSH	BC
	SBC		A,A
	JP		L1294					; jump to branch on zero.

; ------------
; THE '(' WORD
; ------------
; Starts a comment terminated by ')'

L135D:  DEFB	'('+080h				; 'name field'

	DEFW	L13D4					; 'link field'

L1360:  DEFB	041h						; 'name length field' (immediate mode)

L1361:  DEFW	L1108					; 'code field' - compile

; ---

L1363:  DEFW	L1379					;
	DEFW	L104B					; stk_data

	DEFB	029h						; character ')'			- delimiter

L1368:  DEFW	L0460					; here
	DEFW	L0885					; swap
	DEFW	L0F83					; allot2
	DEFW	L139F					; find)
	DEFW	L0885					; swap
	DEFW	L08C1					; !

	DEFW	L04B6					; exit

; ---

x1376:   DEFB	0FFh						;;
x1377:   DEFB	0E5h						;;
x1378:   DEFB	0FFh						;; 1378 + ffe5 = 135d = '('

; -----------------------
; The '???' Internal Word
; -----------------------

L1379:  DEFW	L137B					; headerless 'code field'

; ---

L137B:  POP		HL
	LD		E,(HL)
	INC		HL
	LD		D,(HL)

	INC		DE

	JP		L127C					;

; -------------
; THE '."' WORD
; -------------
; (  --  )
; Prints the following string terminated by ".

L1383:  DEFB	'.'						; 'name field'
	DEFB	'"'+080h

	DEFW	L1360					; 'link field'

L1387:  DEFB	042h						; 'name length field' (immediate mode)

L1388:  DEFW	L1108					; 'code field' - compile

; ---

L138A:  DEFW	L1396					; pr_embedded string.
	DEFW	L104B					; stk_data
	DEFB	022h						; '"'					- delimiter

	DEFW	L1276					; branch
L1391:  DEFW	0FFD6h					; back to 1368 (1392+0FFD6h)
					; same routine as for matching comments

; ---

x1393:   DEFB	0FFh						;;
x1394:   DEFB	0EEh						;;
x1395:   DEFB	0FFh						;; 1395 + ffee = 1383 = ."

; -----------------------
; The '???' Internal Word
; -----------------------
; print string embedded in Dictionary

L1396:  DEFW	L1398					; headerless 'code field'

; ---

L1398:  POP		DE
	CALL	L0979					; pr_string1
	PUSH	DE
	JP		(IY)					; to 'next'.

; -----------------------
; The '???' Internal Word
; -----------------------
; enclose comment
; comments may be multiple 
; e.g. : SV ( system) ( variables) CLS BEGIN 0 0 AT 15360 80 TYPE 0 UNTIL ;


L139F:  DEFW	L13A1					; headerless 'code field'

; ---

L13A1:  RST		18H						; pop word DE
	PUSH	DE						; save delimiter.

	CALL	L05E1					; find the ')' delimiter

	LD		H,D
	LD		L,E
	ADD		HL,BC
	LD		A,(HL)
	POP		HL						; pop the delimiter.
	CP		L
	JR		Z,L13B8					; forward with a match.			=->

	EX		DE,HL					; 
	RST		10H						; push word DE
	LD		DE,00578h				; addr retype?

	CALL	L1815					; pr2

	JR		L13A1					; loop back

; ---
; =->

L13B8:  PUSH	DE
	PUSH	BC
	LD		HL,(STKBOT)				; STKBOT

	CALL	L0F9E					; routine MAKE ROOM

	POP		BC
	POP		DE
	PUSH	DE
	PUSH	BC
	EX		DE,HL
	LDIR							; copy comment to dictionary.
	POP		BC
	LD		D,B
	LD		E,C
	RST		10H						; push word DE
	POP		DE

	CALL	L07DA					;

	JP		(IY)					; to 'next'.

; ------------
; THE '[' WORD
; ------------
; (  --  )
; Enters interpret mode.

L13D1:  DEFB	'['+080h				; 'name field'

	DEFW	L12CF					; 'link field'

L13D4:  DEFB	041h						; 'name length field' (immediate mode)

L13D5:  DEFW	L13D7					; 'code field'

; ---

L13D7:  RES		6,(IX+03Eh)				; FLAGS
	JP		(IY)					; to 'next'.

; ------------
; THE ']' WORD
; ------------
; (  --  )
; Enters compile mode.

L13DD:  DEFB	']'+080h				; 'name field'

	DEFW	L1315					; 'link field'

L13E0:  DEFB	001h						; 'name length field'

L13E1:  DEFW	L13E3					; 'code field'

; ---

L13E3:  SET		6,(IX+03Eh)				; FLAGS
	JP		(IY)					; to 'next'.


; ---------------
; THE 'EXIT' WORD
; ---------------
; (  --  )
; Exits immediately from the word in whose definition it is contained.
; Cannot be used between DO and LOOP or +LOOP, nor between >R and R>.

L13E9:  DEFM	"EXI"					; 'name field'
	DEFB	'T'+080h

	DEFW	L1387					; 'link field'

L13EF:  DEFB	004h						; 'name length field'

L13F0:  DEFW	L04B8					; 'code field'

; -------------------
; THE 'REDEFINE' WORD
; -------------------
; REDEFINE name
; (  --  )
; Takes word 'name' and replaces it with the most recent word in the
; dictionary. Updates entire dictionary to take changes into account.
; Most commonly used as
;  EDIT name
;  REDEFINE name

L13F2:  DEFM	"REDEFIN"				; 'name field'
	DEFB	'E'+080h

	DEFW	L13EF					; 'link field'

L13FC:  DEFB	008h						; 'name length field'

L13FD:  DEFW	L13FF					; 'code field'

; ---

L13FF:  CALL	L0F2E					; blank stack

	LD		HL,(CURRENT)				; CURRENT

	LD		E,(HL)
	INC		HL
	LD		D,(HL)

	EX		DE,HL					; transfer value to HL
	INC		HL
	LD		(02705h),HL				; store in pad

	PUSH	HL						; (*)

	CALL	L15C0					; get 'name field' address

	LD		(0270Dh),HL				; name field addr
	LD		(02707h),BC				; parameter field addr
	LD		(0270Bh),DE				; length field value

	LD		HL,(STKBOT)				; STKBOT
	SBC		HL,DE
	JP		NZ,L14DA				; forward if not matched to Error 11.

	POP		DE						; (*)

	RST		10H						; push word DE

	CALL	L04B9					; forth

L1429:  DEFW	L1610					; prvcur
	DEFW	L063D					; find
	DEFW	L1A0E					; end-forth.

; ---

L1425:  RST		18H						; pop word DE
	LD		HL,0C3AFh
	ADD		HL,DE
	JP		NC,L14CF				;

	EX		DE,HL
	LD		(02703h),HL

	CALL	L15C0					; get 'name field' address

	LD		(02701h),HL

L1441:  PUSH	HL
	LD		(02709h),DE
	LD		A,B
	OR		C
	LD		DE,(02707h)
	JR		Z,L1452					;

	LD		A,D
	OR		E
	JR		Z,L14CF					;

L1452:  POP		HL
	LD		BC,(0270Dh)
	SBC		HL,BC
	EX		DE,HL
	ADD		HL,DE
	LD		(02707h),HL
	LD		HL,(0270Bh)
	ADD		HL,DE
	LD		BC,(02709h)
	AND		A
	SBC		HL,BC
	LD		(0270Bh),HL
	LD		BC,0002Eh				; 46d
	ADD		HL,BC
	BIT		7,H
	JR		NZ,L147F				;

	LD		BC,(SPARE)				; SPARE
	ADD		HL,BC
	JR		C,L14CF					;

	SBC		HL,SP
	JR		NC,L14CF				;

L147F:  LD		HL,(02703h)
	PUSH	HL
	DEC		HL
	DEC		HL
	LD		B,(HL)
	DEC		HL
	LD		C,(HL)
	LD		HL,(02705h)
	PUSH	HL
	DEC		HL
	DEC		HL
	LD		(HL),B
	DEC		HL
	LD		(HL),C
	POP		HL
	ADD		HL,DE
	POP		BC
	AND		A
	SBC		HL,BC
	LD		(02705h),HL
	LD		DE,(02701h)
	LD		HL,(02709h)
	AND		A
	SBC		HL,DE
	LD		B,H
	LD		C,L
	PUSH	DE
	PUSH	BC

	CALL	L14DC					; RECLAIM

	LD		HL,(0270Bh)
	POP		BC
	ADD		HL,BC
	LD		B,H
	LD		C,L
	POP		HL
	PUSH	BC

	CALL	L0F9E					; routine MAKE ROOM

	EX		DE,HL					;
	LD		HL,(0270Dh)				;
	LD		BC,(0270Bh)				;
	ADD		HL,BC					;
	POP		BC						;
	PUSH	BC						;
	PUSH	HL						;

	LDIR							;

	POP		DE
	POP		BC

	CALL	L14DC					; RECLAIM
	CALL	L14F8					;

	JP		(IY)					; to 'next'.

; ---

L14CF:  LD		HL,(CURRENT)				; CURRENT
	LD		DE,(02705h)
	DEC		DE
	LD		(HL),E
	INC		HL
	LD		(HL),D

L14DA:  RST		20H						; Error 11
	DEFB	00Bh						; Error in REDEFINE or FORGET

; ---------------------------
; THE 'RECLAIMING' SUBROUTINE
; ---------------------------

L14DC:  LD		HL,(STKBOT)				; fetch STKBOT
	AND		A						; clear carry flag
	SBC		HL,BC					; subtract number of bytes to reclaim.
	LD		(STKBOT),HL				; update STKBOT

	LD		HL,(SPARE)				; fetch SPARE
	SBC		HL,BC					; subtract number of bytes to reclaim.
	LD		(SPARE),HL				; update SPARE

	SBC		HL,DE					; subtract
	RET		Z						; return if same address.

	PUSH	BC						;
	LD		B,H						;
	LD		C,L						;
	POP		HL						;
	ADD		HL,DE					;

	LDIR							;

	RET								;

; ---
;
; ---

L14F8:  LD		BC,CURRENT				; CURRENT

	CALL	L1557					;
	CALL	L1557					;

	LD		BC,RAMSTART+040h				; addr. of "FORTH" in RAM.

L1504:  LD		HL,(STKBOT)				; STKBOT
	SCF								;
	SBC		HL,BC					;
	RET		C						;

L150B:  LD		A,(BC)					;
	RLA								;
	INC		BC						;
	JR		NC,L150B				;

	INC		BC						;
	INC		BC						;
	CALL	L1557					;
	INC		BC						;
	CALL	L1557					;

L1519:  CALL	L15FB					; routine INDEXER

; -------------------------------------------------------

	DEFW	L0EC3					; DE value
L151E:  DEFB	01Ch						; to L153A

	DEFW	L1085					; DE value
L1521:  DEFB	016h						; to L1537

	DEFW	L1108					; DE value
L1524:  DEFB	013h						; to L1537

	DEFW	L11B5					; DE value
L1527:  DEFB	018h						; to L153F

	DEFW	00000h					; zero end marker

; -------------------------------------------------------

L152A:  LD		HL,0FFF9h
	ADD		HL,BC

	LD		C,(HL)
	INC		HL
	LD		B,(HL)
	DEC		HL

	ADD		HL,BC

	LD		B,H
	LD		C,L
	JR		L1504					;

; -------------------------------------------------------

L1537:  CALL	L1557					;

; ->

L153A:  CALL	L1548					;
	JR		L1504					;

; ---

L153F:  CALL	L1557					;
	INC		BC						;
	CALL	L1557					;
	JR		L1504					;

; -------------------------------------------------------

; XXX?

L1548:  CALL	L1557					;
	LD		HL,L04B6				;
	AND		A						;
	SBC		HL,DE					;
	RET		Z						;

	CALL	L159E					;

	JR		L1548					;

; ---
; often called twice
; ---


L1557:  LD		A,(BC)					; lo byte
	LD		E,A						;
	INC		BC						;
	LD		A,(BC)					; hi byte
	LD		D,A						;
	DEC		BC						; BC now unchanged, DE contents

	CALL	L1568					; routine below. header?

	EX		DE,HL					; value to DE
	LD		A,E						;
	LD		(BC),A					; lo byte
	INC		BC						;
	LD		A,D						;
	LD		(BC),A					; hi byte
	INC		BC						;
	RET								; to next - BC+=2

; ---

L1568:  LD		HL,(02701h)				; first bytes of pad.
	AND		A						;
	SBC		HL,DE					; subtract the DE value read from
					; memory
	LD		H,D						;
	LD		L,E						; transfer that DE to HL as well

	RET		NC						; return if HL was higher than DE

	LD		HL,(02709h)				; tape header
	SBC		HL,DE
	JR		NC,L1584				; forward if higher to

	LD		HL,(0270Dh)
	SBC		HL,DE
	JR		C,L1592					; forward if lower to

	LD		HL,(0270Bh)				;
	ADD		HL,DE
	RET								; return

; ---

L1584:  LD		HL,(02703h)
	SBC		HL,DE
	LD		HL,(02707h)
	RET		C

	LD		HL,(02705h)
	ADD		HL,DE
	RET

; ---

L1592:  LD		HL,(02701h)
	ADD		HL,DE
	LD		DE,(0270Dh)
	AND		A
	SBC		HL,DE
	RET

; ---

L159E:  DEC		DE
	LD		A,(DE)
	RLA
	RET		NC

L15A2:  DEC		DE
	DEC		DE
	LD		A,(DE)
	LD		L,A						; low byte
	LD		H,000h					; make high byte zero
	INC		A						; test offset for 0FFh.
	JR		NZ,L15B1				; forward if not.

	LD		A,(BC)
	LD		L,A
	INC		BC
	LD		A,(BC)
	LD		H,A
	INC		BC

L15B1:  ADD		HL,BC

	LD		B,H
	LD		C,L
	RET

; ---
;
; ---


L15B5:  DEFW	L15B7

; ---

L15B7:  RST		18H						; pop word DE

	EX		DE,HL

	CALL	L15E7					; WORDSTART1

	EX		DE,HL

	RST		10H						; push word DE
	JP		(IY)					; to 'next'.

; ---
;
; ---

L15C0:  PUSH	HL
	LD		E,(HL)
	INC		HL
	LD		D,(HL)

L15C4:  CALL	L15FB					; routine INDEXER

; -------------------------------------------------------

	DEFW	L1108
L15C9:  DEFB	00Bh						; to L15D4 - find parameter field

	DEFW	L1085
L15CC:  DEFB	008h						; to L15D4 - find parameter field

	DEFW	00000h					; zero end_marker.

; -------------------------------------------------------

L15CF:  LD		BC,00000h				; zero indicates no parameter field.
	JR		L15DB					; forward to consider total length.

; -------------------------------------------------------

L15D4:  POP		HL						; retrieve the code field address
	PUSH	HL						; save it again

	INC		HL						; step past the
	INC		HL						; address word
	LD		C,(HL)					; and get following address
	INC		HL						; which if in RAM could be the
	LD		B,(HL)					; parameter field to				BC.

; ->

L15DB:  POP		HL						; retrieve the code field address
	PUSH	HL						; and save it again

	DEC		HL						; the name length field
	DEC		HL						; link field high order byte
	DEC		HL						; link field low order byte
	DEC		HL						; possible length field high
	LD		D,(HL)					; save in D
	DEC		HL						; possible length field low
	LD		E,(HL)					; save in E
	ADD		HL,DE					; add this length
	EX		DE,HL					; and save result in				DE.

	POP		HL						; retrieve code field address

; ->
; indexes the header information of a FORTH word

L15E7:  DEC		HL						; point to name length field

; =>
L15E8:  LD		A,H						; fetch high order byte of the
					; header address.
	CP		03Ch						; compare to RAM location
	LD		A,(HL)					; fetch length byte.
	RES		6,A						; reset the immediate mode bit
	JR		C,L15F2					; forward if definition is in ROM.

	ADD		A,002h					; else add extra for 'length field'

L15F2:  DEC		HL						; step past the
	DEC		HL						; link to previous word.

L15F4:  DEC		HL						; now address last letter on name.
	DEC		A						; decrement the length
	JR		NZ,L15F4				; loop back until at first letter  HL.

	RET								; return.

; -------
; INDEXER
; -------

; indexerloop

L15F9:  INC		HL						; step past the
	PUSH	HL						; offset byte.

; -> Call Entry point

L15FB:  POP		HL						; drop return address - points to byte
					; after the call.
	LD		A,(HL)					; read low-order byte
	INC		HL						; increment address once
	PUSH	HL						; push return address

	LD		H,(HL)					; read high-order byte.
	LD		L,A						; now HL holds the read word
	OR		H						; test for two zeros.
	RET		Z						; two zeros - return
					; (ret addr is second NOP)

	SBC		HL,DE					; compare to value passed in DE

	POP		HL						; now increment the
	INC		HL						; return address on machine stack.

	JR		NZ,L15F9				; loop back if read word is not
					; equal to DE

	PUSH	DE						; else preserve DE

	LD		D,000h					; a 1 byte relative jump.
	LD		E,(HL)					; read one-byte offset.
	ADD		HL,DE					; add to read address.

	POP		DE						; restore DE

	JP		(HL)					; >>>

; ---

L1610:  DEFW	L0EC3					; 'code field' - docolon

	DEFW	L0E1F					; 1-
	DEFW	L0E29					; 2-
	DEFW	L08B3					; @
	DEFW	L0480					; current
	DEFW	L08B3					; @
	DEFW	L08C1					; !
	DEFW	L04B6					; exit

; ---------------------------------
; THE 'FIND WORD IN RAM' SUBROUTINE
; ---------------------------------
; This subroutine is used by FORGET, EDIT and LIST.
; First use the standard FORTH word find to get address of word (in pad).
; If word does not exist then returned value will be zero.
; The lowest word in RAM is the FORTH word at L3C51 so a check is made
; against this address.

L1620:  CALL	L04B9					; forth
	DEFW	L063D					; find

L1625:  DEFW	L1A0E					; end-forth.

	RST		18H						; pop word DE

	LD		HL,0C3AFh				; i.e 00000h - RAMSTART+051h

	ADD		HL,DE					; add to test value.
	RET		C						; carry signals that word exists in RAM.
					; return the address in DE.

; else generate an error code.

	RST		20H						; Error 13
	DEFB	00Dh						; Error word not found or is in ROM.

; -----------------
; THE 'FORGET' WORD
; -----------------
; FORGET name.
; Erases the word 'name' and all subsequently defined names from the dictionary.

L162F:  DEFM	"FORGE"					; 'name field'
	DEFB	'T'+080h

	DEFW	L13FC					; 'link field'

L1637:  DEFB	006h						; 'name length field'

L1638:  DEFW	L163A					; 'code field'

; ---

L163A:  LD		HL,(CURRENT)				; CURRENT
	LD		DE,(CONTEXT)				; CONTEXT
	AND		A
	SBC		HL,DE

	JP		NZ,L14DA				;

	CALL	L1620					; findramword

	LD		HL,0FFFBh
	ADD		HL,DE
	LD		(DICT),HL				; SPARE
	SET		2,(IX+03Eh)				; FLAGS

	RST		20H						; Invoke error routine.
	DEFB	0FFh						; No error

; ---------------
; THE 'EDIT' WORD
; ---------------
; EDIT name
; Lists word 'name' at bottom of the screen to be edited. Lists 18 lines at
; a time, then waits for editing until ENTER is pressed.
; A new version of the word is entered at the end of the dictionary.
; While editing, cursor up and cursor down are needed to move the cursor
; from one line to another. DELETE LINE deletes one line.

L1657:  DEFM	"EDI"					; 'name field'
	DEFB	'T'+080h

	DEFW	L1637					; 'link field'

L165D:  DEFB	004h						; 'name length field'

L165E:  DEFW	L1660					; 'code field'

; ---

L1660:  CALL	L1620					; findramword

	SET		3,(IX+03Eh)				; update FLAGS output -> input buffer
	JR		L1675					; forward to list routine the difference
					; being that the listing will go to the
					; lower screen.

; ---------------
; THE 'LIST' WORD
; ---------------
; LIST name
; (  --  )
; Lists word 'name' on the screen. It must have been defined by :, DEFINER,
; or COMPILER. Lists about 18 lines at a time and waits for key depression
; (shifted space breaks).

L1669:  DEFM	"LIS"					; 'name field'
	DEFB	'T'+080h

	DEFW	L165D					; 'link field'

L166F:  DEFB	004h						; 'name length field'

L1670:  DEFW	L1672					; 'code field'

; ---

L1672:  CALL	L1620					; findramword

; edit path joins here but carriage returns are printed as zeros.

L1675:  LD		A,00Dh					; prepare a carriage return.
	RST		08H						; print_ch

	BIT		3,(IX+03Eh)				; test FLAGS output->input buffer?

	PUSH	DE

	CALL	NZ,L02D8				; call if so to initialize buffer

	POP		BC						; LD DE,(BC)

	LD		A,(BC)
	LD		E,A
	INC		BC
	LD		A,(BC)
	LD		D,A
	DEC		BC

	CALL	L15FB					; routine INDEXER

; -------------------------------------------------------

L168A:  DEFW	L0EC3					; DE value
L168C:  DEFB	00Bh						; offset to L1697

L168D:  DEFW	L1108					; DE value
L168F:  DEFB	00Dh						; offset to L169C

L1690:  DEFW	L1085					; DE value
L1692:  DEFB	01Fh						; offset to L16B1

	DEFW	00000h					; zero end-marker

; -------------------------------------------------------

L1695:  RST		20H						; Error 14
	DEFB	00Eh						; Word unlistable.

; Only words defined by ':', 'DEFINER' or 'COMPILER' are listable.

; -------------------------------------------------------

; ':'
L1697:  LD		HL,00002h
	JR		L16B4					;
; ---

L169C:  PUSH	DE
	LD		HL,00002h
	ADD		HL,BC
	LD		A,(HL)
	INC		HL
	LD		H,(HL)
	LD		L,A
	DEC		HL
	DEC		HL
	DEC		HL

	LD		L,(HL)
	LD		A,L
	RLCA
	SBC		A,A
	LD		H,A

	CALL	L180E					; pr_int_hl?

	POP		DE

L16B1:  LD		HL,00004h


L16B4:  ADD		HL,BC
	PUSH	HL
	PUSH	BC

	CALL	L17E4					;

	POP		DE
	POP		BC

	CALL	L17E4					;

	LD		(IX+014h),001h			; LISTWSx

L16C3:  LD		(IX+016h),010h			; LISTWSx

L16C7:  CALL	L1708					; index_table

	JR		C,L16D2					;

	DEC		(IX+016h)				; LISTWSx
	JP		P,L16C7					;

L16D2:  BIT		3,(IX+03Eh)				; FLAGS
	JR		NZ,L16E8				; branch forward  =->

	JR		C,L1702					;

	LD		HL,KEYCOD				; KEYCOD
	LD		(HL),000h				;

L16DF:  LD		A,(HL)					;
	AND		A						;
	JR		Z,L16DF					; loop back while zero

	CALL	L04E4					; check break

	JR		L16C3					; loop back

; =->

L16E8:  PUSH	AF
	RES		3,(IX+03Eh)				; FLAGS
	PUSH	BC

	CALL	L04B9					; forth

	DEFW	L0578					; retype		- allow user to retype
	DEFW	L0506					; line			- interpret buffer
	DEFW	L1A0E					; end-forth.


	SET		3,(IX+03Eh)				; FLAGS

	CALL	L02D8					;

	POP		BC
	POP		AF
	JR		NC,L16C3				;

L1702:  RES		3,(IX+03Eh)				; FLAGS
	JP		(IY)					; to 'next'.

; -------------------------------------------------------

; called once

L1708:  LD		A,(RAMSTART+014h)				; LISTWS2
	LD		(RAMSTART+015h),A				; LISTWS3

	LD		(IX+013h),005h			; LISTWS

L1712:  LD		A,(BC)
	LD		E,A
	INC		BC
	LD		A,(BC)
	LD		D,A
	INC		BC

L1718:  CALL	L15FB					; routine INDEXER

; -------------------------------------------------------

L171B:  DEFW	L1283					;
L171D:  DEFB	040h						; offset to L175D

L171E:  DEFW	L1271					;
L1720:  DEFB	044h						; offset to L1764

L1721:  DEFW	L12A4					;
L1723:  DEFB	048h						; offset to L176B

L1724:  DEFW	L129F					;
L1726:  DEFB	037h						; offset to L175D

L1727:  DEFW	L128D					;
L1729:  DEFB	042h						; offset to L176B

L172A:  DEFW	L1288					;
L172C:  DEFB	038h						; offset to L1764

L172D:  DEFW	L1276					;
L172F:  DEFB	03Ch						; offset to L176B

L1730:  DEFW	L1323					;
L1732:  DEFB	02Bh						; offset to L175D

L1733:  DEFW	L1332					;
L1735:  DEFB	036h						; offset to L176B

L1736:  DEFW	L133C					;
L1738:  DEFB	033h						; offset to L176B

L1739:  DEFW	L10E8					;
L173B:  DEFB	029h						; offset to L1764

L173C:  DEFW	L1140					;
L173E:  DEFB	026h						; offset to L1764

L173F:  DEFW	L1011					;
L1741:  DEFB	03Bh						; offset to L177C

L1742:  DEFW	L1064					;
L1744:  DEFB	047h						; offset to L178B

L1745:  DEFW	L104B					;
L1747:  DEFB	051h						; offset to L1798

L1748:  DEFW	L1379					;
L174A:  DEFB	062h						; offset to L17AC

L174B:  DEFW	L1396					;
L174D:  DEFB	063h						; offset to L17B0

L174E:  DEFW	L04B6					;
L1750:  DEFB	054h						; offset to L17A4

L1751:  DEFW	00000h					; zero end-marker

; -------------------------------------------------------

; default action

L1753:  CALL	L17E1					;

L1756:  DEC		(IX+013h)				; LISTWS
	JR		NZ,L1712				;
	AND		A
	RET

; ---

L175D:  LD		HL,(RAMSTART+014h)				; LISTWS2
	LD		H,L
	INC		L
	JR		L1770					;

; ---

L1764:  LD		HL,(RAMSTART+014h)				; LISTWS2
	LD		H,L
	DEC		H
	JR		L1770					;

; ---

L176B:  LD		HL,(RAMSTART+014h)				; LISTWS2
	DEC		L
	LD		H,L

L1770:  LD		(RAMSTART+014h),HL				; LISTWS2
	LD		(IX+013h),001h			; LISTWS
	DEC		(IX+016h)				; LISTWSx
	JR		L1753					;

; ---

L177C:  CALL	L17DA					;

	RST		10H						; push word DE
	LD		DE,009B3h				; '.' addr

L1783:  CALL	L17C1					; routine INDENT
	CALL	L1815					; pr2

	JR		L1756					;

; ---

L178B:  CALL	L17DA					;
	RST		10H						; push word DE
	CALL	L17DA					;
	RST		10H						; push word DE
	LD		DE,00AAFh				; 'F.' addr
	JR		L1783					;

; ---

L1798:  LD		A,(BC)
	PUSH	AF

	CALL	L17E1					;

	POP		AF
	RST		08H						; print_ch

	LD		A,020h					; a space character
	RST		08H						; print_ch

	JR		L1756					;

; ---

L17A4:  CALL	L1808					; pr_inline

	DEFB	00Dh						; newline
	DEFB	';'						; ;
	DEFB	08Dh						; inverted newline

	SCF								;
	RET								;

; ---

L17AC:  LD		A,029h					; character ')' - end of comment.
	JR		L17B2					;

L17B0:  LD		A,022h					; character '"' - quote

L17B2:  PUSH	AF
	PUSH	BC
	CALL	L17E1					;
	POP		DE
	CALL	L0979					; pr_string1
	LD		B,D
	LD		C,E
	POP		AF

	RST		08H						; print_ch

	AND		A
	RET

; -------------------------------------------------------

L17C1:  LD		A,(RAMSTART+015h)				; LISTWS3
	AND		A
	RET		M

	PUSH	BC						; preserve BC
	LD		B,A						; transfer count to B

	LD		A,00Dh					; carriage return.
	RST		08H						; print_ch

	INC		B						; test indentation.
	DEC		B						;
	JR		Z,L17D4					;

L17CF:  LD		A,020h					; a space character
	RST		08H						; print_ch

	DJNZ	L17CF					;

L17D4:  LD		(IX+015h),0FFh			; LISTWS3

	POP		BC						; restore BC
	RET								; return.

; ---

L17DA:  LD		A,(BC)
	LD		E,A
	INC		BC
	LD		A,(BC)
	LD		D,A
L17DF:  INC		BC
	RET

; ---

L17E1:  CALL	L17C1					; routine INDENT

L17E4:  EX		DE,HL
	DEC		HL
	LD		A,(HL)
	BIT		7,A
	JR		NZ,L17F0				;

	CALL	L15E8					; routine WORDSTART

	JR		L17FB					;

; ---

L17F0:  EX		DE,HL

	CALL	L15A2					;

	INC		DE
	LD		A,(DE)
	LD		L,A
	INC		DE
	LD		A,(DE)
	LD		H,A
	ADD		HL,DE

; pr_string_sp

L17FB:  LD		A,(HL)
	AND		07Fh
	RST		08H						; print_ch
	BIT		7,(HL)
	INC		HL
	JR		Z,L17FB					;

	LD		A,020h
	RST		08H						; print_ch
	RET

; ---------------------------------------
; THE 'INLINE PRINT STRING SPACE' ROUTINE
; ---------------------------------------
;

L1808:  EX		(SP),HL
	CALL	L17FB					; pr_string_sp
	EX		(SP),HL
	RET

; ---------------------------
; THE 'PRINT INTEGER' ROUTINE
; ---------------------------
; in HL

; -> called twice
L180E:  LD		DE,009B3h				; '.' addr
	PUSH	DE						; but save it as we need DE?

	EX		DE,HL					; transfer HL to DE.
	RST		10H						; push word DE, was HL, on Data Stack.
	POP		DE						; restore L09B3 again

; -> called twice.
L1815:  PUSH	BC						; preserve BC.

	CALL	L04BF					; executes '.' word

; the '.' exits so expects another word here


L1819:  DEFW	L181B

L181B:  DEFW	L181D

L181D:  POP		BC						;
	POP		BC						; restore BC.

	RET								; return.

; ---------------------------------
; THE 'CASSETTE INTERFACE' ROUTINES
; ---------------------------------

; ---
; tape???
; ---

L1820:  PUSH	IY

	PUSH	HL
	POP		IY

	LD		HL,L1892
	PUSH	HL

	LD		HL,0E000h
	BIT		7,C
	JR		Z,L1832					;
	LD		H,0FCh
L1832:  INC		DE
	DEC		IY
	DI
	XOR		A

L1837:  LD		B,097h

L1839:  DJNZ	L1839					;
	OUT		(0FEh),A
	XOR		008h
	INC		L
	JR		NZ,L1843				;
	INC		H
L1843:  JR		NZ,L1837				;
	LD		B,02Bh
L1847:  DJNZ	L1847					;
	OUT		(0FEh),A
	LD		L,C
	LD		BC,03B08h
L184F:  DJNZ	L184F					;
	LD		A,C
	OUT		(0FEh),A
	LD		B,038h
	JP		L188A					;

L1859:  LD		A,C
	BIT		7,B

L185C:  DJNZ	L185C					;

	JR		NC,L1864				;

	LD		B,03Dh
L1862:  DJNZ	L1862					;

L1864:  OUT		(0FEh),A
	LD		B,03Ah
	JP		NZ,L1859				;
	DEC		B
	XOR		A
L186D:  RL		L
	JP		NZ,L185C				;
	DEC		DE
	INC		IY
	LD		B,02Eh

	LD		A,07Fh
	IN		A,(0FEh)
	RRA
	RET		NC

	LD		A,D
	CP		0FFh
	RET		NC

	OR		E
	JR		Z,L188F					;

	LD		L,(IY+000h)
L1887:  LD		A,H
	XOR		L
	LD		H,A
L188A:  XOR		A
	SCF
	JP		L186D					; JUMP back

; ---

L188F:  LD		L,H
	JR		L1887					;

L1892:  POP		IY						; restore the original IY value so that
					; words can be used gain.

	EX		AF,AF'					;;
	LD		B,03Bh					;

L1897:  DJNZ	L1897					; self-loop for delay.

	XOR		A
	OUT		(0FEh),A

	LD		A,07Fh					; read the port 07FFEh
	IN		A,(0FEh)					; keyrows SPACE to V.
	RRA
	EI								; Enable Interrupts.

	JP		NC,L04F0				; jump if SPACE pressed to Error 3
					; 'BREAK pressed'.

	EX		AF,AF'					;;
	RET								; return.

; ---
; READ BYTES FROM TAPE
; ---

L18A7:  DI
	PUSH	IY
	PUSH	HL
	POP		IY
	LD		HL,L1892
	PUSH	HL
	LD		H,C
	EX		AF,AF'					; save carry
	XOR		A
	LD		C,A

L18B5:  RET		NZ

L18B6:  LD		L,000h
L18B8:  LD		B,0B8h

	CALL	L1911					;

	JR		NC,L18B5				;

	LD		A,0DFh
	CP		B
	JR		NC,L18B6				;

	INC		L
	JR		NZ,L18B8				;

L18C7:  LD		B,0CFh

	CALL	L1915					;

	JR		NC,L18B5				;

	LD		A,B
	CP		0D8h
	JR		NC,L18C7				;

	CALL	L1915					;
	RET		NC

	CALL	L18FC					;
	RET		NC

	CCF
	RET		NZ

	JR		L18F0					;

; ---

L18DF:  EX		AF,AF'
	JR		NC,L18E7				;
	LD		(IY+000h),L
	JR		L18EC					;

; ---

L18E7:  LD		A,(IY+000h)
	XOR		L
	RET		NZ

L18EC:  INC		IY
	DEC		DE
	EX		AF,AF'

L18F0:  CALL	L18FC					;

	RET		NC

	LD		A,D
	OR		E
	JR		NZ,L18DF				;

	LD		A,H
	CP		001h
L18FB:  RET

; ---

L18FC:  LD		L,001h
L18FE:  LD		B,0C7h

	CALL	L1911					;

	RET		NC

	LD		A,0E2h
	CP		B
	RL		L
	JP		NC,L18FE				;

	LD		A,H
	XOR		L
	LD		H,A
	SCF
	RET

; ---

L1911:  CALL	L1915					;
	RET		NC

L1915:  LD		A,014h
L1917:  DEC		A

	JR		NZ,L1917				;

	AND		A

L191B:  INC		B
	RET		Z

	LD		A,07Fh
	IN		A,(0FEh)
	RRA
	RET		NC

	XOR		C
	AND		010h
	JR		Z,L191B					;

	LD		A,C
	CPL
	LD		C,A
	SCF
	RET

; ---------------
; THE 'SAVE' WORD
; ---------------
; SAVE name.
; Saves entire dictionary in RAM on a dictionary type cassette file with the
; given name. Makes a noise on the internal loudspeaker.

L192D:  DEFM	"SAV"					; 'name field'
	DEFB	'E'+080h

	DEFW	L166F					; 'link field'

L1933:  DEFB	004h						; 'name length field'

L1934:  DEFW	L0EC3					; 'code field' - docolon

; ---

	DEFW	L1A10					; word to pad
	DEFW	L1A4F					;  prep some sort of header?
	DEFW	L04B6					; exit

; ----------------
; THE 'BSAVE' WORD
; ----------------
; BSAVE name
; (m, n -- )
; Save n bytes to bytes type cassette file 'name' starting at
; address m.
;

L193C:  DEFM	"BSAV"					; 'name field'
	DEFB	'E'+080h

	DEFW	L1933					; 'link field'

L1943:  DEFB	005h						; 'name length field'

L1944:  DEFW	L0EC3					; 'code field' - docolon

; ---

L1946:  DEFW	L1A3D					; prep_header
	DEFW	L1A4F					; prep some sort of header?
	DEFW	L04B6					; exit


; ----------------
; THE 'BLOAD' WORD
; ----------------
; BLOAD name
; (m, n -- )
; Load at most n bytes of bytes type cassette file 'name' starting at
; address m. ERROR 10 if the file has more than m bytes.
;
L194C:  DEFM	"BLOA"					; 'name field'
	DEFB	'D'+080h

	DEFW	L1943					; 'link field'

L1953:  DEFB	005h						; 'name length field'

L1954:  DEFW	L0EC3					; 'code field' - docolon

; ---

	DEFW	L1A3D					; prep_header
	DEFW	L1A74					; ld-bytes??
	DEFW	L1AB8					; tapeFF
	DEFW	L04B6					; exit

; -----------------
; THE 'VERIFY' WORD
; -----------------
; VERIFY name
; (  --  )
; Verifies dictionary on tape against dictionary in RAM.

L195E:  DEFM	"VERIF"					; 'name field'
	DEFB	'Y'+080h

	DEFW	L1953					; 'link field'

L1966:  DEFB	006h						; 'name length field'

L1967:  DEFW	L0EC3					; 'code field' - docolon

; ---

L1969:  DEFW	L1A10					; word to pad
	DEFW	L1271					; branch
L196D:  DEFW	0000Fh					; 15 bytes forward to L197D


; ------------------
; THE 'BVERIFY' WORD
; ------------------
; BVERIFY name
; (m, n -- )
; Verify at most n bytes of bytes type cassette file 'name' against
; RAM starting at address m. ERROR 10 if the file has more than m bytes.
; For BLOAD and BVERIFY, if m = 0, then starts at the address the bytes
; were saved from. If n = 0, then doesn't care about the length.
;

L196F:  DEFM	"BVERIF"				; 'name field'
	DEFB	'Y'+080h

	DEFW	L1966					; 'link field'

L1978:  DEFB	007h						; 'name length field'

L1979:  DEFW	L0EC3					; 'code field' - docolon

; ---

L197B:  DEFW	L1A3D					; prep_header

; ->

L197D:  DEFW	L1A74					; ld_bytes
	DEFW	L1ABE					; tape00
	DEFW	L04B6					; exit

; ---------------
; THE 'LOAD' WORD
; ---------------
; LOAD name
; (  --  )
; Searches for a dictionary cassette file 'name' and loads it in, adding it
; to end of old dictionary. Writes to the screen all files found on tape.
; For best results turn the tone control on the tape recorder right down
; (as bass as possible) and the volume control to about three-quarters
; maximum.

L1983:  DEFM	"LOA"					; 'name field'
	DEFB	'D'+080h

	DEFW	L1978					; 'link field'

L1989:  DEFB	004h						; 'name length field'

L198A:  DEFW	L0EC3					; 'code field' - docolon

; ---

L198C:  DEFW	L1A10					; word to pad

	DEFW	L1A0E					; end-forth.

	LD		HL,(STKBOT)				; STKBOT
	LD		(0230Eh),HL
	EX		DE,HL
	LD		HL,0FFCCh
	ADD		HL,SP
	AND		A
	SBC		HL,DE
	LD		(0230Ch),HL

	CALL	L04B9					; forth

L19A4:  DEFW	L1A74					; ld_bytes
	DEFW	L1AB8					; tapeFF
	DEFW	L1A0E					; end-forth.

	LD		BC,(STKBOT)				; STKBOT
	LD		HL,RAMSTART+050h
	LD		(02701h),HL
	INC		HL
	LD		(02709h),HL
	LD		HL,(02325h)
	ADD		HL,BC
	LD		(STKBOT),HL				; STKBOT
	LD		HL,0C3AFh
	ADD		HL,BC
	LD		(0270Bh),HL
	LD		DE,(02329h)
	ADD		HL,DE
	LD		DE,(RAMSTART+04Ch)
	LD		(RAMSTART+04Ch),HL
	PUSH	BC
	PUSH	DE


L19D4:  LD		(0270Dh),SP
	CALL	L1504					;
	POP		BC
	POP		HL
L19DD:  BIT		7,(HL)
	INC		HL
	JR		Z,L19DD					;
	INC		HL
	INC		HL
	LD		(HL),C
	INC		HL
	LD		(HL),B
	LD		HL,(STKBOT)				; STKBOT
	LD		BC,0000Ch				; allow twelve bytes for underflow.
	ADD		HL,BC
	LD		(SPARE),HL				; SPARE
	JP		(IY)					; to 'next'.

; ---

L19F3:  DEFW	L0EC3					; 'code field' - docolon
	DEFW	L104B					; stk_data
	DEFB	020h						; a space delimiter
	DEFW	L05AB					; word			(to pad)
	DEFW	L1A0E					; end-forth.

; ---

L19FC:  CALL	L0F2E					; blank stack

L19FF:  RST		18H						; pop word DE

	LD		A,020h					;
	LD		(DE),A					;
	LD		DE,0270Ch				;
	LD		HL,027FFh				;

	CALL	L07FA					; routine SPACE_FILL

	JP		(IY)					; to 'next'.

; ---


L1A0E:  DEFW	L18FB					; location of RET instruction.

; ---

L1A10:  DEFW	L0EC3					; 'code field' - docolon
	DEFW	L19F3					; word to pad
	DEFW	L1A0E					; end-forth.

	XOR		A						;
	LD		(02301h),A				;
	LD		HL,RAMSTART+051h				;
	LD		(0230Eh),HL				;
	EX		DE,HL					;
	LD		HL,(STKBOT)				; STKBOT
	AND		A						;
	SBC		HL,DE
	LD		(0230Ch),HL
	LD		HL,(RAMSTART+04Ch)
	LD		(02310h),HL
	LD		HL,CURRENT				; CURRENT
	LD		DE,02312h
	LD		BC,00008h				;

	LDIR							;

	JP		(IY)					; to 'next'.

; ---


L1A3D:  DEFW	L0EC3					; 'code field' - docolon
	DEFW	L19F3					; word to pad
	DEFW	L1011					; stack next word
	DEFW	0230Ch					; header location
	DEFW	L08C1					; !		store int at address
	DEFW	L1011					; stack next word
	DEFW	0230Eh					; header location
	DEFW	L08C1					; !		store int at address
	DEFW	L04B6					; exit

; ---

L1A4F:  DEFW	L1A51

L1A51:  LD		A,(02302h)				; length of word in pad
	AND		A
	JR		Z,L1AB6					; forward if null.

	LD		HL,(0230Ch)
	LD		A,H
	OR		L
	JR		Z,L1AB6					;

	PUSH	HL
	LD		DE,00019h				;
	LD		HL,02301h				; pad using ROM priority
	LD		C,D						;

	CALL	L1820					;

	POP		DE
	LD		HL,(0230Eh)				;
	LD		C,0FFh

	CALL	L1820					;

	JP		(IY)					; to 'next'.

; ---
; ld_bytes
; ---

L1A74:  DEFW	L1A76

L1A76:  LD		DE,00019h
	LD		HL,0231Ah
	LD		C,D

	SCF

	CALL	L18A7					;

	JR		NC,L1A76				; loop back until read

	LD		DE,0231Ah
	LD		A,(DE)
	AND		A
	JR		NZ,L1A95				;

	CALL	L1808					; pr_inline

; ---

L1A8D:  DEFB	00Dh						; newline
	DEFM	"Dict"
	DEFB	':'+080h				;

L1A93:  JR		L1A9F					;

; ---

L1A95:  CALL	L1808					; pr_inline

L1A98:  DEFB	00Dh						; newline

	DEFM	"Bytes"
	DEFB	':'+080h				;

; ---

L1A9F:  LD		HL,02301h
	LD		BC,00B0Bh
	JR		L1AA9					;

; ---

L1AA7:  LD		A,(DE)
	RST		08H						; print_ch

L1AA9:  LD		A,(DE)
	CP		(HL)
	JR		NZ,L1AAE				;
	DEC		C

L1AAE:  INC		HL
	INC		DE
	DJNZ	L1AA7					;

	JR		NZ,L1A76				;
	JP		(IY)					; to 'next'.

; ---

L1AB6:  RST		20H						; Error 10
	DEFB	00Ah						; Tape error

; ---
;
; ---

L1AB8:  DEFW	L1ABA					; headerless 'code field'

L1ABA:  LD		B,0FFh
	JR		L1AD0					; forward to +->

; ---
;
; ---

L1ABE:  DEFW	L1AC0					; headerless 'code field'

L1AC0:  LD		HL,02312h
	LD		DE,0232Bh
	LD		B,008h

L1AC8:  LD		A,(DE)
	INC		DE
	CP		(HL)
	INC		HL
	JR		NZ,L1AB6				; back to tape error

	DJNZ	L1AC8					; back for all 8

; common code - B is 000h from above or 0FFh from previous.

L1AD0:  LD		HL,(0230Ch)
	LD		DE,(02325h)
	LD		A,H
	OR		L
	JR		Z,L1ADF					; skip if zero

	SBC		HL,DE
	JR		C,L1AB6					; back to tape error

L1ADF:  LD		HL,(0230Eh)
	LD		A,H
	OR		L
	JR		NZ,L1AE9				; skip if zero
	LD		HL,(02327h)

L1AE9:  LD		C,0FFh
	RR		B

	CALL	L18A7					;

	JR		NC,L1AB6				; back to report tape error

	JP		(IY)					; to 'next'.

; ==========================================================
; THE 'FLOATING POINT ARITHMETIC' ROUTINES
; ==========================================================

; ---------------------
; THE 'PREP_FP' ROUTINE
; ---------------------
; ( f1, f2 -- m1, m2 )
; -> from add/mult/div
; Entered with two floating point numbers on the stack.
; The exponents are stored in the first two bytes of FP_WS and the third byte
; is loaded with the manipulated result sign.
; the two exponent locations on the Data Stack are blanked leaving just the
; binary coded mantissas.

; Begin by clearing the first part of the workspace.

L1AF4:  LD		BC,RAMSTART+00Fh				; byte 15 of the 19 bytes at FP_WS

	XOR		A						; clear accumulator.

L1AF8:  LD		(BC),A					; clear the workspace.
	DEC		C						; decrement low byte of address.
	JR		NZ,L1AF8				; and back until at RAMSTART

;

	LD		HL,(SPARE)				; fetch end of data stack+1 from SPARE.
	LD		DE,0FFFCh				; prepare  -4

	DEC		HL						; point to last byte of stack.
	LD		C,(HL)					; sign/exponent of (f2) to C.
	LD		(HL),A					; replace with zero to take overflow.

	ADD		HL,DE					; subtract four from address

; update system variable SPARE - this could be deferred.

	INC		HL						; point to location after (f1).
	LD		(SPARE),HL				; update system variable SPARE
	DEC		HL						; point to exponent of (f1)

	LD		B,(HL)					; sign/exponent of (f1) to B.
	LD		(HL),A					; replace with zero.

; At this stage we have the sign/exponent of (f1) in B and the sign/exponent
; of (f2) in C. The next section places the sign bit of (f1) in but 7 of A
; and the sign bit of (f2) in bit 6 of A. The other bits are of no importance.

	LD		A,C						; transfer C to A.
	RRCA							; rotate sign bit to bit 6.
	XOR		B						; XOR B		
	AND		07Fh						; mask off bits to restore
	XOR		B						; bit 6 as it was, bit 7 of B to A.

L1B13:   LD		(RAMSTART+002h),A				; FP_WS_02				see L1C2F

	RES		7,B						; make both numbers
	RES		7,C						; positive

	LD		(RAMSTART),BC				; store the exponents at start of FP_WS

	INC		HL						; point to (f2) again.
	EX		DE,HL					; transfer f2 pointer to DE, HL now -4
	ADD		HL,DE					; subtract four to point HL at (f1)
	RET								; return.

; On exit, HL -> (f1), DE -> (f2), B = exponent of (f1), C = exponent of (f2).

; -----------------------------
; THE 'SHIFT_ADDEND' SUBROUTINE
; -----------------------------

L1B22:  LD		A,009h
	CP		B
	JR		NC,L1B28				;

	LD		B,A						; set shift counter to nine. i.e clear.

L1B28:  LD		C,004h					; four bytes 
	INC		HL
	INC		HL
	INC		HL						; point to highest byte

	XOR		A						; prepare to start with a blank nibble.

L1B2E:  RRD								; A=0000 XXXX --> 7654->3210 =(HL)
					;			\_____<-______/

	DEC		HL						; point to next lower byte on Data Stack
	DEC		C						; decrement the byte counter.
	JR		NZ,L1B2E				; loop for all 4 bytes = 1 nibble shift

	INC		HL						; set pointer to start of number again
	DJNZ	L1B28					; decrement the shift counter and loop.

	ADD		A,0FBh					; add minus five to last nibble lost
					; will set the carry flag if 5 or more.

	PUSH	HL						;; preserve pointer to start of addend.

L1B3A:  LD		A,(HL)					; fetch the pair of BCD nibbles.

	ADC		A,B						; increment if carry set (B = 0)
	DAA								; Decimal Adjust Accumulator
					; (099h becomes 000h with carry set).

	LD		(HL),A					; put nibbles back.
	INC		HL						; point to next significant pair of 
					; binary coded decimal digits.
	JR		C,L1B3A					; and ripple any rounding through.   

	POP		HL						;; retrieve the pointer to start.
	RET								; return.

; ---------------------------
; THE 'BCD NEGATE' SUBROUTINE
; ---------------------------
; Negates the four byte, 8 nibble, binary coded decimal on the Data Stack.
; For example -123.456 
; is prepared as 000h 012h 034h 056h
; and negated as 099h 087h 065h 034h

L1B43:  PUSH	BC						; preserve the two
	PUSH	HL						; main registers used.

	LD		B,004h					; set byte counter to four.
	AND		A						; clear carry.

L1B48:  LD		A,000h					; set to zero without disturbing carry.

	SBC		A,(HL)					; subtract pair of digits
	DAA								; Decimal Adjust Accumulator
					; adjusts as if from 100 setting carry

	LD		(HL),A					; place adjusted decimals back. 

	INC		HL						; next location on Data Stack.

	DJNZ	L1B48					; loop for all 4 bytes.

	POP		HL						; restore the
	POP		BC						; saved registers.

	RET								; return.

; ------------------------------
; THE 'BCD OPERATION' SUBROUTINE
; ------------------------------
; This versatile routine performs the binary coded decimal addition of
; two floating point values with C = 1.
; The second entry point is used in multiplication.

; ->
L1B53:  LD		C,001h					; signal the operation is addition.

; -> (with c!=0)
L1B55:  PUSH	HL						; preserve the 
	PUSH	DE						; three main
	PUSH	BC						; registers.

	LD		A,C						; treat C as a binary coded decimal.
	AND		00Fh						; isolate the right-hand nibble.
	LD		B,A						; transfer R.H. nibble to B

	XOR		C						; A now has L.H. nibble.
	LD		C,A						; place in C.

; this next magical routine converts the two BCD digits to binary.
; imagine we started with ninety-nine so C = 1001 0000  and B = 0000 1001

	RRCA							;	0100 1000
	RRCA							;	0010 0100
	ADD		A,C						;	1011 0100
	RRCA							;	0101 1010
	ADD		A,B						;	0110 0011  = 99 binary

	LD		C,A						;	binary multiplier in C

; note that for simple addition C is unchanged and still contains 1.

	LD		B,004h					; four bytes to consider
	XOR		A						; clear accumulator ensuring no initial
					; carry is fed into the loop.

; loop

L1B67:  PUSH	BC						; push the counters. 
	PUSH	DE						; push the (f2) pointer

	PUSH	HL						; push the (f1) pointer.

	ADD		A,(HL)					; add any running carry to (f1) cell.

	DAA								; Decimal Adjust Accumulator
					; possibly setting carry.

	LD		L,A						; result to L
	LD		A,(DE)					; fetch (f2) cell value.
	LD		H,000h					; set high bytes H and D to
	LD		D,H						; zero without disturbing carry

	RL		H						; now pick up any carry in H.

	AND		A						; test (f2) cell value.
	JR		Z,L1B91					; skip forward to just store the carry
					; result if the addend value is zero.

	LD		E,A						; else DE now holds cell value.

L1B77:  SRL		C						; shift counter C   0->76543210->C

	JR		NC,L1B83				; skip addition if no carry.

; else perform HL=HL+DE in BCD.

	LD		A,L						; fetch low byte of (f1) cell.
	ADD		A,E						; add to low byte of (f2) cell.
	DAA								; DAA.
	LD		L,A						; result in L and carry.

	LD		A,H						; fetch high byte possibly 1 from carry
	ADC		A,D						; add in any carry from above (D=0)
	DAA								; comes into play with multiplication.
	LD		H,A						; result to H.

L1B83:  INC		C						; test the counter for zero.
	DEC		C						; (will be if addition)
	JR		Z,L1B91					; forward when zero ->

; else is BCD multiplication - double the DE value.

	LD		A,E						;
	ADD		A,A						;
	DAA								;
	LD		E,A						;

	LD		A,D						;
	ADC		A,A						;
	DAA								;
	LD		D,A						;

	JR		L1B77					; back to continue multiplying by C.

; ---

; ->
L1B91:  EX		DE,HL					; transfer result to DE.

	POP		HL						; pop (f1) cell pointer
	LD		(HL),E					; insert result.
	LD		A,D						; transfer any carry to A
	POP		DE						; pop the (f2) pointer
	POP		BC						; pop the counter, and initial C value.

	INC		DE						; increment (f2) cell pointer.
	INC		HL						; increment (f1) cell pointer.

	DJNZ	L1B67					; loop back for all 4 bytes.

	POP		BC						; restore the
	POP		DE						; three main
	POP		HL						; registers.

	RET								; return.

; -------------
; THE 'F-' WORD
; -------------
; ( f1, f2 -- f1-f2 )
; Subtracts top two floating point numbers.
;
; just flip the sign and then do floating point addition.

L1B9F:  DEFB	'F'						; 'name field'  
	DEFB	'-'+080h

	DEFW	L1989					; 'link field'

L1BA3:  DEFB	002h						; 'name length field'

L1BA4:  DEFW	L0EC3					; 'code field' - docolon

; ---

L1BA6:  DEFW	L1D0F					; fnegate
	DEFW	L1A0E					; end-forth.

	JR		L1BB3					; forward to floating point addition.

; -------------
; THE 'F+' WORD
; -------------
; ( f1, f2 -- f1+f2 )
; Adds top two floating point numbers.

L1BAC:  DEFB	'F'						; 'name field'   
	DEFB	'+'+080h

	DEFW	L1BA3					; 'link field'

L1BB0:  DEFB	002h						; 'name length field'

L1BB1:  DEFW	L1BB3					; 'code field'

; ---

L1BB3:  CALL	L1AF4					; PREP_FP

	LD		A,C						; take exponent of second number (f2).
	SUB		B						; subtract exponent of first (f1).
	PUSH	AF						; save result flags.

	JR		NC,L1BC1				; forward if second number >= first.

	EX		DE,HL					; else swap the pointers.
	NEG								; negate negative result.
	LD		(IX+000h),B				; place B in FP_WS_0  (was C).

L1BC1:  LD		B,A						; put positive subtraction result in B.

	CALL	NZ,L1B22				; routine SHIFT_ADDEND aligns digits if
					; exponents are not equal.

	POP		AF						; retrieve subtraction result flags.
	JR		NC,L1BC9				; forward is second number was >= first.

	EX		DE,HL					; else switch the pointers back.

L1BC9:  LD		B,002h					; two floating point numbers to consider

	LD		C,(IX+002h)				; FP_WS_02

L1BCE:  RL		C						; test sign bit first bit 7 then bit 6.

	CALL	C,L1B43					; routine BCD neg if carry

	EX		DE,HL					; switch number pointers.

	DJNZ	L1BCE					; decrement counter and loop if second
					; number still to do.

	CALL	L1B53					; the BCD ADDITION routine.

; The routine preserves main registers so HL->(f1), DE->(f2) and B is zero.

	DEC		DE						; point to highest byte of result which
					; could be 099h if one negative number
					; involved or 098h if two negatives.

	LD		A,(DE)					; fetch the result sign byte.
	ADD		A,068h					; add 068h causing carry if negative.
	RR		B						; pick up carry in bit 7 of B, which 
					; was zero so zero flag now set if none.

	LD		(IX+002h),B				; place result sign in  FP_WS_02

	CALL	NZ,L1B43				; routine BCD_NEGATE if negative result.

; if the 

L1BE5:  LD		A,(DE)					;
	AND		A						;

	JR		NZ,L1C02				;

; else A is zero.

	DEC		(IX+000h)				; decrement the result exponent FP_WS_00
	DEC		(IX+000h)				; as two nibbles will be moved at a time

	PUSH	DE						; save pointer to 4th byte

	LD		H,D						; make HL
	LD		L,E						; equal to DE
	DEC		HL						; minus one.

	LD		BC,003FFh				; counter for three bytes. The 0FFh 
					; value ensures B is not affected by 
					; the LDD instruction. Also A is 0.

L1BF6:  OR		(HL)					; (detects if the three bytes are zero)

	LDD								; copy HL contents one location higher 
					; to that addressed by DE. Also dec bc.

	DJNZ	L1BF6					; repeat for all 3 bytes

	EX		DE,HL					; make HL address lowest location
	LD		(HL),B					; and insert a zero into vacated byte.

	POP		DE						; restore the pointer to the 4th byte.

	JR		NZ,L1BE5				; jump back to the end test if something
					; was being shifted through.

; else all four bytes are zero - i.e. the result of the addition is zero.

	JP		(IY)					; to 'next'.

; ---

; The branch was to here, from the end test above, when the 4th byte had been 
; filled.
; Before joining common code, ensure that the initial block move will be
; ineffective.

L1C02:  LD		D,H						; make DE the same as HL - the source
	LD		E,L						; and the destination are the same.

; -> common code from mult and above.

L1C04:  PUSH	DE						; save start location.

	LD		BC,00004h				; 4 bytes to consider.
	LDIR							; block move sets DE to one past dest.

	POP		HL						; restore start of source.

	DEC		DE						; DE now addresses 4th byte.

L1C0C:  LD		A,(DE)					; load the 4th byte to accumulator.
	AND		A						; test for zero.

	JR		Z,L1C21					; skip forward if so.

	CP		010h						; test if one or two nibbles populated
					; setting carry for a single nibble.

	SBC		A,A						; 000h for two nibbles, 0FFh for one.
	INC		A						; 001h					000h
	INC		A						; 002h for two nibbles, 001h for one :-)

	LD		B,A						; nibble count to B.
	ADD		A,(IX+000h)				; add count to FP_WS_00 the result
	LD		(RAMSTART),A				; exponent and place back in FP_WS_00.

	CALL	L1B22					; routine 'shift_addend' moves all the 
					; nibbles to the right.

	JR		L1C0C					; back to pick up byte and then to
					; next routine.

; ---

; now test for a result that is too large or too small. 
; Note. these results may have arisen from multiplication or addition.

L1C21:  LD		A,(RAMSTART)				; fetch result exponent from FP_WS_00

	DEC		A						; decrement?
	CP		0BFh						; compare lower limit
	INC		A						; increment?

	JR		NC,L1C3D				; forward if less to ZERO_RSLT

	CP		080h						; compare upper limit
	JR		NC,L1C3B				; forward to Error 8 - Overflow

	LD		B,A						; save unsigned exponent in B.

; now combine result sign and the exponent.
; for addition then FP_WS_02 contains either 080h or 000h and most of what 
; follows does not apply.
; for multiplication then bit 7 is sign of (f1) bit 6 is sign of (f2).

L1C2F:   LD		A,(RAMSTART+002h)				; FP_WS_02			see L1B13

	LD		C,A						; save a copy in C
	RLA								; rotate bit 6 to 7
	XOR		C						; XOR bit 7 - minus * minus = a plus.
	AND		080h						; only interested in bit 7.
	XOR		B						; combine with exponent.
	LD		(DE),A					; and place in sign/exp on Data Stack.

	JP		(IY)					; to 'next'.

; ---

L1C3B:  RST		20H						; Error 8.
	DEFB	008h						; Overflow in floating-point arithmetic.

; ------------------------------------
; THE 'ZERO RESULT' TERMINATING BRANCH
; ------------------------------------

L1C3D:  LD		BC,00400h				; count 4 bytes, fill byte is zero.

L1C40:  LD		(HL),C					; insert a zero.
	INC		HL						; next location.
	DJNZ	L1C40					; repeat for all 4 bytes.

	JP		(IY)					; to 'next'.




; -------------
; THE 'F*' WORD
; -------------
; (f1, f2 -- f1*f2)
; Multiplies top two floating point numbers and leaves result on the stack.

L1C46:  DEFB	'F'						; 'name field' 
	DEFB	'*'+080h

	DEFW	L1BB0					; 'link field'

L1C4A:  DEFB	002h						; 'name length field'

L1C4B:  DEFW	L1C4D					; 'code field'

; ---

L1C4D:  CALL	L1AF4					; routine PREP_FP prepares the two
					; numbers on the Data Stack placing the
					; exponents and signs in FP_WS.

	XOR		A						; set accumulator to zero.
	CP		B						; compare to exponent of (f1).
	SBC		A,A						; 000h if zero or 0FFh
	AND		C						; combine with exponent of (f2).

	JR		Z,L1C3D					; back if zero to exit via ZERO_RSLT.

	PUSH	HL						; save pointer to first number - result.

	LD		BC,RAMSTART+002h				; set BC to location before free 
					; workspace set to zero by PREP_FP.

	PUSH	BC						; push onto machine stack.

	LD		B,003h					; count three bytes - six nibbles.

L1C5D:  LD		C,(HL)					; fetch BCD pair to C
	INC		HL						; address more significant pair.

	EX		(SP),HL					; Data Stack pointer to machine stack,
					; workspace pointer to HL.
	INC		HL						; increment workspace pointer.

	CALL	L1B55					; routine BCD_OP multiplies C by each
					; of the 4 bytes of (f2) laying the 
					; result down in workspace at HL

	EX		(SP),HL					; swap in multiplier pointer to HL,
					; workspace pointer to machine stack.

	DJNZ	L1C5D					; repeat for all three bytes.

	LD		BC,(RAMSTART)				; fetch raw exponents from FP_WS_00/01
	LD		A,B						; add the exponents
	ADD		A,C						; together.

	SUB		042h						; adjust for sign

	LD		(RAMSTART),A				; put the result back in FP_WS_00.

	POP		HL						; pop workspace pointer to HL.
	POP		DE						; pop result pointer to DE.

	JR		L1C04					; back to common code to copy the 4
					; bytes from the workspace to the 
					; Data Stack and then set exponent
					; and sign.

; -------------
; THE 'F/' WORD
; -------------
; ( f1, f2 -- f1/f2 )
; Divides two floating point numbers.

L1C76:  DEFB	'F'						; 'name field'
	DEFB	'/'+080h

	DEFW	L1C4A					; 'link field'

L1C7A:  DEFB	002h						; 'name length field'

L1C7B:  DEFW	L1C7D					; 'code field'

;---

L1C7D:  CALL	L1AF4					; routine PREP_FP prepares the two
					; numbers (f1) and (f2) placing the 
					; raw exponents in the first two 
					; locations of workspace, the signs in
					; the next location and clearing the
					; sixteen remaining locations.
					; This must be the one that uses them 
					; all.

	XOR		A						; set accumulator to zero.
	CP		B						; compare to exponent of dividend (f1).
	JR		Z,L1C3D					; forward if zero to ZERO_RSLT.

	CP		C						; compare to exponent of divisor (f2).
	JR		Z,L1C3B					; back if zero to Error 8 - Overflow.
					; division by zero.

; HL points to first number on stack, DE to second.

	INC		DE						;
	INC		DE						;
	LD		A,(DE)					; get first two digits to A
	DEC		DE						;
	DEC		DE						; back to first

	ADD		A,001h					; add one (e.g. 99 would give 9A)
	DAA								; adjust  (e.g. 09Ah would be 000h carry)
	EX		AF,AF'					; save the flags
	EX		DE,HL					; HL now points to divisor 

	CALL	L1B43					; routine BCD negate the divisor

	EX		DE,HL					; point back again.
	PUSH	HL						; save pointer to first - the result.

	LD		DE,RAMSTART+010h				; destination FP_WS_10
	LD		BC,00004h				; four bytes

	LDIR							; copy to end of FP_WS 
					; (+ one byte of list_ws)

	EX		DE,HL					; HL points to last cell plus one.
	DEC		HL						; Now points to last byte copied.

	LD		B,005h					; count 5.

; loop

L1CA2:  PUSH	DE						;
	LD		A,(HL)					;
	DEC		HL						;
	LD		E,(HL)					;

	EX		AF,AF'					;
	LD		C,A						;
	EX		AF,AF'					;

	INC		C						;
	DEC		C						;
	JR		NZ,L1CB0				;

	LD		E,A						;
	JR		L1CCB					;

; ---

L1CB0:  PUSH	BC						;
	LD		B,002h					;

L1CB3:  LD		D,010h					;

L1CB5:  SLA		E						;
	RLA								;
	RL		D						;
	JR		NC,L1CB5				;

	INC		D						;

L1CBD:  SUB		C						;
	DAA								;
	INC		E						;
	JR		NC,L1CBD				;

	DEC		D						;
	JR		NZ,L1CBD				;

	ADD		A,C						;
	DAA								;
	DEC		E						;
	DJNZ	L1CB3					;

	POP		BC						;

L1CCB:  LD		C,E						;
	POP		DE						;
	INC		C						;
	DEC		C						;
	JR		Z,L1CE8					;

	PUSH	HL						;
	DEC		HL						;
	DEC		HL						;

	CALL	L1B55					; bcd_op mult

	PUSH	DE						;

	LD		DE,0FFFBh				; -4
	ADD		HL,DE					;

	LD		DE,RAMSTART+003h				; FP_WS_03
	LD		A,C						;
	LD		(DE),A					;

	CALL	L1B53					; bcd_op add

	POP		DE						;
	POP		HL						;
	INC		HL						;
	INC		B						;

L1CE8:  DJNZ	L1CA2					;

	LD		HL,(RAMSTART)				; FP_WS
	LD		A,H						;
	SUB		L						;
	ADD		A,040h					;

	LD		HL,RAMSTART+008h				; FP_WS
	LD		B,A						;
	LD		A,(RAMSTART+00Bh)				;
	AND		A						;
	JR		NZ,L1CFE				;

	DEC		B						;
	DEC		B						;
	DEC		HL						;

L1CFE:  LD		(IX+000h),B				;

	POP		DE						;

	JP		L1C04					; back to common code to copy the 4
					; bytes from the workspace to the 
					; Data Stack and then set exponent
					; and sign.

; ------------------
; THE 'FNEGATE' WORD
; ------------------
; ( f -- -f )
; Floating point negation.
; Toggle the sign bit unless the number is zero (four zero bytes).

L1D05:  DEFM	"FNEGAT"				; 'name field'
	DEFB	'E'+080h

	DEFW	L1C7A					; 'link field'

L1D0E:  DEFB	007h						; 'name length field'

L1D0F:  DEFW	L1D11					; 'code field'

; ---

L1D11:  RST		18H						; pop word from data stack to DE.

	LD		A,D						; exponent byte to A.
	AND		A						; test for zero.
	JR		Z,L1D18					; forward if so to leave undisturbed.

	XOR		080h						; else toggle the sign bit

L1D18:  LD		D,A						; exponent byte to D.
	RST		10H						; push word DE on data stack.

	JP		(IY)					; to 'next'.

; --------------
; THE 'INT' WORD
; --------------
; (f -- n)
; Converts signed floating point number to signed single length integer.
; Truncates towards zero.
; Result in range -32768 to 32767

L1D1C:  DEFM	"IN"					; 'name field'
	DEFB	'T'+080h

	DEFW	L1D0E					; 'link field'

L1D21:  DEFB	003h						; 'name length field'

L1D22:  DEFW	L1D24					; 'code field'

; ---

;L1D24:  LD		HL,(SPARE)				; fetch value from SPARE.
L1D24:  LD		HL,(SPARE)				; fetch value from SPARE.
	DEC		HL						; now points to end of data stack.

	LD		DE,00000h				; initialize 16-bit result.

L1D2B:  LD		A,(HL)					; fetch the exponent byte.

	RLCA							; double exponent moving sign bit to 0.

	CP		082h						; compare exponent to plus 1.
	JR		C,L1D45					; forward if number is smaller than 1
					; to return the result DE.

; else the number is >= 1.0

	XOR		A						; clear accumulator.
	DEC		HL						; point to the first pair of BCD digits.

	CALL	L0732					; call shift_fp

	INC		HL						; point to exponent.

	EX		DE,HL					; pointer to DE, integer to HL.

; before adding in the nibble from the mantissa, multiply any previous result
; by ten.

	LD		B,H						; make a copy of HL in BC.
	LD		C,L						;

	ADD		HL,HL					; * 2
	ADD		HL,HL					; * 4
	ADD		HL,BC					; * 5
	ADD		HL,HL					; * 10

	LD		C,A						; leftmost nibble from mantissa to C.
	LD		B,000h					; prepare to add just the nibble.
	ADD		HL,BC					; add into the result.
	EX		DE,HL					; switch back to DE

	JR		L1D2B					; back to loop.

; ---

L1D45:  DEC		HL						; skip redundant components of Floating
	DEC		HL						; Point number addressing the
					; lower two bytes on the data stack.
	LD		(HL),D					; insert high-order byte first.
	DEC		HL						; point to location beneath.
	LD		(HL),E					; insert low-order byte.

	LD		DE,L0D94				; 'pos' addr.

	JP		L04BF					; exit via 'pos' routine.

; -----------------
; THE 'UFLOAT' WORD
; -----------------
; (un -- f)
; Converts unsigned single length integer to floating point.
; e.g. 65535 16 bit number converted to  32-bit float 8-bit sign/exponent
; 6-nibble BCD mantissa.	045h  6 5 5 3 5 0

L1D50:  DEFM	"UFLOA"					; 'name field'
	DEFB	'T'+080h

	DEFW	L1D21					; 'link field'

L1D58:  DEFB	006h						; 'name length field'

L1D59:  DEFW	L1D5B					; 'code field'

; ---

L1D5B:  RST		18H						; pop word off stack to DE
	EX		DE,HL					; now HL

	LD		BC,01000h				; count 16 bits, set C to zero.
	LD		D,C
	LD		E,C						; initialize DE to zero.

L1D62:  ADD		HL,HL					; double

	LD		A,E						;
	ADC		A,A						; add carry to low byte
	DAA								; adjust
	LD		E,A						;

	LD		A,D						;
	ADC		A,A						; add carry to high byte
	DAA								; adjust
	LD		D,A						;

	RL		C						; pick up overflow
	DJNZ	L1D62					; loop  back for 16 bits

	RST		10H						; DE to Data stack.

	LD		D,046h					; exponent byte   +6
	LD		E,C						; low byte

	RST		10H						; higher word of float to stack.

	DEC		HL						; point to
	DEC		HL						; lower on stack

	CALL	L0740					; normalize routine.

	JP		(IY)					; to 'next'.

; -------------------
; THE 'CHARACTER SET'
; -------------------
; The 96 ASCII character bitmaps are copied to RAM during initialization and
; the 8x8 characters can afterwards be redefined by the user.
; Some ROM space is saved by supplying the blank top line of most characters
; and in case of the middle range (capitals with no descenders) the bottom
; line as well. Only the final copyright symbol is held in ROM as an 8x8
; character.


; 020h - Character: ' '			CHR0h(32)

L1D7B:  DEFB	00000000B
	DEFB	00000000B
	DEFB	00000000B
	DEFB	00000000B
	DEFB	00000000B
	DEFB	00000000B
	DEFB	00000000B

; 021h - Character: '!'			CHR0h(33)

	DEFB	00010000B
	DEFB	00010000B
	DEFB	00010000B
	DEFB	00010000B
	DEFB	00000000B
	DEFB	00010000B
	DEFB	00000000B

; 022h - Character: '"'			CHR0h(34)

	DEFB	00100100B
	DEFB	00100100B
	DEFB	00000000B
	DEFB	00000000B
	DEFB	00000000B
	DEFB	00000000B
	DEFB	00000000B

; 023h - Character: '#'			CHR0h(35)

	DEFB	00100100B
	DEFB	01111110B
	DEFB	00100100B
	DEFB	00100100B
	DEFB	01111110B
	DEFB	00100100B
	DEFB	00000000B

; 024h - Character: '0h'			CHR0h(36)

	DEFB	00001000B
	DEFB	00111110B
	DEFB	00101000B
	DEFB	00111110B
	DEFB	00001010B
	DEFB	00111110B
	DEFB	00001000B

; 025h - Character: '%'			CHR0h(37)

	DEFB	01100010B
	DEFB	01100100B
	DEFB	00001000B
	DEFB	00010000B
	DEFB	00100110B
	DEFB	01000110B
	DEFB	00000000B

; 026h - Character: '&'			CHR0h(38)

	DEFB	00010000B
	DEFB	00101000B
	DEFB	00010000B
	DEFB	00101010B
	DEFB	01000100B
	DEFB	00111010B
	DEFB	00000000B

; 027h - Character: '''			CHR0h(39)

	DEFB	00001000B
	DEFB	00010000B
	DEFB	00000000B
	DEFB	00000000B
	DEFB	00000000B
	DEFB	00000000B
	DEFB	00000000B

; 028h - Character: '('			CHR0h(40)

	DEFB	00000100B
	DEFB	00001000B
	DEFB	00001000B
	DEFB	00001000B
	DEFB	00001000B
	DEFB	00000100B
	DEFB	00000000B

; 029h - Character: ')'			CHR0h(42)

	DEFB	00100000B
	DEFB	00010000B
	DEFB	00010000B
	DEFB	00010000B
	DEFB	00010000B
	DEFB	00100000B
	DEFB	00000000B

; 02Ah - Character: '*'			CHR0h(42)

	DEFB	00000000B
	DEFB	00010100B
	DEFB	00001000B
	DEFB	00111110B
	DEFB	00001000B
	DEFB	00010100B
	DEFB	00000000B

; 02Bh - Character: '+'			CHR0h(43)

	DEFB	00000000B
	DEFB	00001000B
	DEFB	00001000B
	DEFB	00111110B
	DEFB	00001000B
	DEFB	00001000B
	DEFB	00000000B

; 02Ch - Character: ','			CHR0h(44)

	DEFB	00000000B
	DEFB	00000000B
	DEFB	00000000B
	DEFB	00000000B
	DEFB	00001000B
	DEFB	00001000B
	DEFB	00010000B

; 02Dh - Character: '-'			CHR0h(45)

	DEFB	00000000B
	DEFB	00000000B
	DEFB	00000000B
	DEFB	00111110B
	DEFB	00000000B
	DEFB	00000000B
	DEFB	00000000B

; 02Eh - Character: '.'			CHR0h(46)

	DEFB	00000000B
	DEFB	00000000B
	DEFB	00000000B
	DEFB	00000000B
	DEFB	00011000B
	DEFB	00011000B
	DEFB	00000000B

; 02Fh - Character: '/'			CHR0h(47)

	DEFB	00000000B
	DEFB	00000010B
	DEFB	00000100B
	DEFB	00001000B
	DEFB	00010000B
	DEFB	00100000B
	DEFB	00000000B

; 030h - Character: '0'			CHR0h(48)

	DEFB	00111100B
	DEFB	01000110B
	DEFB	01001010B
	DEFB	01010010B
	DEFB	01100010B
	DEFB	00111100B
	DEFB	00000000B

; 031h - Character: '1'			CHR0h(49)

	DEFB	00011000B
	DEFB	00101000B
	DEFB	00001000B
	DEFB	00001000B
	DEFB	00001000B
	DEFB	00111110B
	DEFB	00000000B

; 032h - Character: '2'			CHR0h(50)

	DEFB	00111100B
	DEFB	01000010B
	DEFB	00000010B
	DEFB	00111100B
	DEFB	01000000B
	DEFB	01111110B
	DEFB	00000000B

; 033h - Character: '3'			CHR0h(51)

	DEFB	00111100B
	DEFB	01000010B
	DEFB	00001100B
	DEFB	00000010B
	DEFB	01000010B
	DEFB	00111100B
	DEFB	00000000B

; 034h - Character: '4'			CHR0h(52)

	DEFB	00001000B
	DEFB	00011000B
	DEFB	00101000B
	DEFB	01001000B
	DEFB	01111110B
	DEFB	00001000B
	DEFB	00000000B

; 035h - Character: '5'			CHR0h(53)

	DEFB	01111110B
	DEFB	01000000B
	DEFB	01111100B
	DEFB	00000010B
	DEFB	01000010B
	DEFB	00111100B
	DEFB	00000000B

; 036h - Character: '6'			CHR0h(54)

	DEFB	00111100B
	DEFB	01000000B
	DEFB	01111100B
	DEFB	01000010B
	DEFB	01000010B
	DEFB	00111100B
	DEFB	00000000B

; 037h - Character: '7'			CHR0h(55)

	DEFB	01111110B
	DEFB	00000010B
	DEFB	00000100B
	DEFB	00001000B
	DEFB	00010000B
	DEFB	00010000B
	DEFB	00000000B

; 038h - Character: '8'			CHR0h(56)

	DEFB	00111100B
	DEFB	01000010B
	DEFB	00111100B
	DEFB	01000010B
	DEFB	01000010B
	DEFB	00111100B
	DEFB	00000000B

; 039h - Character: '9'			CHR0h(57)

	DEFB	00111100B
	DEFB	01000010B
	DEFB	01000010B
	DEFB	00111110B
	DEFB	00000010B
	DEFB	00111100B
	DEFB	00000000B

; 03Ah - Character: ':'			CHR0h(58)

	DEFB	00000000B
	DEFB	00000000B
	DEFB	00010000B
	DEFB	00000000B
	DEFB	00000000B
	DEFB	00010000B
	DEFB	00000000B

; 03Bh - Character: ';'			CHR0h(59)

	DEFB	00000000B
	DEFB	00010000B
	DEFB	00000000B
	DEFB	00000000B
	DEFB	00010000B
	DEFB	00010000B
	DEFB	00100000B

; 03Ch - Character: '<'			CHR0h(60)

	DEFB	00000000B
	DEFB	00000100B
	DEFB	00001000B
	DEFB	00010000B
	DEFB	00001000B
	DEFB	00000100B
	DEFB	00000000B

; 03Dh - Character: '='			CHR0h(61)

	DEFB	00000000B
	DEFB	00000000B
	DEFB	00111110B
	DEFB	00000000B
	DEFB	00111110B
	DEFB	00000000B
	DEFB	00000000B

; 03Eh - Character: '>'			CHR0h(62)

	DEFB	00000000B
	DEFB	00010000B
	DEFB	00001000B
	DEFB	00000100B
	DEFB	00001000B
	DEFB	00010000B
	DEFB	00000000B

; 03Fh - Character: '?'			CHR0h(63)

	DEFB	00111100B
	DEFB	01000010B
	DEFB	00000100B
	DEFB	00001000B
	DEFB	00000000B
	DEFB	00001000B

; 040h - Character: '@'			CHR0h(64)

	DEFB	00111100B
	DEFB	01001010B
	DEFB	01010110B
	DEFB	01011110B
	DEFB	01000000B
	DEFB	00111100B

; 041h - Character: 'A'			CHR0h(65)

	DEFB	00111100B
	DEFB	01000010B
	DEFB	01000010B
	DEFB	01111110B
	DEFB	01000010B
	DEFB	01000010B

; 042h - Character: 'B'			CHR0h(66)

	DEFB	01111100B
	DEFB	01000010B
	DEFB	01111100B
	DEFB	01000010B
	DEFB	01000010B
	DEFB	01111100B

; 043h - Character: 'C'			CHR0h(67)

	DEFB	00111100B
	DEFB	01000010B
	DEFB	01000000B
	DEFB	01000000B
	DEFB	01000010B
	DEFB	00111100B

; 044h - Character: 'D'			CHR0h(68)

	DEFB	01111000B
	DEFB	01000100B
	DEFB	01000010B
	DEFB	01000010B
	DEFB	01000100B
	DEFB	01111000B

; 045h - Character: 'E'			CHR0h(69)

	DEFB	01111110B
	DEFB	01000000B
	DEFB	01111100B
	DEFB	01000000B
	DEFB	01000000B
	DEFB	01111110B

; 046h - Character: 'F'			CHR0h(70)

	DEFB	01111110B
	DEFB	01000000B
	DEFB	01111100B
	DEFB	01000000B
	DEFB	01000000B
	DEFB	01000000B

; 047h - Character: 'G'			CHR0h(71)

	DEFB	00111100B
	DEFB	01000010B
	DEFB	01000000B
	DEFB	01001110B
	DEFB	01000010B
	DEFB	00111100B

; 048h - Character: 'H'			CHR0h(72)

	DEFB	01000010B
	DEFB	01000010B
	DEFB	01111110B
	DEFB	01000010B
	DEFB	01000010B
	DEFB	01000010B

; 049h - Character: 'I'			CHR0h(73)

	DEFB	00111110B
	DEFB	00001000B
	DEFB	00001000B
	DEFB	00001000B
	DEFB	00001000B
	DEFB	00111110B

; 04Ah - Character: 'J'			CHR0h(74)

	DEFB	00000010B
	DEFB	00000010B
	DEFB	00000010B
	DEFB	01000010B
	DEFB	01000010B
	DEFB	00111100B

; 04Bh - Character: 'K'			CHR0h(75)

	DEFB	01000100B
	DEFB	01001000B
	DEFB	01110000B
	DEFB	01001000B
	DEFB	01000100B
	DEFB	01000010B

; 04Ch - Character: 'L'			CHR0h(76)

	DEFB	01000000B
	DEFB	01000000B
	DEFB	01000000B
	DEFB	01000000B
	DEFB	01000000B
	DEFB	01111110B

; 04Dh - Character: 'M'			CHR0h(77)

	DEFB	01000010B
	DEFB	01100110B
	DEFB	01011010B
	DEFB	01000010B
	DEFB	01000010B
	DEFB	01000010B

; 04Eh - Character: 'N'			CHR0h(78)

	DEFB	01000010B
	DEFB	01100010B
	DEFB	01010010B
	DEFB	01001010B
	DEFB	01000110B
	DEFB	01000010B

; 04Fh - Character: 'O'			CHR0h(79)

	DEFB	00111100B
	DEFB	01000010B
	DEFB	01000010B
	DEFB	01000010B
	DEFB	01000010B
	DEFB	00111100B

; 050h - Character: 'P'			CHR0h(80)

	DEFB	01111100B
	DEFB	01000010B
	DEFB	01000010B
	DEFB	01111100B
	DEFB	01000000B
	DEFB	01000000B

; 051h - Character: 'Q'			CHR0h(81)

	DEFB	00111100B
	DEFB	01000010B
	DEFB	01000010B
	DEFB	01010010B
	DEFB	01001010B
	DEFB	00111100B

; 052h - Character: 'R'			CHR0h(82)

	DEFB	01111100B
	DEFB	01000010B
	DEFB	01000010B
	DEFB	01111100B
	DEFB	01000100B
	DEFB	01000010B

; 053h - Character: 'S'			CHR0h(83)

	DEFB	00111100B
	DEFB	01000000B
	DEFB	00111100B
	DEFB	00000010B
	DEFB	01000010B
	DEFB	00111100B

; 054h - Character: 'T'			CHR0h(84)

	DEFB	11111110B
	DEFB	00010000B
	DEFB	00010000B
	DEFB	00010000B
	DEFB	00010000B
	DEFB	00010000B

; 055h - Character: 'U'			CHR0h(85)

	DEFB	01000010B
	DEFB	01000010B
	DEFB	01000010B
	DEFB	01000010B
	DEFB	01000010B
	DEFB	00111110B

; 056h - Character: 'V'			CHR0h(86)

	DEFB	01000010B
	DEFB	01000010B
	DEFB	01000010B
	DEFB	01000010B
	DEFB	00100100B
	DEFB	00011000B

; 057h - Character: 'W'			CHR0h(87)

	DEFB	01000010B
	DEFB	01000010B
	DEFB	01000010B
	DEFB	01000010B
	DEFB	01011010B
	DEFB	00100100B

; 058h - Character: 'X'			CHR0h(88)

	DEFB	01000010B
	DEFB	00100100B
	DEFB	00011000B
	DEFB	00011000B
	DEFB	00100100B
	DEFB	01000010B

; 059h - Character: 'Y'			CHR0h(89)

	DEFB	10000010B
	DEFB	01000100B
	DEFB	00101000B
	DEFB	00010000B
	DEFB	00010000B
	DEFB	00010000B

; 05Ah - Character: 'Z'			CHR0h(90)

	DEFB	01111110B
	DEFB	00000100B
	DEFB	00001000B
	DEFB	00010000B
	DEFB	00100000B
	DEFB	01111110B

; 05Bh - Character: '['			CHR0h(91)

	DEFB	00001110B
	DEFB	00001000B
	DEFB	00001000B
	DEFB	00001000B
	DEFB	00001000B
	DEFB	00001110B

; 05Ch - Character: '\'			CHR0h(92)

	DEFB	00000000B
	DEFB	01000000B
	DEFB	00100000B
	DEFB	00010000B
	DEFB	00001000B
	DEFB	00000100B

; 05Dh - Character: ']'			CHR0h(93)

	DEFB	01110000B
	DEFB	00010000B
	DEFB	00010000B
	DEFB	00010000B
	DEFB	00010000B
	DEFB	01110000B

; 05Eh - Character: '^'			CHR0h(94)

	DEFB	00010000B
	DEFB	00111000B
	DEFB	01010100B
	DEFB	00010000B
	DEFB	00010000B
	DEFB	00010000B

; 05Fh - Character: '_'			CHR0h(95)

	DEFB	00000000B
	DEFB	00000000B
	DEFB	00000000B
	DEFB	00000000B
	DEFB	00000000B
	DEFB	00000000B
	DEFB	11111111B

; 060h - Character:  �			CHR0h(96)

	DEFB	00011100B
	DEFB	00100010B
	DEFB	01111000B
	DEFB	00100000B
	DEFB	00100000B
	DEFB	01111110B
	DEFB	00000000B

; 061h - Character: 'a'			CHR0h(97)

	DEFB	00000000B
	DEFB	00111000B
	DEFB	00000100B
	DEFB	00111100B
	DEFB	01000100B
	DEFB	00111110B
	DEFB	00000000B

; 062h - Character: 'b'			CHR0h(98)

	DEFB	00100000B
	DEFB	00100000B
	DEFB	00111100B
	DEFB	00100010B
	DEFB	00100010B
	DEFB	00111100B
	DEFB	00000000B

; 063h - Character: 'c'			CHR0h(99)

	DEFB	00000000B
	DEFB	00011100B
	DEFB	00100000B
	DEFB	00100000B
	DEFB	00100000B
	DEFB	00011100B
	DEFB	00000000B

; 064h - Character: 'd'			CHR0h(100)

	DEFB	00000100B
	DEFB	00000100B
	DEFB	00111100B
	DEFB	01000100B
	DEFB	01000100B
	DEFB	00111110B
	DEFB	00000000B

; 065h - Character: 'e'			CHR0h(101)

	DEFB	00000000B
	DEFB	00111000B
	DEFB	01000100B
	DEFB	01111000B
	DEFB	01000000B
	DEFB	00111100B
	DEFB	00000000B

; 066h - Character: 'f'			CHR0h(102)

	DEFB	00001100B
	DEFB	00010000B
	DEFB	00011000B
	DEFB	00010000B
	DEFB	00010000B
	DEFB	00010000B
	DEFB	00000000B

; 067h - Character: 'g'			CHR0h(103)

	DEFB	00000000B
	DEFB	00111100B
	DEFB	01000100B
	DEFB	01000100B
	DEFB	00111100B
	DEFB	00000100B
	DEFB	00111000B

; 068h - Character: 'h'			CHR0h(104)

	DEFB	01000000B
	DEFB	01000000B
	DEFB	01111000B
	DEFB	01000100B
	DEFB	01000100B
	DEFB	01000100B
	DEFB	00000000B

; 069h - Character: 'i'			CHR0h(105)

	DEFB	00010000B
	DEFB	00000000B
	DEFB	00110000B
	DEFB	00010000B
	DEFB	00010000B
	DEFB	00111000B
	DEFB	00000000B

; 06Ah - Character: 'j'			CHR0h(106)

	DEFB	00000100B
	DEFB	00000000B
	DEFB	00000100B
	DEFB	00000100B
	DEFB	00000100B
	DEFB	00100100B
	DEFB	00011000B

; 06Bh - Character: 'k'			CHR0h(107)

	DEFB	00100000B
	DEFB	00101000B
	DEFB	00110000B
	DEFB	00110000B
	DEFB	00101000B
	DEFB	00100100B
	DEFB	00000000B

; 06Ch - Character: 'l'			CHR0h(108)

	DEFB	00010000B
	DEFB	00010000B
	DEFB	00010000B
	DEFB	00010000B
	DEFB	00010000B
	DEFB	00001100B
	DEFB	00000000B

; 06Dh - Character: 'm'			CHR0h(109)

	DEFB	00000000B
	DEFB	01101000B
	DEFB	01010100B
	DEFB	01010100B
	DEFB	01010100B
	DEFB	01010100B
	DEFB	00000000B

; 06Eh - Character: 'n'			CHR0h(110)

	DEFB	00000000B
	DEFB	01111000B
	DEFB	01000100B
	DEFB	01000100B
	DEFB	01000100B
	DEFB	01000100B
	DEFB	00000000B

; 06Fh - Character: 'o'			CHR0h(111)

	DEFB	00000000B
	DEFB	00111000B
	DEFB	01000100B
	DEFB	01000100B
	DEFB	01000100B
	DEFB	00111000B
	DEFB	00000000B

; 070h - Character: 'p'			CHR0h(112)

	DEFB	00000000B
	DEFB	01111000B
	DEFB	01000100B
	DEFB	01000100B
	DEFB	01111000B
	DEFB	01000000B
	DEFB	01000000B

; 071h - Character: 'q'			CHR0h(113)

	DEFB	00000000B
	DEFB	00111100B
	DEFB	01000100B
	DEFB	01000100B
	DEFB	00111100B
	DEFB	00000100B
	DEFB	00000110B

; 072h - Character: 'r'			CHR0h(114)

	DEFB	00000000B
	DEFB	00011100B
	DEFB	00100000B
	DEFB	00100000B
	DEFB	00100000B
	DEFB	00100000B
	DEFB	00000000B

; 073h - Character: 's'			CHR0h(115)

	DEFB	00000000B
	DEFB	00111000B
	DEFB	01000000B
	DEFB	00111000B
	DEFB	00000100B
	DEFB	01111000B
	DEFB	00000000B

; 074h - Character: 't'			CHR0h(116)

	DEFB	00010000B
	DEFB	00111000B
	DEFB	00010000B
	DEFB	00010000B
	DEFB	00010000B
	DEFB	00001100B
	DEFB	00000000B

; 075h - Character: 'u'			CHR0h(117)

	DEFB	00000000B
	DEFB	01000100B
	DEFB	01000100B
	DEFB	01000100B
	DEFB	01000100B
	DEFB	00111100B
	DEFB	00000000B

; 076h - Character: 'v'			CHR0h(118)

	DEFB	00000000B
	DEFB	01000100B
	DEFB	01000100B
	DEFB	00101000B
	DEFB	00101000B
	DEFB	00010000B
	DEFB	00000000B

; 077h - Character: 'w'			CHR0h(119)

	DEFB	00000000B
	DEFB	01000100B
	DEFB	01010100B
	DEFB	01010100B
	DEFB	01010100B
	DEFB	00101000B
	DEFB	00000000B

; 078h - Character: 'x'			CHR0h(120)

	DEFB	00000000B
	DEFB	01000100B
	DEFB	00101000B
	DEFB	00010000B
	DEFB	00101000B
	DEFB	01000100B
	DEFB	00000000B

; 079h - Character: 'y'			CHR0h(121)

	DEFB	00000000B
	DEFB	01000100B
	DEFB	01000100B
	DEFB	01000100B
	DEFB	00111100B
	DEFB	00000100B
	DEFB	00111000B

; 07Ah - Character: 'z'			CHR0h(122)

	DEFB	00000000B
	DEFB	01111100B
	DEFB	00001000B
	DEFB	00010000B
	DEFB	00100000B
	DEFB	01111100B
	DEFB	00000000B

; 07Bh - Character: '{'			CHR0h(123)

	DEFB	00001110B
	DEFB	00001000B
	DEFB	00110000B
	DEFB	00110000B
	DEFB	00001000B
	DEFB	00001110B
	DEFB	00000000B

; 07Ch - Character: '|'			CHR0h(124)

	DEFB	00001000B
	DEFB	00001000B
	DEFB	00001000B
	DEFB	00001000B
	DEFB	00001000B
	DEFB	00001000B
	DEFB	00000000B

; 07Dh - Character: '}'			CHR0h(125)

	DEFB	01110000B
	DEFB	00010000B
	DEFB	00001100B
	DEFB	00001100B
	DEFB	00010000B
	DEFB	01110000B
	DEFB	00000000B

; 07Eh - Character: '~'			CHR0h(126)

	DEFB	00110010B
	DEFB	01001100B
	DEFB	00000000B
	DEFB	00000000B
	DEFB	00000000B
	DEFB	00000000B
	DEFB	00000000B

; 07Fh - Character:  �			CHR0h(127)

	DEFB	00111100B
	DEFB	01000010B
	DEFB	10011001B
	DEFB	10100001B
	DEFB	10100001B
	DEFB	10011001B
	DEFB	01000010B
L1FFB:  DEFB	00111100B



; ---------------
; THE 'SPARE' ROM
; ---------------

L1FFC:  DEFB	0FFh						; unused

; ----------
; THE 'LINK'
; ----------

; The FORTH word copied to RAM links back to L1FFF

L1FFD:  DEFW	L1D58					; pointer to prev - UFLOAT
L1FFF:  DEFB	000h						; length of dummy word zero

; gap for vide ram

	org RAMSTART

RAMSTART:

; -----------
;
; -----------
; ----------------------
; THE 'SYSTEM VARIABLES'
; ----------------------
; "Here is a list of system variables. We have given them all names, but that
; is just for ease of reference. The Ace will not recognize these names,
; except for a few, like 'BASE', that are FORTH words. I've written these
; FORTH words in bold type in the usual way."
;
;
; FP_WS			RAMSTART+000h (15360)   19 bytes used as work space for floating point
;								arithmetic.
FP_WS: DS 19
;
; LISTWS		RAMSTART+013h (15379)   5 bytes used as workspace by 'LIST' and 'EDIT'.
;
LISTWS: DS	5
;
; RAMTOP		RAMSTART+018h (15384)   2 bytes - the first address past the last
;								address in RAM.
;
RAMTOP:	DS	2
;
; HLD			RAMSTART+01Ah (15386)   2 bytes. The address of the latest character
;								held in the pad by formatted output.
;								('#', 'HOLD' and so on).
HLD:	DS	2
;
; SCRPOS		RAMSTART+01Ch (15388)   2 bytes. The address of the place in video RAM
;								where the next character is to be printed
;								(i.e. the 'print position').
SCRPOS:	DS	2
;
; INSCRN		RAMSTART+01Eh (15390)   2 bytes. The address of the start of the
;								current 'logical line' in the input buffer.
INSCRN:	DS	2
;
; CURSOR		RAMSTART+020h (15392)   2 bytes. The address of the cursor in the
;								input buffer.
CURSOR:	DS	2
;
; ENDSUF		RAMSTART+022h (15394)   2 bytes. The address of the end of the current
;								logical line in the input buffer.
ENDSUF:	DS	2
;
; L_HALF		RAMSTART+024h (15396)   2 bytes. The address of the start of the the
;								input buffer. The input buffer itself is stored
;								in the video RAM, where you see it.
L_HALF:	DS	2
; KEYCOD		RAMSTART+026h (15398)   1 byte. The ASCII code of the last key pressed.
KEYCOD:	DS	1
;
; KEYCNT		RAMSTART+027h (15399)   1 byte. Used by the routine that reads the
;								keyboard.
KEYCNT:	DS	1
; STATIN		RAMSTART+028h (15400)   1 byte. Used by the routine that reads the
;								keyboard.
STATIN:	DS	1
;
; EXWRCH		RAMSTART+029h (15401)   2 bytes. This is normally 0 but it can be
;								changed to allow printing to be sent to some
;								device other than the screen.
EXWRCH:	DS	2
; FRAMES		RAMSTART+02Bh (15403)   4 bytes. These four bytes form a double length
;								integer that counts the time since the Ace was
;								switched on in 50ths of a second.
FRAMES:	DS	4
; XCOORD		RAMSTART+02Fh (15407)   1 byte. The x-coordinate last used by 'PLOT'.
XCOORD:	DS	1
;
; YCOORD		RAMSTART+030h (15408)   1 byte. The y-coordinate last used by 'PLOT'.
YCOORD:	DS	1
;
; CURRENT		RAMSTART+031h (15409)   2 bytes. The parameter field address for the
;								vocabulary word of the current vocabulary.
CURRENT:	DS	2
;
; CONTEXT		RAMSTART+033h (15411)   2 bytes. The parameter field address for the
;								vocabulary word of the context vocabulary.
CONTEXT:	DS	2
;
; VOCLNK		RAMSTART+035h (15413)   2 bytes. The address of the fourth byte in the
;								parameter field - the vocabulary linkage - of
;								the vocabulary word of the most recently
;								defined vocabulary.
VOCLNK:	DS	2
;
; STKBOT		RAMSTART+037h (15415)   2 bytes. The address of the next byte into
;								which anything will be enclosed in the
;								dictionary, i.e. one byte past the present end
;								of the dictionary.
;								'HERE' is equivalent to 15415 @.
STKBOT:	DS	2

; DICT			RAMSTART+039h (15417)   2 bytes. The address of the length field in the
;								newest word in the dictionary. If that length
;								field is correctly filled in then DICT may
;								be 0.
DICT:	DS	2
; SPARE			RAMSTART+03Bh (15419)   2 bytes. The address of the first byte past the
;								top of the stack.
SPARE:	DS	2
;
; ERR_NO		RAMSTART+03Dh (15421)   1 byte. This is usually 255, meaning "no error".
;								If 'ABORT' is used, and ERR_NO is between 0 and
;								127, then "ERROR" will be printed out, followed
;								by the error number ERR_NO.
ERR_NO:	DS	1
;
; FLAGS			RAMSTART+03Eh (15422)   1 byte. Shows the state of various parts of the
;								system, each bit showing whether something
;								particular is happening or not. Some of these
;								may be useful.
;
;								Bit 2, when 1, shows that there is an incomplete
;								definition at the end of the dictionary.
;
;								Bit 3, when 1, shows that output is to fed into
;								the input buffer.
;
;								Bit 4, when 1, shows that the Ace is in
;								invisible mode.
;
;								Bit 6, when 1, shows that the Ace is in compile
;								mode.
FLAGS:	DS	1
;
; BASE			RAMSTART+03Fh (15423)   1 byte. The system number base.
BASE:	DS	1

;;Deuce Vars
	PUBLIC SIOANEXTIN,SIOANEXTOUT,SIOATXBUFF

	SIOANEXTIN:		DS	1
	SIOANEXTOUT:	DS	1
	SIOATXBUFF:		DS	SERIALTXBUFFLEN
;
;
;
; -----------------------------------------------------------------------------
;									---------
;									-------------------------------------------
; ------------						--------------------------------------------
; ACE KEYBOARD					---------
; ------------					---------
;
;+-----+ +-----+ +-----+ +-----+ +-----+ +-----+ +-----+ +-----+ +-----+ +-----+
;|   ! | |   @ | |   # | |   0h | |   % | |   & | |   ' | |   ( | |   ) | |   _ |
;| 1 []| | 2 []| | 3 []| | 4 []| | 5 []| | 6 []| | 7 []| | 8   | | 9   | | 0 []|
;+-----+ +-----+ +-----+ +-----+ +-----+ +-----+ +-----+ +-----+ +-----+ +-----+
; DELETE   CAPS			INV	<=		^		v		=>  GRAPHIC  DELETE
;  LINE	LOCK			VIDEO
;+-----+ +-----+ +-----+ +-----+ +-----+ +-----+ +-----+ +-----+ +-----+ +-----+
;|		| |		| |		| |   < | |   > | |   [ | |   ] | |   � | |   ; | |   " |
;| Q   | | W   | | E   | | R   | | T   | | Y   | | U   | | I   | | O   | | P   |
;+-----+ +-----+ +-----+ +-----+ +-----+ +-----+ +-----+ +-----+ +-----+ +-----+
;
;+-----+ +-----+ +-----+ +-----+ +-----+ +-----+ +-----+ +-----+ +-----+ +-----+
;|   ~ | |   | | |   \ | |   { | |   } | |   ^ | |   - | |   + | |   = | |		|
;| A   | | S   | | D   | | F   | | G   | | H   | | J   | | K   | | L   | |ENTER|
;+-----+ +-----+ +-----+ +-----+ +-----+ +-----+ +-----+ +-----+ +-----+ +-----+
;
;+-----+ +-----+ +-----+ +-----+ +-----+ +-----+ +-----+ +-----+ +-----+ +-----+
;|		| |   : | |   � | |   ? | |   / | |   * | |   , | |   . | | SYM | |		|
;|SHIFT| | Z   | | X   | | C   | | V   | | B   | | N   | | M   | |SHIFT| |SPACE|
;+-----+ +-----+ +-----+ +-----+ +-----+ +-----+ +-----+ +-----+ +-----+ +-----+
;
;
;						[] mosaic graphic			�  currency symbol
;
; -----------------------------------------------------------------------------