;FF2 860218 0734  Part 2 of 2

;TRS80 Model 100 fig-Forth Version 1.1D


	DB	83H	;PAD
	DB	'PA'
	DB	0C4H
	DW	HOLD-7
PAD	DW	DOCOL,HERE,LIT,68,PLUS,SEMIS

	DB	84H	; WORD
	DB	'WOR'
	DB	0C4H
	DW	PAD-6
WORD	DW	DOCOL
	DW	BLK,AT,ZBRAN,WORD1-$
	DW	BLK,AT,BLOCK
	DW	BRAN,WORD2-$
WORD1	DW	TIB,AT
WORD2	DW	INN,AT,PLUS
	DW	SWAP
	DW	ENCL
	DW	HERE,LIT,34,BLANK
	DW	INN,PSTOR
	DW	OVER,SUBB,TOR
	DW	RR,HERE,CSTOR
	DW	PLUS,HERE,ONEP,FROMR,CMOVE
	DW	SEMIS

	DB	88H	; (NUMBER)
	DB	'(NUMBER'
	DB	0A9H
	DW	WORD-7
PNUMB	DW	DOCOL
PNUM1	DW	ONEP
	DW	DUP
	DW	TOR
	DW	CAT
	DW	BASE,AT
	DW	DIGIT
	DW	ZBRAN,PNUM2-$
	DW	SWAP
	DW	BASE,AT,USTAR
	DW	DROP
	DW	ROT
	DW	BASE,AT,USTAR
	DW	DPLUS
	DW	DPL,AT
	DW	ONEP
	DW	ZBRAN,PNUM3-$
	DW	ONE
	DW	DPL
	DW	PSTOR
PNUM3	DW	FROMR,BRAN,PNUM1-$
PNUM2	DW	FROMR,SEMIS

	DB	86H	; NUMBER
	DB	'NUMBE'
	DB	0D2H
	DW	PNUMB-11
NUMB	DW	DOCOL
	DW	ZERO,ZERO
	DW	ROT
	DW	DUP
	DW	ONEP
	DW	CAT
	DW	LIT,45,EQUAL
	DW	DUP
	DW	TOR
	DW	PLUS
	DW	LIT,0FFFFH
NUMB1	DW	DPL,STORE
	DW	PNUMB
	DW	DUP
	DW	CAT
	DW	BL,SUBB
	DW	ZBRAN,NUMB2-$
	DW	DUP
	DW	CAT
	DW	LIT,46
	DW	SUBB
	DW	ZERO,QERR
	DW	ZERO,BRAN,NUMB1-$
NUMB2	DW	DROP
	DW	FROMR
	DW	ZBRAN,NUMB3-$
	DW	DMINU
NUMB3	DW	SEMIS

	DB	85H	; -FIND
	DB	'-FIN'
	DB	0C4H
	DW	NUMB-9
DFIND	DW	DOCOL
	DW	BL,WORD
	DW	HERE
	DW	CONT,AT,AT
	DW	PFIND
	DW	DUP
	DW	ZEQU,ZBRAN,DFIN1-$
	DW	DROP,HERE,LATES,PFIND
DFIN1	DW	SEMIS

	DB	87H	; (ABORT)
	DB	'(ABORT'
	DB	0A9H
	DW	DFIND-8
PABOR	DW	DOCOL,ABORT,SEMIS

	DB	85H	; ERROR
	DB	'ERRO'
	DB	0D2H
	DW	PABOR-10
ERROR	DW	DOCOL
	DW	WARN,AT,ZLESS,ZBRAN,ERRO1-$
	DW	PABOR
ERRO1	DW	HERE,COUNT,TYPE
	DW	PDOTQ
	DB	2
	DB	'? '
	DW	MESS
	DW	SPSTO
	DW	BLK,AT
	DW	DDUP
	DW	ZBRAN,ERRO2-$
	DW	INN,AT,SWAP
ERRO2	DW	QUIT

	DB	83H	; ID.
	DB	'ID'
	DB	0AEH
	DW	ERROR-8
IDDOT	DW	DOCOL
	DW	PAD,LIT,32,LIT,5FH,FILL
	DW	DUP
	DW	PFA,LFA
	DW	OVER
	DW	SUBB
	DW	PAD,SWAP,CMOVE
	DW	PAD,COUNT
	DW	LIT,1FH,ANDD
	DW	TYPE,SPACE,SEMIS

	DB	86H	; CREATE
	DB	'CREAT'
	DB	0C5H
	DW	IDDOT-6
