;		Forth Interest Group  8086 FORTH 
;
;	   Adapted to run under Microsoft's MS-DOS 8086 operating
;	system by:
;
;		J. E. Smith
;		Univ. of Pennsylvania, Dept. of Chemistry
;		250 S. 33rd St.
;		Philadelphia, PA 19104 .
;
;	   Additional modifications and enhancements
;	as described below were also implemented by Mr. Smith.
;	These changes are more fully described in a text file
;	FORTH.DOC which should accompany this source code.
;
;	   This listing is placed in the public domain, and may
;	be freely distributed.
;
;
;	Current Source Version:
;
;	1.01	06-02-82	First to assemble with no errors;
;				all CPM/86 code, but 86-DOS ASM
;				source format.
;	1.02	06-02-82	Deleted all CPM/86 dependant code,
;					substituted 86-DOS calls
;					for console i/o.
;				Changed R/W to RAM simulation.
;	1.03	06-11-82	First working version !  Some minor
;					aesthetic modifications.
;	1.10	06-12-82	Initial disk-based version.
;	1.1B	06-22-82	Configured to use 64K and 2 screens.
;					Set ^C to cause warm start.
;	1.2A	07-02-82	Modified to word align pointers.
;					Aside from assembler source
;					alignment, the following FORTH
;					words were modified:
;					(FIND),PFA,NFA,and CREATE.
;	1.2B	07-08-82	1+, 2+ changed to CODE; added 1-, 2-.
;	1.2C	07-14-82	Added (ARRAY), (2ARR), and (XOF)
;	1.2D	07-18-82	Added (CARR), (2CARR) and PRINTER for
;					echo to list output.
;	1.2E	08-18-82	Added :@, :!, :C@, :C!, MYSEG,
;					DATE@, DATE!, TIME@, TIME!.
;				Changed ^C to use (ABORT).
;				Replaced all parameters with symbols
;					defined by EQU at the start.
;---------------------------------------------------------------------
;	1.2E distributed as version 1.0
;---------------------------------------------------------------------
;
;		( Page 2 )
;
; Version numbering and ASCII equates:
;
FIGREL		EQU	1
FIGREV		EQU	0
USRVER		EQU	0
;
ABL		EQU	20H
ACR		EQU	0DH
ADOT		EQU	2EH
BELL		EQU	07H
BSIN		EQU	7FH
BSOUT		EQU	08H
DLE		EQU	10H
LF		EQU	0AH
FF		EQU	0CH
;
; Memory allocation parameters:
;
EM		EQU	0000		;64K top of memory + 1
NSCR		EQU	2		;No. of 1024 byte screens
KBBUF		EQU	128		;No. of bytes per block
US		EQU	40H		;User area size ( in bytes )
RTS		EQU	0A0H		;Return stack/TIB size
;
CO		EQU	KBBUF+4		;No. bytes per block buffer
NBUF		EQU	16		;No. of block buffers =
					; NSCR*1024 / KBBUF
BUF1		EQU	0F7C0H		;Addr. of first block buffer =
					; EM - CO*NBUF
INITR0		EQU	BUF1-US		;Start of return stack (R0)
INITS0		EQU	INITR0-RTS	;Start of param. stack (S0)
;
; Disk parameters:
;
TRKS		EQU	77		;Tracks on 8" disk
SPT2		EQU	52		;8" Double density sectors/track
SPT1		EQU	26		;8" Single density sectors/track
SPDRV2		EQU	3744		;8" Double density sectors/drive
SPDRV1		EQU	1872		;8" Single density sectors/drive
BPS		EQU	128		;Bytes/sector
SPBL		EQU	1		;Sectors/block=KBBUF/BPS
BPSC		EQU	8		;Blocks/screen=1024/KBBUF
MXDRV		EQU	2		;Max. number of disk drives
DD		EQU	0		;Density(0=single,1=double)
;
;
;		( Page 3 )
;
		ORG	100H
ORIG: 		NOP
		JMP	CLD
		NOP
		JMP	WRM
;
		DB	FIGREL
		DB	FIGREV
		DB	USRVER
		DB	0EH
		DW	TASK-8
		DW	BSIN
		DW	INITR0
;
		DW	INITS0
		DW	INITR0
		DW	INITS0
		DW	32
		DW	0
		DW	INITDP
		DW	INITDP
		DW	FORTH+6
;
		DW	05H,0B326H		;"8086" ( in base 36 ! )
UP: 		DW	INITR0
RPP: 		DW	INITR0
;
;		( Page 6 )
;
BIP: 		DW	0
BIPE: 		DW	0
;
;		( Page 7 )
;
TNEXT: 		PUSHF
		PUSH	AX
		MOV	AX,[BIP]
		OR	AX,AX
		JZ	TNEXT2
		CMP	AX,-1
		JZ	TNEXT1
		CMP	AX,SI
		JZ	TNEXT1
		JA	TNEXT2
		MOV	AX,[BIPE]
		OR	AX,AX
		JZ	TNEXT2
		CMP	AX,SI
		JB	TNEXT2
;
TNEXT1: 	POP	AX
		POPF
BREAK: 		JP	TNEXT3
TNEXT2: 	POP	AX
		POPF
TNEXT3: 	LODW
		MOV	BX,AX
		JP	NEXT1
;
;		( Page 8 )
;
DPUSH: 		PUSH	DX
APUSH: 		PUSH	AX
;
NEXT: 		LODW
		MOV	BX,AX
NEXT1: 		MOV	DX,BX
		INC	DX
		JMP	[BX]
;		( Page 9 )
;
	ALIGN
DP0: 		DM	83H,"LIT"
		DW	0
LIT: 		DW	$ + 2
		LODW
		JMP	APUSH
;
	ALIGN
		DM	87H,"EXECUTE"
		DW	LIT - 6
EXEC: 		DW	$ + 2
		POP	BX
		JMP	NEXT1
;
	ALIGN
		DM	86H,"BRANCH"
	ALIGN
		DW	EXEC - 10
BRAN: 		DW	$ + 2
BRAN1: 		ADD	SI,[SI]
		JMP	NEXT
;
	ALIGN
		DM	87H,"0BRANCH"
		DW	BRAN - 10
ZBRAN: 		DW	$ + 2
		POP	AX
		OR	AX,AX
		JZ	BRAN1
		INC	SI
		INC	SI
		JMP	NEXT
;
;		( Page 10 )
;
	ALIGN
		DM	86H,"(LOOP)"
	ALIGN
		DW	ZBRAN - 10
XLOOP: 		DW	$ + 2
		MOV	BX,1
XLOO1: 		ADD	[BP],BX
		MOV	AX,[BP]
		SUB	AX,[BP+2]
		XOR	AX,BX
		JS	BRAN1
;
		ADD	BP,4
		INC	SI
		INC	SI
		JMP	NEXT
;
	ALIGN
		DM	87H,"(+LOOP)"
		DW	XLOOP - 10
XPLOO: 		DW	$ + 2
		POP	BX
		JMP	XLOO1
;
	ALIGN
		DM	84H,"(DO)"
	ALIGN
		DW	XPLOO - 10
XDO: 		DW	$ + 2
		POP	DX
		POP	AX
		XCHG	BP,SP
		PUSH	AX
		PUSH	DX
		XCHG	BP,SP
		JMP	NEXT
;
;************************
;*			*
;*	(XOF)		*
;*			*
;************************
;
;	Code added for Dr. Eaker's CASE construct
;	After John Cassady's 8080 code in FD 3:187 1982
;	(jes ver1.2C,1982)
;
	ALIGN
		DM	85H,"(XOF)"
		DW	XDO - 8
XOF:		DW	$ + 2
		POP	BX		;BX := case tag
		POP	AX		;AX := search tag
		CMP	AX,BX		;This one ?
		JE	XOF1		;Yes...
		PUSH	AX		;No, save search tag,
		JMP	BRAN1		;   and check the next case.
XOF1:		INC	SI		;...skip the branch offset,
		INC	SI		;   and
		JMP	NEXT		;   don't save the search tag.
;
;		( Page 11 )
;
	ALIGN
		DM	81H,"I"
		DW	XOF - 8
IDO: 		DW	$ + 2
		MOV	AX,[BP]
		JMP	APUSH
;
	ALIGN
		DM	85H,"DIGIT"
		DW	IDO - 4
DIGIT: 		DW	$ + 2
		POP	DX
		POP	AX
		SUB	AL,'0'
		JB	DIGI2
		CMP	AL,9
		JBE	DIGI1
		SUB	AL,7
		CMP	AL,10
		JB	DIGI2
DIGI1: 		CMP	AL,DL
		JAE	DIGI2
		SUB	DX,DX
		MOV	DL,AL
		MOV	AL,1
		JMP	DPUSH
DIGI2: 		SUB	AX,AX
		JMP	APUSH
;
;		( Page 12 )
;
	ALIGN
		DM	86H,"(FIND)"
	ALIGN
		DW	DIGIT - 8
PFIND: 		DW	$ + 2
		MOV	AX,DS
		MOV	ES,AX
		POP	BX
		POP	CX
PFIN1: 		MOV	DI,CX
		MOV	AL,[BX]
		MOV	DL,AL
		XOR	AL,[DI]
		AND	AL,3FH
		JNZ	PFIN5
PFIN2: 		INC	BX
		INC	DI
		MOV	AL,[BX]
		XOR	AL,[DI]
		ADD	AL,AL
		JNZ	PFIN5
		JNB	PFIN2
;
		ADD	BX,6		;Compute PFA (could be 5 or 6)
		AND	BX,0FFFEH	;Clear LSB to align
;
		PUSH	BX
		MOV	AX,1
		SUB	DH,DH
		JMP	DPUSH
PFIN5: 		INC	BX
		JB	PFIN6
		MOV	AL,[BX]
		ADD	AL,AL
		JMP	PFIN5
;
PFIN6:		INC	BX		;This could be one too many...
		AND	BX,0FFFEH	;Clear LSB to align
;
		MOV	BX,[BX]
		OR	BX,BX
		JNZ	PFIN1
		MOV	AX,0
		JMP	APUSH
;
;		( Page 13 )
;
	ALIGN
		DM	87H,"ENCLOSE"
		DW	PFIND - 10
ENCL: 		DW	$ + 2
		POP	AX
		POP	BX
		PUSH	BX
		MOV	AH,0
		MOV	DX,-1
		DEC	BX
ENCL1: 		INC	BX
		INC	DX
		CMP	AL,[BX]
		JZ	ENCL1
		PUSH	DX
		CMP	AH,[BX]
		JNZ	ENCL2
		MOV	AX,DX
		INC	DX
		JMP	DPUSH
ENCL2: 		INC	BX
		INC	DX
		CMP	AL,[BX]
		JZ	ENCL4
		CMP	AH,[BX]
		JNZ	ENCL2
