
;FF1 860218 0714  Part 1 of 2

;TRS80 Model 100 fig-Forth Version 1.1D
;  by Michael Weiblen  CIS: 72506,2072
;  4809 Calvert Rd, College Park MD 20740

;Based on fig-Forth 8080 Release 1.1
;  available from the Forth Interest Group


;   I have commented only my mods.  See the fig source listing for more
;   complete comments.


FIGREL	EQU	1
FIGREV	EQU	1
USRVER	EQU	4

	;ASCII CHARS USED
ABL	EQU	32
ACR	EQU	13
ADOT	EQU	46
BELL	EQU	7
BSIN	EQU	8
BSOUT	EQU	8
CTLC	EQU	3
DLE	EQU	16
LF	EQU	10
FF	EQU	12

	;MEMORY ALLOCATION
EM	EQU	57960	;LIMIT = Highest memory used
NSCR	EQU	1	;# of Screens
KBBUF	EQU	256	;Bytes/Buffer
US	EQU	64	;User Var Space
RTS	EQU	160	;Ret Stack & Term Buffer

CO	EQU	KBBUF+4	;Buffer size
NBUF	EQU	4	;# of Buffers
BUF1	EQU	EM-1040	;FIRST = EM-(CO*NBUF)
INITR0	EQU	BUF1-US		;R0
INITS0	EQU	INITR0-RTS	;S0

	ORG	40960
ORIG	NOP
	JMP	CLD
	NOP
	JMP	WRM
	DB	FIGREL
	DB	FIGREV
	DB	USRVER
	DB	0EH	;Implementation Attrib
	DW	TASK-7	;Top word in vocab
	DW	BSIN
	DW	INITR0	;UP

	DW	INITS0	;S0
	DW	INITR0	;R0
	DW	INITS0	;TIB
	DW	1FH	;WIDTH
	DW	0	;WARNING
	DW	INITDP	;FENCE
	DW	INITDP	;DP
	DW	FORTH+8	;VOC-LINK
	DW	5H,0B320H;CPU Name

UP	DW	INITR0	;User Area Pointer
RPP	DW	INITR0	;Ret Stack Pointer


	;Inner Interpreter
DPUSH	PUSH	D
HPUSH	PUSH	H
NEXT	LDAX	B
	INX	B
	MOV	L,A
	LDAX	B
	INX	B
	MOV	H,A
NEXT1	MOV	E,M
	INX	H
	MOV	D,M
	XCHG
	PCHL

	;FORTH DICTIONARY
DP0	DB	83H	;LIT
	DB	'LI'
	DB	0D4H
	DW	0
LIT	DW	$+2
	LDAX	B
	INX	B
	MOV	L,A
	LDAX	B
	INX	B
	MOV	H,A
	JMP	HPUSH

	DB	87H	;EXECUTE
	DB	'EXECUT'
	DB	0C5H
	DW	LIT-6
EXEC	DW	$+2
	POP	H
	JMP	NEXT1

	DB	86H	;BRANCH
	DB	'BRANC'
	DB	0C8H
	DW	EXEC-0AH
BRAN	DW	$+2
BRAN1	MOV	H,B
	MOV	L,C
	MOV	E,M
	INX	H
	MOV	D,M
	DCX	H
	DAD	D
	MOV	C,L
	MOV	B,H
	JMP	NEXT

	DB	87H	;0BRANCH
	DB	'0BRANC'
	DB	0C8H
	DW	BRAN-9
ZBRAN	DW	$+2
	POP	H
	MOV	A,L
	ORA	H
	JZ	BRAN1
	INX	B
	INX	B
	JMP	NEXT

	DB	86H	;(LOOP)
	DB	'(LOOP'
	DB	0A9H
	DW	ZBRAN-0AH
XLOOP	DW	$+2
	LXI	D,1
XLOO1	LHLD	RPP
	MOV	A,M
	ADD	E
	MOV	M,A
	MOV	E,A
	INX	H
	MOV	A,M
	ADC	D
	MOV	M,A
	INX	H
	INR	D
	DCR	D
	MOV	D,A
	JM	XLOO2
	MOV	A,E
	SUB	M
	MOV	A,D
	INX	H
	SBB	M
	JMP	XLOO3
XLOO2	MOV	A,M
	SUB	E
	INX	H
	MOV	A,M
	SBB	D
XLOO3	JM	BRAN1
	INX	H
	SHLD	RPP
	INX	B
	INX	B
	JMP	NEXT

	DB	87H
	DB	'(+LOOP'
	DB	0A9H
	DW	XLOOP-9
XPLOO	DW	$+2
	POP	D
	JMP	XLOO1

	DB	84H
	DB	'(DO'
	DB	0A9H
	DW	XPLOO-0AH
XDO	DW	$+2
	LHLD	RPP
	DCX	H
	DCX	H
	DCX	H
	DCX	H
	SHLD	RPP
	POP	D
	MOV	M,E
	INX	H
	MOV	M,D
	POP	D
	INX	H
	MOV	M,E
	INX	H
	MOV	M,D
	JMP	NEXT

	DB	81H	;I
	DB	0C9H
	DW	XDO-7
