TITLE	< Z80 fig-FORTH 1.1 g >
	SUBTTL	Adaptive version by EHR
;
;
; Modified frm FIG document keyed by Dennis L. Wilson 800907
; Converted frm "8080 FIG-FORTH VERSION A0 15SEP79"
;
; fig-FORTH release 1.1 for the 8080 processor.
;
; ALL PUBLICATIONS OF THE FORTH INTEREST GROUP
; ARE PUBLIC DOMAIN. THEY MAY BE FURTHER
; DISTRIBUTED BY THE INCLUSION OF THIS CREDIT NOTICE:
;
; This publication has been made available by the
;	Forth Interest Group
;	P.O.Box 1105
;	San Carlos, CA 94070
;	U.S.A.
;
; Implementation on 8080 by:
;	John Cassady
;	339 15th Street
;	Oakland, CA 94612
;	U.S.A
;	on 790528
; Modified by:
;	Kim Harris
; Acknowledgements:
;	George Flammer
;	Robt. D. Villwock
; ----------------------------------------------------------------------
; Z80 Version for Cromemco CDOS & Digital Research CP/M by:
;	Dennis Lee Wilson c/o
;	Aristotelian Logicians
;	2631 East Pinchot Avenue
;	Phoenix, AZ 85016
;	U.S.A.
; ----------------------------------------------------------------------
; The 2 byte Z80 code for Jump Relative (JR) has been substituted for
; the 3 byte Jump (JP) wherever practical. The port I/O words P@ & P!
; have been made ROMable by use of Z80 instructions.
; ----------------------------------------------------------------------
; Further modifications (marked ;/) by:
;	Edmund Ramm
;	Anderheitsallee 24
;	2000 Hamburg 71
;	Fed. Rep. of Germany	840418
; ----------------------------------------------------------------------
; Disc I/O has been modified a la Albert van der Horst (HCCH) to employ
; CP/M 2.x's random access feature.
; ----------------------------------------------------------------------
;
;	Release & Version numbers
;
FIGREL	EQU	1		;FIG RELEASE #
FIGREV	EQU	1		;FIG REVISION #
USRVER	EQU	67H		;USER VERSION # g by DLW/EHR/AvdH
;
;Console & printer drivers are in external source named
;CONPRTIO.FTH & disc drivers in DISCIO.FTH. It has 4 screen
;buffers & end of memory is set to FBASE from locn. 0007H.
	FORM
;	ASCII characters used
;
ABL	EQU	20H		;BLANK
ACR	EQU	0DH		;CR
ADOT	EQU	2EH		;.
BELL	EQU	07H		;^G
BSIN	EQU	08H		;backspace chr = ^H
BSOUT	EQU	08H
DLE	EQU	10H		;^P
LF	EQU	0AH		;^J
FF	EQU	0CH		;^L
;
;	Memory allocation
;
BDOSS	EQU	0005H		;/ system entry
NSCR	EQU	4		;  # of 1024 byte screens
KBBUF	EQU	128		;  bytes/disc buffer
US	EQU	40H		;  user variables space
RTS	EQU	400H		;  Return Stack & term buff space
CO	EQU	KBBUF+4		;  Disc buff + 2 header + 2 tail
NBUF	EQU	NSCR*400H/KBBUF	;  # of buffers
BUFSIZ	EQU	CO*NBUF		;/ total disc buffer size
	FORM
	ABS
;
	ORG	0100H
ORIG:	NOP
	JP	CLD		;VECTOR TO COLD START
	NOP
	JP	WRM		;VECTOR TO WARM START
	DEFB	FIGREL		;FIG RELEASE #
	DEFB	FIGREV		;FIG REVISION #
	DEFB	USRVER		;USER VERSION #
	DEFB	0EH		;IMPLEMENTATION ATTRIBUTES
;
;
;
;	0EH = 0000:1110
;	      ---------
; B +ORIGIN   ...W:IEBA
;
; W: 0=above sufficient
;    1=other differences exist
; I: Interpreter is	0=pre-
;			1=post incrementing
; E: Addr must be even: 0 yes
;			1 no
; B: High byte @	0=low addr.
;			1=high addr.
; A: CPU Addr.		0=BYTE
;			1=WORD
;
;
;
	DEFW	TASK-7		;  TOPMOST WORD IN FORTH VOCABULARY
	DEFW	BSIN		;  BACKSPACE CHR
UPINIT:	DEFW	0		;/ INIT (UP)
;
; * FOLLOWING USED BY COLD; MUST BE IN SAME ORDER AS USER VARIABLES *
;
S0INIT:	DEFW	0		;/ INIT (S0)
R0INIT:	DEFW	0		;/ INIT (R0)
TIBINI:	DEFW	0		;/ INIT (TIB)
	DEFW	1FH		;  INIT (WIDTH)
	DEFW	0		;  INIT (WARNING)
	DEFW	INITDP		;  INIT (FENCE)
	DEFW	INITDP		;  INIT (DP)
	DEFW	FORTH+8		;  INIT (VOC-LINK)
;
; *  END DATA USED BY COLD *
;
	DEFW	0H,0B250H	;Z80 CPU NAME (HW,LW)
				;(32 BIT BASE 36 INTEGER)
	FORM
;	REGISTERS
;
;	FORTH	Z80	FORTH PRESERVATION RULES
;	-----	---	-----------------------
;	IP	BC	should be preserved
;			accross FORTH words.
;	W	DE	sometimes output from
;			NEXT, may be altered
;			b4 JP'ing to NEXT,
;			input only when 
;			"DPUSH" called.
;	SP	SP	should be used only as
;			Data Stack accross
;			FORTH words, may be
;			used within FORTH
;			words if restored
;			b4 "NEXT"
;		HL	Never output frm NEXT
;			input only when
;			"HPUSH" called
;
;
UP:	DEFW	0		;/ USER AREA PTR
RPP:	DEFW	0		;/ RETURN STACK PTR
BUF1:	DEFW	0		;/ address of 1st disc buffer
;
;
;	COMMENT CONVENTIONS:
;
;	=	MEANS "IS EQUAL TO"
;	<--	MEANS ASSIGNMENT
;	NAME	=     ADDR OF NAME
;	(NAME)  =     CONTENTS @ NAME
;	((NAME))=     INDIRECT CONTENTS
;	CFA	=     CODE FIELD ADDR
;	LFA	=     LINK FIELD ADDR
;	NFA	=     NAME FIELD ADDR
;	PFA	=     PARAMETER FIELD ADDR
;	S1	=     ADDR OF 1st WORD OF PARAMETER STACK
;	S2	=     -"-  OF 2nd -"-  OF    -"-     -"-
;	R1	=     -"-  OF 1st -"-  OF RETURN STACK
;	R2	=     -"-  OF 2nd -"-  OF  -"-    -"-
; ( above Stack posn. valid b4 & after execution of any word, not during)
;
;	LSB	=     LEAST SIGNIFICANT BIT
;	MSB	=     MOST  SIGNIFICANT BIT
;	LB	=     LOW  BYTE
;	HB	=     HIGH BYTE
;	LW	=     LOW  WORD
;	HW	=     HIGH WORD
; (May be used as suffix to above names)
	FORM
;	FORTH ADDRESS INTERPRETER
;	POST INCREMENTING VERSION
;
DPUSH:	PUSH	DE
HPUSH:	PUSH	HL		;		IY points here
NEXT:	LD	A,(BC)		;(W)<--((IP))	IX points here
	LD	L,A
	INC	BC		;INC IP
	LD	A,(BC)
	LD	H,A		;(HL)<--CFA
	INC	BC		;INC IP
NEXT1:	LD	E,(HL)		;(PC)<--((W))
	INC	HL
	LD	D,(HL)
	EX	DE,HL
	JP	(HL)		;NOTE: (DE)=CFA+1
;
JNEXT	MACRO
	JP	(IX)
	ENDM
;
JHPUSH	MACRO
	JP	(IY)
	ENDM
	FORM