ENCL3: 		MOV	AX,DX
		JMP	DPUSH
ENCL4: 		MOV	AX,DX
		INC	AX
		JMP	DPUSH
;
;		( Page 14 )
;
	ALIGN
		DM	84H,"EMIT"
	ALIGN
		DW	ENCL - 10
EMIT: 		DW	DOCOL
		DW	PEMIT
		DW	ONE,OUTT
		DW	PSTOR,SEMIS
;
	ALIGN
		DM	83H,"KEY"
		DW	EMIT - 8
KEY: 		DW	$ + 2
		JMP	PKEY
;
	ALIGN
		DM	89H,"?TERMINAL"
		DW	KEY - 6
QTERM: 		DW	$ + 2
		JMP	PQTER
;
	ALIGN
		DM	82H,"CR"
	ALIGN
		DW	QTERM - 12
CR: 		DW	$ + 2
		JMP	PCR
;
	ALIGN
		DM	85H,"CMOVE"
		DW	CR - 6
CMOVE: 		DW	$ + 2
		CLD
		MOV	BX,SI
		POP	CX
		POP	DI
		POP	SI
		MOV	AX,DS
		MOV	ES,AX
		REP
		MOVB
		MOV	SI,BX
		JMP	NEXT
;
	ALIGN
		DM	82H,"U*"
	ALIGN
		DW	CMOVE - 8
USTAR: 		DW	$ + 2
		POP	AX
		POP	BX
		MUL	AX,BX
		XCHG	AX,DX
		JMP	DPUSH
;
	ALIGN
		DM	82H,"U/"
	ALIGN
		DW	USTAR - 6
USLAS: 		DW	$ + 2
		POP	BX
		POP	DX
		POP	AX
		CMP	DX,BX
		JNB	DZERO
		DIV	AX,BX
		JMP	DPUSH
DZERO: 		MOV	AX,-1
		MOV	DX,AX
		JMP	DPUSH
;
;		( Page 16 )
;
	ALIGN
		DM	83H,"AND"
		DW	USLAS - 6
ANDD: 		DW	$ + 2
		POP	AX
		POP	BX
		AND	AX,BX
		JMP	APUSH
;
	ALIGN
		DM	82H,"OR"
	ALIGN
		DW	ANDD - 6
ORR: 		DW	$ + 2
		POP	AX
		POP	BX
		OR	AX,BX
		JMP	APUSH
;
	ALIGN
		DM	83H,"XOR"
		DW	ORR - 6
XORR: 		DW	$ + 2
		POP	AX
		POP	BX
		XOR	AX,BX
		JMP	APUSH
;
;		( Page 17 )
;
	ALIGN
		DM	83H,"SP@"
		DW	XORR - 6
SPAT: 		DW	$ + 2
		MOV	AX,SP
		JMP	APUSH
;
	ALIGN
		DM	83H,"SP!"
		DW	SPAT - 6
SPSTO: 		DW	$ + 2
		MOV	BX,[UP]
		MOV	SP,[BX+6]
		JMP	NEXT
;
	ALIGN
		DM	83H,"RP@"
		DW	SPSTO - 6
RPAT: 		DW	$ + 2
		MOV	AX,BP
		JMP	APUSH
;
	ALIGN
		DM	83H,"RP!"
		DW	RPAT - 6
RPSTO: 		DW	$ + 2
		MOV	BX,[UP]
		MOV	BP,[BX+8]
		JMP	NEXT
;
;		( Page 18 )
;
	ALIGN
		DM	82H,";S"
	ALIGN
		DW	RPSTO - 6
SEMIS: 		DW	$ + 2
		MOV	SI,[BP]
		INC	BP
		INC	BP
		JMP	NEXT
;
	ALIGN
		DM	85H,"LEAVE"
		DW	SEMIS - 6
LEAVE: 		DW	$ + 2
		MOV	AX,[BP]
		MOV	[BP+2],AX
		JMP	NEXT
;
;		( Page 19 )
;
	ALIGN
		DM	82H,">R"
	ALIGN
		DW	LEAVE - 8
TOR: 		DW	$ + 2
		POP	BX
		DEC	BP
		DEC	BP
		MOV	[BP],BX
		JMP	NEXT
;
	ALIGN
		DM	82H,"R>"
	ALIGN
		DW	TOR - 6
FROMR: 		DW	$ + 2
		MOV	AX,[BP]
		INC	BP
		INC	BP
		JMP	APUSH
;
	ALIGN
		DM	81H,"R"
		DW	FROMR - 6
RR: 		DW	IDO + 2
;
;		( Page 20 )
;
	ALIGN
		DM	82H,"0="
	ALIGN
		DW	RR - 4
ZEQU: 		DW	$ + 2
		POP	AX
		OR	AX,AX
		MOV	AX,1
		JZ	ZEQU1
		DEC	AX
ZEQU1:		JMP	APUSH
;
	ALIGN
		DM	82H,"0<"
	ALIGN
		DW	ZEQU - 6
ZLESS: 		DW	$ + 2
		POP	AX
		OR	AX,AX
		MOV	AX,1
		JS	ZLESS1
		DEC	AX
ZLESS1:		JMP	APUSH
;
	ALIGN
		DM	81H,"+"
		DW	ZLESS - 6
PLUS: 		DW	$ + 2
		POP	AX
		POP	BX
		ADD	AX,BX
		JMP	APUSH
;
;		( Page 21 )
;
	ALIGN
		DM	82H,"D+"
	ALIGN
		DW	PLUS - 4
DPLUS: 		DW	$ + 2
		POP	AX
		POP	DX
		POP	BX
		POP	CX
		ADD	DX,CX
		ADC	AX,BX
		JMP	DPUSH
;
	ALIGN
		DM	85H,"MINUS"
		DW	DPLUS - 6
MINUS: 		DW	$ + 2
		POP	AX
		NEG	AX
		JMP	APUSH
;
	ALIGN
		DM	86H,"DMINUS"
	ALIGN
		DW	MINUS - 8
DMINU: 		DW	$ + 2
		POP	BX
		POP	CX
		SUB	AX,AX
		MOV	DX,AX
		SUB	DX,CX
		SBB	AX,BX
		JMP	DPUSH
;
;		( Page 22 )
;
	ALIGN
		DM	84H,"OVER"
	ALIGN
		DW	DMINU - 10
OVER: 		DW	$ + 2
		POP	DX
		POP	AX
		PUSH	AX
		JMP	DPUSH
;
	ALIGN
		DM	84H,"DROP"
	ALIGN
		DW	OVER - 8
DROP: 		DW	$ + 2
		POP	AX
		JMP	NEXT
;
	ALIGN
		DM	84H,"SWAP"
	ALIGN
		DW	DROP - 8
SWAP: 		DW	$ + 2
		POP	DX
		POP	AX
		JMP	DPUSH
;
	ALIGN
		DM	83H,"DUP"
		DW	SWAP - 8
DUP: 		DW	$ + 2
		POP	AX
		PUSH	AX
		JMP	APUSH
;
;		( Page 23 )
;
	ALIGN
		DM	84H,"2DUP"
	ALIGN
		DW	DUP - 6
TDUP: 		DW	$ + 2
		POP	AX
		POP	DX
		PUSH	DX
		PUSH	AX
		JMP	DPUSH
;
	ALIGN
		DM	82H,"+!"
	ALIGN
		DW	TDUP - 8
PSTOR: 		DW	$ + 2
		POP	BX
		POP	AX
		ADD	[BX],AX
		JMP	NEXT
;
	ALIGN
		DM	86H,"TOGGLE"
	ALIGN
		DW	PSTOR - 6
TOGGL: 		DW	$ + 2
		POP	AX
		POP	BX
		XOR	[BX],AL
		JMP	NEXT
;
	ALIGN
		DM	81H,"@"
		DW	TOGGL - 10
AT: 		DW	$ + 2
		POP	BX
		MOV	AX,[BX]
		JMP	APUSH
;
;		( Page 24 )
;
	ALIGN
		DM	82H,"C@"
	ALIGN
		DW	AT - 4
CAT: 		DW	$ + 2
		POP	BX
		MOV	AL,[BX]
		SUB	AH,AH
		JMP	APUSH
;
	ALIGN
		DM	82H,"2@"
	ALIGN
		DW	CAT - 6
TAT: 		DW	$ + 2
		POP	BX
		MOV	AX,[BX]
		MOV	DX,[BX+2]
		JMP	DPUSH
;
	ALIGN
		DM	81H,"!"
		DW	TAT - 6
STORE: 		DW	$ + 2
		POP	BX
		POP	AX
		MOV	[BX],AX
		JMP	NEXT
;
	ALIGN
		DM	82H,"C!"
	ALIGN
		DW	STORE - 4
CSTOR: 		DW	$ + 2
		POP	BX
		POP	AX
		MOV	[BX],AL
		JMP	NEXT
;
;		( Page 25 )
;
	ALIGN
		DM	82H,"2!"
	ALIGN
		DW	CSTOR - 6
TSTOR: 		DW	$ + 2
		POP	BX
		POP	AX
		MOV	[BX],AX
		POP	AX
		MOV	[BX+2],AX
		JMP	NEXT
;
;********************************************************
;*							*
;*	long fetch/store operators:	:@, :!		*
;*					:C@, :C!	*
;*					MYSEG		*
;*							*
;********************************************************
;
	ALIGN
		DM	82H,":@"
	ALIGN
		DW	TSTOR - 6
FARAT:		DW	$ + 2
		POP	BX		;Offset
		MOV	DX,DS		;Save current segment
		POP	DS		;Segment
		MOV	AX,[BX]		;Fetch word at DS:BX
		MOV	DS,DX		;Restore segment register
		JMP	APUSH		;Return
;
	ALIGN
		DM	82H,":!"
	ALIGN
		DW	FARAT - 6
FARST:		DW	$ + 2
		MOV	DX,DS
		POP	BX		;Offset
		POP	DS		;Segment
		POP	AX		;Data
		MOV	[BX],AX
		MOV	DS,DX
		JMP	NEXT
;
	ALIGN
		DM	83H,":C@"
		DW	FARST - 6
FARCAT:		DW	$ + 2
		MOV	DX,DS
		POP	BX
		POP	DS
		MOV	B,AL,[BX]
		XOR	AH,AH
		MOV	DS,DX
		JMP	APUSH
;
	ALIGN
		DM	83H,":C!"
		DW	FARCAT - 6
FARCST:		DW	$ + 2
		MOV	DX,DS
		POP	BX
		POP	DS
		POP	AX
		MOV	B,[BX],AL
		MOV	DS,DX
		JMP	NEXT
;
	ALIGN
		DM	85H,"MYSEG"
		DW	FARCST - 6
MYSEG:		DW	$ + 2
		MOV	AX,DS
		JMP	APUSH