CREAT	DW	DOCOL
	DW	DFIND,ZBRAN,CREA1-$
	DW	DROP,NFA,IDDOT,LIT,4,MESS,SPACE
CREA1	DW	HERE,DUP,CAT
	DW	WIDTH,AT,MIN,ONEP,ALLOT
	DW	DUP
	DW	LIT,0A0H,TOGGL
	DW	HERE,ONE,SUBB
	DW	LIT,80H,TOGGL
	DW	LATES
	DW	COMMA
	DW	CURR,AT
	DW	STORE
	DW	HERE
	DW	TWOP
	DW	COMMA
	DW	SEMIS

	DB	0C9H	; [COMPILE]
	DB	'[COMPILE'
	DB	0DDH
	DW	CREAT-9
BCOMP	DW	DOCOL
	DW	DFIND,ZEQU,ZERO,QERR
	DW	DROP,CFA,COMMA,SEMIS

	DB	0C7H	; LITERAL
	DB	'LITERA'
	DB	0CCH
	DW	BCOMP-12
LITER	DW	DOCOL
	DW	STATE,AT,ZBRAN,LITE1-$
	DW	COMP,LIT,COMMA
LITE1	DW	SEMIS

	DB	0C8H	; DLITERAL
	DB	'DLITERA'
	DB	0CCH
	DW	LITER-10
DLITE	DW	DOCOL
	DW	STATE,AT,ZBRAN,DLIT1-$
	DW	SWAP,LITER,LITER,
DLIT1	DW	SEMIS

	DB	86H	; ?STACK
	DB	'?STAC'
	DB	0CBH
	DW	DLITE-11
QSTAC	DW	DOCOL
	DW	SPAT
	DW	SZERO,AT
	DW	SWAP
	DW	ULESS,ONE,QERR
	DW	SPAT
	DW	HERE
	DW	LIT,80H,PLUS
	DW	ULESS,LIT,7,QERR
	DW	SEMIS

	DB	89H	; INTERPRET
	DB	'INTERPRE'
	DB	0D4H
	DW	QSTAC-9
INTER	DW	DOCOL
INTE1	DW	DFIND,ZBRAN,INTE2-$
	DW	STATE,AT
	DW	LESS,ZBRAN,INTE3-$
	DW	CFA
	DW	COMMA
	DW	BRAN,INTE4-$
INTE3	DW	CFA
	DW	EXEC
INTE4	DW	QSTAC
	DW	BRAN,INTE5-$
INTE2	DW	HERE
	DW	NUMB
	DW	DPL,AT
	DW	ONEP
	DW	ZBRAN,INTE6-$
	DW	DLITE
	DW	BRAN,INTE7-$
INTE6	DW	DROP,LITER
INTE7	DW	QSTAC
INTE5	DW	BRAN,INTE1-$

	DB	89H	; IMMEDIATE
	DB	'IMMEDIAT'
	DB	0C5H
	DW	INTER-0CH
IMMED	DW	DOCOL,LATES,LIT,40H,TOGGL,SEMIS

	DB	8AH	; VOCABULARY
	DB	'VOCABULAR'
	DB	0D9H
	DW	IMMED-0CH
VOCAB	DW	DOCOL
	DW	BUILD
	DW	LIT,0A081H,COMMA
	DW	CURR,AT,CFA,COMMA
	DW	HERE,VOCL,AT,COMMA
	DW	VOCL,STORE
	DW	DOES
DOVOC	DW	TWOP,CONT,STORE,SEMIS

	DB	0C5H	; FORTH
	DB	'FORT'
	DB	0C8H
	DW	VOCAB-0DH
FORTH	DW	DODOE,DOVOC,0A081H,TASK-7,0

	DB	8BH	;DEFINITIONS
	DB	'DEFINITION'
	DB	0D3H
	DW	FORTH-8