;	FORTH DICTIONARY
;	DICTIONARY FORMAT:
;
;				BYTE
;	ADDRESS NAME		CONTENTS
;	------- ----		--------
;						(MSB=1
;						(P=PRECEDENCE BIT
;						(S=SMUDGE BIT
;	NFA	NAME FIELD	1PS<LEN>	<NAME LENGTH
;				0<1CHAR>	MSB=0, NAME'S 1st CHAR
;				0<2CHAR>
;				  ...
;				1<LCHAR>	MSB=1, NAME'S LAST CHAR
;	LFA	LINK FIELD	<LINKLB>	=PREVIOUS WORD'S NFA
;				<LINKHB>
;LABEL:	CFA	CODE FIELD	<CODELB>	=ADDR CPU CODE
;				<CODEHB>
;	PFA	PARAMETER	<1PARAM>	1st PARAMETER BYTE
;		FIELD		<2PARAM>
;				  ...
;
;
;
DP0:	DEFB	83H		;LIT
	DM	'LIT'
	DEFW	0		;(LFA)=0 MARKS END OF DICTIONARY
LIT:	DEFW	$+2		;(S1)<--((IP))
	LD	A,(BC)		;(HL)<--((IP))=LITERAL
	INC	BC		;(IP)<--(IP)+2
	LD	L,A		;LB
	LD	A,(BC)		;HB
	INC	BC
	LD	H,A
	JHPUSH			;(S1)<--(HL)
;
	DEFB	87H		;EXECUTE
	DM	'EXECUTE'
	DEFW	LIT-6
EXEC:	DEFW	$+2
	POP	HL
	JP	NEXT1
;
	DEFB	86H		;BRANCH
	DM	'BRANCH'
	DEFW	EXEC-0AH
BRAN:	DEFW	$+2		;(IP)<--(IP)+((IP))
BRAN1:	LD	H,B		;(HL)<--(IP)
	LD	L,C
	LD	E,(HL)		;(DE)<--((IP))=BRANCH OFFSET
	INC	HL
	LD	D,(HL)
	DEC	HL
	ADD	HL,DE		;(HL)<--(HL)+((IP))
	LD	C,L		;(IP)<--(HL)
	LD	B,H
	JNEXT
;
	DEFB	87H		;0BRANCH
	DM	'0BRANCH'
	DEFW	BRAN-9
ZBRAN:	DEFW	$+2
	POP	HL
	LD	A,L
	OR	H
	JR	Z,BRAN1		;IF (S1)=0 THEN BRANCH
	INC	BC		;ELSE SKIP BRANCH OFFSET
	INC	BC
	JNEXT
;
	DEFB	86H		;(LOOP)
	DM	'(LOOP)'
	DEFW	ZBRAN-0AH
XLOOP:	DEFW	$+2
	LD	HL,(RPP)	;  ((HL))=INDEX=(R1)
	inc	(hl)		;/  index(lb) += 1
	LD	E,(HL)		;/
	INC	HL		;/ (hl)-->index(hb)
	jr	nz,xloop1	;/ jump if ((hl)) < 256
	inc	(hl)		;/ else index(hb) += 1
xloop1:	LD	D,(HL)		;/ (DE)<-- new INDEX
	INC	HL		;/ ((HL))=LIMIT
	LD	A,E
	SUB	(HL)
	LD	A,D
	INC	HL
	SBC	A,(HL)		;  INDEX<LIMIT?
	JP	M,BRAN1		;  YES, LOOP AGAIN
	INC	HL		;  NO, DONE
	LD	(RPP),HL	;  DISCARD R1 & R2
	INC	BC
	INC	BC		;  SKIP BRANCH OFFSET
	JNEXT
;
	DEFB	87H		;(+LOOP)
	DM	'(+LOOP)'
	DEFW	XLOOP-9
XPLOO:	DEFW	$+2
	POP	DE		;(DE)<--INCR
	LD	HL,(RPP)	;((HL))=INDEX
	LD	A,(HL)		;INDEX<--INDEX+INCR
	ADD	A,E
	LD	(HL),A
	LD	E,A
	INC	HL
	LD	A,(HL)
	ADC	A,D
	LD	(HL),A
	INC	HL		;((HL))=LIMIT
	INC	D
	DEC	D
	LD	D,A		;(DE)<--NEW INDEX
	JP	M,XLOO2		;IF INCR>0
	LD	A,E
	SUB	(HL)		;THEN (A)<--INDEX - LIMIT
	LD	A,D
	INC	HL
	SBC	A,(HL)
	JP	XLOO3
XLOO2:	LD	A,(HL)		;ELSE (A)<--LIMIT - INDEX
	SUB	E
	INC	HL
	LD	A,(HL)
	SBC	A,D
;				;IF (A)<0
XLOO3:	JP	M,BRAN1		;THEN LOOP AGN
	INC	HL		;ELSE DONE
	LD	(RPP),HL	;DISCARD R1 & R2
	INC	BC		;SKIP BRANCH OFFSET
	INC	BC
	JNEXT
;
	DEFB	84H		;  (DO)
	DM	'(DO)'
	DEFW	XPLOO-0AH
XDO:	DEFW	$+2
	EXX			;/ SAVE IP
	POP	DE		;  (DE)<--INITIAL INDEX
	POP	BC		;/ (BC)<--LIMIT
	LD	HL,(RPP)	;  (HL)<--(RP)
	DEC	HL
	LD	(HL),B
	DEC	HL
	LD	(HL),C		;/ (R2)<--LIMIT
	DEC	HL
	LD	(HL),D
	DEC	HL
	LD	(HL),E		;  (R1)<--INITIAL INDEX
	LD	(RPP),HL	;  (RP)<--(RP)-4
	EXX			;/ RESTORE IP
	JNEXT
;
	DEFB	81H		;I
	DM	'I'
	DEFW	XDO-7
IDO:	DEFW	$+2		;(S1)<--(R1), (R1) UNCHANGED
	LD	HL,(RPP)
	LD	E,(HL)		;(DE)<--(R1)
	INC	HL
	LD	D,(HL)
	PUSH	DE		;(S1)<--(DE)
	JNEXT
;
	DEFB	85H		;DIGIT
	DM	'DIGIT'
	DEFW	IDO-4
DIGIT:	DEFW	$+2
	POP	HL		;(L)<--(S1)LB = BASE VALUE
	POP	DE		;(E)<--(S2)LB = ASCII CHR TO BE CONVERTED
	LD	A,E		;ACCU<--CHR
	SUB	'0'		;>=0?
	JR	C,DIGI2		;/ <0 IS INVALID
	CP	0AH		;>9?
	JR	C,DIGI1		;/ NO, TEST BASE VALUE
	SUB	07H		;GAP BETWEEN "9" & "A", NW "A"=0AH
	CP	0AH		;>="A"?
	JR	C,DIGI2		;/ CHRs BETWEEN "9" & "A" ARE INVALID
DIGI1:	CP	L		;<BASE VALUE?
	JR	NC,DIGI2	;/ NO, INVALID
	LD	E,A		;(S2)<--(DE) = CONVERTED DIGIT
	LD	HL,0001H	;(S1)<--TRUE
	JP	DPUSH
DIGI2:	LD	L,H		;(HL)<--FALSE
	JHPUSH			;(S1)<--FALSE
;
	DEFB	86H		;(FIND) (2-1)FAILURE
	DM	'(FIND)'	;	(2-3)SUCCESS
	DEFW	DIGIT-8
PFIND:	DEFW	$+2
	POP	DE		;(DE)<--NFA
PFIN1:	POP	HL		;(HL)<--STRING ADDR
	PUSH	HL		;SAVE FOR NEXT ITERATION
	LD	A,(DE)
	XOR	(HL)		;FILTER DEVIATIONS
	AND	3FH		;MASK MSB & PRECEDENCE BIT
	JR	NZ,PFIN4	;LENGTHS DIFFER
PFIN2:	INC	HL		;(HL)<--ADDR NEXT CHR IN STRING
	INC	DE		;(DE)<--ADDR NEXT CHR IN NF
	LD	A,(DE)
	XOR	(HL)		;FILTER DEVIATIONS
	ADD	A,A
	JR	NZ,PFIN3	;NO MATCH
	JR	NC,PFIN2	;MATCH SO FAR, LOOP AGN
	LD	HL,0005H	;STRING MATCHES
	ADD	HL,DE		;((SP))<--PFA
	EX	(SP),HL
PFIN6:	DEC	DE		;POSN DE ON NFA
	LD	A,(DE)
	OR	A		;MSB=1? =LENGTH BYTE
	JP	P,PFIN6		;NO, TRY NEXT CHR
	LD	E,A		;(E)<--LENGTH BYTE
	LD	D,00H
	LD	HL,0001H	;(HL)<--TRUE
	JP	DPUSH		;NF FOUND, RETURN
;
;ABOVE NF NOT A MATCH, TRY NEXT ONE
;
PFIN3:	JR	C,PFIN5		;CARRY=END OF NF
PFIN4:	INC	DE		;FIND END OF NF
	LD	A,(DE)
	OR	A		;MSB=1?
	JP	P,PFIN4		;NO, LOOP
PFIN5:	INC	DE		;(DE)<--LFA
	EX	DE,HL
	LD	E,(HL)
	INC	HL
	LD	D,(HL)		;(DE)<--(LFA)
	LD	A,D
	OR	E		;END OF DICTIONARY? (LFA)=0
	JR	NZ,PFIN1	;NO, TRY PREVIOUS DEFINITION
	POP	HL		;DROP STRING ADDR
	LD	HL,0		;(HL)<--FALSE
	JHPUSH			;NO MATCH FOUND, RETURN
;
	DEFB	87H		;ENCLOSE
	DM	'ENCLOSE'
	DEFW	PFIND-9
ENCL:	DEFW	$+2
	POP	DE		;(DE)<--(S1)=DELIMITER CHR
	POP	HL		;(HL)<--(S2)=ADDR OF TEXT TO SCAN
	PUSH	HL		;(S4)<--ADDR
	LD	A,E
	LD	D,A		;(D)<--DELIM CHR
	LD	E,-1		;INIT CHR OFFSET COUNTER
	DEC	HL		;(HL)<--ADDR-1
ENCL1:	INC	HL		;SKIP OVER LEADING DELIM CHRs
	INC	E
	CP	(HL)		;DELIM CHR?
	JR	Z,ENCL1		;YES, LOOP
	LD	D,0
	PUSH	DE		;(S3)<--(E)=OFFSET TO 1st NON DELIM
	LD	D,A		;(D)<--DELIM CHR
	LD	A,(HL)
	AND	A		;1st non-DELIM=NULL?
	JR	NZ,ENCL2	;NO
	LD	D,0		;YES
	INC	E
	PUSH	DE		;(S2)<--OFFSET TO BYTE FOLLOWING NULL
	DEC	E
	PUSH	DE		;(S1)<--OFFSET TO NULL
	JNEXT
ENCL2:	LD	A,D		;(A)<--DELIM CHR
	INC	HL		;(HL)<--ADDR NEXT CHR
	INC	E		;(E)<--OFFSET TO NEXT CHR
	CP	(HL)		;DELIM CHR?
	JR	Z,ENCL4		;YES
	LD	A,(HL)
	AND	A		;NULL?
	JR	NZ,ENCL2	;NO, CONT SCAN
ENCL3:	LD	D,0
	PUSH	DE		;(S2)<--OFFSET TO NULL
	PUSH	DE		;(S1)<--OFFSET TO NULL
	JNEXT
ENCL4:	LD	D,0
	PUSH	DE		;(S2)<--OFFSET TO BYTE FOLLOWING TEXT
	INC	E
	PUSH	DE		;(S1)<--OFFSET TO 2 BYTES AFTER END OF WORD
	JNEXT
;
	DEFB	84H		;EMIT
	DM	'EMIT'
	DEFW	ENCL-0AH
EMIT:	DEFW	DOCOL
	DEFW	PEMIT
	DEFW	ONE,OUTT
	DEFW	PSTOR,SEMIS
;
	DEFB	83H		;KEY
	DM	'KEY'
	DEFW	EMIT-7
KEY:	DEFW	$+2
	JP	PKEY
;
	DEFB	89H		;?TERMINAL
	DM	'?TERMINAL'
	DEFW	KEY-6
QTERM:	DEFW	$+2
	LD	HL,0
	JP	PQTER
;
	DEFB	82H		;CR
	DM	'CR'
	DEFW	QTERM-0CH
CR:	DEFW	$+2
	JP	PCR
;
	DEFB	85H		;CMOVE
	DM	'CMOVE'
	DEFW	CR-5
CMOVE:	DEFW	$+2
	EXX			;/ SAVE IP
	POP	BC		;  (BC)<--(S1)= #CHRs
	POP	DE		;  (DE)<--(S2)= DEST ADDR
	POP	HL		;/ (HL)<--(S3)= SOURCE ADDR
	LD	A,B
	OR	C		;  BC=0?
	JR	Z,EXCMOV	;  YES, DON'T MOVE ANYTHING
	LDIR			;/ XFER STRING
EXCMOV:	EXX			;/ RESTORE IP
	JNEXT
;
	DEFB	82H		;U*   16*16 unsigned multiply
	DM	'U*'		;994 T cycles average (8080)
	DEFW	CMOVE-8
USTAR:	DEFW	$+2
	POP	DE		;(DE)<--MPLIER
	POP	HL		;(HL)<--MPCAND
	PUSH	BC		;SAVE IP
	LD	B,H
	LD	A,L		;(BA)<--MPCAND
	CALL	MPYX		;(AHL)1<--MPCAND.LB*MPLIER
				;       1st PARTIAL PRODUCT
	PUSH	HL		;SAVE (HL)1
	LD	H,A
	LD	A,B
	LD	B,H		;SAVE (A)1
	CALL	MPYX		;(AHL)2<--MPCAND.HB*MPLIER
				;	2nd PARTIAL PRODUCT
	POP	DE		;(DE)<--(HL)1
	LD	C,D		;(BC)<--(AH)1
;	FORM SUM OF PARTIALS:
;				; (AHL)1
;				;+(AHL)2
;				;-------
;				; (AHLE)
	ADD	HL,BC		;(HL)<--(HL)2+(AH)1
	ADC	A,00H		;(AHLE)<--(BA)*(DE)
	LD	D,L
	LD	L,H
	LD	H,A		;(HLDE)<--MPLIER*MPCAND
	POP	BC		;RESTORE IP
	PUSH	DE		;(S2)<--PRODUCT.LW
	JHPUSH			;(S1)<--PRODUCT.HW
;
;	MULTIPLY PRIMITIVE
;		 (AHL)<--(A)*(DE)
;	#BITS:	  24	8   16
;
MPYX:	LD	HL,0		;(HL)<--0=PARTIAL PRODUCT.LW
	LD	C,08H		;LOOP COUNTER
MPYX1:	ADD	HL,HL		;LEFT SHIFT (AHL) 24 BITS
	RLA
	JR	NC,MPYX2	;IF NEXT MPLIER BIT = 1
	ADD	HL,DE		;THEN ADD MPCAND
	ADC	A,0
MPYX2:	DEC	C		;LAST MPLIER BIT?
	JR	NZ,MPYX1	;NO, LOOP AGN
	RET			;YES, DONE
;
	DEFB	82H		;U/
	DM	'U/'
	DEFW	USTAR-5
USLAS:	DEFW	$+2
	LD	HL,0004H
	ADD	HL,SP		;((HL))<--NUMERATOR.LW
	LD	E,(HL)		;(DE)<--NUMER.LW
	LD	(HL),C		;SAVE IP ON STACK
	INC	HL
	LD	D,(HL)
	LD	(HL),B
	POP	BC		;(BC)<--DENOMINATOR
	POP	HL		;(HL)<--NUMER.HW
	LD	A,L
	SUB	C
	LD	A,H
	SBC	A,B		;NUMER >= DENOM?
	JR	C,USLA1		;NO, GO AHEAD
	LD	HL,0FFFFH	;YES, OVERFLOW
	LD	D,H
	LD	E,L		;/ SET REM & QUOT TO MAX
	JP	USLA7
USLA1:	LD	A,10H		;LOOP COUNTER
USLA2:	ADD	HL,HL		;LEFT SHIFT (HLDE) THRU CARRY
	RLA			;ROT CARRY INTO ACCU BIT 0
	EX	DE,HL
	ADD	HL,HL
	JR	NC,USLA3
	INC	DE		;ADD CARRY
	AND	A		;RESET CARRY
USLA3:	EX	DE,HL		;SHIFT DONE
	RRA			;RESTORE 1st CARRY & COUNTER
	JR	NC,USLA4	;IF CARRY=1
	OR	A		;/ RESET CARRY
	SBC	HL,BC		;/ THEN (HL)<--(HL)-(BC)
	JP	USLA5
USLA4:	SBC	HL,BC		;/ (HL)<--PARTIAL REMAINDER
	JR	NC,USLA5
	ADD	HL,BC		;UNDERFLOW, RESTORE
	DEC	DE
USLA5:	INC	DE		;INC QUOT
	DEC	A		;COUNTER=0?
	JP	NZ,USLA2	;NO, LOOP AGN
USLA7:	POP	BC		;RESTORE IP
	PUSH	HL		;(S2)<--REMAINDER
	PUSH	DE		;(S1)<--QUOTIENT
	JNEXT
;
	DEFB	83H		;AND
	DM	'AND'
	DEFW	USLAS-5
ANDD:	DEFW	$+2		;(S1)<--(S1) AND (S2)
	POP	DE
	POP	HL
	LD	A,E
	AND	L
	LD	L,A
	LD	A,D
	AND	H
	LD	H,A
	JHPUSH
;
	DEFB	82H		;OR
	DM	'OR'
	DEFW	ANDD-6
ORR:	DEFW	$+2		;(S1)<--(S1) OR (S2)
	POP	DE
	POP	HL
	LD	A,E
	OR	L
	LD	L,A
	LD	A,D
	OR	H
	LD	H,A
	JHPUSH
;
	DEFB	83H		;XOR
	DM	'XOR'
	DEFW	ORR-5
XORR:	DEFW	$+2		;(S1)<--(S1) XOR (S2)
	POP	DE
	POP	HL
	LD	A,E
	XOR	L
	LD	L,A
	LD	A,D
	XOR	H
	LD	H,A
	JHPUSH
;
	DEFB	83H		;SP@
	DM	'SP@'
	DEFW	XORR-6
SPAT:	DEFW	$+2		;(S1)<--(SP)
	LD	HL,0
	ADD	HL,SP		;(HL)<--(SP)
	JHPUSH
;
	DEFB	83H		;SP!
	DM	'SP!'
	DEFW	SPAT-6
SPSTO:	DEFW	$+2		;(SP)<--(S0) (USER VARIABLE)
	LD	HL,(UP)		;(HL)<--USER VAR BASE ADDR
	LD	DE,0006H
	ADD	HL,DE		;(HL)<--S0
	LD	E,(HL)
	INC	HL
	LD	D,(HL)		;(DE)<--(S0)
	EX	DE,HL
	LD	SP,HL		;(SP)<--(S0)
	JNEXT
;
	DEFB	83H		;RP@
	DM	'RP@'
	DEFW	SPSTO-6
RPAT:	DEFW	$+2		;(S1)<--(RP)
	LD	HL,(RPP)
	JHPUSH
;
	DEFB	83H		;RP!
	DM	'RP!'
	DEFW	RPAT-6
RPSTO:	DEFW	$+2		;(RP)<--(R0) (USER VARIABLE)
	LD	HL,(UP)		;(HL)<--USER VAR BASE ADDR
	LD	DE,0008H
	ADD	HL,DE		;(HL)<--R0
	LD	E,(HL)
	INC	HL
	LD	D,(HL)		;(DE)<--(R0)
	LD	(RPP),DE	;/ (RP)<--(R0)
	JNEXT
;
	DEFB	82H		; ;S
	DM	';S'
	DEFW	RPSTO-6
SEMIS:	DEFW	$+2		;(IP)<--(R1)
	LD	HL,(RPP)
	LD	C,(HL)
	INC	HL
	LD	B,(HL)		;(BC)<--(R1)
	INC	HL
	LD	(RPP),HL	;(RP)<--(RP)+2
	JNEXT
;
	DEFB	85H		;LEAVE
	DM	'LEAVE'
	DEFW	SEMIS-5
LEAVE:	DEFW	$+2		;LIMIT<--INDEX
	LD	HL,(RPP)
	LD	E,(HL)
	INC	HL
	LD	D,(HL)		;(DE)<--(R1)=INDEX
	INC	HL
	LD	(HL),E
	INC	HL
	LD	(HL),D		;(R2)<--(DE)=LIMIT
	JNEXT
;
	DEFB	82H		;>R
	DM	'>R'
	DEFW	LEAVE-8
TOR:	DEFW	$+2
	POP	DE
	LD	HL,(RPP)
	DEC	HL
	LD	(HL),D		
	DEC	HL
	LD	(HL),E		;/ (R1)<--(DE)
	LD	(RPP),HL	;  (RP)<--(RP)-2
	JNEXT
;
	DEFB	82H		;R>
	DM	'R>'
	DEFW	TOR-5
FROMR:	DEFW	$+2
	LD	HL,(RPP)
	LD	E,(HL)
	INC	HL
	LD	D,(HL)
	INC	HL
	LD	(RPP),HL
	PUSH	DE		;(S1)<--(R1)
	JNEXT
;
	DEFB	81H		;R
	DM	'R'
	DEFW	FROMR-5
RR:	DEFW	IDO+2
;
	DEFB	82H		;0=
	DM	'0='
	DEFW	RR-4
ZEQU:	DEFW	$+2
	POP	HL
	LD	A,L
	OR	H
	LD	HL,0
	JR	NZ,ZEQU1
	INC	L		;(HL)<--TRUE
ZEQU1:	JHPUSH
;
	DEFB	82H		;0<
	DM	'0<'
	DEFW	ZEQU-5
ZLESS:	DEFW	$+2
	POP	AF		;/ (A)<--(S1)H
	RLA			;/ (CARRY)<--BIT 7
	LD	HL,0		;  (HL)<--FALSE
	JR	NC,ZLES1
	INC	L		;  (HL)<--TRUE
ZLES1:	JHPUSH
;
	DEFB	81H		;+
	DM	'+'
	DEFW	ZLESS-5
PLUS:	DEFW	$+2
	POP	DE
	POP	HL
	ADD	HL,DE
	JHPUSH
;
	DEFB	82H		;D+ ( d1L d1H d2L d2h -- d3L d3H)
	DM	'D+'
	DEFW	PLUS-4
DPLUS:	DEFW	$+2
	EXX			;/ SAVE IP
	POP	BC		;  (BC)<--d2H
	POP	HL		;  (HL)<--d2L
	POP	AF		;d (AF)<--d1H
	POP	DE		;  (DE)<--d1L
	PUSH	AF		;/ (S1)<--d1H
	ADD	HL,DE		;  (HL)<--d2L+d1L=d3L
	EX	DE,HL		;  (DE)<--d3L
	POP	HL		;  (HL)<--d1H
	ADC	HL,BC		;/ (HL)<--d1H+d2H+CARRY=d3H
	PUSH	DE		;  (S2)<--d3L
	PUSH	HL		;/ (S1)<--d3H
	EXX			;/ RESTORE IP
	JNEXT
;
	DEFB	85H		;MINUS
	DM	'MINUS'
	DEFW	DPLUS-5
MINUS:	DEFW	$+2
	POP	DE		;/
	XOR	A		;/ RESET CARRY, (A)<--0
	LD	H,A		;/
	LD	L,A		;/ LD HL,0
	SBC	HL,DE		;/ (HL)<--(DE)2's COMPL.
	JHPUSH
;
	DEFB	86H		;DMINUS
	DM	'DMINUS'
	DEFW	MINUS-8
DMINU:	DEFW	$+2
	POP	HL		;(HL)<--d1H
	POP	DE		;(DE)<--d1L
	SUB	A		;(A)<--0
	SUB	E
	LD	E,A		;(E)<--NEG(E)
	LD	A,00H
	SBC	A,D
	LD	D,A		;(D)<--NEG(D)
	LD	A,00H
	SBC	A,L
	LD	L,A		;(L)<--NEG(L)
	LD	A,00H
	SBC	A,H
	LD	H,A		;(H)<--NEG(H)
	JP	DPUSH		;(S2)<--d2L, (S1)<--d2H
;
	DEFB	84H		;OVER
	DM	'OVER'
	DEFW	DMINU-9
OVER:	DEFW	$+2
	POP	DE
	POP	HL
	PUSH	HL
	JP	DPUSH
;
	DEFB	84H		;DROP
	DM	'DROP'
	DEFW	OVER-7
DROP:	DEFW	$+2
	POP	HL
	JNEXT
;
	DEFB	84H		;SWAP
	DM	'SWAP'
	DEFW	DROP-7
SWAP:	DEFW	$+2
	POP	HL
	EX	(SP),HL
	JHPUSH
;
	DEFB	83H		;DUP
	DM	'DUP'
	DEFW	SWAP-7
DUP:	DEFW	$+2
	POP	HL
	PUSH	HL
	JHPUSH
;
	DEFB	84H		;2DUP
	DM	'2DUP'
	DEFW	DUP-6
TDUP:	DEFW	$+2
	POP	HL
	POP	DE
	PUSH	DE
	PUSH	HL
	JP	DPUSH
;
	DEFB	82H		;+!
	DM	'+!'
	DEFW	TDUP-7
PSTOR:	DEFW	$+2
	POP	HL		;(HL)<--VAR ADDR
	POP	DE		;(DE)<--NUMBER
	LD	A,(HL)
	ADD	A,E
	LD	(HL),A
	INC	HL
	LD	A,(HL)
	ADC	A,D
	LD	(HL),A		;((HL))<--((HL))+NUMBER
	JNEXT
;
	DEFB	86H		;TOGGLE
	DM	'TOGGLE'
	DEFW	PSTOR-5
TOGGL:	DEFW	$+2
	POP	DE		;(E)<--BIT PATTERN
	POP	HL		;(HL)<--ADDR
	LD	A,(HL)
	XOR	E
	LD	(HL),A
	JNEXT
;
	DEFB	81H		;@
	DM	'@'
	DEFW	TOGGL-9
AT:	DEFW	$+2
	POP	HL
	LD	E,(HL)
	INC	HL
	LD	D,(HL)
	PUSH	DE
	JNEXT
;
	DEFB	82H		;C@
	DM	'C@'
	DEFW	AT-4
CAT:	DEFW	$+2
	POP	HL
	LD	L,(HL)
	LD	H,0
	JHPUSH
;
	DEFB	82H		;2@
	DM	'2@'
	DEFW	CAT-5
TAT:	DEFW	$+2
	EXX			;/ SAVE IP
	POP	HL		;  (HL)<--ADDR
	LD	C,(HL)
	INC	HL
	LD	B,(HL)		;/ (BC)<--dH
	INC	HL
	LD	E,(HL)
	INC	HL
	LD	D,(HL)		;  (DE)<--dL
	PUSH	DE		;  (S2)<--dL
	PUSH	BC		;/ (S1)<--dH
	EXX			;/ RESTORE IP
	JNEXT
;
	DEFB	81H		;!
	DM	'!'
	DEFW	TAT-5
STORE:	DEFW	$+2
	POP	HL
	POP	DE
	LD	(HL),E
	INC	HL
	LD	(HL),D
	JNEXT
;
	DEFB	82H		;C!
	DM	'C!'
	DEFW	STORE-4
CSTOR:	DEFW	$+2
	POP	HL
	POP	DE
	LD	(HL),E
	JNEXT
;
	DEFB	82H		;2!
	DM	'2!'
	DEFW	CSTOR-5
TSTOR:	DEFW	$+2
	POP	HL
	POP	DE
	LD	(HL),E
	INC	HL
	LD	(HL),D
	INC	HL
	POP	DE
	LD	(HL),E
	INC	HL
	LD	(HL),D
	JNEXT
;
	DEFB	0C1H		; :
	DM	':'
	DEFW	TSTOR-5
COLON:	DEFW	DOCOL
	DEFW	QEXEC
	DEFW	SCSP
	DEFW	CURR
	DEFW	AT
	DEFW	CONT
	DEFW	STORE
	DEFW	CREAT
	DEFW	RBRAC
	DEFW	PSCOD
DOCOL:	LD	HL,(RPP)
	DEC	HL
	LD	(HL),B
	DEC	HL
	LD	(HL),C
	LD	(RPP),HL
	INC	DE
	LD	C,E
	LD	B,D
	JNEXT
;
	DEFB	0C1H		; ;
	DM	';'
	DEFW	COLON-4
SEMI:	DEFW	DOCOL
	DEFW	QCSP
	DEFW	COMP
	DEFW	SEMIS
	DEFW	SMUDG
	DEFW	LBRAC
	DEFW	SEMIS
;
	DEFB	84H		;NOOP
	DM	'NOOP'
	DEFW	SEMI-4
NOOP:	DEFW	DOCOL
	DEFW	SEMIS
;
	DEFB	88H		;CONSTANT
	DM	'CONSTANT'
	DEFW	NOOP-7
CON:	DEFW	DOCOL
	DEFW	CREAT
	DEFW	SMUDG
	DEFW	COMMA
	DEFW	PSCOD
DOCON:	INC	DE
	EX	DE,HL
	LD	E,(HL)
	INC	HL
	LD	D,(HL)
	PUSH	DE
	JNEXT
;
	DEFB	88H		;VARIABLE
	DM	'VARIABLE'
	DEFW	CON-0BH
VAR:	DEFW	DOCOL
	DEFW	CON
	DEFW	PSCOD
DOVAR:	INC	DE
	PUSH	DE
	JNEXT
;
	DEFB	84H		;USER
	DM	'USER'
	DEFW	VAR-0BH
USER:	DEFW	DOCOL
	DEFW	CON
	DEFW	PSCOD
DOUSE:	INC	DE
	EX	DE,HL
	LD	E,(HL)
	LD	D,00H
	LD	HL,(UP)
	ADD	HL,DE
	JHPUSH
;
	DEFB	81H		;0
	DM	'0'
	DEFW	USER-7
ZERO:	DEFW	$+2		;/
	LD	HL,0		;/
	JHPUSH			;/
;
	DEFB	81H		;1
	DM	'1'
	DEFW	ZERO-4
ONE:	DEFW	$+2		;/
	LD	HL,1		;/
	JHPUSH			;/
;
	DEFB	81H		;2
	DM	'2'
	DEFW	ONE-4
TWO:	DEFW	$+2		;/
	LD	HL,2		;/
	JHPUSH			;/
;
	DEFB	81H		;3
	DM	'3'
	DEFW	TWO-4
THREE:	DEFW	$+2		;/
	LD	HL,3		;/
	JHPUSH			;/
;
	DEFB	82H		;BL
	DM	'BL'
	DEFW	THREE-4
BL:	DEFW	DOCON
	DEFW	20H
;
	DEFB	83H		;C/L
	DM	'C/L'
	DEFW	BL-5
CSLL:	DEFW	DOCON
	DEFW	64
;
	DEFB	85H		;FIRST
	DM	'FIRST'
	DEFW	CSLL-6
FIRST:	DEFW	DOCON
	DEFW	0		;/ set by CLD
;
	DEFB	85H		;LIMIT
	DM	'LIMIT'
	DEFW	FIRST-8
LIMIT:	DEFW	DOCON
	DEFW	0		;/ set by CLD
;
	DEFB	85H		;B/BUF
	DM	'B/BUF'
	DEFW	LIMIT-8
BBUF:	DEFW	DOCON
	DEFW	KBBUF
;
	DEFB	85H		;B/SCR
	DM	'B/SCR'
	DEFW	BBUF-8
BSCR:	DEFW	DOCON
	DEFW	400H/KBBUF
;
	DEFB	87H		;+ORIGIN
	DM	'+ORIGIN'
	DEFW	BSCR-8
PORIG:	DEFW	DOCOL
	DEFW	LIT
	DEFW	ORIG
	DEFW	PLUS
	DEFW	SEMIS
;
;	USER VARIABLES
;
	DEFB	82H		;S0
	DM	'S0'
	DEFW	PORIG-0AH
SZERO:	DEFW	DOUSE
	DEFW	6
;
	DEFB	82H		;R0
	DM	'R0'
	DEFW	SZERO-5
RZERO:	DEFW	DOUSE
	DEFW	8
;
	DEFB	83H		;TIB
	DM	'TIB'
	DEFW	RZERO-5
TIB:	DEFW	DOUSE
	DEFB	0AH
;
	DEFB	85H		;WIDTH
	DM	'WIDTH'
	DEFW	TIB-6
WIDTH:	DEFW	DOUSE
	DEFB	0CH
;
	DEFB	87H		;WARNING
	DM	'WARNING'
	DEFW	WIDTH-8
WARN:	DEFW	DOUSE
	DEFB	0EH
;
	DEFB	85H		;FENCE
	DM	'FENCE'
	DEFW	WARN-0AH
FENCE:	DEFW	DOUSE
	DEFB	10H
;
	DEFB	82H		;DP
	DM	'DP'
	DEFW	FENCE-8
DP:	DEFW	DOUSE
	DEFB	12H
;
	DEFB	88H		;VOC-LINK
	DM	'VOC-LINK'
	DEFW	DP-5
VOCL:	DEFW	DOUSE
	DEFW	14H
;
	DEFB	83H		;BLK
	DM	'BLK'
	DEFW	VOCL-0BH
BLK:	DEFW	DOUSE
	DEFB	16H
;
	DEFB	82H		;IN
	DM	'IN'
	DEFW	BLK-6
INN:	DEFW	DOUSE
	DEFB	18H
;
	DEFB	83H		;OUT
	DM	'OUT'
	DEFW	INN-5
OUTT:	DEFW	DOUSE
	DEFB	1AH
;
	DEFB	83H		;SCR
	DM	'SCR'
	DEFW	OUTT-6
SCR:	DEFW	DOUSE
	DEFB	1CH
;
	DEFB	86H		;OFFSET
	DM	'OFFSET'
	DEFW	SCR-6
OFSET:	DEFW	DOUSE
	DEFB	1EH
;
	DEFB	87H		;CONTEXT
	DM	'CONTEXT'
	DEFW	OFSET-9
CONT:	DEFW	DOUSE
	DEFB	20H
;
	DEFB	87H		;CURRENT
	DM	'CURRENT'
	DEFW	CONT-0AH
CURR:	DEFW	DOUSE
	DEFB	22H
;
	DEFB	85H		;STATE
	DM	'STATE'
	DEFW	CURR-0AH
STATE:	DEFW	DOUSE
	DEFB	24H
;
	DEFB	84H		;BASE
	DM	'BASE'
	DEFW	STATE-8
BASE:	DEFW	DOUSE
	DEFB	26H
;
	DEFB	83H		;DPL
	DM	'DPL'
	DEFW	BASE-7
DPL:	DEFW	DOUSE
	DEFB	28H
;
	DEFB	83H		;FLD
	DM	'FLD'
	DEFW	DPL-6
FLD:	DEFW	DOUSE
	DEFB	2AH
;
	DEFB	83H		;CSP
	DM	'CSP'
	DEFW	FLD-6
CSPP:	DEFW	DOUSE
	DEFB	2CH
;
	DEFB	82H		;R#
	DM	'R#'
	DEFW	CSPP-6
RNUM:	DEFW	DOUSE
	DEFB	2EH
;
	DEFB	83H		;HLD
	DM	'HLD'
	DEFW	RNUM-5
HLD:	DEFW	DOUSE
	DEFW	30H
;
;	END OF USER VARIABLES
;
	DEFB	82H		;1+
	DM	'1+'
	DEFW	HLD-6
ONEP:	DEFW	$+2		;/
	POP	HL		;/
	INC	HL		;/
	JHPUSH			;/
;
	DEFB	82H		;2+
	DM	'2+'
	DEFW	ONEP-5
TWOP:	DEFW	$+2		;/
	POP	HL		;/
	INC	HL		;/
	INC	HL		;/
	JHPUSH			;/
;
	DEFB	82H		;/ 1-
	DM	'1-'		;/
	DEFW	TWOP-5		;/
ONEMIN:	DEFW	$+2		;/
	POP	HL		;/
	DEC	HL		;/
	JHPUSH			;/
;
	DEFB	82H		;/ 2-
	DM	'2-'		;/
	DEFW	ONEMIN-5	;/
TWOMIN:	DEFW	$+2		;/
	POP	HL		;/
	DEC	HL		;/
	DEC	HL		;/
	JHPUSH			;/
;
	DEFB	82H		;/ 2*
	DM	'2*'		;/
	DEFW	TWOMIN-5	;/
TWOSTA:	DEFW	$+2		;/
	POP	HL		;/
	ADD	HL,HL		;/ ASL HL
	JHPUSH			;/
;
	DEFB	82H		;/ 2/
	DM	'2/'		;/
	DEFW	TWOSTA-5	;/
TWOSLA:	DEFW	$+2		;/
	POP	HL		;/
	BIT	7,H		;/
	JR	Z,TWOSL1	;/
	INC	HL		;/
TWOSL1:	SRA	H		;/
	RR	L		;/ ASR HL
	JHPUSH			;/
;
	DEFB	84H		;HERE
	DM	'HERE'
	DEFW	TWOSLA-5
HERE:	DEFW	DOCOL
	DEFW	DP
	DEFW	AT
	DEFW	SEMIS
;
	DEFB	85H		;ALLOT
	DM	'ALLOT'
	DEFW	HERE-7
ALLOT:	DEFW	DOCOL
	DEFW	DP
	DEFW	PSTOR
	DEFW	SEMIS
;
	DEFB	81H		; ,
	DM	','
	DEFW	ALLOT-8
COMMA:	DEFW	DOCOL
	DEFW	HERE
	DEFW	STORE
	DEFW	TWO
	DEFW	ALLOT
	DEFW	SEMIS
;
	DEFB	82H		;C,
	DM	'C,'
	DEFW	COMMA-4
CCOMM:	DEFW	DOCOL
	DEFW	HERE
	DEFW	CSTOR
	DEFW	ONE
	DEFW	ALLOT
	DEFW	SEMIS
;
	DEFB	81H		;-
	DM	'-'
	DEFW	CCOMM-5
SUBB:	DEFW	$+2
	POP	DE
	POP	HL
	OR	A		;/ RESET CARRY
	SBC	HL,DE		;/
	JHPUSH
;
	DEFB	81H		;=
	DM	'='
	DEFW	SUBB-4
EQUAL:	DEFW	$+2		;/
	POP	DE		;/
	POP	HL		;/
	XOR	A		;/ RESET CARRY
	SBC	HL,DE		;/
	LD	H,A		;/
	LD	L,A		;/ LD HL,0000H
	JR	NZ,EXEQU	;/ FALSE
	INC	L		;/ TRUE
EXEQU:	JHPUSH			;/
;
	DEFB	81H		;  <
	DM	'<'
	DEFW	EQUAL-4
LESS:	DEFW	$+2
	POP	DE
	POP	HL		;  (HL) (DE) <
	LD	A,D
	XOR	H		;  ONE OF THEM NEGATIVE?
	JP	M,LES1		;  YES, DETERMINE WHICH
	OR	A		;/ CLR CARRY
	SBC	HL,DE		;/
LES1:	BIT	7,H		;/ (H) NEGATIVE?
	LD	HL,0
	JR	Z,EXLESS	;/ NO, FALSE
	INC	L		;/ TRUE
EXLESS:	JHPUSH
;
	DEFB	82H		;U<
	DM	'U<'
	DEFW	LESS-4
ULESS:	DEFW	$+2		;/
	POP	DE
	POP	HL		;/ (HL) (DE) U<
	XOR	A		;/
	SBC	HL,DE		;/
	LD	H,A		;/
	LD	L,A		;/ LD HL,0000H
	JR	NC,EXULES	;/ FALSE
	INC	L		;/ TRUE
EXULES:	JHPUSH
;
	DEFB	81H		;>
	DM	'>'
	DEFW	ULESS-5
GREAT:	DEFW	$+2
	POP	HL		;/
	POP	DE		;/ (HL) (DE) > = (DE) (HL) <
	LD	A,D
	XOR	H		;  ONE OF THEM NEGATIVE?
	JP	M,GREAT1	;  YES, DETERMINE WHICH
	OR	A		;/ CLR CARRY
	SBC	HL,DE		;/
GREAT1:	BIT	7,H		;/ (H) NEGATIVE?
	LD	HL,0		;  (HL)<--FALSE
	JR	Z,GREAT2	;/ NO, FALSE
	INC	L		;/ (HL)<--TRUE
GREAT2:	JHPUSH
;
	DEFB	83H		;ROT
	DM	'ROT'
	DEFW	GREAT-4
ROT:	DEFW	$+2
	POP	DE
	POP	HL
	EX	(SP),HL
	JP	DPUSH
;
	DEFB	85H		;SPACE
	DM	'SPACE'
	DEFW	ROT-6
SPACE:	DEFW	DOCOL
	DEFW	BL
	DEFW	EMIT
	DEFW	SEMIS
;
	DEFB	84H		;-DUP
	DM	'-DUP'
	DEFW	SPACE-8
DDUP:	DEFW	$+2		;/
	POP	HL		;/
	LD	A,H		;/
	OR	L		;/ (HL)=0?
	JR	Z,EXDDUP	;/ YES, DON'T DUP
	PUSH	HL		;/
EXDDUP:	JHPUSH
;
	DEFB	88H		;TRAVERSE
	DM	'TRAVERSE'
	DEFW	DDUP-7
TRAV:	DEFW	DOCOL
	DEFW	SWAP
TRAV1:	DEFW	OVER		;BEGIN
	DEFW	PLUS
	DEFW	LIT
	DEFW	7FH
	DEFW	OVER
	DEFW	CAT
	DEFW	LESS
	DEFW	ZBRAN		;UNTIL
	DEFW	TRAV1-$
	DEFW	SWAP
	DEFW	DROP
	DEFW	SEMIS
;
	DEFB	86H		;LATEST
	DM	'LATEST'
	DEFW	TRAV-0BH
LATES:	DEFW	DOCOL
	DEFW	CURR
	DEFW	AT
	DEFW	AT
	DEFW	SEMIS
;
	DEFB	83H		;LFA
	DM	'LFA'
	DEFW	LATES-9
LFA:	DEFW	$+2		;/
	POP	HL		;/ (HL)<--PFA
	DEC	HL		;/
	DEC	HL		;/
	DEC	HL		;/
	DEC	HL		;/ (HL)<--(HL)-4 = LFA
	JHPUSH			;/
;
	DEFB	83H		;CFA
	DM	'CFA'
	DEFW	LFA-6
CFA:	DEFW	DOCOL
	DEFW	TWOMIN		;/
	DEFW	SEMIS
;
	DEFB	83H		;NFA
	DM	'NFA'
	DEFW	CFA-6
NFA:	DEFW	DOCOL
	DEFW	LIT
	DEFW	5
	DEFW	SUBB
	DEFW	LIT
	DEFW	-1
	DEFW	TRAV
	DEFW	SEMIS
;
	DEFB	83H		;PFA
	DM	'PFA'
	DEFW	NFA-6
PFA:	DEFW	DOCOL
	DEFW	ONE
	DEFW	TRAV
	DEFW	LIT
	DEFW	5
	DEFW	PLUS
	DEFW	SEMIS
;
	DEFB	84H		;!CSP
	DM	'!CSP'
	DEFW	PFA-6
SCSP:	DEFW	DOCOL
	DEFW	SPAT
	DEFW	CSPP
	DEFW	STORE
	DEFW	SEMIS
;
	DEFB	86H		;?ERROR
	DM	'?ERROR'
	DEFW	SCSP-7
QERR:	DEFW	DOCOL
	DEFW	SWAP
	DEFW	ZBRAN		;IF
	DEFW	QERR1-$
	DEFW	ERROR
	DEFW	BRAN		;ELSE
	DEFW	QERR2-$
QERR1:	DEFW	DROP		;ENDIF
QERR2:	DEFW	SEMIS
;
	DEFB	85H		;?COMP
	DM	'?COMP'
	DEFW	QERR-9
QCOMP:	DEFW	DOCOL
	DEFW	STATE
	DEFW	AT
	DEFW	ZEQU
	DEFW	LIT
	DEFW	11H
	DEFW	QERR
	DEFW	SEMIS
;
	DEFB	85H		;?EXEC
	DM	'?EXEC'
	DEFW	QCOMP-8
QEXEC:	DEFW	DOCOL
	DEFW	STATE
	DEFW	AT
	DEFW	LIT
	DEFW	12H
	DEFW	QERR
	DEFW	SEMIS
;
	DEFB	86H		;?PAIRS
	DM	'?PAIRS'
	DEFW	QEXEC-8
QPAIR:	DEFW	DOCOL
	DEFW	SUBB
	DEFW	LIT
	DEFW	13H
	DEFW	QERR
	DEFW	SEMIS
;
	DEFB	84H		;?CSP
	DM	'?CSP'
	DEFW	QPAIR-9
QCSP:	DEFW	DOCOL
	DEFW	SPAT
	DEFW	CSPP
	DEFW	AT
	DEFW	SUBB
	DEFW	LIT
	DEFW	14H
	DEFW	QERR
	DEFW	SEMIS
;
	DEFB	88H		;?LOADING
	DM	'?LOADING'
	DEFW	QCSP-7
QLOAD:	DEFW	DOCOL
	DEFW	BLK
	DEFW	AT
	DEFW	ZEQU
	DEFW	LIT
	DEFW	16H
	DEFW	QERR
	DEFW	SEMIS
;
	DEFB	87H		;COMPILE
	DM	'COMPILE'
	DEFW	QLOAD-0BH
COMP:	DEFW	DOCOL
	DEFW	QCOMP
	DEFW	FROMR
	DEFW	DUP
	DEFW	TWOP
	DEFW	TOR
	DEFW	AT
	DEFW	COMMA
	DEFW	SEMIS
;
	DEFB	0C1H		;[
	DM	'['
	DEFW	COMP-0AH
LBRAC:	DEFW	DOCOL
	DEFW	ZERO
	DEFW	STATE
	DEFW	STORE
	DEFW	SEMIS
;
	DEFB	81H		;]
	DM	']'
	DEFW	LBRAC-4
RBRAC:	DEFW	DOCOL
	DEFW	LIT,0C0H
	DEFW	STATE,STORE
	DEFW	SEMIS
;
	DEFB	86H		;SMUDGE
	DM	'SMUDGE'
	DEFW	RBRAC-4
SMUDG:	DEFW	DOCOL
	DEFW	LATES
	DEFW	LIT
	DEFW	20H
	DEFW	TOGGL
	DEFW	SEMIS
;
	DEFB	83H		;HEX
	DM	'HEX'
	DEFW	SMUDG-9
HEX:	DEFW	DOCOL
	DEFW	LIT
	DEFW	10H
	DEFW	BASE
	DEFW	STORE
	DEFW	SEMIS
;
	DEFB	87H		;DECIMAL
	DM	'DECIMAL'
	DEFW	HEX-6
DEC:	DEFW	DOCOL
	DEFW	LIT
	DEFW	0AH
	DEFW	BASE
	DEFW	STORE
	DEFW	SEMIS
;
	DEFB	87H		;(;CODE)
	DM	'(;CODE)'
	DEFW	DEC-0AH
PSCOD:	DEFW	DOCOL
	DEFW	FROMR
	DEFW	LATES
	DEFW	PFA
	DEFW	CFA
	DEFW	STORE
	DEFW	SEMIS
;
	DEFB	0C5H		; ;CODE
	DM	';CODE'
	DEFW	PSCOD-0AH
SEMIC:	DEFW	DOCOL
	DEFW	QCSP
	DEFW	COMP
	DEFW	PSCOD
	DEFW	LBRAC
SEMI1:	DEFW	NOOP		;ASSEMBLER
	DEFW	SEMIS
;
	DEFB	87H		;<BUILDS
	DM	'<BUILDS'
	DEFW	SEMIC-8
BUILD:	DEFW	DOCOL
	DEFW	ZERO
	DEFW	CON
	DEFW	SEMIS
;
	DEFB	85H		;DOES>
	DM	'DOES>'
	DEFW	BUILD-0AH
DOES:	DEFW	DOCOL
	DEFW	FROMR
	DEFW	LATES
	DEFW	PFA
	DEFW	STORE
	DEFW	PSCOD
DODOE:	LD	HL,(RPP)
	DEC	HL
	LD	(HL),B
	DEC	HL
	LD	(HL),C
	LD	(RPP),HL
	INC	DE
	EX	DE,HL
	LD	C,(HL)
	INC	HL
	LD	B,(HL)
	INC	HL
	JHPUSH
;
	DEFB	85H		;COUNT
	DM	'COUNT'
	DEFW	DOES-8
COUNT:	DEFW	DOCOL
	DEFW	DUP
	DEFW	ONEP
	DEFW	SWAP
	DEFW	CAT
	DEFW	SEMIS
;
	DEFB	84H		;TYPE
	DM	'TYPE'
	DEFW	COUNT-8
TYPE:	DEFW	DOCOL
	DEFW	DDUP
	DEFW	ZBRAN		;IF
	DEFW	TYPE1-$
	DEFW	OVER
	DEFW	PLUS
	DEFW	SWAP
	DEFW	XDO		;DO
TYPE2:	DEFW	IDO
	DEFW	CAT
	DEFW	EMIT
	DEFW	XLOOP		;LOOP
	DEFW	TYPE2-$
	DEFW	BRAN		;ELSE
	DEFW	TYPE3-$
TYPE1:	DEFW	DROP		;ENDIF
TYPE3:	DEFW	SEMIS
;
	DEFB	89H		;-TRAILING
	DM	'-TRAILING'
	DEFW	TYPE-7
DTRAI:	DEFW	DOCOL
	DEFW	DUP
	DEFW	ZERO
	DEFW	XDO		;DO
DTRA1:	DEFW	TDUP		;/
	DEFW	PLUS
	DEFW	ONEMIN		;/
	DEFW	CAT
	DEFW	BL
	DEFW	SUBB
	DEFW	ZBRAN		;IF
	DEFW	DTRA2-$
	DEFW	LEAVE
	DEFW	BRAN		;ELSE
	DEFW	DTRA3-$
DTRA2:	DEFW	ONEMIN		;/
DTRA3:	DEFW	XLOOP		;LOOP
	DEFW	DTRA1-$
	DEFW	SEMIS
;
	DEFB	84H		;(.")
	DM	'(.")'
	DEFW	DTRAI-0CH
PDOTQ:	DEFW	DOCOL
	DEFW	RR
	DEFW	COUNT
	DEFW	DUP
	DEFW	ONEP
	DEFW	FROMR
	DEFW	PLUS
	DEFW	TOR
	DEFW	TYPE
	DEFW	SEMIS
;
	DEFB	0C2H		;."
	DM	'."'
	DEFW	PDOTQ-7
DOTQ:	DEFW	DOCOL
	DEFW	LIT
	DEFW	22H
	DEFW	STATE
	DEFW	AT
	DEFW	ZBRAN		;IF
	DEFW	DOTQ1-$
	DEFW	COMP
	DEFW	PDOTQ
	DEFW	WORD
	DEFW	HERE
	DEFW	CAT
	DEFW	ONEP
	DEFW	ALLOT
	DEFW	BRAN		;ELSE
	DEFW	DOTQ2-$
DOTQ1:	DEFW	WORD
	DEFW	HERE
	DEFW	COUNT
	DEFW	TYPE		;ENDIF
DOTQ2:	DEFW	SEMIS
;
	DEFB	86H		;EXPECT
	DM	'EXPECT'
	DEFW	DOTQ-5
EXPEC:	DEFW	DOCOL
	DEFW	OVER
	DEFW	PLUS
	DEFW	OVER
	DEFW	XDO		;DO
EXPE1:	DEFW	KEY
	DEFW	DUP
	DEFW	LIT
	DEFW	0EH
	DEFW	PORIG
	DEFW	AT
	DEFW	EQUAL
	DEFW	ZBRAN		;IF
	DEFW	EXPE2-$
	DEFW	DROP
	DEFW	DUP
	DEFW	IDO
	DEFW	EQUAL
	DEFW	DUP
	DEFW	FROMR
	DEFW	TWOMIN		;/
	DEFW	PLUS
	DEFW	TOR
	DEFW	ZBRAN		;IF
	DEFW	EXPE6-$
	DEFW	LIT
	DEFW	BELL
	DEFW	BRAN		;ELSE
	DEFW	EXPE7-$
EXPE6:	DEFW	LIT
	DEFW	BSOUT		;ENDIF
EXPE7:	DEFW	BRAN		;ELSE
	DEFW	EXPE3-$
EXPE2:	DEFW	DUP
	DEFW	LIT
	DEFW	ACR		;/
	DEFW	EQUAL
	DEFW	ZBRAN		;IF
	DEFW	EXPE4-$
	DEFW	LEAVE
	DEFW	DROP
	DEFW	BL
	DEFW	ZERO
	DEFW	BRAN		;ELSE
	DEFW	EXPE5-$
EXPE4:	DEFW	DUP		;ENDIF
EXPE5:	DEFW	IDO
	DEFW	CSTOR
	DEFW	ZERO
	DEFW	IDO
	DEFW	ONEP
	DEFW	STORE		;ENDIF
EXPE3:	DEFW	EMIT
	DEFW	XLOOP		;LOOP
	DEFW	EXPE1-$
	DEFW	DROP
	DEFW	SEMIS
;
	DEFB	85H		;QUERY
	DM	'QUERY'
	DEFW	EXPEC-9
QUERY:	DEFW	DOCOL
	DEFW	TIB
	DEFW	AT
	DEFW	LIT
	DEFW	50H
	DEFW	EXPEC
	DEFW	ZERO
	DEFW	INN
	DEFW	STORE
	DEFW	SEMIS
;
	DEFB	0C1H		;NULL
	DEFB	80H
	DEFW	QUERY-8
NULL:	DEFW	DOCOL
	DEFW	BLK
	DEFW	AT
	DEFW	ZBRAN		;IF
	DEFW	NULL1-$
	DEFW	ONE
	DEFW	BLK
	DEFW	PSTOR
	DEFW	ZERO
	DEFW	INN
	DEFW	STORE
	DEFW	BLK
	DEFW	AT
	DEFW	BSCR
	DEFW	ONEMIN		;/
	DEFW	ANDD
	DEFW	ZEQU
	DEFW	ZBRAN		;IF
	DEFW	NULL2-$
	DEFW	QEXEC
	DEFW	FROMR
	DEFW	DROP		;ENDIF
NULL2:	DEFW	BRAN		;ELSE
	DEFW	NULL3-$
NULL1:	DEFW	FROMR
	DEFW	DROP		;ENDIF
NULL3:	DEFW	SEMIS
;
	DEFB	84H		;FILL
	DM	'FILL'
	DEFW	NULL-4
FILL:	DEFW	$+2
	EXX			;/ SAVE IP
	POP	DE		;/ (E)<--BYTE
	POP	BC		;  (BC)<--QUANTITY
	POP	HL		;/ (HL)<--ADDR
FILL1:	LD	A,B
	OR	C		;  QTY=0?
	JR	Z,FILL2		;  YES
	LD	(HL),E		;/ ((HL))<--BYTE
	INC	HL		;  INC POINTER
	DEC	BC		;  DEC COUNTER
	JP	FILL1		;/
FILL2:	EXX			;/ RESTORE IP
	JNEXT
;
	DEFB	85H		;ERASE
	DM	'ERASE'
	DEFW	FILL-7
ERASEE:	DEFW	DOCOL
	DEFW	ZERO
	DEFW	FILL
	DEFW	SEMIS
;
	DEFB	86H		;BLANKS
	DM	'BLANKS'
	DEFW	ERASEE-8
BLANK:	DEFW	DOCOL
	DEFW	BL
	DEFW	FILL
	DEFW	SEMIS
;
	DEFB	84H		;HOLD
	DM	'HOLD'
	DEFW	BLANK-9
HOLD:	DEFW	DOCOL
	DEFW	LIT
	DEFW	-1
	DEFW	HLD
	DEFW	PSTOR
	DEFW	HLD
	DEFW	AT
	DEFW	CSTOR
	DEFW	SEMIS
;
	DEFB	83H		;PAD
	DM	'PAD'
	DEFW	HOLD-7
PAD:	DEFW	DOCOL
	DEFW	HERE
	DEFW	LIT
	DEFW	44H
	DEFW	PLUS
	DEFW	SEMIS
;
	DEFB	84H		;WORD
	DM	'WORD'
	DEFW	PAD-6
WORD:	DEFW	DOCOL
	DEFW	BLK
	DEFW	AT
	DEFW	ZBRAN		;IF
	DEFW	WORD1-$
	DEFW	BLK
	DEFW	AT
	DEFW	BLOCK
	DEFW	BRAN		;ELSE
	DEFW	WORD2-$
WORD1:	DEFW	TIB
	DEFW	AT		;ENDIF
WORD2:	DEFW	INN
	DEFW	AT
	DEFW	PLUS
	DEFW	SWAP
	DEFW	ENCL
	DEFW	HERE
	DEFW	LIT
	DEFW	22H
	DEFW	BLANK
	DEFW	INN
	DEFW	PSTOR
	DEFW	OVER
	DEFW	SUBB
	DEFW	TOR
	DEFW	RR
	DEFW	HERE
	DEFW	CSTOR
	DEFW	PLUS
	DEFW	HERE
	DEFW	ONEP
	DEFW	FROMR
	DEFW	CMOVE
	DEFW	SEMIS
;
	DEFB	88H		;(NUMBER)
	DM	'(NUMBER)'
	DEFW	WORD-7
PNUMB:	DEFW	DOCOL
PNUM1:	DEFW	ONEP		;BEGIN
	DEFW	DUP
	DEFW	TOR
	DEFW	CAT
	DEFW	BASE
	DEFW	AT
	DEFW	DIGIT
	DEFW	ZBRAN		;WHILE
	DEFW	PNUM2-$
	DEFW	SWAP
	DEFW	BASE
	DEFW	AT
	DEFW	USTAR
	DEFW	DROP
	DEFW	ROT
	DEFW	BASE
	DEFW	AT
	DEFW	USTAR
	DEFW	DPLUS
	DEFW	DPL
	DEFW	AT
	DEFW	ONEP
	DEFW	ZBRAN		;IF
	DEFW	PNUM3-$
	DEFW	ONE
	DEFW	DPL
	DEFW	PSTOR		;ENDIF
PNUM3:	DEFW	FROMR
	DEFW	BRAN		;REPEAT
	DEFW	PNUM1-$
PNUM2:	DEFW	FROMR
	DEFW	SEMIS
;
	DEFB	86H		;NUMBER
	DM	'NUMBER'
	DEFW	PNUMB-0BH
NUMB:	DEFW	DOCOL
	DEFW	ZERO
	DEFW	ZERO
	DEFW	ROT
	DEFW	DUP
	DEFW	ONEP
	DEFW	CAT
	DEFW	LIT
	DEFW	2DH
	DEFW	EQUAL
	DEFW	DUP
	DEFW	TOR
	DEFW	PLUS
	DEFW	LIT
	DEFW	-1
NUMB1:	DEFW	DPL		;BEGIN
	DEFW	STORE
	DEFW	PNUMB
	DEFW	DUP
	DEFW	CAT
	DEFW	BL
	DEFW	SUBB
	DEFW	ZBRAN		;WHILE
	DEFW	NUMB2-$
	DEFW	DUP
	DEFW	CAT
	DEFW	LIT
	DEFW	2EH
	DEFW	SUBB
	DEFW	ZERO
	DEFW	QERR
	DEFW	ZERO
	DEFW	BRAN		;REPEAT
	DEFW	NUMB1-$
NUMB2:	DEFW	DROP
	DEFW	FROMR
	DEFW	ZBRAN		;IF
	DEFW	NUMB3-$
	DEFW	DMINU		;ENDIF
NUMB3:	DEFW	SEMIS
;
	DEFB	85H		;-FIND (0-3) SUCCESS
	DM	'-FIND'		;      (0-1) FAILURE
	DEFW	NUMB-9
DFIND:	DEFW	DOCOL
	DEFW	BL
	DEFW	WORD
	DEFW	HERE
	DEFW	CONT
	DEFW	AT
	DEFW	AT
	DEFW	PFIND
	DEFW	DUP
	DEFW	ZEQU
	DEFW	ZBRAN		;IF
	DEFW	DFIN1-$
	DEFW	DROP
	DEFW	HERE
	DEFW	LATES
	DEFW	PFIND		;ENDIF
DFIN1:	DEFW	SEMIS
;
	DEFB	87H		;(ABORT)
	DM	'(ABORT)'
	DEFW	DFIND-8
PABOR:	DEFW	DOCOL
	DEFW	ABORT
	DEFW	SEMIS
;
	DEFB	85H		;ERROR
	DM	'ERROR'
	DEFW	PABOR-0AH
ERROR:	DEFW	DOCOL
	DEFW	WARN
	DEFW	AT
	DEFW	ZLESS
	DEFW	ZBRAN		;IF
	DEFW	ERRO1-$
	DEFW	PABOR		;ENDIF
ERRO1:	DEFW	HERE
	DEFW	COUNT
	DEFW	TYPE
	DEFW	PDOTQ
	DEFB	2
	DB	'? '
	DEFW	MESS
	DEFW	SPSTO
;	CHANGE FROM fig MODEL
;	DEFW	INN,AT,BLK,AT
	DEFW	BLK,AT
	DEFW	DDUP
	DEFW	ZBRAN,ERRO2-$	;IF
	DEFW	INN,AT
	DEFW	SWAP		;ENDIF
ERRO2:	DEFW	QUIT
;
	DEFB	83H		;ID.
	DM	'ID.'
	DEFW	ERROR-8
IDDOT:	DEFW	DOCOL
	DEFW	PAD
	DEFW	LIT
	DEFW	20H
	DEFW	BLANK		;/
	DEFW	DUP
	DEFW	PFA
	DEFW	LFA
	DEFW	OVER
	DEFW	SUBB
	DEFW	DUP		;/ change frm MODEL
	DEFW	TOR		;/ to suppress BIT 7
	DEFW	PAD
	DEFW	SWAP
	DEFW	CMOVE
	DEFW	PAD
	DEFW	FROMR		;/ for terminals
	DEFW	PAD		;/ with an 8 bit
	DEFW	PLUS		;/ ASCCI character set.
	DEFW	ONEMIN		;/
	DEFW	DUP		;/
	DEFW	AT		;/
	DEFW	LIT		;/
	DEFW	7FH		;/
	DEFW	ANDD		;/
	DEFW	SWAP		;/
	DEFW	STORE		;/
	DEFW	COUNT
	DEFW	LIT
	DEFW	1FH		;  WIDTH
	DEFW	ANDD
	DEFW	TYPE
	DEFW	SPACE
	DEFW	SEMIS
;
	DEFB	86H		;CREATE
	DM	'CREATE'
	DEFW	IDDOT-6
CREAT:	DEFW	DOCOL
	DEFW	DFIND
	DEFW	ZBRAN		;IF
	DEFW	CREA1-$
	DEFW	DROP
	DEFW	NFA
	DEFW	IDDOT
	DEFW	LIT
	DEFW	4
	DEFW	MESS
	DEFW	SPACE		;ENDIF
CREA1:	DEFW	HERE
	DEFW	DUP
	DEFW	CAT
	DEFW	WIDTH
	DEFW	AT
	DEFW	MIN
	DEFW	ONEP
	DEFW	ALLOT
	DEFW	DUP
	DEFW	LIT
	DEFW	0A0H
	DEFW	TOGGL
	DEFW	HERE
	DEFW	ONEMIN
	DEFW	LIT
	DEFW	80H
	DEFW	TOGGL
	DEFW	LATES
	DEFW	COMMA
	DEFW	CURR
	DEFW	AT
	DEFW	STORE
	DEFW	HERE
	DEFW	TWOP
	DEFW	COMMA
	DEFW	SEMIS
;
	DEFB	0C9H		;[COMPILE]
	DM	'[COMPILE]'
	DEFW	CREAT-9
BCOMP:	DEFW	DOCOL
	DEFW	DFIND
	DEFW	ZEQU
	DEFW	ZERO
	DEFW	QERR
	DEFW	DROP
	DEFW	CFA
	DEFW	COMMA
	DEFW	SEMIS
;
	DEFB	0C7H		;LITERAL
	DM	'LITERAL'
	DEFW	BCOMP-0CH
LITER:	DEFW	DOCOL
	DEFW	STATE
	DEFW	AT
	DEFW	ZBRAN		;IF
	DEFW	LITE1-$
	DEFW	COMP
	DEFW	LIT
	DEFW	COMMA		;ENDIF
LITE1:	DEFW	SEMIS
;
	DEFB	0C8H		;DLITERAL
	DM	'DLITERAL'
	DEFW	LITER-0AH
DLITE:	DEFW	DOCOL
	DEFW	STATE
	DEFW	AT
	DEFW	ZBRAN		;IF
	DEFW	DLIT1-$
	DEFW	SWAP
	DEFW	LITER
	DEFW	LITER		;ENDIF
DLIT1:	DEFW	SEMIS
;
	DEFB	86H		;?STACK
	DM	'?STACK'
	DEFW	DLITE-0BH
QSTAC:	DEFW	DOCOL
	DEFW	SPAT
	DEFW	SZERO
	DEFW	AT
	DEFW	SWAP
	DEFW	ULESS
	DEFW	ONE
	DEFW	QERR
	DEFW	SPAT
	DEFW	HERE
	DEFW	LIT
	DEFW	80H
	DEFW	PLUS
	DEFW	ULESS
	DEFW	LIT
	DEFW	7
	DEFW	QERR
	DEFW	SEMIS
;
	DEFB	89H		;INTERPRET
	DM	'INTERPRET'
	DEFW	QSTAC-9
INTER:	DEFW	DOCOL
INTE1:	DEFW	DFIND		;BEGIN
	DEFW	ZBRAN		;IF
	DEFW	INTE2-$
	DEFW	STATE
	DEFW	AT
	DEFW	LESS
	DEFW	ZBRAN		;IF
	DEFW	INTE3-$
	DEFW	CFA
	DEFW	COMMA
	DEFW	BRAN		;ELSE
	DEFW	INTE4-$
INTE3:	DEFW	CFA
	DEFW	EXEC		;ENDIF
INTE4:	DEFW	QSTAC
	DEFW	BRAN		;ELSE
	DEFW	INTE5-$
INTE2:	DEFW	HERE
	DEFW	NUMB
	DEFW	DPL
	DEFW	AT
	DEFW	ONEP
	DEFW	ZBRAN		;IF
	DEFW	INTE6-$
	DEFW	DLITE
	DEFW	BRAN		;ELSE
	DEFW	INTE7-$
INTE6:	DEFW	DROP
	DEFW	LITER		;ENDIF
INTE7:	DEFW	QSTAC		;ENDIF
INTE5:	DEFW	BRAN		;AGAIN
	DEFW	INTE1-$
;
	DEFB	89H		;IMMEDIATE
	DM	'IMMEDIATE'
	DEFW	INTER-0CH
IMMED:	DEFW	DOCOL
	DEFW	LATES
	DEFW	LIT
	DEFW	40H
	DEFW	TOGGL
	DEFW	SEMIS
;
	DEFB	8AH		;VOCABULARY
	DM	'VOCABULARY'
	DEFW	IMMED-0CH
VOCAB:	DEFW	DOCOL
	DEFW	BUILD
	DEFW	LIT
	DEFW	0A081H
	DEFW	COMMA
	DEFW	CURR
	DEFW	AT
	DEFW	CFA
	DEFW	COMMA
	DEFW	HERE
	DEFW	VOCL
	DEFW	AT
	DEFW	COMMA
	DEFW	VOCL
	DEFW	STORE
	DEFW	DOES
DOVOC:	DEFW	TWOP
	DEFW	CONT
	DEFW	STORE
	DEFW	SEMIS
;
	DEFB	0C5H		;FORTH
	DM	'FORTH'
	DEFW	VOCAB-0DH
FORTH:	DEFW	DODOE
	DEFW	DOVOC
	DEFW	0A081H
	DEFW	TASK-7		;COLD START VALUE ONLY.
;				CHANGED EACH TIME A DEF IS APPENDED
;				TO THE FORTH VOCABULARY
	DEFW	0		;END OF VOCABULARY LIST
;
	DEFB	8BH		;DEFINITIONS
	DM	'DEFINITIONS'
	DEFW	FORTH-8
DEFIN:	DEFW	DOCOL
	DEFW	CONT
	DEFW	AT
	DEFW	CURR
	DEFW	STORE
	DEFW	SEMIS
;
	DEFB	0C1H		;(
	DM	'('
	DEFW	DEFIN-0EH
PAREN:	DEFW	DOCOL
	DEFW	LIT
	DEFW	29H
	DEFW	WORD
	DEFW	SEMIS
;
	DEFB	84H		;QUIT
	DM	'QUIT'
	DEFW	PAREN-4
QUIT:	DEFW	DOCOL
	DEFW	ZERO
	DEFW	BLK
	DEFW	STORE
	DEFW	LBRAC
QUIT1:	DEFW	RPSTO		;BEGIN
	DEFW	CR
	DEFW	QUERY
	DEFW	INTER
	DEFW	STATE
	DEFW	AT
	DEFW	ZEQU
	DEFW	ZBRAN		;IF
	DEFW	QUIT2-$
	DEFW	PDOTQ
	DEFB	2
	DB	'ok'		;ENDIF
QUIT2:	DEFW	BRAN		;AGAIN
	DEFW	QUIT1-$
;
	DEFB	85H		;ABORT
	DM	'ABORT'
	DEFW	QUIT-7
ABORT:	DEFW	DOCOL
	DEFW	SPSTO
	DEFW	DEC
	DEFW	QSTAC
	DEFW	CR
	DEFW	DOTCPU
	DEFW	PDOTQ
	DEFB	0EH		;count of CHRs to follow
	DB	'fig-FORTH '
	DEFB	FIGREL+30H,ADOT,FIGREV+30H,USRVER
	DEFW	FORTH
	DEFW	DEFIN
	DEFW	QUIT
;
WRM:	LD	BC,WRM1
	JNEXT
WRM1:	DEFW	WARM
;
	DEFB	84H		;WARM
	DM	'WARM'
	DEFW	ABORT-8
WARM:	DEFW	DOCOL
	DEFW	MTBUF
	DEFW	ABORT
;
CLD:	LD	HL,(BDOSS+1)	;/
	LD	L,0		;/ (HL)<--FBASE
	LD	(LIMIT+2),HL	;/ set LIMIT
	LD	DE,BUFSIZ	;/ (DE)<--total disc buffer size
	OR	A		;/ clr carry
	SBC	HL,DE		;/ (HL)<--addr. of 1st disc buffer
	LD	(FIRST+2),HL	;/ set FIRST
	LD	(USE+2),HL	;/ set USE
	LD	(PREV+2),HL	;/ set PREV
	LD	(BUF1),HL	;/
	LD	DE,US		;/ (DE)<--user variable space
	SBC	HL,DE		;/ (HL)<--INITR0
	LD	(UPINIT),HL	;/
	LD	(R0INIT),HL	;/
	LD	(UP),HL		;/
	LD	(RPP),HL	;/
	LD	DE,RTS		;/ (DE)<--return stack & terminal buffer space
	SBC	HL,DE		;/ (HL)<--INITS0
	LD	(S0INIT),HL	;/
	LD	(TIBINI),HL	;/
	LD	SP,HL		;/
	LD	BC,CLD1
	LD	IX,NEXT		; POINTER TO NEXT
	LD	IY,HPUSH	; POINTER TO HPUSH
	JNEXT
;
CLD1:	DEFW	COLD
;
	DEFB	84H		;COLD
	DM	'COLD'
	DEFW	WARM-7
COLD:	DEFW	DOCOL
	DEFW	MTBUF
	DEFW	ONE,RECADR	;AvdH
	DEFW	STORE
	DEFW	LIT,BUF1
	DEFW	AT		;/
	DEFW	USE,STORE
	DEFW	LIT,BUF1
	DEFW	AT		;/
	DEFW	PREV,STORE
	DEFW	DRZER
	DEFW	ZERO		;/
	DEFW	LIT,EPRINT
	DEFW	CSTOR		;/
;
	DEFW	LIT
	DEFW	ORIG+12H
	DEFW	LIT
	DEFW	UP
	DEFW	AT
	DEFW	LIT
	DEFW	6
	DEFW	PLUS
	DEFW	LIT
	DEFW	10H
	DEFW	CMOVE
	DEFW	LIT
	DEFW	ORIG+0CH
	DEFW	AT
	DEFW	LIT
	DEFW	FORTH+6
	DEFW	STORE
	DEFW	FCB		;/A
	DEFW	LIT,OPNFIL	;/A open mass storage
	DEFW	BDOS		;/A
	DEFW	LIT,0FFH	;/A
	DEFW	EQUAL		;/A file present?
	DEFW	ZBRAN,CLD2-$	;/A
	DEFW	ZERO		;/A
	DEFW	WARN,STORE	;/A
	DEFW	CR,PDOTQ	;/A
	DEFB	7		;/A
	DB	'No file'	;/A
CLD2:	DEFW	ABORT
;
	DEFB	84H		;S->D
	DM	'S->D'
	DEFW	COLD-7
STOD:	DEFW	$+2
	POP	DE
	LD	HL,0
	BIT	7,D		;/ # NEGATIVE?
	JR	Z,STOD1		;  NO
	DEC	HL		;  YES, EXTEND SIGN
STOD1:	JP	DPUSH		;  ( n1--d1L d1H)
;
	DEFB	82H		;+-
	DM	'+-'
	DEFW	STOD-7
PM:	DEFW	DOCOL
	DEFW	ZLESS
	DEFW	ZBRAN		;IF
	DEFW	PM1-$
	DEFW	MINUS		;ENDIF
PM1:	DEFW	SEMIS
;
	DEFB	83H		;D+-
	DM	'D+-'
	DEFW	PM-5
DPM:	DEFW	DOCOL
	DEFW	ZLESS
	DEFW	ZBRAN		;IF
	DEFW	DPM1-$
	DEFW	DMINU		;ENDIF
DPM1:	DEFW	SEMIS
;
	DEFB	83H		;ABS
	DM	'ABS'
	DEFW	DPM-6
ABS:	DEFW	DOCOL
	DEFW	DUP
	DEFW	PM
	DEFW	SEMIS
;
	DEFB	84H		;DABS
	DM	'DABS'
	DEFW	ABS-6
DABS:	DEFW	DOCOL
	DEFW	DUP
	DEFW	DPM
	DEFW	SEMIS
;
	DEFB	83H		;MIN
	DM	'MIN'
	DEFW	DABS-7
MIN:	DEFW	DOCOL,TDUP
	DEFW	GREAT
	DEFW	ZBRAN		;IF
	DEFW	MIN1-$
	DEFW	SWAP		;ENDIF
MIN1:	DEFW	DROP
	DEFW	SEMIS
;
	DEFB	83H		;MAX
	DM	'MAX'
	DEFW	MIN-6
MAX:	DEFW	DOCOL
	DEFW	TDUP
	DEFW	LESS
	DEFW	ZBRAN		;IF
	DEFW	MAX1-$
	DEFW	SWAP		;ENDIF
MAX1:	DEFW	DROP
	DEFW	SEMIS
;
	DEFB	82H		;M*
	DM	'M*'
	DEFW	MAX-6
MSTAR:	DEFW	DOCOL,TDUP
	DEFW	XORR
	DEFW	TOR
	DEFW	ABS
	DEFW	SWAP
	DEFW	ABS
	DEFW	USTAR
	DEFW	FROMR
	DEFW	DPM
	DEFW	SEMIS
;
	DEFB	82H		;M/
	DM	'M/'
	DEFW	MSTAR-5
MSLAS:	DEFW	DOCOL
	DEFW	OVER
	DEFW	TOR
	DEFW	TOR
	DEFW	DABS
	DEFW	RR
	DEFW	ABS
	DEFW	USLAS
	DEFW	FROMR
	DEFW	RR
	DEFW	XORR
	DEFW	PM
	DEFW	SWAP
	DEFW	FROMR
	DEFW	PM
	DEFW	SWAP
	DEFW	SEMIS
;
	DEFB	81H		;  *
	DM	'*'
	DEFW	MSLAS-5
STAR:	DEFW	$+2
	EXX			;/ SAVE IP
	POP	HL
	POP	DE
	LD	A,L		;/
	LD	C,H		;/
	LD	B,10H		;/
	LD	HL,0		;/
STAR1:	SRL	C		;/
	RRA			;/ SRL CA  (MPCATOR)
	JR	NC,STAR2	;/ LSB (CA)=0?
	ADD	HL,DE		;/ NO, ADD MPCANT TO HL
STAR2:	SLA	E		;/
	RL	D		;/ SLA DE  (MPCANT 2 *)
	DJNZ	STAR1		;/ DO ALL 16 BITS
	PUSH	HL		;/ (S1)<--PRODUCT
	EXX			;/ RESTORE IP
	JNEXT
;
	DEFB	84H		;  /MOD
	DM	'/MOD'
	DEFW	STAR-4
SLMOD:	DEFW	$+2
	POP	DE		;/ DIVISOR
	POP	HL		;/ DIVIDEND
	PUSH	BC		;/ SAVE IP
	XOR	A		;/ RESET NEGATE FLAG
	EX	AF,AF'		;/ ALT SET
	LD	A,D		;/
	OR	E		;/ DIV BY 0?
	JR	NZ,SLMOD1	;/
	LD	HL,-1		;/ YES
	LD	D,H		;/
	LD	E,L		;/ QUOT & REM <-- -1
	JR	SLMOD7		;/ EXIT
SLMOD1:	BIT	7,D		;/ DIVISOR NEGATIVE?
	JR	Z,SLMOD2	;/
	LD	A,E		;/ YES
	CPL			;/
	LD	E,A		;/
	LD	A,D		;/
	CPL			;/
	LD	D,A		;/
	INC	DE		;/ (DE)<--(DE)'s 2's COMPLEMENT
	EX	AF,AF'		;/ STD SET
	SCF			;/ SET NEGATE FLAG
	EX	AF,AF'		;/ ALT SET
SLMOD2:	BIT	7,H		;/ DIVIDEND NEGATIVE?
	JR	Z,SLMOD3	;/
	LD	A,L		;/ YES
	CPL			;/
	LD	L,A		;/
	LD	A,H		;/
	CPL			;/
	LD	H,A		;/
	INC	HL		;/ (HL)<--(HL)'s 2's COMPLEMENT
	EX	AF,AF'		;/ STD SET
	CCF			;/ NEGATE FLAG
	INC	A		;/ DIVIDEND SIGN FLAG
	EX	AF,AF'		;/ ALT SET
SLMOD3:	LD	A,L		;/
	LD	C,H		;/ (CA)<--DIVIDEND
	LD	HL,0		;/ PRIME REMAINDER
	LD	B,10H		;/ LOOP COUNTER
SLMOD4:	RLA			;/
	RL	C		;/ RL CA
	ADC	HL,HL		;/ (HL)<--(HL) 2 * CARRY +
	SBC	HL,DE		;/ UNDERFLOW?
	JR	NC,SLMOD5	;/ NO
	ADD	HL,DE		;/ YES, RESTORE REMAINDER
SLMOD5:	CCF			;/
	DJNZ	SLMOD4		;/ DO ALL 16 BITS
	RLA			;/
	RL	C		;/ RL CA
	LD	E,A		;/
	LD	D,C		;/ (DE)<--QUOTIENT
	EX	AF,AF'		;/ STD SET
	JR	Z,SLMOD6	;/ DIVIDEND POSITIVE
	LD	A,L		;/
	CPL			;/
	LD	L,A		;/
	LD	A,H		;/
	CPL			;/
	LD	H,A		;/
	INC	HL		;/ REM GETS DIVIDEND'S SIGN
SLMOD6:	JR	NC,SLMOD7	;/ QUOTIENT POSITIVE
	LD	A,E		;/
	CPL			;/
	LD	E,A		;/
	LD	A,D		;/
	CPL			;/
	LD	D,A		;/
	INC	DE		;/ NEGATIVE QUOTIENT
SLMOD7:	POP	BC		;/ RESTORE IP
	EX	DE,HL		;/ (S2)<--REMAINDER
	JP	DPUSH		;/ (S1)<--QUOTIENT
;
	DEFB	81H		; /
	DM	'/'
	DEFW	SLMOD-7
SLASH:	DEFW	$+2
	POP	DE		;/ DIVISOR
	POP	HL		;/ DIVIDEND
	PUSH	BC		;/ SAVE IP
	XOR	A		;/ RESET NEG. FLAG
	EX	AF,AF'		;/ ALT SET
	LD	A,D		;/
	OR	E		;/ DIV BY 0?
	JR	NZ,SLASH1	;/
	LD	HL,-1		;/ YES, SET QUOTIENT TO -1
	JR	SLASH6		;/ EXIT
SLASH1:	BIT	7,D		;/ DIVISOR NEGATIVE?
	JR	Z,SLASH2	;/
	LD	A,E		;/ YES
	CPL			;/
	LD	E,A		;/
	LD	A,D		;/
	CPL			;/
	LD	D,A		;/
	INC	DE		;/ (DE)<--(DE)'s 2's COMPLEMENT
	EX	AF,AF'		;/ STD SET
	SCF			;/ SET NEG. FLAG
	EX	AF,AF'		;/ ALT SET
SLASH2:	BIT	7,H		;/ DIVIDEND NEGATIVE?
	JR	Z,SLASH3	;/
	LD	A,L		;/ YES
	CPL			;/
	LD	L,A		;/
	LD	A,H		;/
	CPL			;/
	LD	H,A		;/
	INC	HL		;/ (HL)<--(HL)'s 2's COMPLEMENT
	EX	AF,AF'		;/ STD SET
	CCF			;/ NEG. FLAG
	EX	AF,AF'		;/ ALT SET
SLASH3:	LD	A,L		;/
	LD	C,H		;/ (CA)<--DIVIDEND
	LD	HL,0		;/
	LD	B,10H		;/ LOOP COUNTER
SLASH4:	RLA			;/
	RL	C		;/ RL CA
	ADC	HL,HL		;/ (HL)<--(HL) 2 * CARRY +
	SBC	HL,DE		;/ UNDERFLOW?
	JR	NC,SLASH5	;/ NO
	ADD	HL,DE		;/ YES, RESTORE REMAINDER
SLASH5:	CCF			;/
	DJNZ	SLASH4		;/ DO ALL 16 BITS
	RLA			;/
	RL	C		;/ RL CA
	LD	L,A		;/
	LD	H,C		;/ (HL)<--QUOTIENT
	EX	AF,AF'		;/ STD SET
	JR	NC,SLASH6	;/ POSITIVE QUOTIENT
	LD	A,L		;/
	CPL			;/
	LD	L,A		;/
	LD	A,H		;/
	CPL			;/
	LD	H,A		;/
	INC	HL		;/ NEGATIVE QUOTIENT
SLASH6:	POP	BC		;/ RESTORE IP
	JHPUSH
;
	DEFB	83H		; MOD
	DM	'MOD'
	DEFW	SLASH-4
MODD:	DEFW	DOCOL
	DEFW	SLMOD
	DEFW	DROP
	DEFW	SEMIS
;
	DEFB	85H		; */MOD
	DM	'*/MOD'
	DEFW	MODD-6
SSMOD:	DEFW	DOCOL
	DEFW	TOR
	DEFW	MSTAR
	DEFW	FROMR
	DEFW	MSLAS
	DEFW	SEMIS
;
	DEFB	82H		; */
	DM	'*/'
	DEFW	SSMOD-8
SSLA:	DEFW	DOCOL
	DEFW	SSMOD
	DEFW	SWAP
	DEFW	DROP
	DEFW	SEMIS
;
	DEFB	85H		; M/MOD
	DM	'M/MOD'
	DEFW	SSLA-5
MSMOD:	DEFW	DOCOL
	DEFW	TOR
	DEFW	ZERO
	DEFW	RR
	DEFW	USLAS
	DEFW	FROMR
	DEFW	SWAP
	DEFW	TOR
	DEFW	USLAS
	DEFW	FROMR
	DEFW	SEMIS
;
;	Block moved down 2 pages
;
	DEFB	86H		; (LINE)
	DM	'(LINE)'
	DEFW	MSMOD-8
PLINE:	DEFW	DOCOL
	DEFW	TOR
	DEFW	LIT
	DEFW	40H
	DEFW	BBUF
	DEFW	SSMOD
	DEFW	FROMR
	DEFW	BSCR
	DEFW	STAR
	DEFW	PLUS
	DEFW	BLOCK
	DEFW	PLUS
	DEFW	LIT
	DEFW	40H
	DEFW	SEMIS
;
	DEFB	85H		; .LINE
	DM	'.LINE'
	DEFW	PLINE-9
DLINE:	DEFW	DOCOL
	DEFW	PLINE
	DEFW	DTRAI
	DEFW	TYPE
	DEFW	SEMIS
;
	DEFB	87H		;MESSAGE
	DM	'MESSAGE'
	DEFW	DLINE-8
MESS:	DEFW	DOCOL
	DEFW	WARN
	DEFW	AT
	DEFW	ZBRAN		;IF
	DEFW	MESS1-$
	DEFW	DDUP
	DEFW	ZBRAN		;IF
	DEFW	MESS2-$
	DEFW	LIT
	DEFW	4		;1st MESSAGE SCREEN
	DEFW	OFSET
	DEFW	AT
	DEFW	BSCR
	DEFW	SLASH
	DEFW	SUBB
	DEFW	DLINE
	DEFW	SPACE		;ENDIF
MESS2:	DEFW	BRAN		;ELSE
	DEFW	MESS3-$
MESS1:	DEFW	PDOTQ
	DEFB	6
	DB	'MSG # '
	DEFW	DOT		;ENDIF
MESS3:	DEFW	SEMIS
;
	DEFB	82H		;P@
	DM	'P@'
	DEFW	MESS-0AH
PTAT:	DEFW	$+2
	EXX			;d SAVE REGISTERS
	POP	BC		;d (BC)<--PORT#
	IN	L,(C)		;d (L)<--DATA BYTE
	LD	H,0
	PUSH	HL
	EXX			;d RESTORE REGISTERS
	JNEXT
;
	DEFB	82H		;P!
	DM	'P!'
	DEFW	PTAT-5
PTSTO:	DEFW	$+2
	EXX			;d SAVE REGISTERS
	POP	BC		;d (C)<--PORT#
	POP	HL		;d (L)<--DATA BYTE
	OUT	(C),L
	EXX			;d RESTORE REGISTERS
	JNEXT
;
	FORM
*INCLUDE DISCIO.FTH
	FORM
*INCLUDE CONPRTIO.FTH
	FORM
;
	DEFB	0C1H		; ' (tick)
	DEFB	0A7H
	DEFW	ARROW-6
TICK:	DEFW	DOCOL
	DEFW	DFIND
	DEFW	ZEQU
	DEFW	ZERO
	DEFW	QERR
	DEFW	DROP
	DEFW	LITER
	DEFW	SEMIS
;
	DEFB	86H		;FORGET
	DM	'FORGET'
	DEFW	TICK-4
FORG:	DEFW	DOCOL
	DEFW	CURR
	DEFW	AT
	DEFW	CONT
	DEFW	AT
	DEFW	SUBB
	DEFW	LIT
	DEFW	18H
	DEFW	QERR
	DEFW	TICK
	DEFW	DUP
	DEFW	FENCE
	DEFW	AT
	DEFW	uless		;/ FORGET >8000h nw o.k.
	DEFW	LIT
	DEFW	15H
	DEFW	QERR
	DEFW	DUP
	DEFW	NFA
	DEFW	DP
	DEFW	STORE
	DEFW	LFA
	DEFW	AT
	DEFW	CONT
	DEFW	AT
	DEFW	STORE
	DEFW	SEMIS
;
	DEFB	84H		;BACK
	DM	'BACK'
	DEFW	FORG-9
BACK:	DEFW	DOCOL
	DEFW	HERE
	DEFW	SUBB
	DEFW	COMMA
	DEFW	SEMIS
;
	DEFB	0C5H		;BEGIN
	DM	'BEGIN'
	DEFW	BACK-7
BEGIN:	DEFW	DOCOL
	DEFW	QCOMP
	DEFW	HERE
	DEFW	ONE
	DEFW	SEMIS
;
	DEFB	0C5H		;ENDIF
	DM	'ENDIF'
	DEFW	BEGIN-8
ENDIFF:	DEFW	DOCOL
	DEFW	QCOMP
	DEFW	TWO
	DEFW	QPAIR
	DEFW	HERE
	DEFW	OVER
	DEFW	SUBB
	DEFW	SWAP
	DEFW	STORE
	DEFW	SEMIS
;
	DEFB	0C4H		;THEN
	DM	'THEN'
	DEFW	ENDIFF-8
THEN:	DEFW	DOCOL
	DEFW	ENDIFF
	DEFW	SEMIS
;
	DEFB	0C2H		;DO
	DM	'DO'
	DEFW	THEN-7
DO:	DEFW	DOCOL
	DEFW	COMP
	DEFW	XDO
	DEFW	HERE
	DEFW	THREE
	DEFW	SEMIS
;
	DEFB	0C4H		;LOOP
	DM	'LOOP'
	DEFW	DO-5
LOOP:	DEFW	DOCOL
	DEFW	THREE
	DEFW	QPAIR
	DEFW	COMP
	DEFW	XLOOP
	DEFW	BACK
	DEFW	SEMIS
;
	DEFB	0C5H		;+LOOP
	DM	'+LOOP'
	DEFW	LOOP-7
PLOOP:	DEFW	DOCOL
	DEFW	THREE
	DEFW	QPAIR
	DEFW	COMP
	DEFW	XPLOO
	DEFW	BACK
	DEFW	SEMIS
;
	DEFB	0C5H		;UNTIL
	DM	'UNTIL'
	DEFW	PLOOP-8
UNTIL:	DEFW	DOCOL
	DEFW	ONE
	DEFW	QPAIR
	DEFW	COMP
	DEFW	ZBRAN
	DEFW	BACK
	DEFW	SEMIS
;
	DEFB	0C3H		;END
	DM	'END'
	DEFW	UNTIL-8
ENDD:	DEFW	DOCOL
	DEFW	UNTIL
	DEFW	SEMIS
;
	DEFB	0C5H		;AGAIN
	DM	'AGAIN'
	DEFW	ENDD-6
AGAIN:	DEFW	DOCOL
	DEFW	ONE
	DEFW	QPAIR
	DEFW	COMP
	DEFW	BRAN
	DEFW	BACK
	DEFW	SEMIS
;
	DEFB	0C6H		;REPEAT
	DM	'REPEAT'
	DEFW	AGAIN-8
REPEA:	DEFW	DOCOL
	DEFW	TOR
	DEFW	TOR
	DEFW	AGAIN
	DEFW	FROMR
	DEFW	FROMR
	DEFW	TWOMIN		;/
	DEFW	ENDIFF
	DEFW	SEMIS
;
	DEFB	0C2H		;IF
	DM	'IF'
	DEFW	REPEA-9
IFF:	DEFW	DOCOL
	DEFW	COMP
	DEFW	ZBRAN
	DEFW	HERE
	DEFW	ZERO
	DEFW	COMMA
	DEFW	TWO
	DEFW	SEMIS
;
	DEFB	0C4H		;ELSE
	DM	'ELSE'
	DEFW	IFF-5
ELSEE:	DEFW	DOCOL
	DEFW	TWO
	DEFW	QPAIR
	DEFW	COMP
	DEFW	BRAN
	DEFW	HERE
	DEFW	ZERO
	DEFW	COMMA
	DEFW	SWAP
	DEFW	TWO
	DEFW	ENDIFF
	DEFW	TWO
	DEFW	SEMIS
;
	DEFB	0C5H		;WHILE
	DM	'WHILE'
	DEFW	ELSEE-7
WHILE:	DEFW	DOCOL
	DEFW	IFF
	DEFW	TWOP
	DEFW	SEMIS
;
	DEFB	86H		;SPACES
	DM	'SPACES'
	DEFW	WHILE-8
SPACS:	DEFW	DOCOL
	DEFW	ZERO
	DEFW	MAX
	DEFW	DDUP
	DEFW	ZBRAN		;IF
	DEFW	SPAX1-$
	DEFW	ZERO
	DEFW	XDO		;DO
SPAX2:	DEFW	SPACE
	DEFW	XLOOP		;LOOP ENDIF
	DEFW	SPAX2-$
SPAX1:	DEFW	SEMIS
;
	DEFB	82H		;<#
	DM	'<#'
	DEFW	SPACS-9
BDIGS:	DEFW	DOCOL
	DEFW	PAD
	DEFW	HLD
	DEFW	STORE
	DEFW	SEMIS
;
	DEFB	82H		;#>
	DM	'#>'
	DEFW	BDIGS-5
EDIGS:	DEFW	DOCOL
	DEFW	DROP
	DEFW	DROP
	DEFW	HLD
	DEFW	AT
	DEFW	PAD
	DEFW	OVER
	DEFW	SUBB
	DEFW	SEMIS
;
	DEFB	84H		;SIGN
	DM	'SIGN'
	DEFW	EDIGS-5
SIGN:	DEFW	DOCOL
	DEFW	ROT
	DEFW	ZLESS
	DEFW	ZBRAN		;IF
	DEFW	SIGN1-$
	DEFW	LIT
	DEFW	2DH
	DEFW	HOLD		;ENDIF
SIGN1:	DEFW	SEMIS
;
	DEFB	81H		;#
	DM	'#'
	DEFW	SIGN-7
DIG:	DEFW	DOCOL
	DEFW	BASE
	DEFW	AT
	DEFW	MSMOD
	DEFW	ROT
	DEFW	LIT
	DEFW	9
	DEFW	OVER
	DEFW	LESS
	DEFW	ZBRAN		;IF
	DEFW	DIG1-$
	DEFW	LIT
	DEFW	7
	DEFW	PLUS		;ENDIF
DIG1:	DEFW	LIT
	DEFW	30H
	DEFW	PLUS
	DEFW	HOLD
	DEFW	SEMIS
;
	DEFB	82H		;#S
	DM	'#S'
	DEFW	DIG-4
DIGS:	DEFW	DOCOL
DIGS1:	DEFW	DIG		;BEGIN
	DEFW	TDUP		;/
	DEFW	ORR
	DEFW	ZEQU
	DEFW	ZBRAN		;UNTIL
	DEFW	DIGS1-$
	DEFW	SEMIS
;
	DEFB	83H		;D.R
	DM	'D.R'
	DEFW	DIGS-5
DDOTR:	DEFW	DOCOL
	DEFW	TOR
	DEFW	SWAP
	DEFW	OVER
	DEFW	DABS
	DEFW	BDIGS
	DEFW	DIGS
	DEFW	SIGN
	DEFW	EDIGS
	DEFW	FROMR
	DEFW	OVER
	DEFW	SUBB
	DEFW	SPACS
	DEFW	TYPE
	DEFW	SEMIS
;
	DEFB	82H		;.R
	DM	'.R'
	DEFW	DDOTR-6
DOTR:	DEFW	DOCOL
	DEFW	TOR
	DEFW	STOD
	DEFW	FROMR
	DEFW	DDOTR
	DEFW	SEMIS
;
	DEFB	82H		;D.
	DM	'D.'
	DEFW	DOTR-5
DDOT:	DEFW	DOCOL
	DEFW	ZERO
	DEFW	DDOTR
	DEFW	SPACE
	DEFW	SEMIS
;
	DEFB	81H		; .
	DM	'.'
	DEFW	DDOT-5
DOT:	DEFW	DOCOL
	DEFW	STOD
	DEFW	DDOT
	DEFW	SEMIS
;
	DEFB	81H		;?
	DM	'?'
	DEFW	DOT-4
QUES:	DEFW	DOCOL
	DEFW	AT
	DEFW	DOT
	DEFW	SEMIS
;
	DEFB	82H		;U.
	DM	'U.'
	DEFW	QUES-4
UDOT:	DEFW	DOCOL
	DEFW	ZERO
	DEFW	DDOT
	DEFW	SEMIS
;
	DEFB	85H		;VLIST
	DM	'VLIST'
	DEFW	UDOT-5
VLIST:	DEFW	DOCOL
	DEFW	LIT
	DEFW	80H
	DEFW	OUTT
	DEFW	STORE
	DEFW	CONT
	DEFW	AT
	DEFW	AT
VLIS1:	DEFW	OUTT		;BEGIN
	DEFW	AT
	DEFW	CSLL
	DEFW	GREAT
	DEFW	ZBRAN		;IF
	DEFW	VLIS2-$
	DEFW	CR
	DEFW	ZERO
	DEFW	OUTT
	DEFW	STORE		;ENDIF
VLIS2:	DEFW	DUP
	DEFW	IDDOT
	DEFW	SPACE
	DEFW	SPACE
	DEFW	PFA
	DEFW	LFA
	DEFW	AT
	DEFW	DUP
	DEFW	ZEQU
	DEFW	QTERM
	DEFW	ORR
	DEFW	ZBRAN		;UNTIL
	DEFW	VLIS1-$
	DEFW	DROP
	DEFW	SEMIS
;
	DEFB	83H		;BYE
	DM	'BYE'
	DEFW	VLIST-8
BYE:	DEFW	DOCOL		;/A
	DEFW	FLUSH		;/A
	DEFW	FCB,LIT		;/E
	DEFW	10H,BDOS	;/E close file
	DEFW	DROP		;/E discard directory code
	DEFW	ZERO,ZERO	;/A
	DEFW	BDOS		;/A return to CP/M
	DEFW	SEMIS		;/A won't get this far, just for pretty
;
	DEFB	84H		;LIST
	DM	'LIST'
	DEFW	BYE-6
LIST:	DEFW	DOCOL,DEC
	DEFW	CR,DUP
	DEFW	SCR,STORE
	DEFW	PDOTQ
	DEFB	6
	DB	'SCR # '
	DEFW	DOT
	DEFW	LIT,10H
	DEFW	ZERO,XDO
LIST1:	DEFW	CR,IDO
	DEFW	THREE		;/ WAS LIT,3
	DEFW	DOTR,SPACE
	DEFW	IDO,SCR
	DEFW	AT,DLINE
	DEFW	QTERM
	DEFW	ZBRAN,LIST2-$	;IF
	DEFW	LEAVE
LIST2:	DEFW	XLOOP,LIST1-$	;ENDIF
	DEFW	CR,SEMIS
;
	DEFB	85H		;INDEX
	DM	'INDEX'
	DEFW	LIST-7
INDEX:	DEFW	DOCOL
	DEFW	LIT,FF
	DEFW	EMIT,CR
	DEFW	ONEP,SWAP
	DEFW	XDO
INDE1:	DEFW	CR,IDO
	DEFW	THREE		;/ WAS LIT,3
	DEFW	DOTR,SPACE
	DEFW	ZERO,IDO
	DEFW	DLINE,QTERM
	DEFW	ZBRAN,INDE2-$	;IF
	DEFW	LEAVE		;ENDIF
INDE2:	DEFW	XLOOP,INDE1-$
	DEFW	SEMIS
;
	DEFB	85H		;TRIAD
	DM	'TRIAD'
	DEFW	INDEX-8
TRIAD:	DEFW	DOCOL
	DEFW	LIT,FF
	DEFW	EMIT
	DEFW	THREE		;/ WAS LIT,3
	DEFW	SLASH
	DEFW	THREE		;/ WAS LIT,3
	DEFW	STAR
	DEFW	THREE		;/ WAS LIT,3
	DEFW	OVER,PLUS
	DEFW	SWAP,XDO
TRIA1:	DEFW	CR,IDO
	DEFW	LIST
	DEFW	QTERM
	DEFW	ZBRAN,TRIA2-$	;IF
	DEFW	LEAVE
TRIA2:	DEFW	XLOOP,TRIA1-$	;ENDIF
	DEFW	CR
	DEFW	LIT,15
	DEFW	MESS,CR
	DEFW	SEMIS
;
	DEFB	84H		;.CPU
	DM	'.CPU'
	DEFW	TRIAD-8
DOTCPU:	DEFW	DOCOL
	DEFW	BASE,AT
	DEFW	LIT,36
	DEFW	BASE,STORE
	DEFW	LIT,22H
	DEFW	PORIG,TAT
	DEFW	DDOT
	DEFW	BASE,STORE
	DEFW	SEMIS
;
	DEFB	84H		;TASK
	DM	'TASK'
	DEFW	DOTCPU-7
TASK:	DEFW	DOCOL
	DEFW	SEMIS
;
INITDP:	DEFW	0
;
	END