IDO	DW	$+2
	LHLD	RPP
	MOV	E,M
	INX	H
	MOV	D,M
	PUSH	D
	JMP	NEXT

	DB	85H	;DIGIT
	DB	'DIGI'
	DB	0D4H
	DW	IDO-4
DIGIT	DW	$+2
	POP	H
	POP	D
	MOV	A,E
	SUI	30H
	JM	DIGI2
	CPI	10
	JM	DIGI1
	SUI	7
	CPI	10
	JM	DIGI2
DIGI1	CMP	L
	JP	DIGI2
	MOV	E,A
	LXI	H,1
	JMP	DPUSH
DIGI2	MOV	L,H
	JMP	HPUSH

	DB	86H	;(FIND)
	DB	'(FIND'
	DB	0A9H
	DW	DIGIT-8
PFIND	DW	$+2
	POP	D
PFIN1	POP	H
	PUSH	H
	LDAX	D
	XRA	M
	ANI	3FH
	JNZ	PFIN4
PFIN2	INX	H
	INX	D
	LDAX	D
	XRA	M
	ADD	A
	JNZ	PFIN3
	JNC	PFIN2
	LXI	H,5
	DAD	D
	XTHL
PFIN6	DCX	D
	LDAX	D
	ORA	A
	JP	PFIN6
	MOV	E,A
	MVI	D,0
	LXI	H,1
	JMP	DPUSH
PFIN3	JC	PFIN5
PFIN4	INX	D
	LDAX	D
	ORA	A
	JP	PFIN4
PFIN5	INX	D
	XCHG
	MOV	E,M
	INX	H
	MOV	D,M
	MOV	A,D
	ORA	E
	JNZ	PFIN1
	POP	H
	LXI	H,0
	JMP	HPUSH

	DB	87H	;ENCLOSE (New Version)
	DB	'ENCLOS'
	DB	0C5H
	DW	PFIND-9
ENCL	DW	$+2
	POP	D
	POP	H
	PUSH	H
	MOV	A,E
	LXI	D,0FFFFH
	DCX	H
ENCL1	INX	H
	INX	D
	CMP	M
	JZ	ENCL1
	PUSH	D
	PUSH	PSW
	MOV	A,M
	ANA	A
	JNZ	ENCL2
	POP	PSW
	INX	D
	PUSH	D
	DCX	D
	PUSH	D
	JMP	NEXT
ENCL2	POP	PSW
	INX	H
	INX	D
	CMP	M
	JZ	ENCL4
	PUSH	PSW
	MOV	A,M
	ANA	A
	JNZ	ENCL2
ENCL3	POP	PSW
	PUSH	D
	PUSH	D
	JMP	NEXT
ENCL4	PUSH	D
	INX	D
	PUSH	D
	JMP	NEXT

	DB	84H	;EMIT
	DB	'EMI'
	DB	0D4H
	DW	ENCL-10
EMIT	DW	DOCOL
	DW	PEMIT
	DW	ONE,OUTT
	DW	PSTOR,SEMIS

	DB	83H	;KEY
	DB	'KE'
	DB	0D9H
	DW	EMIT-7
KEY	DW	$+2
	JMP	PKEY

	DB	89H	;?TERMINAL
	DB	'?TERMINA'
	DB	0CCH
	DW	KEY-6
QTERM	DW	$+2
	JMP	PQTER

	DB	82H	;CR
	DB	'C'
	DB	0D2H
	DW	QTERM-0CH
CR	DW	$+2
	JMP	PCR

	DB	85H	;CMOVE
	DB	'CMOV'
	DB	0C5H
	DW	CR-5
CMOVE	DW	$+2
	MOV	L,C
	MOV	H,B
	POP	B
	POP	D
	XTHL
	JMP	CMOV2
CMOV1	MOV	A,M
	INX	H
	STAX	D
	INX	D
	DCX	B
CMOV2	MOV	A,B
	ORA	C
	JNZ	CMOV1
	POP	B
	JMP	NEXT

	DB	82H	;U*
	DB	'U'
	DB	0AAH
	DW	CMOVE-8
USTAR	DW	$+2
	POP	D
	POP	H
	PUSH	B
	MOV	B,H
	MOV	A,L
	CALL	MPYX
	PUSH	H
	MOV	H,A
	MOV	A,B
	MOV	B,H
	CALL	MPYX
	POP	D
	MOV	C,D
	DAD	B
	ACI	0
	MOV	D,L
	MOV	L,H
	MOV	H,A
	POP	B
	PUSH	D
	JMP	HPUSH

MPYX	LXI	H,0	;MULTIPLY PRIMITIVE
	MVI	C,8
MPYX1	DAD	H
	RAL
	JNC	MPYX2
	DAD	D
	ACI	0
MPYX2	DCR	C
	JNZ	MPYX1
	RET

	DB	82H	;U/
	DB	'U'
	DB	0AFH
	DW	USTAR-5