;
;		( Page 26 )
;
	ALIGN
		DM	0C1H,":"
		DW	MYSEG - 8
COLON: 		DW	DOCOL
		DW	QEXEC,	SCSP
		DW	CURR,	AT
		DW	CONT,	STORE
		DW	CREAT,	RBRAC
		DW	PSCOD
DOCOL: 		INC	DX
		DEC	BP
		DEC	BP
		MOV	[BP],SI
		MOV	SI,DX
		JMP	NEXT
;
	ALIGN
		DM	0C1H,";"
		DW	COLON - 4
SEMI: 		DW	DOCOL
		DW	QCSP,	COMP
		DW	SEMIS,	SMUDG
		DW	LBRAC,	SEMIS
;
	ALIGN
		DM	84H,"NOOP"
	ALIGN
		DW	SEMI - 4
NOOP: 		DW	DOCOL,	SEMIS
;
;		( Page 27 )
;
	ALIGN
		DM	88H,"CONSTANT"
	ALIGN
		DW	NOOP - 8
CON: 		DW	DOCOL
		DW	CREAT,	SMUDG
		DW	COMMA,	PSCOD
DOCON: 		INC	DX
		MOV	BX,DX
		MOV	AX,[BX]
		JMP	APUSH
;
	ALIGN
		DM	88H,"VARIABLE"
	ALIGN
		DW	CON - 12
VAR: 		DW	DOCOL
		DW	CON,	PSCOD
DOVAR: 		INC	DX
		PUSH	DX
		JMP	NEXT
;
	ALIGN
		DM	84H,"USER"
	ALIGN
		DW	VAR - 12
USER:		DW	DOCOL
		DW	CON,	PSCOD
DOUSE: 		INC	DX
		MOV	BX,DX
		MOV	BL,[BX]
		SUB	BH,BH
		MOV	DI,[UP]
		LEA	AX,[BX+DI]
		JMP	APUSH
;
;************************
;*			*
;*	(ARRAY)		*
;*			*
;************************
;
;	Code added to support array references.
;	Used by ARRAY to calculate the address of the
;	nth element of the array.
;	(jes ver1.2c,1982)
;
	ALIGN
		DM	87H,"(ARRAY)"
		DW	USER - 8
PARR:		DW	$ + 2
		POP	BX		;BX -> SIZE
		POP	AX		;AX := n
		ADD	AX,AX		;AX := AX*2
		ADD	AX,BX		;AX -> ARRAY[n]
		ADD	AX,2		;Offset to ARRAY[0]
		JMP	APUSH
;
	ALIGN
		DM	86H,"(2ARR)"
	ALIGN
		DW	PARR - 10
P2ARR:		DW	$ + 2
		POP	BX		;BX -> rowsize
		POP	CX		;CX := column
		POP	AX		;AX := row
		MUL	AX,[BX]		;AX := row*row dim.
		ADD	AX,CX		;AX := AX + col
		ADD	AX,AX		;2 bytes per element
		ADD	AX,BX		;AX := AX+PFA
		ADD	AX,4		;Offset to ARRAY[0]
		JMP	APUSH
;
	ALIGN
		DM	86H,"(CARR)"
	ALIGN
		DW	P2ARR - 10
PCARR:		DW	$ + 2
		POP	BX
		POP	AX
		ADD	AX,BX
		ADD	AX,2
		JMP	APUSH
;
	ALIGN
		DM	87H,"(2CARR)"
		DW	PCARR - 10
P2CAR:		DW	$ + 2
		POP	BX
		POP	CX
		POP	AX
		MUL	AX,[BX]
		ADD	AX,CX
		ADD	AX,BX
		ADD	AX,4
		JMP	APUSH
;
;		( Page 28 )
;
	ALIGN
		DM	81H,"0"
		DW	P2CAR - 10
ZERO: 		DW	DOCON
		DW	0
;
		DM	81H,"1"
		DW	ZERO - 4
ONE: 		DW	DOCON
		DW	1
;
		DM	81H,"2"
		DW	ONE - 4
TWO: 		DW	DOCON
		DW	2
;
		DM	81H,"3"
		DW	TWO - 4
THREE: 		DW	DOCON
		DW	3
;
		DM	82H,"BL"
	ALIGN
		DW	THREE - 4
BLS: 		DW	DOCON
		DW	20H
;
;		( Page 29 )
;
		DM	83H,"C/L"
		DW	BLS - 6
CSLL: 		DW	DOCON
		DW	64
;
		DM	85H,"FIRST"
		DW	CSLL - 6
FIRST: 		DW	DOCON
		DW	BUF1
;
		DM	85H,"LIMIT"
		DW	FIRST - 8
LIMIT: 		DW	DOCON
		DW	EM
;
		DM	85H,"B/BUF"
		DW	LIMIT - 8
BBUF: 		DW	DOCON
		DW	KBBUF
;
		DM	85H,"B/SCR"
		DW	BBUF - 8
BSCR: 		DW	DOCON
		DW	BPSC		; 400H/KBBUF
;
;		( Page 30 )
;



		DM	87H,"+ORIGIN"
		DW	BSCR - 8
PORIG: 		DW	DOCOL
		DW	LIT,	ORIG
		DW	PLUS,	SEMIS
;
;		( Page 31 )
;
		DM	82H,"S0"
	ALIGN
		DW	PORIG - 10
SZERO: 		DW	DOUSE
		DW	6
;
		DM	82H,"R0"
	ALIGN
		DW	SZERO - 6
RZERO: 		DW	DOUSE
		DW	8
;
		DM	83H,"TIB"
		DW	RZERO - 6
TIB: 		DW	DOUSE
		DW	10
;
		DM	85H,"WIDTH"
		DW	TIB - 6
WIDTH: 		DW	DOUSE
		DW	12
;
		DM	87H,"WARNING"
		DW	WIDTH - 8
WARN: 		DW	DOUSE
		DW	14
;
;		( Page 32 )
;
		DM	85H,"FENCE"
		DW	WARN - 10
FENCE: 		DW	DOUSE
		DW	16
;
		DM	82H,"DP"
	ALIGN
		DW	FENCE - 8
DP: 		DW	DOUSE
		DW	18
;
		DM	88H,"VOC-LINK"
	ALIGN
		DW	DP - 6
VOCL: 		DW	DOUSE
		DW	20
;
		DM	83H,"BLK"
		DW	VOCL - 12
BLK: 		DW	DOUSE
		DW	22
;
;		( Page 33 )
;
		DM	82H,"IN"
	ALIGN
		DW	BLK - 6
INN: 		DW	DOUSE
		DW	24
;
		DM	83H,"OUT"
		DW	INN - 6
OUTT: 		DW	DOUSE
		DW	26
;
		DM	83H,"SCR"
		DW	OUTT - 6
SCR: 		DW	DOUSE
		DW	28
;
		DM	86H,"OFFSET"
	ALIGN
		DW	SCR - 6
OFSET: 		DW	DOUSE
		DW	30
;
		DM	87H,"CONTEXT"
		DW	OFSET - 10
CONT: 		DW	DOUSE
		DW	32
;
		DM	87H,"CURRENT"
		DW	CONT - 10
CURR: 		DW	DOUSE
		DW	34
;
		DM	85H,"STATE"
		DW	CURR - 10
STATE: 		DW	DOUSE
		DW	36
;
		DM	84H,"BASE"
	ALIGN
		DW	STATE - 8
BASE: 		DW	DOUSE
		DW	38
;
		DM	83H,"DPL"
		DW	BASE - 8
DPL: 		DW	DOUSE
		DW	40
;
		DM	83H,"FLD"
		DW	DPL - 6
FLD: 		DW	DOUSE
		DW	42
;
;		( Page 35 )
;
		DM	83H,"CSP"
		DW	FLD - 6
CSPP: 		DW	DOUSE
		DW	44
;
		DM	82H,"R#"
	ALIGN
		DW	CSPP - 6
RNUM: 		DW	DOUSE
		DW	46
;
		DM	83H,"HLD"
		DW	RNUM - 6
HLD: 		DW	DOUSE
		DW	48
;
;		( Page 36 )
;
		DM	82H,"1+"
	ALIGN
		DW	HLD - 6
ONEP: 		DW	$ + 2
		POP	AX
		INC	AX
		JMP	APUSH
;
	ALIGN
		DM	82H,"2+"
	ALIGN
		DW	ONEP - 6
TWOP: 		DW	$ + 2
		POP	AX
		INC	AX
		INC	AX
		JMP	APUSH
;
	ALIGN
		DM	82H,"1-"
	ALIGN
		DW	TWOP - 6
ONEM:		DW	$ + 2
		POP	AX
		DEC	AX
		JMP	APUSH
	ALIGN
		DM	82H,"2-"
	ALIGN
		DW	ONEM - 6
TWOM:		DW	$ + 2
		POP	AX
		DEC	AX
		DEC	AX
		JMP	APUSH
	ALIGN
		DM	84H,"HERE"
	ALIGN
		DW	TWOM - 6
HERE: 		DW	DOCOL
		DW	DP,	AT,	SEMIS
;
		DM	85H,"ALLOT"
		DW	HERE - 8
ALLOT: 		DW	DOCOL
		DW	DP,	PSTOR,	SEMIS
;
;		( Page 37 )
;
		DM	81H,","
		DW	ALLOT - 8
COMMA: 		DW	DOCOL
		DW	HERE,	STORE
		DW	TWO,	ALLOT,	SEMIS
;
		DM	82H,"C,"
	ALIGN
		DW	COMMA - 4
CCOMM: 		DW	DOCOL
		DW	HERE,	CSTOR
		DW	ONE,	ALLOT,	SEMIS
;
		DM	81H,"-"
		DW	CCOMM - 6
SUBB: 		DW	$ + 2
		POP	DX
		POP	AX
		SUB	AX,DX
		JMP	APUSH
;
;		( Page 38 )
;
	ALIGN
		DM	81H,"="
		DW	SUBB - 4
EQUAL: 		DW	DOCOL
		DW	SUBB,	ZEQU,	SEMIS
;
		DM	81H,"<"
		DW	EQUAL - 4
LESS: 		DW	$ + 2
		POP	DX
		POP	AX
		MOV	BX,DX
		XOR	BX,AX
		JS	LES1
		SUB	AX,DX
LES1: 		OR	AX,AX
		MOV	AX,0
		JNS	LES2
		INC	AX
LES2: 		JMP	APUSH
;
	ALIGN
		DM	82H,"U<"
	ALIGN
		DW	LESS - 4
ULESS: 		DW	DOCOL
		DW	TDUP,	XORR,	ZLESS
		DW	ZBRAN,	ULES1-$-2
		DW	DROP,	ZLESS,	ZEQU
		DW	BRAN,	ULES2-$-2