DEFIN	DW	DOCOL,CONT,AT,CURR,STORE,SEMIS

	DB	0C1H	; (
	DB	0A8H
	DW	DEFIN-0EH
PAREN	DW	DOCOL,LIT,41,WORD,SEMIS

	DB	84H	;QUIT
	DB	'QUI'
	DB	0D4H
	DW	PAREN-4
QUIT	DW	DOCOL
	DW	ZERO,BLK,STORE
	DW	LBRAC
QUIT1	DW	RPSTO
	DW	CR
	DW	QUERY
	DW	INTER
	DW	STATE,AT,ZEQU,ZBRAN,QUIT2-$
	DW	PDOTQ
	DB	2
	DB	'Ok'
QUIT2	DW	BRAN,QUIT1-$

	DB	85H	; ABORT
	DB	'ABOR'
	DB	0D4H
	DW	QUIT-7
ABORT	DW	DOCOL
	DW	SPSTO
	DW	DEC
	DW	QSTAC
	DW	CR,DOTCPU
	DW	PDOTQ
	DB	14
	DB	'fig-FORTH '
	DB	FIGREL+48,ADOT,FIGREV+48,USRVER+64
	DW	FORTH,DEFIN,QUIT

WRM	LXI	B,WRM1
	JMP	NEXT
WRM1	DW	WARM
	DB	84H	;WARM
	DB	'WAR'
	DB	0CDH
	DW	ABORT-8
WARM	DW	DOCOL,MTBUF,ABORT

CLD	LXI	B,CLD1
	LHLD	ORIG+12H
	SPHL
	JMP	NEXT
CLD1	DW	COLD
	DB	84H	;COLD
	DB	'COL'
	DB	0C4H
	DW	WARM-7
COLD	DW	DOCOL
	DW	MTBUF
	DW	LIT,BUF1,USE,STORE
	DW	LIT,BUF1,PREV,STORE
	DW	ZERO,LIT,EPRINT,STORE
	DW	LIT,ORIG+12H
	DW	LIT,UP,AT
	DW	LIT,6,PLUS
	DW	LIT,16
	DW	CMOVE
	DW	LIT,ORIG+0CH,AT
	DW	LIT,FORTH+6,STORE
	DW	ABORT

	DB	84H	; S->D
	DB	'S->'
	DB	0C4H
	DW	COLD-7
STOD	DW	$+2
	POP	D
	LXI	H,0
	MOV	A,D
	ANI	80H
	JZ	STOD1
	DCX	H
STOD1	JMP	DPUSH

	DB	82H	; +-
	DB	'+'
	DB	0ADH
	DW	STOD-7
PM	DW	DOCOL
	DW	ZLESS,ZBRAN,PM1-$
	DW	MINUS
PM1	DW	SEMIS

	DB	83H	; D+-
	DB	'D+'
	DB	0ADH
	DW	PM-5
DPM	DW	DOCOL
	DW	ZLESS,ZBRAN,DPM1-$
	DW	DMINU
DPM1	DW	SEMIS

	DB	83H	; ABS
	DB	'AB'
	DB	0D3H
	DW	DPM-6
ABS	DW	DOCOL,DUP,PM,SEMIS

	DB	84H	; DABS
	DB	'DAB'
	DB	0D3H
	DW	ABS-6
DABS	DW	DOCOL,DUP,DPM,SEMIS

	DB	83H	; MIN
	DB	'MI'
	DB	0CEH
	DW	DABS-7
MIN	DW	DOCOL,TDUP
	DW	GREAT,ZBRAN,MIN1-$
	DW	SWAP
MIN1	DW	DROP,SEMIS

	DB	83H	; MAX
	DB	'MA'
	DB	0D8H
	DW	MIN-6
MAX	DW	DOCOL,TDUP
	DW	LESS,ZBRAN,MAX1-$
	DW	SWAP
MAX1	DW	DROP,SEMIS

	DB	82H	; M*
	DB	'M'
	DB	0AAH
	DW	MAX-6
MSTAR	DW	DOCOL,TDUP,XORR
	DW	TOR,ABS,SWAP,ABS,USTAR,FROMR
	DW	DPM,SEMIS

	DB	82H	; M/
	DB	'M'
	DB	0AFH
	DW	MSTAR-5
MSLAS	DW	DOCOL,OVER
	DW	TOR,TOR
	DW	DABS
	DW	RR
	DW	ABS
	DW	USLAS
	DW	FROMR
	DW	RR
	DW	XORR
	DW	PM
	DW	SWAP
	DW	FROMR
	DW	PM
	DW	SWAP
	DW	SEMIS

	DB	81H	; *
	DB	0AAH
	DW	MSLAS-5
STAR	DW	DOCOL,MSTAR,DROP,SEMIS

	DB	84H	; /MOD
	DB	'/MO'
	DB	0C4H
	DW	STAR-4
SLMOD	DW	DOCOL
	DW	TOR,STOD,FROMR,MSLAS,SEMIS

	DB	81H	; /
	DB	0AFH
	DW	SLMOD-7
SLASH	DW	DOCOL,SLMOD,SWAP,DROP,SEMIS

	DB	83H	; MOD
	DB	'MO'
	DB	0C4H
	DW	SLASH-4
MODD	DW	DOCOL,SLMOD,DROP,SEMIS

	DB	85H	; */MOD
	DB	'*/MO'
	DB	0C4H
	DW	MODD-6
SSMOD	DW	DOCOL,TOR,MSTAR,FROMR,MSLAS,SEMIS

	DB	82H	; */
	DB	'*'
	DB	0AFH
	DW	SSMOD-8
SSLA	DW	DOCOL,SSMOD,SWAP,DROP,SEMIS

	DB	85H	; M/MOD
	DB	'M/MO'
	DB	0C4H
	DW	SSLA-5
MSMOD	DW	DOCOL
	DW	TOR,ZERO,RR,USLAS,FROMR
	DW	SWAP,TOR,USLAS,FROMR,SEMIS

	DB	86H	; (LINE)
	DB	'(LINE'
	DB	0A9H
	DW	MSMOD-8
PLINE	DW	DOCOL
	DW	TOR
	DW	LIT,64,BBUF,SSMOD
	DW	FROMR
	DW	BSCR,STAR
	DW	PLUS
	DW	BLOCK,PLUS
	DW	LIT,64,SEMIS

	DB	85H	; .LINE
	DB	'.LIN'
	DB	0C5H
	DW	PLINE-9
DLINE	DW	DOCOL,PLINE,DTRAI,TYPE,SEMIS

	DB	87H	; MESSAGE
	DB	'MESSAG'
	DB	0C5H
	DW	DLINE-8
MESS	DW	DOCOL
	DW	WARN,AT,ZBRAN,MESS1-$
	DW	DDUP,ZBRAN,MESS2-$
	DW	LIT,4,DLINE,SPACE
MESS2	DW	BRAN,MESS3-$
MESS1	DW	PDOTQ
	DB	5
	DB	'Msg #'
	DW	DOT
MESS3	DW	SEMIS

	DB	82H	; P@
	DB	'P'
	DB	0C0H
	DW	MESS-10
PTAT	DW	$+2
	POP	D
	LXI	H,PTAT1+1
	MOV	M,E
PTAT1	IN	0
	MOV	L,A
	MVI	H,0
	JMP	HPUSH

	DB	82H	; P!
	DB	'P'
	DB	0A1H
	DW	PTAT-5
PTSTO	DW	$+2
	POP	D
	LXI	H,PTSTO1+1
	MOV	M,E
	POP	H
	MOV	A,L
PTSTO1	OUT	0
	JMP	NEXT


;FORTH INTERFACE TO CHIPMUNK DISK OPERATING SYSTEM

CDOS	EQU	42H	;CDOS Hook Table Pointer
SRSECT	EQU	2	;CDOS 'Read Sector' code
SWSECT	EQU	4	;CDOS 'Write Sector' code

SPT	EQU	18	;Sectors per track (Numbered from 1 to 1440)
SPDRV	EQU	1440	;Sectors per drive

	DB	83H	;SEC
	DB	'SE'
	DB	0C3H
	DW	PTSTO-5
SEC	DW	DOVAR,0

	DB	85H	;TRACK
	DB	'TRAC'
	DB	0CBH
	DW	SEC-6
TRACK	DW	DOVAR,0

	DB	83H	;USE
	DB	'US'
	DB	0C5H
	DW	TRACK-8
USE	DW	DOVAR,BUF1

	DB	84H	;PREV
	DB	'PRE'
	DB	0D6H
	DW	USE-6
PREV	DW	DOVAR,BUF1

	DB	87H	;SEC/BLK
	DB	'SEC/BL'
	DB	0CBH
	DW	PREV-7
SPBLK	DW	DOCON,1

	DB	85H	;#BUFF
	DB	'#BUF'
	DB	0C6H
	DW	SPBLK-10
NOBUF	DW	DOCON,NBUF

	DB	8AH	;DISK-ERROR
	DB	'DISK-ERRO'
	DB	0D2H
	DW	NOBUF-8
DSKERR	DW	DOVAR,0

	DB	84H	;+BUF
	DB	'+BU'
	DB	0C6H
	DW	DSKERR-13
PBUF	DW	DOCOL
	DW	LIT,CO,PLUS,DUP
	DW	LIMIT,EQUAL,ZBRAN,PBUF1-$
	DW	DROP,FIRST
PBUF1	DW	DUP,PREV,AT,SUBB,SEMIS

	DB	86H	;UPDATE
	DB	'UPDAT'
	DB	0C5H
	DW	PBUF-7
UPDAT	DW	DOCOL,PREV,AT,AT
	DW	LIT,8000H,ORR
	DW	PREV,AT,STORE,SEMIS

	DB	8DH	;EMPTY-BUFFERS
	DB	'EMPTY-BUFFER'
	DB	0D3H
	DW	UPDAT-9
MTBUF	DW	DOCOL,FIRST
	DW	LIMIT,OVER,SUBB,ERASEE,SEMIS

	DB	86H	;BUFFER
	DB	'BUFFE'
	DB	0D2H
	DW	MTBUF-16
BUFFE	DW	DOCOL,USE,AT,DUP,TOR
BUFF1	DW	PBUF,ZBRAN,BUFF1-$
	DW	USE,STORE,RR,AT
	DW	ZLESS,ZBRAN,BUFF2-$
	DW	RR,TWOP,RR,AT
	DW	LIT,7FFFH,ANDD
	DW	ZERO,RSLW
BUFF2	DW	RR,STORE,RR,PREV
	DW	STORE,FROMR,TWOP,SEMIS

	DB	85H	;BLOCK
	DB	'BLOC'
	DB	0CBH
	DW	BUFFE-9
BLOCK	DW	DOCOL,OFSET,AT,PLUS,TOR
	DW	PREV,AT,DUP,AT
	DW	RR,SUBB,DUP,PLUS
	DW	ZBRAN,BLOC1-$
BLOC2	DW	PBUF,ZEQU,ZBRAN,BLOC3-$
	DW	DROP
	DW	RR,BUFFE,DUP
	DW	RR,ONE,RSLW,TWO,SUBB
BLOC3	DW	DUP,AT,RR,SUBB,DUP,PLUS
	DW	ZEQU,ZBRAN,BLOC2-$
	DW	DUP,PREV,STORE
BLOC1	DW	FROMR,DROP,TWOP,SEMIS


	DB	87H	;T&SCALC - Includes sector range checking
	DB	'T&SCAL'
	DB	0C3H
	DW	BLOCK-8
TSCALC	DW	DOCOL
	DW	DUP,ZLESS
	DW	OVER,LIT,SPDRV-1,GREAT
	DW	ORR,LIT,6,QERR
	DW	LIT,SPT,SLMOD
	DW	TRACK,STORE,ONEP,SEC,STORE,SEMIS



IOSET	LHLD	TRACK+2	;This routine sets up the registers prior to calling
	MOV	D,L	;a CDOS routine.
	LHLD	SEC+2	;D = Track # (0 to 79)
	MOV	E,L	;E = Sector # (1 to 18)
	LHLD	USE+2	;HL= Address to read/write the sector
	RET

IORET	MOV	A,E	;This routine cleans up after a CDOS call.
	JC	IORET1	;If carry is set, an error occured, so store its

	XRA	A	;error code in DISK-ERROR.
IORET1	STA	DSKERR+2
	POP	B	;Restore IP before returning to forth
	JMP	NEXT

	DB	88H	;SEC-READ - Instruct CDOS to read a sector
	DB	'SEC-REA'
	DB	0C4H
	DW	TSCALC-10
SECRD	DW	$+2
	PUSH	B	;Save the IP
	CALL	IOSET	;Setup the registers
	RST	7	;These two lines...
	DB	CDOS,SRSECT  ;are the CDOS call to do the read
	JMP	IORET

	DB	89H	;SEC-WRITE - Instruct CDOS to write a sector
	DB	'SEC-WRIT'
	DB	0C5H
	DW	SECRD-11
SECWT	DW	$+2
	PUSH	B	;Save the IP
	CALL	IOSET	;Setup the registers
	RST	7	;These two lines...
	DB	CDOS,SWSECT  ;are the CDOS call to do the write
	JMP	IORET

	DB	83H	;R/W - The Forth sector read/write command
	DB	'R/'
	DB	0D7H
	DW	SECWT-12
RSLW	DW	DOCOL,USE,AT,TOR
	DW	SWAP,SPBLK,STAR,ROT,USE,STORE
	DW	SPBLK,ZERO,XDO
RSLW1	DW	OVER,OVER,TSCALC
	DW	ZBRAN,RSLW2-$
	DW	SECRD,BRAN,RSLW3-$
RSLW2	DW	SECWT
RSLW3	DW	ONEP,LIT,80H,USE,PSTOR
	DW	XLOOP,RSLW1-$
	DW	DROP,DROP,FROMR,USE,STORE,SEMIS

	DB	85H	;FLUSH
	DB	'FLUS'
	DB	0C8H
	DW	RSLW-6
FLUSH	DW	DOCOL,NOBUF,ONEP,ZERO
	DW	XDO
FLUS1	DW	ZERO,BUFFE,DROP
	DW	XLOOP,FLUS1-$,SEMIS

	DB	84H	; LOAD
	DB	'LOA'
	DB	0C4H
	DW	FLUSH-8
LOAD	DW	DOCOL
	DW	BLK,AT,TOR,INN,AT,TOR
	DW	ZERO,INN,STORE
	DW	BSCR,STAR,BLK,STORE
	DW	INTER
	DW	FROMR,INN,STORE,FROMR,BLK,STORE,SEMIS

	DB	0C3H	; -->
	DB	'--'
	DB	0BEH
	DW	LOAD-7
ARROW	DW	DOCOL,QLOAD
	DW	ZERO,INN,STORE
	DW	BSCR,BLK,AT
	DW	OVER,MODD,SUBB,BLK,PSTOR
	DW	SEMIS


;M100 INTERFACE FOR TERMINAL

CHGET	EQU	12CBH	;Get a character from the keyboard
BRKCHK	EQU	729FH	;Check if shift-break pressed
LCD	EQU	4B44H	;Display a character of the LCD screen
LPT	EQU	6D3FH	;Send a character to the printer

EPRINT	DW	0	;Printer echo on/off flag

CPOUT	CALL	LCD	;Display A on the LCD & send to LPT if EPRINT<>0
	MOV	E,A
	LDA	EPRINT
	ORA	A
	RZ
	MOV	A,E	;This checks for linefeeds.
	CPI	LF	;Most printers dont need them.
	RZ		;Make this line a NOP if you do.
	JMP	LPT

PQTER	CALL	BRKCHK	;(?TERMINAL)
	LXI	H,0	;HL=1 if shift-break is pressed
	JNC	PQTE1
	INR	L
PQTE1	JMP	HPUSH

PKEY	CALL	CHGET	;(KEY)
	CPI	CTLC	;If its a ^C, ignore it. (We detect break elsewhere)
	JZ	PKEY
	CPI	DLE	;If its a ^P, toggle the printer echo flag.
	JNZ	PKEY1
	LXI	H,EPRINT
	MOV	A,M
	XRI	1
	MOV	M,A
	JMP	PKEY
PKEY1	MOV	L,A
	MVI	H,0
	JMP	HPUSH

PEMIT	DW	$+2	; (EMIT)
	POP	H
	PUSH	B
	MOV	A,L
	CALL	CPOUT
	POP	B
	JMP	NEXT

PCR	PUSH	B	;(CR)
	MVI	A,ACR
	CALL	CPOUT
	MVI	A,LF
	CALL	CPOUT
	POP	B
	JMP	NEXT

	;BACK TO THE VOCAB

	DB	0C1H	; '
	DB	0A7H
	DW	ARROW-6
TICK	DW	DOCOL,DFIND,ZEQU,ZERO,QERR
	DW	DROP,LITER,SEMIS

	DB	86H	;FORGET
	DB	'FORGE'
	DB	0D4H
	DW	TICK-4
FORG	DW	DOCOL,CURR,AT,CONT,AT
	DW	SUBB,LIT,24,QERR
	DW	TICK,DUP,FENCE,AT
	DW	LESS,LIT,21,QERR
	DW	DUP,NFA,DP,STORE
	DW	LFA,AT,CONT,AT,STORE
	DW	SEMIS

	DB	84H	;BACK
	DB	'BAC'
	DB	0CBH
	DW	FORG-9
BACK	DW	DOCOL,HERE,SUBB,COMMA,SEMIS

	DB	0C5H	;BEGIN
	DB	'BEGI'
	DB	0CEH
	DW	BACK-7
BEGIN	DW	DOCOL,QCOMP,HERE,ONE,SEMIS

	DB	0C5H	;ENDIF
	DB	'ENDI'
	DB	0C6H
	DW	BEGIN-8
ENDIFF	DW	DOCOL,QCOMP,TWO,QPAIR
	DW	HERE,OVER,SUBB,SWAP,STORE
	DW	SEMIS

	DB	0C4H	;THEN
	DB	'THE'
	DB	0CEH
	DW	ENDIFF-8
THEN	DW	DOCOL,ENDIFF,SEMIS

	DB	0C2H	;DO
	DB	'D'
	DB	0CFH
	DW	THEN-7
DO	DW	DOCOL,COMP,XDO,HERE,THREE,SEMIS

	DB	0C4H	;LOOP
	DB	'LOO'
	DB	0D0H
	DW	DO-5
LOOP	DW	DOCOL,THREE,QPAIR
	DW	COMP,XLOOP,BACK,SEMIS

	DB	0C5H	;+LOOP
	DB	'+LOO'
	DB	0D0H
	DW	LOOP-7
PLOOP	DW	DOCOL,THREE,QPAIR
	DW	COMP,XPLOO,BACK,SEMIS

	DB	0C5H	;UNTIL
	DB	'UNTI'
	DB	0CCH
	DW	PLOOP-8
UNTIL	DW	DOCOL,ONE,QPAIR
	DW	COMP,ZBRAN,BACK,SEMIS

	DB	0C3H	;END
	DB	'EN'
	DB	0C4H
	DW	UNTIL-8
ENDD	DW	DOCOL,UNTIL,SEMIS

	DB	0C5H	;AGAIN
	DB	'AGAI'
	DB	0CEH
	DW	ENDD-6
AGAIN	DW	DOCOL,ONE,QPAIR
	DW	COMP,BRAN,BACK,SEMIS

	DB	0C6H	;REPEAT
	DB	'REPEA'
	DB	0D4H
	DW	AGAIN-8
REPEA	DW	DOCOL
	DW	TOR,TOR,AGAIN,FROMR,FROMR
	DW	TWO,SUBB,ENDIFF,SEMIS

	DB	0C2H	;IF
	DB	'I'
	DB	0C6H
	DW	REPEA-9
IFF	DW	DOCOL,COMP,ZBRAN,HERE
	DW	ZERO,COMMA,TWO,SEMIS

	DB	0C4H	;ELSE
	DB	'ELS'
	DB	0C5H
	DW	IFF-5
ELSEE	DW	DOCOL,TWO,QPAIR
	DW	COMP,BRAN,HERE,ZERO,COMMA
	DW	SWAP,TWO,ENDIFF,TWO,SEMIS

	DB	0C5H	;WHILE
	DB	'WHIL'
	DB	0C5H
	DW	ELSEE-7
WHILE	DW	DOCOL,IFF,TWOP,SEMIS

	DB	86H	;SPACES
	DB	'SPACE'
	DB	0D3H
	DW	WHILE-8
SPACS	DW	DOCOL,ZERO,MAX,DDUP
	DW	ZBRAN,SPAX1-$
	DW	ZERO,XDO
SPAX2	DW	SPACE,XLOOP,SPAX2-$
SPAX1	DW	SEMIS

	DB	82H	;<#
	DB	'<'
	DB	0A3H
	DW	SPACS-9
BDIGS	DW	DOCOL,PAD,HLD,STORE,SEMIS

	DB	82H	; #>
	DB	'#'
	DB	0BEH
	DW	BDIGS-5
EDIGS	DW	DOCOL,DROP,DROP,HLD,AT
	DW	PAD,OVER,SUBB,SEMIS

	DB	84H	;SIGN
	DB	'SIG'
	DB	0CEH
	DW	EDIGS-5
SIGN	DW	DOCOL,ROT,ZLESS,ZBRAN,SIGN1-$
	DW	LIT,45,HOLD
SIGN1	DW	SEMIS

	DB	81H	; #
	DB	0A3H
	DW	SIGN-7
DIG	DW	DOCOL,BASE,AT
	DW	MSMOD,ROT,LIT,9,OVER
	DW	LESS,ZBRAN,DIG1-$
	DW	LIT,7,PLUS
DIG1	DW	LIT,30H,PLUS,HOLD,SEMIS

	DB	82H	; #S
	DB	'#'
	DB	0D3H
	DW	DIG-4
DIGS	DW	DOCOL
DIGS1	DW	DIG,OVER,OVER,ORR
	DW	ZEQU,ZBRAN,DIGS1-$
	DW	SEMIS

	DB	83H	; D.R
	DB	'D.'
	DB	0D2H
	DW	DIGS-5
DDOTR	DW	DOCOL,TOR,SWAP,OVER,DABS
	DW	BDIGS,DIGS,SIGN,EDIGS
	DW	FROMR,OVER,SUBB,SPACS
	DW	TYPE,SEMIS

	DB	82H	; .R
	DB	'.'
	DB	0D2H
	DW	DDOTR-6
DOTR	DW	DOCOL,TOR,STOD,FROMR,DDOTR,SEMIS

	DB	82H	; D.
	DB	'D'
	DB	0AEH
	DW	DOTR-5
DDOT	DW	DOCOL,ZERO,DDOTR,SPACE,SEMIS

	DB	81H	; .
	DB	0AEH
	DW	DDOT-5
DOT	DW	DOCOL,STOD,DDOT,SEMIS

	DB	81H	; ?
	DB	0BFH
	DW	DOT-4
QUES	DW	DOCOL,AT,DOT,SEMIS

	DB	82H	; U.
	DB	'U'
	DB	0AEH
	DW	QUES-4
UDOT	DW	DOCOL,ZERO,DDOT,SEMIS

	DB	85H	;VLIST
	DB	'VLIS'
	DB	0D4H
	DW	UDOT-5
VLIST	DW	DOCOL,LIT,80H,OUTT,STORE
	DW	CONT,AT,AT
VLIS1	DW	OUTT,AT,CSLL
	DW	GREAT,ZBRAN,VLIS2-$
	DW	CR,ZERO,OUTT,STORE
VLIS2	DW	DUP,IDDOT,SPACE,SPACE
	DW	PFA,LFA,AT,DUP,ZEQU
	DW	QTERM,ORR,ZBRAN,VLIS1-$
	DW	DROP,SEMIS

	DB	84H	;MENU
	DB	'MEN'	;Jump to address 0 to return to the M100 menu.
	DB	0D5H
	DW	VLIST-8
MENU	DW	0

	DB	84H	;LIST
	DB	'LIS'
	DB	0D4H
	DW	MENU-7
LIST	DW	DOCOL,DEC,CR,DUP,SCR,STORE
	DW	PDOTQ
	DB	8
	DB	'Screen #'
	DW	DOT,LIT,16,ZERO,XDO
LIST1	DW	CR,IDO,LIT,3,DOTR,SPACE
	DW	IDO,SCR,AT,DLINE
	DW	QTERM,ZBRAN,LIST2-$,LEAVE
LIST2	DW	XLOOP,LIST1-$,CR,SEMIS

	DB	85H	;INDEX
	DB	'INDE'
	DB	0D8H
	DW	LIST-7
INDEX	DW	DOCOL,LIT,FF,EMIT,CR
	DW	ONEP,SWAP,XDO
INDE1	DW	CR,IDO,LIT,3,DOTR,SPACE
	DW	ZERO,IDO,DLINE
	DW	QTERM,ZBRAN,INDE2-$,LEAVE
INDE2	DW	XLOOP,INDE1-$,SEMIS

	DB	85H	;TRIAD
	DB	'TRIA'
	DB	0C4H
	DW	INDEX-8
TRIAD	DW	DOCOL,LIT,FF,EMIT
	DW	LIT,3,SLASH,LIT,3,STAR
	DW	LIT,3,OVER,PLUS,SWAP,XDO
TRIA1	DW	CR,IDO,LIST
	DW	QTERM,ZBRAN,TRIA2-$,LEAVE
TRIA2	DW	XLOOP,TRIA1-$
	DW	CR,LIT,15,MESS,CR,SEMIS

	DB	84H	; .CPU
	DB	'.CP'
	DB	0D5H
	DW	TRIAD-8
DOTCPU	DW	DOCOL,BASE,AT
	DW	LIT,36,BASE,STORE
	DW	LIT,22H,PORIG,TAT,DDOT
	DW	BASE,STORE,SEMIS

	DB	84H	;CALL
	DB	'CAL'	;This word makes it easy to use the M100 ROM routines
	DB	0CCH	;from Forth.
	DW	DOTCPU-7
CALLL	DW	$+2
	MOV	L,C
	MOV	H,B
	SHLD	CALLL2
	POP	H
	SHLD	CALLL1+1
	POP	H
	POP	D
	POP	B
	POP	PSW
CALLL1	CALL	0
	PUSH	PSW
	PUSH	B
	PUSH	D
	PUSH	H
	LHLD	CALLL2
	MOV	C,L
	MOV	B,H
	JMP	NEXT
CALLL2	DW	0

	DB	84H	;TASK
	DB	'TAS'
	DB	0CBH
	DW	CALLL-7
TASK	DW	DOCOL,SEMIS

INITDP	DB	0

	END