USLAS	DW	$+2
	LXI	H,4
	DAD	SP
	MOV	E,M
	MOV	M,C
	INX	H
	MOV	D,M
	MOV	M,B
	POP	B
	POP	H
	MOV	A,L
	SUB	C
	MOV	A,H
	SBB	B
	JC	USLA1
	LXI	H,0FFFFH
	LXI	D,0FFFFH
	JMP	USLA7
USLA1	MVI	A,16
USLA2	DAD	H
	RAL
	XCHG
	DAD	H
	JNC	USLA3
	INX	D
	ANA	A
USLA3	XCHG
	RAR
	PUSH	PSW
	JNC	USLA4
	MOV	A,L
	SUB	C
	MOV	L,A
	MOV	A,H
	SBB	B
	MOV	H,A
	JMP	USLA5
USLA4	MOV	A,L
	SUB	C
	MOV	L,A
	MOV	A,H
	SBB	B
	MOV	H,A
	JNC	USLA5
	DAD	B
	DCX	D
USLA5	INX	D
USLA6	POP	PSW
	DCR	A
	JNZ	USLA2
USLA7	POP	B
	PUSH	H
	PUSH	D
	JMP	NEXT

	DB	83H	;AND
	DB	'AN'
	DB	0C4H
	DW	USLAS-5
ANDD	DW	$+2
	POP	D
	POP	H
	MOV	A,E
	ANA	L
	MOV	L,A
	MOV	A,D
	ANA	H
	MOV	H,A
	JMP	HPUSH

	DB	82H	;OR
	DB	'O'
	DB	0D2H
	DW	ANDD-6
ORR	DW	$+2
	POP	D
	POP	H
	MOV	A,E
	ORA	L
	MOV	L,A
	MOV	A,D
	ORA	H
	MOV	H,A
	JMP	HPUSH

	DB	83H	;XOR
	DB	'XO'
	DB	0D2H
	DW	ORR-5
XORR	DW	$+2
	POP	D
	POP	H
	MOV	A,E
	XRA	L
	MOV	L,A
	MOV	A,D
	XRA	H
	MOV	H,A
	JMP	HPUSH

	DB	83H	;SP@
	DB	'SP'
	DB	0C0H
	DW	XORR-6
SPAT	DW	$+2
	LXI	H,0
	DAD	SP
	JMP	HPUSH

	DB	83H	;SP!
	DB	'SP'
	DB	0A1H
	DW	SPAT-6
SPSTO	DW	$+2
	LHLD	UP
	LXI	D,6
	DAD	D
	MOV	E,M
	INX	H
	MOV	D,M
	XCHG
	SPHL
	JMP	NEXT

	DB	83H	;RP@
	DB	'RP'
	DB	0C0H
	DW	SPSTO-6
RPAT	DW	$+2
	LHLD	RPP
	JMP	HPUSH

	DB	83H	;RP!
	DB	'RP'
	DB	0A1H
	DW	RPAT-6
RPSTO	DW	$+2
	LHLD	UP
	LXI	D,8
	DAD	D
	MOV	E,M
	INX	H
	MOV	D,M
	XCHG
	SHLD	RPP
	JMP	NEXT

	DB	82H	; ;S
	DB	03BH
	DB	0D3H
	DW	RPSTO-6
SEMIS	DW	$+2
	LHLD	RPP
	MOV	C,M
	INX	H
	MOV	B,M
	INX	H
	SHLD	RPP
	JMP	NEXT

	DB	85H	;LEAVE
	DB	'LEAV'
	DB	0C5H
	DW	SEMIS-5
LEAVE	DW	$+2
	LHLD	RPP
	MOV	E,M
	INX	H
	MOV	D,M
	INX	H
	MOV	M,E
	INX	H
	MOV	M,D
	JMP	NEXT

	DB	82H
	DB	'>'
	DB	0D2H
	DW	LEAVE-8
TOR	DW	$+2
	POP	D
	LHLD	RPP
	DCX	H
	DCX	H
	SHLD	RPP
	MOV	M,E
	INX	H
	MOV	M,D
	JMP	NEXT

	DB	82H	;R>
	DB	'R'
	DB	0BEH
	DW	TOR-5
FROMR	DW	$+2
	LHLD	RPP
	MOV	E,M
	INX	H
	MOV	D,M
	INX	H
	SHLD	RPP
	PUSH	D
	JMP	NEXT

	DB	81H	; R
	DB	0D2H
	DW	FROMR-5
RR	DW	IDO+2

	DB	82H	;0=
	DB	'0'
	DB	0BDH
	DW	RR-4
ZEQU	DW	$+2
	POP	H
	MOV	A,L
	ORA	H
	LXI	H,0
	JNZ	ZEQU1
	INX	H
ZEQU1	JMP	HPUSH

	DB	82H	;0<
	DB	'0'
	DB	0BCH
	DW	ZEQU-5
ZLESS	DW	$+2
	POP	H
	DAD	H
	LXI	H,0
	JNC	ZLES1
	INX	H
ZLES1	JMP	HPUSH

	DB	81H	;+
	DB	0ABH
	DW	ZLESS-5
PLUS	DW	$+2
	POP	D
	POP	H
	DAD	D
	JMP	HPUSH

	DB	82H	;D+
	DB	'D'
	DB	0ABH
	DW	PLUS-4