ULES1: 		DW	SUBB,	ZLESS
ULES2: 		DW	SEMIS
;
;		( Page 39 )
;
		DM	81H,">"
		DW	ULESS - 6
GREAT: 		DW	DOCOL
		DW	SWAP,	LESS,	SEMIS
;
		DM	83H,"ROT"
		DW	GREAT - 4
ROT: 		DW	$ + 2
		POP	DX
		POP	BX
		POP	AX
		PUSH	BX
		JMP	DPUSH
;
	ALIGN
		DM	85H,"SPACE"
		DW	ROT - 6
SPACE: 		DW	DOCOL
		DW	BLS,	EMIT,	SEMIS
;
		DM	84H,"-DUP"
	ALIGN
		DW	SPACE - 8
DDUP: 		DW	DOCOL
		DW	DUP
		DW	ZBRAN,	DDUP1-$-2
		DW	DUP
DDUP1: 		DW	SEMIS
;
;		( Page 40 )
;
		DM	88H,"TRAVERSE"
	ALIGN
		DW	DDUP - 8
TRAV: 		DW	DOCOL
		DW	SWAP
TRAV1: 		DW	OVER,	PLUS
		DW	LIT,	7FH
		DW	OVER,	CAT,	LESS
		DW	ZBRAN,	TRAV1-$-2
		DW	SWAP,	DROP,	SEMIS
;
		DM	86H,"LATEST"
	ALIGN
		DW	TRAV - 12
LATES: 		DW	DOCOL
		DW	CURR,	AT,	AT,	SEMIS
;
		DM	83H,"LFA"
		DW	LATES - 10
LFA: 		DW	DOCOL
		DW	LIT,	4
		DW	SUBB,	SEMIS
;
;		( Page 41 )
;
		DM	83H,"CFA"
		DW	LFA - 6
CFA: 		DW	DOCOL
		DW	TWO,	SUBB,	SEMIS
;
		DM	83H,"NFA"
		DW	CFA - 6
NFA: 		DW	DOCOL
		DW	LIT,	5		;Could be 5 or 6
		DW	SUBB
		DW	DUP,	CAT
		DW	LIT,	80H,	ANDD,	ZEQU
		DW	ZBRAN,	NFA1-$-2	;MSB set, OK
		DW	ONEM			;MSB not set, adjust
NFA1:		DW	LIT,	-1
		DW	TRAV,	SEMIS
;
		DM	83H,"PFA"
		DW	NFA - 6
PFA: 		DW	$ + 2
		POP	BX		;BX:=NFA
		MOV	AL,[BX]		;AL:=count
		AND	AL,1FH		;Only lowest 5 bits
		ADD	AL,6
		SUB	AH,AH
		ADD	BX,AX		;BX:=NFA+count+6
		AND	BX,0FFFEH	;Clear LSB to align
		MOV	AX,BX
		JMP	APUSH		;Save PFA
;
;		( Page 42 )
;
	ALIGN
		DM	84H,"!CSP"
	ALIGN
		DW	PFA - 6
SCSP: 		DW	DOCOL
		DW	SPAT,	CSPP
		DW	STORE,	SEMIS
;
		DM	86H,"?ERROR"
	ALIGN
		DW	SCSP - 8
QERR: 		DW	DOCOL
		DW	SWAP
		DW	ZBRAN,	QERR1-$-2
		DW	ERROR
		DW	BRAN,	QERR2-$-2
QERR1: 		DW	DROP
QERR2: 		DW	SEMIS
;
		DM	85H,"?COMP"
		DW	QERR - 10
QCOMP: 		DW	DOCOL
		DW	STATE,	AT
		DW	ZEQU,	LIT,	17
		DW	QERR,	SEMIS
;
;		( Page 43 )
;
		DM	85H,"?EXEC"
		DW	QCOMP - 8
QEXEC: 		DW	DOCOL
		DW	STATE,	AT
		DW	LIT,	18
		DW	QERR,	SEMIS
;
		DM	86H,"?PAIRS"
	ALIGN
		DW	QEXEC - 8
QPAIR: 		DW	DOCOL
		DW	SUBB
		DW	LIT,	19
		DW	QERR,	SEMIS
;
		DM	84H,"?CSP"
	ALIGN
		DW	QPAIR - 10
QCSP: 		DW	DOCOL
		DW	SPAT,	CSPP,	AT,	SUBB
		DW	LIT,	20
		DW	QERR,	SEMIS
;
		DM	88H,"?LOADING"
	ALIGN
		DW	QCSP - 8
QLOAD: 		DW	DOCOL
		DW	BLK,	AT,	ZEQU
		DW	LIT,	22
		DW	QERR,	SEMIS
;
;		( Page 45 )
;
		DM	87H,"COMPILE"
		DW	QLOAD - 12
COMP: 		DW	DOCOL
		DW	QCOMP
		DW	FROMR,	DUP,	TWOP,	TOR
		DW	AT,	COMMA,	SEMIS
;
		DM	0C1H,"["
		DW	COMP - 10
LBRAC: 		DW	DOCOL
		DW	ZERO,	STATE,	STORE,	SEMIS
;
		DM	81H,"]"
		DW	LBRAC - 4
RBRAC: 		DW	DOCOL
		DW	LIT,	0C0H
		DW	STATE,	STORE,	SEMIS
;
;		( Page 46 )
;
		DM	86H,"SMUDGE"
	ALIGN
		DW	RBRAC - 4
SMUDG: 		DW	DOCOL
		DW	LATES
		DW	LIT,	20H
		DW	TOGGL,	SEMIS
;
		DM	83H,"HEX"
		DW	SMUDG - 10
HEX: 		DW	DOCOL
		DW	LIT,	16
		DW	BASE,	STORE,	SEMIS
;
		DM	87H,"DECIMAL"
		DW	HEX - 6
DECA: 		DW	DOCOL
		DW	LIT,	10
		DW	BASE,	STORE,	SEMIS
;
;		( Page 47 )
;
		DM	87H,"(;CODE)"
		DW	DECA - 10
PSCOD: 		DW	DOCOL
		DW	FROMR,	LATES,	PFA
		DW	CFA,	STORE,	SEMIS
;
		DM	0C5H,";CODE"
		DW	PSCOD - 10
SEMIC: 		DW	DOCOL
		DW	QCSP
		DW	COMP,	PSCOD,	LBRAC
SEMI1		DW	NOOP
		DW	SEMIS
;
		DM	87H,"<BUILDS"
		DW	SEMIC - 8
BUILD: 		DW	DOCOL
		DW	ZERO,	CON,	SEMIS
;
		DM	85H,"DOES>"
		DW	BUILD - 10
DOES: 		DW	DOCOL
		DW	FROMR,	LATES,	PFA,	STORE
		DW	PSCOD
DODOE: 		XCHG	BP,SP
		PUSH	SI
		XCHG	BP,SP
		INC	DX
		MOV	BX,DX
		MOV	SI,[BX]
		INC	DX
		INC	DX
		PUSH	DX
		JMP	NEXT
;
;		( Page 48 )
;
	ALIGN
		DM	85H,"COUNT"
		DW	DOES - 8
COUNT: 		DW	DOCOL
		DW	DUP,	ONEP,	SWAP,	CAT,	SEMIS
;
		DM	84H,"TYPE"
	ALIGN
		DW	COUNT - 8
TYPES: 		DW	DOCOL
		DW	DDUP
		DW	ZBRAN,	TYPE1-$-2
		DW	OVER,	PLUS
		DW	SWAP,	XDO
TYPE2: 		DW	IDO,	CAT,	EMIT
		DW	XLOOP,	TYPE2-$-2
		DW	BRAN,	TYPE3-$-2
TYPE1: 		DW	DROP
TYPE3: 		DW	SEMIS
;
;		( Page 49 )
;
		DM	89H,"-TRAILING"
		DW	TYPES - 8
DTRAI: 		DW	DOCOL
		DW	DUP,	ZERO,	XDO
DTRA1: 		DW	OVER,	OVER,	PLUS
		DW	ONE,	SUBB,	CAT
		DW	BLS,	SUBB
		DW	ZBRAN,	DTRA2-$-2
		DW	LEAVE
		DW	BRAN,	DTRA3-$-2
DTRA2: 		DW	ONE,	SUBB
DTRA3: 		DW	XLOOP,	DTRA1-$-2
		DW	SEMIS
;
;		( Page 50 )
;
		DM	84H,'(.")'
	ALIGN
		DW	DTRAI - 12
PDOTQ: 		DW	DOCOL
		DW	RR
		DW	COUNT,	DUP,	ONEP
		DW	FROMR,	PLUS,	TOR
		DW	TYPES,	SEMIS
;
		DM	0C2H,'."'
	ALIGN
		DW	PDOTQ - 8
DOTQ: 		DW	DOCOL
		DW	LIT,	'"'
		DW	STATE,	AT
		DW	ZBRAN,	DOTQ1-$-2
		DW	COMP
		DW	PDOTQ,	WORDS,	HERE
		DW	CAT,	ONEP,	ALLOT
		DW	BRAN,	DOTQ2-$-2
DOTQ1: 		DW	WORDS,	HERE,	COUNT,	TYPES
DOTQ2: 		DW	SEMIS
;
;		( Page 51 )
;
		DM	86H,"EXPECT"
	ALIGN
		DW	DOTQ - 6
EXPEC: 		DW	DOCOL
		DW	OVER,	PLUS,	OVER
		DW	XDO
EXPE1: 		DW	KEY,	DUP
		DW	LIT,	0EH
		DW	PORIG,	AT,	EQUAL
		DW	ZBRAN,	EXPE2-$-2
		DW	DROP,	DUP,	IDO
		DW	EQUAL,	DUP,	FROMR
		DW	TWO,	SUBB,	PLUS
		DW	TOR
		DW	ZBRAN,	EXPE6-$-2
		DW	LIT,	BELL
		DW	BRAN,	EXPE7-$-2
EXPE6: 		DW	LIT,	BSOUT,	EMIT
		DW	BLS,	EMIT
		DW	LIT,	BSOUT
EXPE7: 		DW	BRAN,	EXPE3-$-2
EXPE2: 		DW	DUP,	LIT,	ACR
		DW	EQUAL
		DW	ZBRAN,	EXPE4-$-2
		DW	LEAVE,	DROP,	BLS,	ZERO
		DW	BRAN,	EXPE5-$-2
EXPE4: 		DW	DUP
EXPE5: 		DW	IDO
		DW	CSTOR,	ZERO,	IDO,	ONEP
		DW	STORE
EXPE3: 		DW	EMIT
		DW	XLOOP,	EXPE1-$-2
		DW	DROP,	SEMIS
;
;		( Page 52 )
;
		DM	85H,"QUERY"
		DW	EXPEC - 10