DPLUS	DW	$+2
	LXI	H,6
	DAD	SP
	MOV	E,M
	MOV	M,C
	INX	H
	MOV	D,M
	MOV	M,B
	POP	B
	POP	H
	DAD	D
	XCHG
	POP	H
	MOV	A,L
	ADC	C
	MOV	L,A
	MOV	A,H
	ADC	B
	MOV	H,A
	POP	B
	PUSH	D
	JMP	HPUSH

	DB	85H	;MINUS
	DB	'MINU'
	DB	0D3H
	DW	DPLUS-5
MINUS	DW	$+2
	POP	H
	MOV	A,L
	CMA
	MOV	L,A
	MOV	A,H
	CMA
	MOV	H,A
	INX	H
	JMP	HPUSH

	DB	86H	;DMINUS
	DB	'DMINU'
	DB	0D3H
	DW	MINUS-8
DMINU	DW	$+2
	POP	H
	POP	D
	SUB	A
	SUB	E
	MOV	E,A
	MVI	A,0
	SBB	D
	MOV	D,A
	MVI	A,0
	SBB	L
	MOV	L,A
	MVI	A,0
	SBB	H
	MOV	H,A
	PUSH	D
	JMP	HPUSH

	DB	84H	;OVER
	DB	'OVE'
	DB	0D2H
	DW	DMINU-9
OVER	DW	$+2
	POP	D
	POP	H
	PUSH	H
	JMP	DPUSH

	DB	84H	;DROP
	DB	'DRO'
	DB	0D0H
	DW	OVER-7
DROP	DW	$+2
	POP	H
	JMP	NEXT

	DB	84H	;SWAP
	DB	'SWA'
	DB	0D0H
	DW	DROP-7
SWAP	DW	$+2
	POP	H
	XTHL
	JMP	HPUSH

	DB	83H	;DUP
	DB	'DU'
	DB	0D0H
	DW	SWAP-7
DUP	DW	$+2
	POP	H
	PUSH	H
	JMP	HPUSH

	DB	84H	;2DUP
	DB	'2DU'
	DB	0D0H
	DW	DUP-6
TDUP	DW	$+2
	POP	H
	POP	D
	PUSH	D
	PUSH	H
	JMP	DPUSH

	DB	82H	; +!
	DB	'+'
	DB	0A1H
	DW	TDUP-7
PSTOR	DW	$+2
	POP	H
	POP	D
	MOV	A,M
	ADD	E
	MOV	M,A
	INX	H
	MOV	A,M
	ADC	D
	MOV	M,A
	JMP	NEXT

	DB	86H	;TOGGLE
	DB	'TOGGL'
	DB	0C5H
	DW	PSTOR-5
TOGGL	DW	$+2
	POP	D
	POP	H
	MOV	A,M
	XRA	E
	MOV	M,A
	JMP	NEXT

	DB	81H	; @
	DB	0C0H
	DW	TOGGL-9
AT	DW	$+2
	POP	H
	MOV	E,M
	INX	H
	MOV	D,M
	PUSH	D
	JMP	NEXT

	DB	82H	; C@
	DB	'C'
	DB	0C0H
	DW	AT-4
CAT	DW	$+2
	POP	H
	MOV	L,M
	MVI	H,0
	JMP	HPUSH

	DB	82H	; 2@
	DB	'2'
	DB	0C0H
	DW	CAT-5
TAT	DW	$+2
	POP	H
	LXI	D,2
	DAD	D
	MOV	E,M
	INX	H
	MOV	D,M
	PUSH	D
	LXI	D,0FFFDH
	DAD	D
	MOV	E,M
	INX	H
	MOV	D,M
	PUSH	D
	JMP	NEXT

	DB	81H	;!
	DB	0A1H
	DW	TAT-5
STORE	DW	$+2
	POP	H
	POP	D
	MOV	M,E
	INX	H
	MOV	M,D
	JMP	NEXT

	DB	82H	;C!
	DB	'C'
	DB	0A1H
	DW	STORE-4
CSTOR	DW	$+2
	POP	H
	POP	D
	MOV	M,E
	JMP	NEXT

	DB	82H	;2!
	DB	'2'
	DB	0A1H
	DW	CSTOR-5
TSTOR	DW	$+2
	POP	H
	POP	D
	MOV	M,E
	INX	H
	MOV	M,D
	INX	H
	POP	D
	MOV	M,E
	INX	H
	MOV	M,D
	JMP	NEXT

	DB	0C1H	; :
	DB	0BAH
	DW	TSTOR-5
COLON	DW	DOCOL
	DW	QEXEC
	DW	SCSP
	DW	CURR
	DW	AT
	DW	CONT
	DW	STORE
	DW	CREAT
	DW	RBRAC
	DW	PSCOD
DOCOL	LHLD	RPP
	DCX	H
	MOV	M,B
	DCX	H
	MOV	M,C
	SHLD	RPP
	INX	D
	MOV	C,E
	MOV	B,D
	JMP	NEXT

	DB	0C1H	; ;
	DB	0BBH
	DW	COLON-4
SEMI	DW	DOCOL
	DW	QCSP
	DW	COMP
	DW	SEMIS
	DW	SMUDG
	DW	LBRAC
	DW	SEMIS

	DB	84H	; NOOP
	DB	'NOO'
	DB	0D0H
	DW	SEMI-4
NOOP	DW	DOCOL,SEMIS

	DB	88H	; CONSTANT
	DB	'CONSTAN'
	DB	0D4H
	DW	NOOP-7
CON	DW	DOCOL,CREAT,SMUDG,COMMA,PSCOD
DOCON	INX	D
	XCHG
	MOV	E,M
	INX	H
	MOV	D,M
	PUSH	D
	JMP	NEXT

	DB	88H	; VARIABLE
	DB	'VARIABL'
	DB	0C5H
	DW	CON-11
VAR	DW	DOCOL,CON,PSCOD
DOVAR	INX	D
	PUSH	D
	JMP	NEXT

	DB	84H	; USER
	DB	'USE'
	DB	0D2H
	DW	VAR-11
USER	DW	DOCOL,CON,PSCOD
DOUSE	INX	D
	XCHG
	MOV	E,M
	MVI	D,0
	LHLD	UP
	DAD	D
	JMP	HPUSH

	; CONSTANTS

	DB	81H	; 0
	DB	0B0H
	DW	USER-7
ZERO	DW	DOCON,0

	DB	81H	; 1
	DB	0B1H
	DW	ZERO-4
ONE	DW	DOCON,1

	DB	81H	; 2
	DB	0B2H
	DW	ONE-4
TWO	DW	DOCON,2

	DB	81H	; 3
	DB	0B3H
	DW	TWO-4
THREE	DW	DOCON,3

	DB	82H	;BL
	DB	'B'
	DB	0CCH
	DW	THREE-4
BL	DW	DOCON,ABL

	DB	83H	; C/L
	DB	'C/'
	DB	0CCH
	DW	BL-5
CSLL	DW	DOCON,64

	DB	85H	; FIRST
	DB	'FIRS'
	DB	0D4H
	DW	CSLL-6
FIRST	DW	DOCON,BUF1

	DB	85H	; LIMIT
	DB	'LIMI'
	DB	0D4H
	DW	FIRST-8
LIMIT	DW	DOCON,EM

	DB	85H	; B/BUF
	DB	'B/BU'
	DB	0C6H
	DW	LIMIT-8
BBUF	DW	DOCON,KBBUF

	DB	85H	; B/SCR
	DB	'B/SC'
	DB	0D2H
	DW	BBUF-8
BSCR	DW	DOCON,4

	DB	87H	; +ORIGIN
	DB	'+ORIGI'
	DB	0CEH
	DW	BSCR-8
PORIG	DW	DOCOL,LIT,ORIG,PLUS,SEMIS

	; USER VARIABLES

	DB	82H	; S0
	DB	'S'
	DB	0B0H
	DW	PORIG-10
SZERO	DW	DOUSE
	DB	6

	DB	82H	; R0
	DB	'R'
	DB	0B0H
	DW	SZERO-5
RZERO	DW	DOUSE
	DB	8

	DB	83H	; TIB
	DB	'TI'
	DB	0C2H
	DW	RZERO-5
TIB	DW	DOUSE
	DB	10

	DB	85H	; WIDTH
	DB	'WIDT'
	DB	0C8H
	DW	TIB-6
WIDTH	DW	DOUSE
	DB	12

	DB	87H	;WARNING
	DB	'WARNIN'
	DB	0C7H
	DW	WIDTH-8
WARN	DW	DOUSE
	DB	14

	DB	85H	;FENCE
	DB	'FENC'
	DB	0C5H
	DW	WARN-10
FENCE	DW	DOUSE
	DB	16

	DB	82H	;DP
	DB	'D'
	DB	0D0H
	DW	FENCE-8
DP	DW	DOUSE
	DB	18

	DB	88H	;VOC-LINK
	DB	'VOC-LIN'
	DB	0CBH
	DW	DP-5
VOCL	DW	DOUSE
	DB	20

	DB	83H	;BLK
	DB	'BL'
	DB	0CBH
	DW	VOCL-11
BLK	DW	DOUSE
	DB	22

	DB	82H	;IN
	DB	'I'
	DB	0CEH
	DW	BLK-6
INN	DW	DOUSE
	DB	24

	DB	83H	;OUT
	DB	'OU'
	DB	0D4H
	DW	INN-5
OUTT	DW	DOUSE
	DB	26

	DB	83H	;SCR
	DB	'SC'
	DB	0D2H
	DW	OUTT-6
SCR	DW	DOUSE
	DB	28

	DB	86H	;OFFSET
	DB	'OFFSE'
	DB	0D4H
	DW	SCR-6
OFSET	DW	DOUSE
	DB	30

	DB	87H	;CONTEXT
	DB	'CONTEX'
	DB	0D4H
	DW	OFSET-9
CONT	DW	DOUSE
	DB	32

	DB	87H	;CURRENT
	DB	'CURREN'
	DB	0D4H
	DW	CONT-10