QUERY: 		DW	DOCOL
		DW	TIB,	AT
		DW	LIT,	80,	EXPEC
		DW	ZERO,	INN,	STORE,	SEMIS
;
;		( Page 53 )
;
		DB	0C1H,80H
		DW	QUERY - 8
NULL: 		DW	DOCOL
		DW	BLK,	AT
		DW	ZBRAN,	NULL1-$-2
		DW	ONE,	BLK,	PSTOR
		DW	ZERO,	INN,	STORE
		DW	BLK,	AT
		DW	BSCR,	ONE,	SUBB,	ANDD
		DW	ZEQU
		DW	ZBRAN,	NULL2-$-2
		DW	QEXEC,	FROMR,	DROP
NULL2: 		DW	BRAN,	NULL3-$-2
NULL1: 		DW	FROMR,	DROP
NULL3: 		DW	SEMIS
;
		DM	84H,"FILL"
	ALIGN
		DW	NULL - 4
FILL: 		DW	$ + 2
		POP	AX
		POP	CX
		POP	DI
		MOV	BX,DS
		MOV	ES,BX
		CLD
		REP
		STOB
		JMP	NEXT
;
;		( Page 54 )
;
	ALIGN
		DM	85H,"ERASE"
		DW	FILL - 8
ERASEE: 	DW	DOCOL
		DW	ZERO,	FILL,	SEMIS
;
		DM	86H,"BLANKS"
	ALIGN
		DW	ERASEE - 8
BLANK: 		DW	DOCOL
		DW	BLS,	FILL,	SEMIS
;
		DM	84H,"HOLD"
	ALIGN
		DW	BLANK - 10
HOLD: 		DW	DOCOL
		DW	LIT,	-1
		DW	HLD,	PSTOR
		DW	HLD,	AT,	CSTOR,	SEMIS
;
		DM	83H,"PAD"
		DW	HOLD - 8
PAD: 		DW	DOCOL
		DW	HERE,	LIT,	68,	PLUS,	SEMIS
		DW	PLUS,	SEMIS
;
;		( Page 55 )
;
		DM	84H,"WORD"
	ALIGN
		DW	PAD - 6
WORDS: 		DW	DOCOL
		DW	BLK,	AT
		DW	ZBRAN,	WORD1-$-2
		DW	BLK,	AT,	BLOCK
		DW	BRAN,	WORD2-$-2
WORD1: 		DW	TIB,	AT
WORD2: 		DW	INN,	AT,	PLUS,	SWAP
		DW	ENCL,	HERE
		DW	LIT,	34
		DW	BLANK,	INN,	PSTOR
		DW	OVER,	SUBB,	TOR
		DW	RR,	HERE,	CSTOR
		DW	PLUS,	HERE,	ONEP
		DW	FROMR,	CMOVE,	SEMIS
;
;		( Page 56 )
;
		DM	88H,"(NUMBER)"
	ALIGN
		DW	WORDS - 8
PNUMB: 		DW	DOCOL
PNUM1: 		DW	ONEP
		DW	DUP,	TOR
		DW	CAT,	BASE,	AT,	DIGIT
		DW	ZBRAN,	PNUM2-$-2
		DW	SWAP,	BASE,	AT,	USTAR
		DW	DROP,	ROT,	BASE,	AT
		DW	USTAR,	DPLUS
		DW	DPL,	AT,	ONEP
		DW	ZBRAN,	PNUM3-$-2
		DW	ONE,	DPL,	PSTOR
PNUM3: 		DW	FROMR
		DW	BRAN,	PNUM1-$-2
PNUM2: 		DW	FROMR,	SEMIS
;
;		( Page 57 )
;
		DM	86H,"NUMBER"
	ALIGN
		DW	PNUMB - 12
NUMB: 		DW	DOCOL
		DW	ZERO,	ZERO
		DW	ROT,	DUP,	ONEP,	CAT
		DW	LIT,	"-",	EQUAL
		DW	DUP,	TOR,	PLUS
		DW	LIT,	-1
NUMB1: 		DW	DPL,	STORE
		DW	PNUMB
		DW	DUP,	CAT,	BLS,	SUBB
		DW	ZBRAN,	NUMB2-$-2
		DW	DUP,	CAT
		DW	LIT,	".",	SUBB
		DW	ZERO,	QERR,	ZERO
		DW	BRAN,	NUMB1-$-2
NUMB2: 		DW	DROP,	FROMR
		DW	ZBRAN,	NUMB3-$-2
		DW	DMINU
	ALIGN
NUMB3: 		DW	SEMIS
;
;		( Page 58 )
;
		DM	85H,"-FIND"
		DW	NUMB - 10
DFIND: 		DW	DOCOL
		DW	BLS,	WORDS
		DW	HERE,	CONT,	AT,	AT
		DW	PFIND,	DUP,	ZEQU
		DW	ZBRAN,	DFIN1-$-2
		DW	DROP
		DW	HERE,	LATES,	PFIND
DFIN1: 		DW	SEMIS
;
		DM	87H,"(ABORT)"
		DW	DFIND - 8
PABOR: 		DW	DOCOL
		DW	ABORT,	SEMIS
;
		DM	85H,"ERROR"
		DW	PABOR - 10
ERROR: 		DW	DOCOL
		DW	WARN,	AT,	ZLESS
		DW	ZBRAN,	ERRO1-$-2
		DW	PABOR
ERRO1: 		DW	HERE,	COUNT,	TYPES
		DW	PDOTQ
		DB	2,"? "
		DW	MESS
		DW	SPSTO
		DW	BLK,	AT,	DDUP
		DW	ZBRAN,	ERRO2-$-2
		DW	INN,	AT,	SWAP
ERRO2: 		DW	QUIT
;
;		( Page 59 )
;
	ALIGN
		DM	83H,"ID."
		DW	ERROR - 8
IDDOT: 		DW	DOCOL
		DW	PAD
		DW	LIT,	32
		DW	LIT,	'_'
		DW	FILL
		DW	DUP,	PFA,	LFA
		DW	OVER,	SUBB
		DW	PAD,	SWAP,	CMOVE
		DW	PAD,	COUNT
		DW	LIT,	1FH
		DW	ANDD,	TYPES,	SPACE,	SEMIS
;
;		( Page 60 )
;
		DM	86H,"CREATE"
	ALIGN
		DW	IDDOT - 6
CREAT: 		DW	DOCOL
		DW	DFIND
		DW	ZBRAN,	CREA1-$-2
		DW	DROP,	NFA,	IDDOT
		DW	LIT,	4,	MESS
		DW	SPACE
CREA1: 		DW	HERE,	DUP,	CAT
		DW	WIDTH,	AT,	MIN
		DW	ONEP,	ALLOT
		DW	DUP
		DW	LIT,	0A0H
		DW	TOGGL
		DW	HERE,	ONE,	SUBB
		DW	LIT,	80H
		DW	TOGGL
;
		DW	DP,	AT
		DW	ONEP
		DW	LIT,	0FFFEH,	ANDD
		DW	DP,	STORE
;
		DW	LATES,	COMMA
		DW	CURR,	AT,	STORE
		DW	HERE,	TWOP,	COMMA,	SEMIS
;
;		( Page 61 )
;
		DM	0C9H,"[COMPILE]"
		DW	CREAT - 10
BCOMP: 		DW	DOCOL
		DW	DFIND
		DW	ZEQU,	ZERO,	QERR
		DW	DROP,	CFA,	COMMA,	SEMIS
;
		DM	0C7H,"LITERAL"
		DW	BCOMP - 12
LITER: 		DW	DOCOL
		DW	STATE,	AT
		DW	ZBRAN,	LITE1-$-2
		DW	COMP,	LIT,	COMMA
LITE1: 		DW	SEMIS
;
;		( Page 62 )
;
		DM	0C8H,"DLITERAL"
	ALIGN
		DW	LITER - 10
DLITE: 		DW	DOCOL
		DW	STATE,	AT
		DW	ZBRAN,	DLIT1-$-2
		DW	SWAP,	LITER,	LITER
DLIT1:		DW	SEMIS
;
		DM	86H,"?STACK"
	ALIGN
		DW	DLITE-12
QSTAC:		DW	DOCOL
		DW	SPAT,	SZERO,	AT
		DW	SWAP,	ULESS,	ONE,	QERR
		DW	SPAT,	HERE
		DW	LIT,	80H
		DW	PLUS,	ULESS
		DW	LIT,	7
		DW	QERR
		DW	SEMIS
;
;		( Page 63 )
;
		DM	89H,"INTERPRET"
		DW	QSTAC - 10
INTER: 		DW	DOCOL
INTE1: 		DW	DFIND
		DW	ZBRAN,	INTE2-$-2
		DW	STATE,	 AT,	LESS
		DW	ZBRAN,	INTE3-$-2
		DW	CFA,	COMMA
		DW	BRAN,	INTE4-$-2
INTE3: 		DW	CFA,	EXEC
INTE4: 		DW	QSTAC
		DW	BRAN,	INTE5-$-2
INTE2: 		DW	HERE,	NUMB,	DPL,	AT,	ONEP
		DW	ZBRAN,	INTE6-$-2
		DW	DLITE
		DW	BRAN,	INTE7-$-2
INTE6: 		DW	DROP,	LITER
INTE7:		DW	QSTAC
INTE5:		DW	BRAN,	INTE1-$-2
;
;		( Page 64 )
;
		DM	89H,"IMMEDIATE"
		DW	INTER-12
IMMED:		DW	DOCOL
		DW	LATES
		DW	LIT,	40H
		DW	TOGGL,	SEMIS
;
		DM	8AH,"VOCABULARY"
	ALIGN
		DW	IMMED - 12
VOCAB: 		DW	DOCOL
		DW	BUILD
		DW	LIT,	0A081H
		DW	COMMA
		DW	CURR,	AT
		DW	CFA,	COMMA,	HERE,	VOCL
		DW	AT,	COMMA,	VOCL,	STORE
		DW	DOES
DOVOC: 		DW	TWOP,	CONT,	STORE,	SEMIS
;
;		( Page 65 )
;
		DM	0C5H,"FORTH"
		DW	VOCAB - 14
FORTH: 		DW	DODOE
		DW	DOVOC
		DW	0A081H
		DW	TASK - 8
		DW	0
;
		DM	8BH,"DEFINITIONS"
		DW	FORTH - 8
DEFIN: 		DW	DOCOL
		DW	CONT,	AT
		DW	CURR,	STORE,	SEMIS
;
		DM	0C1H,"("
		DW	DEFIN - 14
PAREN: 		DW	DOCOL
		DW	LIT,	')',	WORDS,	SEMIS
;
;		( Page 66 )
;
		DM	84H,"QUIT"
	ALIGN
		DW	PAREN - 4
QUIT: 		DW	DOCOL
		DW	ZERO,	BLK,	STORE
		DW	LBRAC