CURR	DW	DOUSE
	DB	34

	DB	85H	;STATE
	DB	'STAT'
	DB	0C5H
	DW	CURR-10
STATE	DW	DOUSE
	DB	36

	DB	84H	;BASE
	DB	'BAS'
	DB	0C5H
	DW	STATE-8
BASE	DW	DOUSE
	DB	38

	DB	83H	;DPL
	DB	'DP'
	DB	0CCH
	DW	BASE-7
DPL	DW	DOUSE
	DB	40

	DB	83H	;FLD
	DB	'FL'
	DB	0C4H
	DW	DPL-6
FLD	DW	DOUSE
	DB	42

	DB	83H	;CSP
	DB	'CS'
	DB	0D0H
	DW	FLD-6
CSPP	DW	DOUSE
	DB	44

	DB	82H	; R#
	DB	'R'
	DB	0A3H
	DW	CSPP-6
RNUM	DW	DOUSE
	DB	46

	DB	83H	;HLD
	DB	'HL'
	DB	0C4H
	DW	RNUM-5
HLD	DW	DOUSE
	DB	48

	DB	82H	; 1+
	DB	'1'
	DB	0ABH
	DW	HLD-6
ONEP	DW	DOCOL,ONE,PLUS,SEMIS

	DB	82H	; 2+
	DB	'2'
	DB	0ABH
	DW	ONEP-5
TWOP	DW	DOCOL,TWO,PLUS,SEMIS

	DB	84H	;HERE
	DB	'HER'
	DB	0C5H
	DW	TWOP-5
HERE	DW	DOCOL,DP,AT,SEMIS

	DB	85H	;ALLOT
	DB	'ALLO'
	DB	0D4H
	DW	HERE-7
ALLOT	DW	DOCOL,DP,PSTOR,SEMIS

	DB	81H	; ,
	DB	0ACH
	DW	ALLOT-8
COMMA	DW	DOCOL,HERE,STORE,TWO,ALLOT,SEMIS

	DB	82H	; C,
	DB	'C'
	DB	0ACH
	DW	COMMA-4
CCOMM	DW	DOCOL,HERE,CSTOR,ONE,ALLOT,SEMIS

SSUB	MOV	A,L	;(HL)=(HL)-(DE)
	SUB	E
	MOV	L,A
	MOV	A,H
	SBB	D
	MOV	H,A
	RET

	DB	81H	; -
	DB	0ADH
	DW	CCOMM-5
SUBB	DW	$+2
	POP	D
	POP	H
	CALL	SSUB
	JMP	HPUSH

	DB	81H	; =
	DB	0BDH
	DW	SUBB-4
EQUAL	DW	DOCOL,SUBB,ZEQU,SEMIS

	DB	81H	; <
	DB	0BCH
	DW	EQUAL-4
LESS	DW	$+2
	POP	D
	POP	H
	MOV	A,D
	XRA	H
	JM	LES1
	CALL	SSUB
LES1	INR	H
	DCR	H
	JM	LES2
	LXI	H,0
	JMP	HPUSH
LES2	LXI	H,1
	JMP	HPUSH

	DB	82H	; U<
	DB	'U'
	DB	0BCH
	DW	LESS-4
ULESS	DW	DOCOL,TDUP
	DW	XORR,ZLESS,ZBRAN,ULES1-$
	DW	DROP,ZLESS,ZEQU
	DW	BRAN,ULES2-$
ULES1	DW	SUBB,ZLESS
ULES2	DW	SEMIS

	DB	81H	; >
	DB	0BEH
	DW	ULESS-5
GREAT	DW	DOCOL,SWAP,LESS,SEMIS

	DB	83H	;ROT
	DB	'RO'
	DB	0D4H
	DW	GREAT-4
ROT	DW	$+2
	POP	D
	POP	H
	XTHL
	JMP	DPUSH

	DB	85H	;SPACE
	DB	'SPAC'
	DB	0C5H
	DW	ROT-6
SPACE	DW	DOCOL,BL,EMIT,SEMIS

	DB	84H	; -DUP
	DB	'-DU'
	DB	0D0H
	DW	SPACE-8
DDUP	DW	DOCOL,DUP
	DW	ZBRAN,DDUP1-$
	DW	DUP
DDUP1	DW	SEMIS

	DB	88H	;TRAVERSE
	DB	'TRAVERS'
	DB	0C5H
	DW	DDUP-7
TRAV	DW	DOCOL,SWAP
TRAV1	DW	OVER
	DW	PLUS
	DW	LIT,7FH
	DW	OVER
	DW	CAT
	DW	LESS,ZBRAN,TRAV1-$
	DW	SWAP,DROP,SEMIS

	DB	86H	;LATEST
	DB	'LATES'
	DB	0D4H
	DW	TRAV-11
LATES	DW	DOCOL,CURR,AT,AT,SEMIS

	DB	83H	; LFA
	DB	'LF'
	DB	0C1H
	DW	LATES-9
LFA	DW	DOCOL,LIT,4,SUBB,SEMIS

	DB	83H	;CFA
	DB	'CF'
	DB	0C1H
	DW	LFA-6
CFA	DW	DOCOL,TWO,SUBB,SEMIS

	DB	83H	;NFA
	DB	'NF'
	DB	0C1H
	DW	CFA-6
NFA	DW	DOCOL,LIT,5,SUBB
	DW	LIT,0FFFFH,TRAV,SEMIS

	DB	83H	;PFA
	DB	'PF'
	DB	0C1H
	DW	NFA-6
PFA	DW	DOCOL,ONE,TRAV
	DW	LIT,5,PLUS,SEMIS

	DB	84H	; !CSP
	DB	'!CS'
	DB	0D0H
	DW	PFA-6
SCSP	DW	DOCOL,SPAT,CSPP,STORE,SEMIS

	DB	86H	;?ERROR
	DB	'?ERRO'
	DB	0D2H
	DW	SCSP-7
QERR	DW	DOCOL
	DW	SWAP,ZBRAN,QERR1-$
	DW	ERROR,BRAN,QERR2-$
QERR1	DW	DROP
QERR2	DW	SEMIS

	DB	85H	;?COMP
	DB	'?COM'
	DB	0D0H
	DW	QERR-9
QCOMP	DW	DOCOL
	DW	STATE,AT,ZEQU
	DW	LIT,17,QERR,SEMIS

	DB	85H	;?EXEC
	DB	'?EXE'
	DB	0C3H
	DW	QCOMP-8
QEXEC	DW	DOCOL,STATE,AT
	DW	LIT,18,QERR,SEMIS

	DB	86H	;?PAIRS
	DB	'?PAIR'
	DB	0D3H
	DW	QEXEC-8
QPAIR	DW	DOCOL,SUBB
	DW	LIT,19,QERR,SEMIS

	DB	84H	; ?CSP
	DB	'?CS'
	DB	0D0H
	DW	QPAIR-9
QCSP	DW	DOCOL,SPAT
	DW	CSPP,AT,SUBB
	DW	LIT,20,QERR,SEMIS

	DB	88H	; ?LOADING
	DB	'?LOADIN'
	DB	0C7H
	DW	QCSP-7
QLOAD	DW	DOCOL
	DW	BLK,AT,ZEQU
	DW	LIT,22,QERR,SEMIS

	DB	87H	;COMPILE
	DB	'COMPIL'
	DB	0C5H
	DW	QLOAD-11
COMP	DW	DOCOL,QCOMP
	DW	FROMR,DUP,TWOP,TOR
	DW	AT,COMMA,SEMIS

	DB	0C1H	; [
	DB	0DBH
	DW	COMP-10
LBRAC	DW	DOCOL,ZERO,STATE,STORE,SEMIS

	DB	81H	; ]
	DB	0DDH
	DW	LBRAC-4
RBRAC	DW	DOCOL,LIT,0C0H,STATE,STORE,SEMIS

	DB	86H	;SMUDGE
	DB	'SMUDG'
	DB	0C5H
	DW	RBRAC-4
SMUDG	DW	DOCOL,LATES
	DW	LIT,20H,TOGGL,SEMIS

	DB	83H	;HEX
	DB	'HE'
	DB	0D8H
	DW	SMUDG-9
HEX	DW	DOCOL,LIT,16,BASE,STORE,SEMIS

	DB	87H	;DECIMAL
	DB	'DECIMA'
	DB	0CCH
	DW	HEX-6
DEC	DW	DOCOL,LIT,10,BASE,STORE,SEMIS

	DB	87H	; (;CODE)
	DB	28H,3BH
	DB	'CODE'
	DB	0A9H
	DW	DEC-10
PSCOD	DW	DOCOL,FROMR,LATES
	DW	PFA,CFA,STORE,SEMIS

	DB	0C5H	; ;CODE
	DB	3BH
	DB	'COD'
	DB	0C5H
	DW	PSCOD-10
SEMIC	DW	DOCOL
	DW	QCSP,COMP,PSCOD,LBRAC
SEMI1	DW	NOOP,SEMIS

	DB	87H	; <BUILDS
	DB	'<BUILD'
	DB	0D3H
	DW	SEMIC-8
BUILD	DW	DOCOL,ZERO,CON,SEMIS

	DB	85H	; DOES>
	DB	'DOES'
	DB	0BEH
	DW	BUILD-10
DOES	DW	DOCOL,FROMR,LATES,PFA,STORE,PSCOD
DODOE	LHLD	RPP
	DCX	H
	MOV	M,B
	DCX	H
	MOV	M,C
	SHLD	RPP
	INX	D
	XCHG
	MOV	C,M
	INX	H
	MOV	B,M
	INX	H
	JMP	HPUSH

	DB	85H	; COUNT
	DB	'COUN'
	DB	0D4H
	DW	DOES-8
COUNT	DW	DOCOL,DUP,ONEP,SWAP,CAT,SEMIS

	DB	84H	; TYPE
	DB	'TYP'
	DB	0C5H
	DW	COUNT-8
TYPE	DW	DOCOL
	DW	DDUP,ZBRAN,TYPE1-$
	DW	OVER,PLUS,SWAP
	DW	XDO