QUIT1: 		DW	RPSTO,	CR,	QUERY
		DW	INTER
		DW	STATE,	AT,	ZEQU
		DW	ZBRAN,	QUIT2-$-2
		DW	PDOTQ
		DB	2,"ok"
QUIT2: 		DW	BRAN,	QUIT1-$-2
;
	ALIGN
		DM	85H,"ABORT"
		DW	QUIT - 8
ABORT: 		DW	DOCOL
		DW	SPSTO,	DECA,	QSTAC,	CR
		DW	DOTCPU,	PDOTQ
		DB	16H,'Fig-FORTH  Version '
		DB	FIGREL+30H, ADOT, FIGREV+30H
		DW	LIT,	10,	PORIG,	CAT
		DW	LIT,	41H,	PLUS,	EMIT
		DW	FORTH,	DEFIN
		DW	LIT,	0,	PRTER,	STORE	;Reset echo
		DW	QUIT
;
;		( Page 67 )
;
CTRLC:		
WRM: 		MOV	SI,WRM1
		JMP	NEXT
WRM1		DW	PABOR
;
	ALIGN
		DM	84H,"WARM"
	ALIGN
		DW	ABORT - 8
WARM: 		DW	DOCOL
		DW	MTBUF,	ABORT
;
CLD: 		MOV	SI,CLD1
		MOV	AX,CS
		MOV	DS,AX
		MOV	SP,[ ORIG + 12H ]
		MOV	SS,AX
		MOV	ES,AX
		CLD
		MOV	BP,[RPP]
;
		MOV	AH,37
		MOV	AL,35
		MOV	DX,CTRLC
		INT	33		;Set ^C exit address
;
		JMP	NEXT
CLD1: 		DW	COLD
;
	ALIGN
		DM	84H,"COLD"
	ALIGN
		DW	WARM - 8
COLD: 		DW	DOCOL
		DW	MTBUF
		DW	ZERO,	DENSTY,	STORE
		DW	FIRST,	USE,	STORE
		DW	FIRST,	PREV,	STORE
		DW	DRZER
		DW	LIT,	ORIG+12H
		DW	LIT,	UP,	AT
		DW	LIT,	6,	PLUS
		DW	LIT,	16,	CMOVE
		DW	LIT,	ORIG+12,AT
		DW	LIT,	FORTH+6,STORE
		DW	LIT,	4,	SCR,	STORE
		DW	ABORT
;
;		( Page 69 )
;
		DM	84H,"S->D"
	ALIGN
		DW	COLD - 8
STOD: 		DW	$ + 2
		POP	DX
		SUB	AX,AX
		OR	DX,DX
		JNS	STOD1
		DEC	AX
STOD1: 		JMP	DPUSH
;
	ALIGN
		DM	82H,"+-"
	ALIGN
		DW	STOD - 8
PM: 		DW	DOCOL
		DW	ZLESS
		DW	ZBRAN,	PM1-$-2
		DW	MINUS
PM1: 		DW	SEMIS
;
		DM	83H,"D+-"
		DW	PM - 6
DPM: 		DW	DOCOL
		DW	ZLESS
		DW	ZBRAN,	DPM1-$-2
		DW	DMINU
DPM1: 		DW	SEMIS
;
		DM	83H,"ABS"
		DW	DPM - 6
ABS: 		DW	DOCOL
		DW	DUP,	PM,	SEMIS
;
;		( Page 70 )
;
		DM	84H,"DABS"
	ALIGN
		DW	ABS - 6
DABS: 		DW	DOCOL
		DW	DUP,	DPM,	SEMIS
;
		DM	83H,"MIN"
		DW	DABS - 8
MIN: 		DW	DOCOL
		DW	TDUP,	GREAT
		DW	ZBRAN,	MIN1-$-2
		DW	SWAP
MIN1: 		DW	DROP,	SEMIS
;
		DM	83H,"MAX"
		DW	MIN - 6
MAX: 		DW	DOCOL
		DW	TDUP,	LESS
		DW	ZBRAN,	MAX1-$-2
		DW	SWAP
MAX1: 		DW	DROP,	SEMIS
;
;		( Page 71 )
;
		DM	82H,"M*"
	ALIGN
		DW	MAX - 6
MSTAR:		DW	DOCOL
		DW	TDUP,	XORR,	TOR
		DW	ABS
		DW	SWAP,	ABS,	USTAR
		DW	FROMR,	DPM,	SEMIS
;
		DM	82H,"M/"
	ALIGN
		DW	MSTAR - 6
MSLAS: 		DW	DOCOL
		DW	OVER,	TOR,	TOR
		DW	DABS
		DW	RR,	ABS,	USLAS
		DW	FROMR,	RR,	XORR
		DW	PM,	SWAP,	FROMR
		DW	PM,	SWAP,	SEMIS
;
		DM	81H,"*"
		DW	MSLAS - 6
STAR: 		DW	DOCOL
		DW	MSTAR,	DROP,	SEMIS
;
;		( Page 72 )
;
		DM	84H,"/MOD"
	ALIGN
		DW	STAR - 4
SLMOD: 		DW	DOCOL
		DW	TOR,	STOD,	FROMR
		DW	MSLAS,	SEMIS
;
		DM	81H,"/"
		DW	SLMOD - 8
SLASH: 		DW	DOCOL
		DW	SLMOD,	SWAP,	DROP,	SEMIS
;
		DM	83H,"MOD"
		DW	SLASH - 4
MODD: 		DW	DOCOL
		DW	SLMOD,	DROP,	SEMIS
;
		DM	85H,"*/MOD"
		DW	MODD - 6
SSMOD: 		DW	DOCOL
		DW	TOR,	MSTAR,	FROMR
		DW	MSLAS,	SEMIS
;
;		( Page 73 )
;
		DM	82H,"*/"
	ALIGN
		DW	SSMOD - 8
SSLA: 		DW	DOCOL
		DW	SSMOD,	SWAP,	DROP,	SEMIS
;
		DM	85H,"M/MOD"
		DW	SSLA - 6
MSMOD: 		DW	DOCOL
		DW	TOR,	ZERO,	RR,	USLAS
		DW	FROMR,	SWAP,	TOR
		DW	USLAS,	FROMR,	SEMIS
;
;		( Page 74 )
;
		DM	86H,"(LINE)"
	ALIGN
		DW	MSMOD - 8
PLINE: 		DW	DOCOL
		DW	TOR
		DW	LIT,	64
		DW	BBUF,	SSMOD
		DW	FROMR,	BSCR,	STAR
		DW	PLUS
		DW	BLOCK,	PLUS
		DW	LIT,	64,	SEMIS
;
		DM	85H,".LINE"
		DW	PLINE - 10
DLINE: 		DW	DOCOL
		DW	PLINE,	DTRAI,	TYPES,	SEMIS
;
		DM	87H,"MESSAGE"
		DW	DLINE - 8
MESS: 		DW	DOCOL
		DW	WARN,	AT
		DW	ZBRAN,	MESS1-$-2
		DW	DDUP
		DW	ZBRAN,	MESS2-$-2
		DW	LIT,	4
		DW	OFSET,	AT,	BSCR,	SLASH
		DW	SUBB,	DLINE,	SPACE
MESS2: 		DW	BRAN,	MESS3-$-2
MESS1: 		DW	PDOTQ
		DB	6,"MSG # "
		DW	DOT
MESS3: 		DW	SEMIS
;
;		( Page 76 )
;
	ALIGN
		DM	83H,"PC@"
		DW	MESS - 10
PTCAT: 		DW	$ + 2
		POP	DX
		INB	DX
		SUB	AH,AH
		JMP	APUSH
;
	ALIGN
		DM	83H,"PC!"
		DW	PTCAT - 6
PTCSTO: 	DW	$ + 2
		POP	DX
		POP	AX
		OUTB	DX
		JMP	NEXT
;
	ALIGN
		DM	82H,"P@"
	ALIGN
		DW	PTCSTO - 6
PTAT: 		DW	$ + 2
		POP	DX
		INW	DX
		JMP	APUSH
;
;		( Page 77 )
;
	ALIGN
		DM	82H,"P!"
	ALIGN
		DW	PTAT - 6
PTSTO: 		DW	$ + 2
		POP	DX
		POP	AX
		OUTW	DX
		JMP	NEXT
;
;		( Page 78 )
;
;		Disk Interface Words for MS-DOS, etc.
;		--------------------------------
;
;
	ALIGN
		DM	85H,"DRIVE"
		DW	PTSTO - 6
DRIVE: 		DW	DOVAR,	0
;
		DM	86H,"RECORD"	;Not in fig listing
	ALIGN
		DW	DRIVE - 8
REC: 		DW	DOVAR,	0
;
;		( Page 79 )
;
		DM	83H,"USE"
		DW	REC - 10
USE: 		DW	DOVAR,	BUF1
;
		DM	84H,"PREV"
	ALIGN
		DW	USE - 6
PREV: 		DW	DOVAR,	BUF1
;
		DM	87H,"SEC/BLK"
		DW	PREV - 8
SPBLK: 		DW	DOCON,	SPBL	; KBBUF / BPS
;
;		( Page 80 )
;
		DM	85H,"#BUFF"
		DW	SPBLK - 10
NOBUF: 		DW	DOCON,	NBUF
;
		DM	87H,"DENSITY"
		DW	NOBUF - 8
DENSTY: 	DW	DOVAR,	DD
;
		DM	8AH,"DISK-ERROR"
	ALIGN
		DW	DENSTY - 10
DSKERR: 	DW	DOVAR,	0
;
		DM	87H,"PRINTER"		;EPRINT in fig
		DW	DSKERR - 14
PRTER:		DW	DOVAR, 0
;
;		( Page 81 )
;
		DM	84H,"+BUF"
	ALIGN
		DW	PRTER - 10
PBUF: 		DW	DOCOL
		DW	BBUF,	TWOP,	TWOP	;B/BUF+4
		DW	PLUS,	DUP,	LIMIT,	EQUAL
		DW	ZBRAN,	PBUF1-$-2
		DW	DROP,	FIRST
PBUF1: 		DW	DUP,	PREV,	AT
		DW	SUBB,	SEMIS
;
		DM	86H,"UPDATE"
	ALIGN
		DW	PBUF - 8
UPDAT: 		DW	DOCOL
		DW	PREV,	AT,	AT
		DW	LIT,	8000H
		DW	ORR
		DW	PREV,	AT,	STORE,	SEMIS
;
		DM	8DH,"EMPTY-BUFFERS"
		DW	UPDAT - 10
MTBUF: 		DW	DOCOL
		DW	FIRST,	LIMIT,	OVER
		DW	SUBB,	ERASEE,	SEMIS
;
;		( Page 82 )
;
		DM	83H,"DR0"
		DW	MTBUF - 16