TYPE2	DW	IDO,CAT
	DW	LIT,7FH,ANDD	;Here I AND the ascii with 7FH to strip off the
	DW	EMIT		;flags used to mark the end of the word.
	DW	XLOOP,TYPE2-$	;(Keeps unwanted graphics characters away)
	DW	BRAN,TYPE3-$
TYPE1	DW	DROP
TYPE3	DW	SEMIS

	DB	89H	; -TRAILING
	DB	'-TRAILIN'
	DB	0C7H
	DW	TYPE-7
DTRAI	DW	DOCOL
	DW	DUP,ZERO
	DW	XDO
DTRA1	DW	OVER,OVER,PLUS,ONE,SUBB
	DW	CAT,BL,SUBB
	DW	ZBRAN,DTRA2-$
	DW	LEAVE
	DW	BRAN,DTRA3-$
DTRA2	DW	ONE,SUBB
DTRA3	DW	XLOOP,DTRA1-$
	DW	SEMIS

	DB	84H	; (.")
	DB	'(."'
	DB	0A9H
	DW	DTRAI-12
PDOTQ	DW	DOCOL,RR
	DW	COUNT,DUP,ONEP
	DW	FROMR,PLUS,TOR
	DW	TYPE
	DW	SEMIS

	DB	0C2H	; ."
	DB	02EH
	DB	0A2H
	DW	PDOTQ-7
DOTQ	DW	DOCOL
	DW	LIT,34
	DW	STATE,AT,ZBRAN,DOTQ1-$
	DW	COMP
	DW	PDOTQ
	DW	WORD
	DW	HERE,CAT,ONEP,ALLOT
	DW	BRAN,DOTQ2-$
DOTQ1	DW	WORD,HERE,COUNT,TYPE
DOTQ2	DW	SEMIS

	DB	86H	;EXPECT
	DB	'EXPEC'
	DB	0D4H
	DW	DOTQ-5
EXPEC	DW	DOCOL
	DW	OVER,PLUS,OVER
	DW	XDO
EXPE1	DW	KEY,DUP
	DW	LIT,14,PORIG,AT
	DW	EQUAL,ZBRAN,EXPE2-$
	DW	DROP
	DW	DUP
	DW	IDO,EQUAL
	DW	DUP
	DW	FROMR,TWO,SUBB,PLUS,TOR
	DW	ZBRAN,EXPE6-$
	DW	LIT,BELL
	DW	BRAN,EXPE7-$
EXPE6	DW	LIT,BSOUT
EXPE7	DW	BRAN,EXPE3-$
EXPE2	DW	DUP
	DW	LIT,13,EQUAL,ZBRAN,EXPE4-$
	DW	LEAVE
	DW	DROP
	DW	BL
	DW	ZERO
	DW	BRAN,EXPE5-$
EXPE4	DW	DUP
EXPE5	DW	IDO
	DW	CSTOR
	DW	ZERO
	DW	IDO
	DW	ONEP
	DW	STORE
EXPE3	DW	EMIT
	DW	XLOOP,EXPE1-$
	DW	DROP,SEMIS

	DB	85H	; QUERY
	DB	'QUER'
	DB	0D9H
	DW	EXPEC-9
QUERY	DW	DOCOL
	DW	TIB,AT,LIT,80,EXPEC
	DW	ZERO,INN,STORE,SEMIS

	DB	0C1H	; NULL
	DB	80H
	DW	QUERY-8
NULL	DW	DOCOL
	DW	BLK,AT,ZBRAN,NULL1-$
	DW	ONE,BLK,PSTOR
	DW	ZERO,INN,STORE
	DW	BLK,AT
	DW	BSCR
	DW	ONE
	DW	SUBB
	DW	ANDD
	DW	ZEQU
	DW	ZBRAN,NULL2-$
	DW	QEXEC
	DW	FROMR
	DW	DROP
NULL2	DW	BRAN,NULL3-$
NULL1	DW	FROMR,DROP
NULL3	DW	SEMIS

	DB	84H	;FILL
	DB	'FIL'
	DB	0CCH
	DW	NULL-4
FILL	DW	$+2
	MOV	L,C
	MOV	H,B
	POP	D
	POP	B
	XTHL
	XCHG
FILL1	MOV	A,B
	ORA	C
	JZ	FILL2
	MOV	A,L
	STAX	D
	INX	D
	DCX	B
	JMP	FILL1
FILL2	POP	B
	JMP	NEXT

	DB	85H	;ERASE
	DB	'ERAS'
	DB	0C5H
	DW	FILL-7
ERASEE	DW	DOCOL,ZERO,FILL,SEMIS

	DB	086H	; BLANKS
	DB	'BLANK'
	DB	0D3H
	DW	ERASEE-8
BLANK	DW	DOCOL,BL,FILL,SEMIS

	DB	84H	; HOLD
	DB	'HOL'
	DB	0C4H
	DW	BLANK-9
HOLD	DW	DOCOL
	DW	LIT,0FFFFH
	DW	HLD,PSTOR
	DW	HLD,AT,CSTOR
	DW	SEMIS