DRZER: 		DW	DOCOL
		DW	ZERO,	OFSET,	STORE,	SEMIS
;
		DM	83H,"DR1"
		DW	DRZER - 6
DRONE: 		DW	DOCOL
		DW	DENSTY,	AT
		DW	ZBRAN,	DRON1-$-2
		DW	LIT,	SPDRV2
		DW	BRAN,	DRON2-$-2
DRON1: 		DW	LIT,	SPDRV1
DRON2: 		DW	OFSET,	STORE,	SEMIS
;
;		( Page 83 )
;
		DM	86H,"BUFFER"
	ALIGN
		DW	DRONE - 6
BUFFE: 		DW	DOCOL
		DW	USE,	AT,	DUP,	TOR
BUFF1: 		DW	PBUF
		DW	ZBRAN,	BUFF1-$-2
		DW	USE,	STORE
		DW	RR,	AT,	ZLESS
		DW	ZBRAN,	BUFF2-$-2
		DW	RR,	TWOP
		DW	RR,	AT
		DW	LIT,	7FFFH
		DW	ANDD,	ZERO,	RSLW
BUFF2: 		DW	RR,	STORE
		DW	RR,	PREV,	STORE
		DW	FROMR,	TWOP,	SEMIS
;
;		( Page 84 )
;
		DM	85H,"BLOCK"
		DW	BUFFE - 10
BLOCK: 		DW	DOCOL
		DW	OFSET,	AT,	PLUS,	TOR
		DW	PREV,	AT,	DUP
		DW	AT,	RR,	SUBB
		DW	DUP,	PLUS
		DW	ZBRAN,	BLOC1-$-2
BLOC2: 		DW	PBUF,	ZEQU
		DW	ZBRAN,	BLOC3-$-2
		DW	DROP,	RR
		DW	BUFFE,	DUP
		DW	RR,	ONE,	RSLW
		DW	TWO,	SUBB
BLOC3: 		DW	DUP,	AT,	RR,	SUBB
		DW	DUP,	PLUS,	ZEQU
		DW	ZBRAN,	BLOC2-$-2
		DW	DUP,	PREV,	STORE
BLOC1: 		DW	FROMR,	DROP
		DW	TWOP,	SEMIS
;
;		( Page 85 )
;		( Page 86 )
;
		DM	87H,"T&SCALC"
		DW	BLOCK-8
TSCALC:		DW	DOCOL
		DW	DENSTY,	AT
		DW	ZBRAN,	TSCALS-$-2
		DW	LIT,	SPDRV2,	SLMOD
;		DW	LIT,	MXDRV,	MIN
		DW	DRIVE,	STORE
		DW	REC,	STORE,	SEMIS
;		single density calculations :
TSCALS:		DW	LIT,	SPDRV1,	SLMOD
;		DW	LIT,	MXDRV,	MIN
		DW	DRIVE,	STORE
		DW	REC,	STORE,	SEMIS
;
;		( Page 87 )
;
		DM	8AH,"BLOCK-READ"
	ALIGN
		DW	TSCALC - 10
BLKRD:		DW	$ + 2
		MOV	[DSKERR+2],0	;reset error flag
		MOV	AX,[DRIVE+2]	;AL = drive no.
		MOV	BX,[USE+2]	;BX = transfer address
		MOV	CX,[SPBLK+2]	;CX = no. records to transfer
		MOV	DX,[REC+2]	;DX = logical record #
		PUSH	SI
		PUSH	BP
		INT	37		;BIOS disk read function
		JNC	READOK
		MOV	B,[DSKERR+2],AL	;READ ERROR!
READOK:		POPF
		POP	BP
		POP	SI
		JMP	NEXT
;
	ALIGN
		DM	8BH,"BLOCK-WRITE"
		DW	BLKRD - 14
BLKWRT:		DW	$ + 2
		MOV	[DSKERR+2],0	;reset error flag
		MOV	AX,[DRIVE+2]
		MOV	BX,[USE+2]
		MOV	CX,[SPBLK+2]
		MOV	DX,[REC+2]
		PUSH	SI
		PUSH	BP
		INT	38		;BIOS disk write function
		JNC	WRTOK
		XOR	AH,AH		;return negative error code
		NEG	AX
		MOV	[DSKERR+2],AX	;WRITE ERROR!
WRTOK:		POPF
		POP	BP
		POP	SI
		JMP	NEXT
;
;		( Page 88 )
;
	ALIGN
		DM	83H,"R/W"
		DW	BLKWRT - 14
RSLW: 		DW	DOCOL
		DW	USE,	AT,	TOR
		DW	TOR
		DW	SWAP,	USE, STORE
		DW	SPBLK,	STAR
		DW	TSCALC
		DW	FROMR
		DW	ZBRAN,	RSLW1-$-2
		DW	BLKRD
		DW	BRAN,	RSLW2-$-2
RSLW1:		DW	BLKWRT
RSLW2:		DW	FROMR,	USE,	STORE
		DW	DSKERR,	AT,	DDUP
		DW	ZBRAN,	RSLW5-$-2		;OK
		DW	ZLESS
		DW	ZBRAN,	RSLW3-$-2
		DW	LIT,	9			;Write error
		DW	BRAN,	RSLW4-$-2
RSLW3:		DW	LIT,	8			;Read error
RSLW4:		DW	ZERO,	PREV,	AT,	STORE	;This  buffer
							; is no good!
		DW	QERR
RSLW5:		DW	SEMIS
;
;		( Page 89 )
;
		DM	85H,"FLUSH"
		DW	RSLW - 6
FLUSH: 		DW	DOCOL
		DW	NOBUF,	ONEP
		DW	ZERO,	XDO
FLUS1: 		DW	ZERO,	BUFFE,	DROP
		DW	XLOOP,	FLUS1-$-2
		DW	SEMIS
;
		DM	84H,"LOAD"
	ALIGN
		DW	FLUSH - 8
LOAD: 		DW	DOCOL
		DW	BLK,	AT,	TOR
		DW	INN,	AT,	TOR
		DW	ZERO,	INN,	STORE
		DW	BSCR,	STAR,	BLK,	STORE
		DW	INTER
		DW	FROMR,	INN,	STORE
		DW	FROMR,	BLK,	STORE
		DW	SEMIS
;
;		( Page 90 )
;
		DM	0C3H,"-->"
		DW	LOAD - 8
ARROW: 		DW	DOCOL
		DW	QLOAD
		DW	ZERO,	INN,	STORE
		DW	BSCR,	BLK,	AT
		DW	OVER,	MODD,	SUBB
		DW	BLK,	PSTOR,	SEMIS
;
;		( Page 91 )
;
;****************************************
;*					*
;*	i/o primitives :		*
;*					*
;*	PQTER, PKEY, PEMIT, PCR,	*
;*	CONOUT, LSTOUT			*
;*					*
;****************************************
;
REQUEST		EQU	33		;BIOS function request intr.
CONOUT		EQU	2		;BIOS console output function
LSTOUT		EQU	5		;BIOS printer output function
CONIO		EQU	8		;BIOS console i/o fctn, no echo
CONSTAT		EQU	11		;BIOS console status check fctn
;
ACTRLC		EQU	3		;ASCII ^C
;
PQTER: 		MOV	AH,CONSTAT
		INT	REQUEST
		SUB	AH,AH
		JMP	APUSH
;
PKEY:		MOV	DX,0FFH
		MOV	AH,CONIO
		INT	REQUEST
		OR	AL,AL
		JZ	PKEY
		AND	AX,7FH
		CMP	AL,ACTRLC	;check for ^C
		JNZ	PKEY1		;pass anything else
		INT	35		;Force ^C interrupt 
PKEY1:		JMP	APUSH
;
PEMIT: 		DW	$ + 2
		POP	DX
		CALL	POUT
		JMP	NEXT
;
;		( Page 92 )
;
PCR: 		MOV	DX,ACR
		CALL	POUT
		MOV	DX,LF
		CALL	POUT
		JMP	NEXT
;
POUT: 		AND	DX,7FH
		MOV	AH,CONOUT
		INT	REQUEST
		MOV	BX,[ PRTER+2 ]	;Check echo flag
		OR	BX,BX
		JZ	RET
		MOV	AH,LSTOUT
		INT	REQUEST		;Echo to printer
		RET
;
;********************************************************
;*							*
;*		TIME@, TIME!, DATE@, DATE!		*
;*							*
;********************************************************
;
	ALIGN
		DM	85H,"TIME@"
		DW	ARROW - 6
TIMAT:		DW	$ + 2
		MOV	AH,2CH		;Get time
		INT	REQUEST
		PUSH	DX		;[sec sec/100]
		PUSH	CX		;[hr min]
		JMP	NEXT
;
	ALIGN
		DM	85H,"TIME!"
		DW	TIMAT - 8
TIMST:		DW	$ + 2
		POP	CX		;[hr min]
		POP	DX		;[sec sec/100]
		MOV	AH,2DH
		INT	REQUEST
		JMP	NEXT
;
	ALIGN
		DM	85H,"DATE@"
		DW	TIMST - 8
DATAT:		DW	$ + 2
		MOV	AH,2AH
		INT	REQUEST
		PUSH	CX		;year
		MOV	AL,DH		;month
		XOR	AH,AH
		XOR	DH,DH
		JMP	DPUSH		;DL=day
;
	ALIGN
		DM	85H,"DATE!"
		DW	DATAT - 8
DATST:		DW	$ + 2
		POP	CX		;year
		POP	DX		;DL=day
		POP	AX
		MOV	DH,AL		;DH=month
		MOV	AH,2BH
		INT	REQUEST
		JMP	NEXT
;
;		( Page 93 )
;		( Page 94 )
;
EXIT: 		INT	32
;
;		( Page 96 )
;		( Page 98 )
;
	ALIGN
		DM	0C1H,"'"
		DW	DATST - 8
TICK: 		DW	DOCOL
		DW	DFIND,	ZEQU
		DW	ZERO,	QERR
		DW	DROP,	LITER,	SEMIS
;
		DM	86H,"FORGET"
	ALIGN
		DW	TICK - 4
FORG: 		DW	DOCOL
		DW	CURR,	AT
		DW	CONT,	AT
		DW	SUBB
		DW	LIT,	24,	QERR
		DW	TICK,	DUP
		DW	FENCE,	AT,	LESS
		DW	LIT,	21,	QERR
		DW	DUP
		DW	NFA,	DP,	STORE
		DW	LFA,	AT
		DW	CONT,	AT,	STORE,	SEMIS
;
;		( Page 99 )
;
		DM	84H,"BACK"
	ALIGN
		DW	FORG - 10
BACK: 		DW	DOCOL
		DW	HERE,	SUBB
		DW	COMMA,	SEMIS
;
		DM	0C5H,"BEGIN"
		DW	BACK - 8
BEGIN: 		DW	DOCOL
		DW	QCOMP
		DW	HERE,	ONE,	SEMIS
;
		DM	0C5H,"ENDIF"
		DW	BEGIN - 8
ENDIFF: 	DW	DOCOL
		DW	QCOMP
		DW	TWO,	QPAIR
		DW	HERE,	OVER,	SUBB
		DW	SWAP,	STORE,	SEMIS
;
;		( Page 100 )
;
		DM	0C4H,"THEN"
	ALIGN
		DW	ENDIFF - 8
THEN: 		DW	DOCOL
		DW	ENDIFF,	SEMIS
;
		DM	0C2H,"DO"
	ALIGN
		DW	THEN - 8
DO: 		DW	DOCOL
		DW	COMP,	XDO
		DW	HERE,	THREE,	SEMIS
;
		DM	0C4H,"LOOP"
	ALIGN
		DW	DO - 6
LOOPC: 		DW	DOCOL
		DW	THREE,	QPAIR
		DW	COMP,	XLOOP
		DW	BACK,	SEMIS
;
;		( Page 101 )
;
		DM	0C5H,"+LOOP"
		DW	LOOPC - 8
PLOOP: 		DW	DOCOL
		DW	THREE,	QPAIR
		DW	COMP,	XPLOO
		DW	BACK,	SEMIS
;
		DM	0C5H,"UNTIL"
		DW	PLOOP - 8
UNTIL: 		DW	DOCOL
		DW	ONE,	QPAIR
		DW	COMP,	ZBRAN
		DW	BACK,	SEMIS
;
		DM	0C3H,"END"
		DW	UNTIL - 8
ENDD: 		DW	DOCOL
		DW	UNTIL,	SEMIS
;
;		( Page 102 )
;
		DM	0C5H,"AGAIN"
		DW	ENDD - 6
AGAIN: 		DW	DOCOL
		DW	ONE,	QPAIR
		DW	COMP,	BRAN
		DW	BACK,	SEMIS
;
		DM	0C6H,"REPEAT"
	ALIGN
		DW	AGAIN - 8
REPEA: 		DW	DOCOL
		DW	TOR,	TOR
		DW	AGAIN
		DW	FROMR,	FROMR
		DW	TWO,	SUBB
		DW	ENDIFF,	SEMIS
;
		DM	0C2H,"IF"
	ALIGN
		DW	REPEA - 10
IFF: 		DW	DOCOL
		DW	COMP,	ZBRAN
		DW	HERE,	ZERO,	COMMA
		DW	TWO,	SEMIS
;
;		( Page 103 )
;
		DM	0C4H,"ELSE"
	ALIGN
		DW	IFF - 6
ELSEE: 		DW	DOCOL
		DW	TWO,	QPAIR
		DW	COMP,	BRAN
		DW	HERE,	ZERO,	COMMA
		DW	SWAP
		DW	TWO,	ENDIFF,	TWO
		DW	SEMIS
;
		DM	0C5H,"WHILE"
		DW	ELSEE - 8
WHILE: 		DW	DOCOL
		DW	IFF,	TWOP,	SEMIS
;
;		( Page 104 )
;
		DM	86H,"SPACES"
	ALIGN
		DW	WHILE - 8
SPACS: 		DW	DOCOL
		DW	ZERO,	MAX
		DW	DDUP
		DW	ZBRAN,	SPAX1-$-2
		DW	ZERO,	XDO
SPAX2: 		DW	SPACE
		DW	XLOOP,	SPAX2-$-2
SPAX1: 		DW	SEMIS
;
		DM	82H,"<#"
	ALIGN
		DW	SPACS - 10
BDIGS: 		DW	DOCOL
		DW	PAD,	HLD,	STORE
		DW	SEMIS
;
		DM	82H,"#>"
	ALIGN
		DW	BDIGS - 6
EDIGS: 		DW	DOCOL
		DW	DROP,	DROP
		DW	HLD,	AT
		DW	PAD
		DW	OVER,	SUBB,	SEMIS
;
;		( Page 105 )
;
		DM	84H,"SIGN"
	ALIGN
		DW	EDIGS - 6
SIGN: 		DW	DOCOL
		DW	ROT,	ZLESS
		DW	ZBRAN,	SIGN1-$-2
		DW	LIT,	'-',	HOLD
SIGN1: 		DW	SEMIS
;
		DM	81H,"#"
		DW	SIGN - 8
DIG: 		DW	DOCOL
		DW	BASE,	AT,	MSMOD
		DW	ROT
		DW	LIT,	9
		DW	OVER,	LESS
		DW	ZBRAN,	DIG1-$-2
		DW	LIT,	7,	PLUS
DIG1: 		DW	LIT,	'0',	PLUS
		DW	HOLD,	SEMIS
;
		DM	82H,"#S"
	ALIGN
		DW	DIG - 4
DIGS: 		DW	DOCOL
DIGS1: 		DW	DIG
		DW	OVER,	OVER
		DW	ORR,	ZEQU
		DW	ZBRAN,	DIGS1-$-2
		DW	SEMIS
;
;		( Page 106 )
;
		DM	83H,"D.R"
		DW	DIGS - 6
DDOTR: 		DW	DOCOL
		DW	TOR,	SWAP,	OVER
		DW	DABS
		DW	BDIGS
		DW	DIGS,	SIGN
		DW	EDIGS
		DW	FROMR,	OVER,	SUBB
		DW	SPACS,	TYPES,	SEMIS
;
		DM	82H,".R"
	ALIGN
		DW	DDOTR - 6
DOTR: 		DW	DOCOL
		DW	TOR
		DW	STOD,	FROMR,	DDOTR,	SEMIS
;
;		( Page 107 )
;
		DM	82H,"D."
	ALIGN
		DW	DOTR - 6
DDOT: 		DW	DOCOL
		DW	ZERO
		DW	DDOTR,	SPACE,	SEMIS
;
		DM	81H,"."
		DW	DDOT - 6
DOT: 		DW	DOCOL
		DW	STOD,	DDOT,	SEMIS
;
		DM	81H,"?"
		DW	DOT - 4
QUES: 		DW	DOCOL
		DW	AT,	DOT,	SEMIS
;
		DM	82H,"U."
	ALIGN
		DW	QUES - 4
UDOT: 		DW	DOCOL
		DW	ZERO,	DDOT,	SEMIS
;
;		( Page 108 )
;
		DM	85H,"VLIST"
		DW	UDOT - 6
VLIST: 		DW	DOCOL
		DW	LIT,	80H
		DW	OUTT,	STORE
		DW	CONT,	AT,	AT
VLIS1: 		DW	OUTT,	AT
		DW	CSLL,	GREAT
		DW	ZBRAN,	VLIS2-$-2
		DW	CR
		DW	ZERO,	OUTT,	STORE
VLIS2: 		DW	DUP
		DW	IDDOT
		DW	SPACE,	SPACE
		DW	PFA,	LFA,	AT
		DW	DUP,	ZEQU
		DW	QTERM,	ORR
		DW	ZBRAN,	VLIS1-$-2
		DW	DROP,	SEMIS
;
		DM	83H,"BYE"
		DW	VLIST - 8
BYE: 		DW	$ + 2
		JMP	EXIT
;
;		( Page 109 )
;
	ALIGN
		DM	84H,"LIST"
	ALIGN
		DW	BYE - 6
LISTC: 		DW	DOCOL
		DW	DECA,	CR
		DW	DUP,	SCR,	STORE
		DW	PDOTQ
		DB	6,"SCR # "
		DW	DOT
		DW	LIT,	16,	ZERO,	XDO
LIST1: 		DW	CR,	IDO
		DW	LIT,	3,	DOTR,	SPACE
		DW	IDO,	SCR,	AT,	DLINE
		DW	QTERM
		DW	ZBRAN,	LIST2-$-2
		DW	LEAVE
LIST2: 		DW	XLOOP,	LIST1-$-2
		DW	CR,	SEMIS
;
	ALIGN
		DM	85H,"INDEX"
		DW	LISTC - 8
INDEX: 		DW	DOCOL
		DW	LIT,	FF,	EMIT,	CR
		DW	ONEP,	SWAP,	XDO
INDE1: 		DW	CR,	IDO
		DW	LIT,	3,	DOTR,	SPACE
		DW	ZERO,	IDO,	DLINE
		DW	QTERM
		DW	ZBRAN,	INDE2-$-2
		DW	LEAVE
INDE2: 		DW	XLOOP,	INDE1-$-2
		DW	SEMIS
;
;		( Page 110 )
;
		DM	85H,"TRIAD"
		DW	INDEX - 8
TRIAD: 		DW	DOCOL
		DW	LIT,	FF,	EMIT
		DW	LIT,	3,	SLASH
		DW	LIT,	3,	STAR
		DW	LIT,	3,	OVER
		DW	PLUS,	SWAP,	XDO
TRIA1: 		DW	CR,	IDO,	LISTC
		DW	QTERM
		DW	ZBRAN,	TRIA2-$-2
		DW	LEAVE
TRIA2: 		DW	XLOOP,	TRIA1-$-2
		DW	CR
		DW	LIT,	15,	MESS,	CR
		DW	SEMIS
;
		DM	84H,".CPU"
	ALIGN
		DW	TRIAD - 8
DOTCPU: 	DW	DOCOL
		DW	BASE,	AT
		DW	LIT,	36,	BASE,	STORE
		DW	LIT,	22H,	PORIG,	TAT
		DW	DDOT
		DW	BASE,	STORE,	SEMIS
;
;		( Page 111 )
;
		DM	85H,"MATCH"
		DW	DOTCPU - 8
MATCH: 		DW	$ + 2
		MOV	DI,SI
		POP	CX
		POP	BX
		POP	DX
		POP	SI
		PUSH	SI
MAT1: 		LODB
		CMP	AL,[BX]
		JNZ	MAT3
		PUSH	BX
		PUSH	CX
		PUSH	SI
MAT2: 		DEC	CX
		JZ	MATCHOK
		DEC	DX
		JZ	NOMATCH
		INC	BX
		LODB
		CMP	AL,[BX]
		JZ	MAT2
		POP	SI
		POP	CX
		POP	BX
MAT3: 		DEC	DX
		JNZ	MAT1
		JMP	MAT4
MATCHOK:
NOMATCH: 	POP	CX
		POP	CX
		POP	CX
MAT4: 		MOV	AX,SI
		POP	SI
		SUB	AX,SI
		MOV	SI,DI
		JMP	DPUSH
;
;		( Page 113 )
;
	ALIGN
		DM	84H,"TASK"
	ALIGN
		DW	MATCH - 8
TASK: 		DW	DOCOL
		DW	SEMIS
;
INITDP		EQU	$
W	DOCOL
	DW	TNUM
	DW	ATT
	DW	EXEC