tforth.asm

;	TITLE	'8080 FIG-FORTH 1.1 VERSION A0 17SEP79'
;
;	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
;
;	IMPLEMENTATION BY:
;		JOHN CASSADY
;                FOR THE FORTH IMPLEMENTATION TEAM (FIT) MARCH 1979
;	MODIFIED for CP/M by:
;	   	KIM HARRIS
;               FIT LIBRARIAN SEPT 1979
;	MODIFIED FOR iPDS / ISIS-II by:
;		SCOTT BAKER
;		Some time in June, 2024
;	ACKNOWLEDGEMENTS:
;		GEORGE FLAMMER
;		ROBT. D. VILLWOCK
;               Microsystems inc. Pasadena Ca.
;
;        DISTRIBUTED BY    FORTH POWER
;               P.O. BOX 2455 SAN RAFAEL CA
;               94902   415-471-1762
;               SUPPORT, SYSTEMS PROGRAMMING, 
;               APPLICATIONS PROGRAMMING
;
;  UNLESS OTHERWISE INDICATED, THIS DISTRIBUTION IS SUPPORTED
;  SOLELY BY THE FORTH INTEREST GROUP (LISTINGS) AND BY
;  FORTH POWER (MACHINE READABLE COPIES AND EXTENSIONS).
;
;   COPYRIGHT AND TRADEMARK NOTICES:
;   FORTH (C) 1974,1975,1976,1977,1978,1979 FORTH INC.
;   FIST (C) 1979 FORTH INTERNATIONAL STANDARDS TEAM
;   FIG, FORTH DIMENSIONS, FIT, (C) 1978, 1979 FORTH INTEREST GROUP
;   FORTH POWER (C) 1978, 1979 MARIN SERVICES, INC.
;   FORTH 77, FORTH 78, FORTH 79, STANDARD FORTH, FORTH INTERNATIONAL
;   STANDARD, (C) 1976, 1977, 1978, 1979, FIST
;   MULTI-FORTH (C) 1978, 1979 CREATIVE SOLUTIONS
;   CP/M (C) 1979 DIGITAL RESEARCH INC.
;   MOST ANYTHING WITH AN 11 IN IT (C) DIGITAL EQUIPMENT CORP
;   THERE MAY BE OTHERS ! !
;   MINIFORTH, MICROFORTH, POLYFORTH, FORTH  TM FORTH INC.
;   FIG-FORTH (C) 1978 1979 FORTH INTEREST GROUP
;   ALL RIGHTS RESERVED EXCEPT AS EXPRESSLY INDICATED !
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
;               UPDATES, PATCHES, BUG REPORTS, EXTENSIONS
;               FOR THIS SOFTWARE IN  FORTH DIMENSIONS  
;               NEWSLETTER OF FORTH INTEREST GROUP (FIG)
;               6 issues $5.00 includes fig membership
;
;          DOCUMENTATION FROM FIG or FORTH POWER
;        
;               FORTH PRIMER (240pp) Richard Stevens
;               KITT PEAK NATIONAL OBSERVATORY    $20.00
;    
;               FORTH IMPLEMENTATION TEAM LANGUAGE MODEL, EDITOR SOURCE,
;               LANGUAGE GLOSSARY, AND IMPLEMENTATION GUIDE  $10.00
;
;               FORTH FOR MICROCOMPUTERS by JOHN S JAMES
;               reprint from DDJ #25          $2.00
;
;               FORTH POCKET PROGRAMMERS CARD  FREE W/ S.A.S.E.
;
;               SOURCE CODE FOR TI990, 6502, 6800, PDP11, PACE,
;               8080 (included here)    $10.00/ LISTING
;
;          DOCUMENTATION FROM FIG
;
;               USING FORTH by ELIZABETH RATHER (200pp)
;               FORTH INC. 1979               $20.00
;
;          DOCUMENTATION FROM FORTH POWER
;               
;
;               CP/M MULTI-FORTH USERS MANUAL  $20.00
;               FORTH 79 INTERNATIONAL STANDARD 
;
;               CP/M 8080 FORTH BY FIG 8" DISKETT IBM STD.
;               WITH EDITOR AND ASSEMBLER, COPY AND PRINT,
;               AND USERS GUIDE                $65.00
;
;               also on 5" CP/M, 5 & 8 Northstar DOS
;
;               CP/M Multi-Forth, Full 79 International
;               Standard with extensions, Strings, Prom burner,
;               Real time clock, VIDEO EDITOR, UTILITIES
;               A PROFESSIONAL LEVEL PRODUCT    $150.00
;               includes manual
;
;               PDP 11 FORTH by JOHN S. JAMES
;               8" RX01 diskett or 9 track 800 bpi DOS tape
;               runs under OS or stand alone
;               WITH USERS GUIDE                $150.00
;
;               FIG TRS 80 FORTH cassette or diskette
;               WRITE FOR PRICES
;
;               APPLE FORTH BY CapN' SOFTWARE   $40.00
;               EASYWRITER (word processor for APPLE
;               by CapN' SOFTWARE)        $100.00
;
;               APPLE FORTH BY UNIVERSITY OF UTRECHT,
;               includes floating pt and many extensions
;               A PROFESSIONAL LEVEL PRODUCT  $100.00
;
;               FORTH FOR MICROPROSSOR DEVELOPMENT SYSTEMS,
;               FORTH FOR D.G., VAX 11, INTERDATA, Series 1,
;               C.A., HONEYWELL LEVEL 6, and others,   Write for prices
;
;          DOCUMENTATION FROM CALTECH
;                CALTECH FORTH MANUAL $6.00
;               CAL TECH BOOKSTORE PASADENA CA
;               by MARTIN S. EWING 100pp postpaid
;
;  CALL FOR PAPERS, ARTICLES, SPEAKERS: FOR FORTH DIMENSIONS
;   AND TRADE PUBLICATIONS SEND TO FIG.  FOR SPEAKERS, WORKSHOPS,
;   SHOWS AND CONVENTIONS CONTACT FIG.  FIG SOLICITES FORTH SOFTWARE
;   FOR INCLUSION IN THIS EFFORT.
;               FORTH INTERNATIONAL STANDARDS TEAM (FIT)
;              FORTH 79 INTERNATIONAL STANDARD, REQUIRED AND
;              RESERVED WORD GLOSSARY, AND STANDARDS ACTIVITY
;              DISTRIBUTION.  $30.00 TO FIT c/o FIG or to
;
;              CAROLYN ROSENBERG, FIT SECRETARY
;              c/o FORTH INC. MANHATTAN BEACH CA.
;
;
;-----------------------------------------------------
;	LABELS USED WHICH DIFFER FROM FIG-FORTH PUBLISHED
;	8080 LISTING 1.0:
;
;	REL 1.1		REL 1.0
;	-------		-------
;	ANDD		AND
;	CSPP		CSP
;	ELSEE		ELSE
;	ENDD		END
;	ENDIFF		ENDIF
;	ERASEE		ERASE
;	IDO		I
;	IFF		IF
;	INN		IN
;	MODD		MOD
;	ORR		OR
;	OUTT		OUT
;	RR		R
;	RPP		RP
;	SUBB		SUB
;	XORR		XOR
;
;	SEE ALSO:
;		RELEASE & VERSION NUMBERS
;		ASCII CHARACTER EQUATES
;		MEMORY ALLOCATION
;		DISK INTERFACE
;		CONSOLE & PRINTER INTERFACE
;
;
;----------------------------------------------------------
;
;
PROMP80	EQU	0
ISIS	EQU	1
;
;
;	RELEASE & VERSION NUMBERS
;
FIGREL	EQU	1	; FIG RELEASE #
FIGREV	EQU	1	; FIG REVISION #
USRVER	EQU	0	; USER VERSION #
;
;	ASCII CHARACTERS USED
;
ABL	EQU	20H	; SPACE
ACR	EQU	0DH	; CARRIAGE RETURN
ADOT	EQU	02EH	; PERIOD
BELL	EQU	07H	; (^G)
BSIN	EQU	7FH	; INPUT BACKSPACE CHR = RUBOUT
BSOUT	EQU	08H	; OUTPUT BACKSPACE (^H)
DLE	EQU	10H	; (^P)
LF	EQU	0AH	; LINE FEED
FF	EQU	0CH	; FORM FEED (^L)
;
;	MEMORY ALLOCATION
;

IF	(PROMP80)
MEMORY	EQU	0x3000
EM	EQU	0x3C00
ENDIF

IF	(ISIS)
EM	EQU	0F000H	; TOP OF MEMORY + 1 = LIMIT
ENDIF

STARTP	EQU	MEMORY	; START OF PATCH TO RAM
INITDP	EQU	STASKE  ; START OF PROGRAM MEMORY
US	EQU	40H	; USER VARIABLES SPACE
RTS	EQU	0A0H	; RETURN STACK & TERM BUFF SPACE
;
INITR0	EQU	EM-US		; (R0)
INITS0	EQU	INITR0-RTS	; (S0)

IF (ISIS)

;
; CONIO library
;

	EXTRN COPEN
	EXTRN CCLOSE
	EXTRN COUT
	EXTRN CIN
	EXTRN CSTAT

;
; ISIS system calls
;

	EXTRN EXIT

ENDIF

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

	CSEG
IF (PROMP80)
	ORG	0C00H
ENDIF
ORIG:	NOP
	JMP	CLD	; VECTOR TO COLD START
	NOP
	JMP	WRM	; VECTOR TO WARM START
	DB	FIGREL	; FIG RELEASE #
	DB	FIGREV	; FIG REVISION #
	DB	USRVER	; USER VERSION #
	DB	0EH	; IMPLEMENTATION ATTRIBUTES
	DW	STASW   ; TOPMOST WORD IN FORTH VOCABULARY (WAS TASK-7)
	DW	BSIN	; BKSPACE CHARACTER
	DW	INITR0	; INIT (UP)
;<<<<<< FOLLOWING USED BY COLD;
;	MUST BE IN SAME ORDER AS USER VARIABLES
	DW	INITS0	; INIT (S0)
	DW	INITR0	; INIT (R0)
	DW	INITS0	; INIT (TIB)
	DW	20H		; INIT (WIDTH)
	DW	0		; INIT (WARNING)
	DW	INITDP		; INIT (FENCE)
	DW	INITDP		; INIT (DP)
	DW	SFVOC		; INIT (VOC-LINK) (WAS FORTH+6)
;<<<<<< END DATA USED BY COLD
	DW	5H,0B320H	; CPU NAME	( HW,LW )
;				  ( 32 BIT, BASE 36 INTEGER )
;
;
;			+---------------+
;	B +ORIGIN	| . . .W:I.E.B.A|	IMPLEMENTATION
;			+---------------+	ATTRIBUTES
;			       ^ ^ ^ ^ ^
;			       | | | | +-- PROCESSOR ADDR =
;			       | | | |     { 0 BYTE | 1 WORD }
;			       | | | +---- HIGH BYTE AT
;			       | | |       { 0 LOW ADDR |
;			       | | |	     1 HIGH ADDR }
;			       | | +------ ADDR MUST BE EVEN
;			       | |	   { 0 YES | 1 NO }
;			       | +-------- INTERPRETER IS
;			       |	   { 0 PRE | 1 POST }
;			       |	   INCREMENTING
;			       +---------- { 0 ABOVE SUFFICIENT
;					     | 1 OTHER DIFFER-
;					     ENCES EXIST }
;
;
;------------------------------------------------------
;
;	FORTH REGISTERS
;
;	FORTH	8080	FORTH PRESERVATION RULES
;	-----	----	------------------------------------------------------------------------HH+	;	IP	BC	SHOULD BE PRESERVED ACROSS
;			  FORTH WORDS
;	W	DE	SOMETIMES OUTPUT FROM NEXT
;			MAY BE ALTERED BEFORE JMP'ING TO NEXT
;			INPUT ONLY WHEN 'DPUSH' CALLED
;	SP	SP	SHOULD BE USED ONLY AS DATA STACK
;			  ACROSS FORTH WORDS
;			MAY BE USED WITHIN FORTH WORDS
;			  IF RESTORED BEFORE 'NEXT'
;		HL	NEVER OUTPUT FROM NEXT
;			INPUT ONLY WHEN 'HPUSH' CALLED
;
;UP:	DW	INITR0	; USER AREA POINTER
;RPP:	DW	INITR0	; RETURN STACK POINTER
UP	EQU	SUP	; relocated to startp area in RAM
RPP	EQU	SRPP	; relocated to startp area in RAM
;
;------------------------------------------------------
;
;	COMMENT CONVENTIONS:
;
;	=	MEANS	"IS EQUAL TO"
;	<-	MEANS	ASSIGNMENT
;
;	NAME	=	ADDRESS OF NAME
;	(NAME)	=	CONTENTS AT NAME
;	((NAME))=	INDIRECT CONTENTS
;
;	CFA	=	ADDRESS OF CODE FIELD
;	LFA	=	ADDRESS OF LINK FIELD
;	NFA	=	ADDR OF START OF NAME FIELD
;	PFA	=	ADDR OF START OF PARAMETER FIELD
;
;	S1	=	ADDR OF 1ST WORD OF PARAMETER STACK
;	S2	=	ADDR OF 2ND WORD OF PARAMETER STACK
;	R1	=	ADDR OF 1ST WORD OF RETURN STACK
;	R2	=	ADDR OF 2ND WORD OF RETURN STACK
;	( ABOVE STACK POSITIONS VALID BEFORE & 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 )
;
;
;--------------------------------------------------
;
;	NEXT, THE FORTH ADDRESS INTERPRETER
;	  ( POST INCREMENTING VERSION )
;
DPUSH:	PUSH	D
HPUSH:	PUSH	H
NEXT:	LDAX	B	;(W) <- ((IP))
	INX	B	;(IP) <- (IP)+2
	MOV	L,A
	LDAX	B
	INX	B
	MOV	H,A	; (HL) <- CFA
NEXT1:	MOV	E,M	;(PC) <- ((W))
	INX	H
	MOV	D,M
	XCHG
	PCHL		; NOTE: (DE) = CFA+1
;
;
;		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 CHR
;	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:	DB	83H	; LIT
	DB	'LI'
	DB	'T'+80H
	DW	0	; (LFA)=0 MARKS END OF DICTIONARY
LIT:	DW	$+2	;(S1) <- ((IP))
	LDAX	B	; (HL) <- ((IP)) = LITERAL
	INX	B	; (IP) <- (IP) + 2
	MOV	L,A	; LB
	LDAX	B	; HB
	INX	B
	MOV	H,A
	JMP	HPUSH	; (S1) <- (HL)
 ;
	DB	87H	; EXECUTE
	DB	'EXECUT'
	DB	'E'+80H
	DW	LIT-6
EXEC:	DW	$+2
	POP	H	; (HL) <- (S1) = CFA
	JMP	NEXT1
;
	DB	86H	; BRANCH
	DB	'BRANC'
	DB	'H'+80H
	DW	EXEC-0AH
BRAN:	DW	$+2	;(IP) <- (IP) + ((IP))
BRAN1:	MOV	H,B	; (HL) <- (IP)
	MOV	L,C
	MOV	E,M	; (DE) <- ((IP)) = BRANCH OFFSET
	INX	H
	MOV	D,M
	DCX	H
	DAD	D	; (HL) <- (HL) + ((IP))
	MOV	C,L	; (IP) <- (HL)
	MOV	B,H
	JMP	NEXT
;
	DB	87H	; 0BRANCH
	DB	'0BRANC'
	DB	'H'+80H
	DW	BRAN-9
ZBRAN:	DW	$+2
	POP	H
	MOV	A,L
	ORA	H
	JZ	BRAN1	; IF (S1)=0 THEN BRANCH
	INX	B	; ELSE SKIP BRANCH OFFSET
	INX	B
	JMP	NEXT
;
	DB	86H	; (LOOP)
	DB	'(LOOP'
	DB	')'+80H
	DW	ZBRAN-0AH
XLOOP:	DW	$+2
	LXI	D,1	; (DE) <- INCREMENT
XLOO1:	LHLD	RPP	; ((HL)) = INDEX
	MOV	A,M	; INDEX <- INDEX + INCR
	ADD	E
	MOV	M,A
	MOV	E,A
	INX	H
	MOV	A,M
	ADC	D
	MOV	M,A
	INX	H	; ((HL)) = LIMIT
	INR	D
	DCR	D
	MOV	D,A	; (DE) <- NEW INDEX
	JM	XLOO2	; IF INCR > 0
	MOV	A,E
	SUB	M	; THEN (A) <- INDEX - LIMIT
	MOV	A,D
	INX	H
	SBB	M
	JMP	XLOO3
XLOO2:	MOV	A,M	; ELSE (A) <- LIMIT - INDEX
	SUB	E
	INX	H
	MOV	A,M
	SBB	D
;			; IF (A) < 0
XLOO3:	JM	BRAN1	; THEN LOOP AGAIN
	INX	H	; ELSE DONE
	SHLD	RPP	; DISCARD R1 & R2
	INX	B	; SKIP BRANCH OFFSET
	INX	B
	JMP	NEXT
;
	DB	87H	; (+LOOP)
	DB	'(+LOOP'
	DB	')'+80H
	DW	XLOOP-9
XPLOO:	DW	$+2
	POP	D	; (DE) <- INCR
	JMP	XLOO1
;
	DB	84H	; (DO)
	DB	'(DO'
	DB	')'+80H
	DW	XPLOO-0AH
XDO:	DW	$+2
	LHLD	RPP	; (RP) <- (RP) - 4
	DCX	H
	DCX	H
	DCX	H
	DCX	H
	SHLD	RPP
	POP	D	; (R1) <- (S1) = INIT INDEX
	MOV	M,E
	INX	H
	MOV	M,D
	POP	D	; (R2) <- (S2) = LIMIT
	INX	H
	MOV	M,E
	INX	H
	MOV	M,D
	JMP	NEXT
;
	DB	81H	; I
	DB	'I'+80H
	DW	XDO-7
IDO:	DW	$+2	;(S1) <- (R1) , (R1) UNCHANGED
	LHLD	RPP
	MOV	E,M	; (DE) <- (R1)
	INX	H
	MOV	D,M
	PUSH	D	; (S1) <- (DE)
	JMP	NEXT
;
	DB	85H	; DIGIT
	DB	'DIGI'
	DB	'T'+80H
	DW	IDO-4
DIGIT:	DW	$+2
	POP	H	; (L) <- (S1)LB = ASCII CHR TO BE
;			 CONVERTED
	POP	D	; (DE) <- (S2) = BASE VALUE
	MOV	A,E
	SUI	30H	; IF CHR > "0"
	JM	DIGI2
	CPI	0AH	; AND IF CHR > "9"
	JM	DIGI1
	SUI	7
	CPI	0AH	; AND IF CHR >= "A"
	JM	DIGI2
;			; THEN VALID NUMERIC OR ALPHA CHR
DIGI1:	CMP	L	; IF < BASE VALUE
	JP	DIGI2
;			; THEN VALID DIGIT CHR
	MOV	E,A	; (S2) <- (DE) = CONVERTED DIGIT
	LXI	H,1	; (S1) <- TRUE
	JMP	DPUSH
;			; ELSE INVALID DIGIT CHR
DIGI2:	MOV	L,H	; (HL) <- FALSE
	JMP	HPUSH	; (S1) <- FALSE
;
	DB	86H	; (FIND)  (2-1)FAILURE
	DB	'(FIND'	; (2-3)SUCCESS
	DB	')'+80H
	DW	DIGIT-8
PFIND:	DW	$+2
	POP	D	; (DE) <- NFA
PFIN1:	POP	H	; (HL) <- STRING ADDR
	PUSH	H	; SAVE STRING ADDR FOR NEXT ITERATION
	LDAX	D
	XRA	M	; CHECK LENGTHS & SMUDGE BIT
	ANI	3FH
	JNZ	PFIN4	; LENGTHS DIFFERENT
;			; LENGTHS MATCH, CHECK EACH CHR
PFIN2:	INX	H	; (HL) <- ADDR NEXT CHR IN STRING
	INX	D	; (DE) <- ADDR NEXT CHR IN NF
	LDAX	D
	XRA	M	; IGNORE MSB
	ADD	A
	JNZ	PFIN3	; NO MATCH
	JNC	PFIN2	; MATCH SO FAR, LOOP AGAIN

	LXI	H,5	; STRING MATCHES
	DAD	D	; ((SP)) <- PFA
	XTHL
;			; BACK UP TO LENGTH BYTE OF NF = NFA
PFIN6:	DCX	D
	LDAX	D
	ORA	A
	JP	PFIN6	; IF MSB = 1 THEN (DE) = NFA
	MOV	E,A	; (DE) <- LENGTH BYTE
	MVI	D,0
	LXI	H,1	; (HL) <- TRUE
	JMP	DPUSH  ; RETURN, NF FOUND
;	ABOVE NF NOT A MATCH, TRY ANOTHER
PFIN3:	JC	PFIN5	; IF NOT END OF NF
PFIN4:	INX	D	; THEN FIND END OF NF
	LDAX	D
	ORA	A
	JP	PFIN4
PFIN5:	INX	D	; (DE) <- LFA
	XCHG
	MOV	E,M	; (DE) <- (LFA)
	INX	H
	MOV	D,M
	MOV	A,D
	ORA	E	; IF (LFA) <> 0
	JNZ	PFIN1	; THEN TRY PREVIOUS DICT. DEF.
;			; ELSE END OF DICTIONARY
	POP	H	; DISCARD STRING ADDR
	LXI	H,0	; (HL) <- FALSE
	JMP	HPUSH  	; RETURN, NO MATCH FOUND
;
	DB	87H	; ENCLOSE
	DB	'ENCLOS'
	DB	'E'+80H
	DW	PFIND-9
ENCL:	DW	$+2
	POP	D	; (DE) <- (S1) = DELIMITER CHAR
	POP	H	; (HL) <- (S2) = ADDR TEXT TO SCAN
	PUSH	H	; (S4) <- ADDR
	MOV	A,E
	MOV	D,A	; (D) <- DELIM CHR
	MVI	E,-1	; INITIALIZE CHR OFFSET COUNTER
	DCX	H	; (HL) <- ADDR-1
;			; SKIP OVER LEADING DELIMITER CHRS
ENCL1:	INX	H
	INR	E
	CMP	M	; IF TEXT CHR = DELIM CHR
	JZ	ENCL1	; THEN LOOP AGAIN
;			; ELSE NON-DELIM CHR FOUND
	MVI	D,0	; (S3) <- (E) = OFFSET TO 1ST NON-DELIM
	PUSH	D
	MOV	D,A	; (D) <- DELIM CHR
	MOV	A,M	; IF 1ST NON-DELIM = NULL
	ANA	A
	JNZ	ENCL2
	MVI	D,0	; THEN (S2) <- OFFSET TO BYTE
	INR	E	;   FOLLOWING NULL
	PUSH	D
	DCR	E	; (S1) <- OFFSET TO NULL
	PUSH	D
	JMP	NEXT
;			; ELSE TEXT CONTAINS NON-DELIM &
;			  NON-NULL CHR
ENCL2:	MOV	A,D	; (A) <- DELIM CHR
	INX	H	; (HL) <- ADDR NEXT CHR
	INR	E	; (E) <- OFFSET TO NEXT CHR
	CMP	M	; IF NEXT CHR <> DELIM CHR
	JZ	ENCL4
	MOV	A,M	; AND IF NEXT CHR <> NULL
	ANA	A
	JNZ	ENCL2	; THEN CONTINUE SCAN
;			; ELSE CHR = NULL
ENCL3:	MVI	D,0	; (S2) <- OFFSET TO NULL
	PUSH	D
	PUSH	D	; (S1) <- OFFSET TO NULL
	JMP	NEXT
;			; ELSE CHR = DELIM CHR
ENCL4:	MVI	D,0	; (S2) <- OFFSET TO BYTE
;			  FOLLOWING TEXT
	PUSH	D
	INR	E	; (S1) <- OFFSET TO 2 BYTES AFTER
;			    END OF WORD
	PUSH	D
	JMP	NEXT
;
	DB	84H	; EMIT
	DB	'EMI'
	DB	'T'+80H
	DW	ENCL-0AH
EMIT:	DW	DOCOL
	DW	PEMIT
	DW	ONE,OUTT
	DW	PSTOR,SEMIS
;
	DB	83H	; KEY
	DB	'KE'
	DB	'Y'+80H
	DW	EMIT-7
KEY:	DW	$+2
	JMP	PKEY
;
	DB	89H	; ?TERMINAL
	DB	'?TERMINA'
	DB	'L'+80H
	DW	KEY-6
QTERM:	DW	$+2
	LXI	H,0
	JMP	PQTER
;
	DB	82H	; CR
	DB	'C'
	DB	'R'+80H
	DW	QTERM-0CH
CR:	DW	$+2
	JMP	PCR
;
	DB	85H	; CMOVE
	DB	'CMOV'
	DB	'E'+80H
	DW	CR-5
CMOVE:	DW	$+2
	MOV	L,C	; (HL) <- (IP)
	MOV	H,B
	POP	B	; (BC) <- (S1) = #CHRS
	POP	D	; (DE) <- (S2) = DEST ADDR
	XTHL		; (HL) <- (S3) = SOURCE ADDR
;			; (S1) <- (IP)
	JMP	CMOV2	; RETURN IF #CHRS = 0
CMOV1:	MOV	A,M	; ((DE)) <- ((HL))
	INX	H	; INC SOURCE ADDR
	STAX	D
	INX	D	; INC DEST ADDR
	DCX	B	; DEC #CHRS
CMOV2:	MOV	A,B
	ORA	C
	JNZ	CMOV1	; REPEAT IF #CHRS <> 0
	POP	B	; RESTORE (IP) FROM (S1)
	JMP	NEXT
;
	DB	82H	; U*	16X16 UNSIGNED MULTIPLY
	DB	'U'	; AVG EXECUUION TIME = 994 CYCLES
	DB	'*'+80H
	DW	CMOVE-8
USTAR:	DW	$+2
	POP	D	; (DE) <- MPLIER
	POP	H	; (HL) <- MPCAND
	PUSH	B	; SAVE IP
	MOV	B,H
	MOV	A,L	; (BA) <- MPCAND
	CALL	MPYX	; (AHL)1 <- MPCAND.LB * MPLIER
;			       1ST PARTIAL PRODUCT
	PUSH	H	; SAVE (HL)1
	MOV	H,A
	MOV	A,B
	MOV	B,H	; SAVE (A)1
	CALL	MPYX	; (AHL)2 <- MPCAND.HB * MPLIER
;			       2ND PARTIAL PRODUCT
	POP	D	; (DE) <- (HL)1
	MOV	C,D	; (BC) <- (AH)1
;	FORM SUM OF PARTIALS:
;			   (AHL) 1
;			+ (AHL)  2
;			--------
;			  (AHLE)
	DAD	B	; (HL) <- (HL)2 + (AH)1
	ACI	0	; (AHLE) <- (BA) * (DE)
	MOV	D,L
	MOV	L,H
	MOV	H,A	; (HLDE) <- MPLIER * MPCAND
	POP	B	; RESTORE IP
	PUSH	D	; (S2) <- PRODUCT.LW
	JMP	HPUSH	; (S1) <- PRODUCT.HW
;
;	MULTIPLY PRIMITIVE
;		(AHL) <- (A) * (DE)
;	#BITS =	 24	  8	16
MPYX:	LXI	H,0	; (HL) <- 0 = PARTIAL PRODUCT.LW
	MVI	C,8	; LOOP COUNTER
MPYX1:	DAD	H	; LEFT SHIFT (AHL) 24 BITS
	RAL
	JNC	MPYX2	; IF NEXT MPLIER BIT = 1
	DAD	D	; THEN ADD MPCAND
	ACI	0
MPYX2:	DCR	C	; IF NOT LAST MPLIER BIT
	JNZ	MPYX1	; THEN LOOP AGAIN
	RET		; ELSE DONE
;
	DB	82H	; U/
	DB	'U'
	DB	'/'+80H
	DW	USTAR-5
USLAS:	DW	$+2
	LXI	H,4
	DAD	SP	; ((HL)) <- NUMERATOR.LW
	MOV	E,M	; (DE) <- NUMER.LW
	MOV	M,C	; SAVE IP ON STACK
	INX	H
	MOV	D,M
	MOV	M,B
	POP	B	; (BC) <- DENOMINATOR
	POP	H	; (HL) <- NUMER.HW
	MOV	A,L
	SUB	C	; IF NUMER >= DENOM
	MOV	A,H
	SBB	B
	JC	USLA1
	LXI	H,0FFFFH	; THEN OVERFLOW
	LXI	D,0FFFFH	; SET REM & QUOT TO MAX
	JMP	USLA7
USLA1:	MVI	A,16	; LOOP COUNTER
USLA2:	DAD	H	; LEFT SHIFT (HLDE) THRU CARRY
	RAL
	XCHG
	DAD	H
	JNC	USLA3
	INX	D
	ANA	A
USLA3:	XCHG		; SHIFT DONE
	RAR		; RESTORE 1ST CARRY
	PUSH	PSW	; SAVE COUNTER
	JNC	USLA4	; IF CARRY = 1
	MOV	A,L	; THEN (HL) <- (HL) - (BC)
	SUB	C
	MOV	L,A
	MOV	A,H
	SBB	B
	MOV	H,A
	JMP	USLA5
USLA4:	MOV	A,L	; ELSE TRY (HL) <- (HL) - (BC)
	SUB	C
	MOV	L,A
	MOV	A,H
	SBB	B	; (HL) <- PARTIAL REMAINDER
	MOV	H,A
	JNC	USLA5
	DAD	B	; UNDERFLOW, RESTORE
	DCX	D
USLA5:	INX	D	; INC QUOT
USLA6:	POP	PSW	; RESTORE COUNTER
	DCR	A	; IF COUNTER > 0
	JNZ	USLA2	; THEN LOOP AGAIN
USLA7:	POP	B	; ELSE DONE, RESTORE IP
	PUSH	H	; (S2) <- REMAINDER
	PUSH	D	; (S1) <- QUOTIENT
	JMP	NEXT
;
	DB	83H	; AND
	DB	'AN'
	DB	'D'+80H
	DW	USLAS-5
ANDD:	DW	$+2	; (S1) <- (S1) AND (S2)
	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	'V'+80H
	DW	ANDD-6
ORR:	DW	$+2	; (S1) <- (S1) OR (S2)
	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	'R'+80H
	DW	ORR-5
XORR:	DW	$+2	; (S1) <- (S1) XOR (S2)
	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	'@'+80H
	DW	XORR-6
SPAT:	DW	$+2	;(S1) <- (SP)
	LXI	H,0
	DAD	SP	; (HL) <- (SP)
	JMP	HPUSH	; (S1) <- (HL)
;
	DB	83H	; STACK POINTER STORE
	DB	'SP'
	DB	'!'+80H
	DW	SPAT-6
SPSTO:	DW	$+2	;(SP) <- (S0) ( USER VARIABLE )
	LHLD	UP	; (HL) <- USER VAR BASE ADDR
	LXI	D,6
	DAD	D	; (HL) <- S0
	MOV	E,M	; (DE) <- (S0)
	INX	H
	MOV	D,M
	XCHG
	SPHL		; (SP) <- (S0)
	JMP	NEXT
;
	DB	83H	; RP@
	DB	'RP'
	DB	'@'+80H
	DW	SPSTO-6
RPAT:	DW	$+2	;(S1) <- (RP)
	LHLD	RPP
	JMP	HPUSH
;
	DB	83H	; RETURN STACK POINTER STORE
	DB	'RP'
	DB	'!'+80H
	DW	RPAT-6
RPSTO:	DW	$+2	;(RP) <- (R0) ( USER VARIABLE )
	LHLD	UP	; (HL) <- USER VARIABLE BASE ADDR
	LXI	D,8
	DAD	D	; (HL) <- R0
	MOV	E,M	; (DE) <- (R0)
	INX	H
	MOV	D,M
	XCHG
	SHLD	RPP	; (RP) <- (R0)
	JMP	NEXT
;
	DB	82H	; ;S
	DB	';'
	DB	'S'+80H
	DW	RPSTO-6
SEMIS:	DW	$+2	;(IP) <- (R1)
	LHLD	RPP
	MOV	C,M	; (BC) <- (R1)
	INX	H
	MOV	B,M
	INX	H
	SHLD	RPP	; (RP) <- (RP) + 2
	JMP	NEXT
;
	DB	85H	; LEAVE
	DB	'LEAV'
	DB	'E'+80H
	DW	SEMIS-5
LEAVE:	DW	$+2	;LIMIT <- INDEX
	LHLD	RPP
	MOV	E,M	; (DE) <- (R1) = INDEX
	INX	H
	MOV	D,M
	INX	H
	MOV	M,E	; (R2) <- (DE) = LIMIT
	INX	H
	MOV	M,D
	JMP	NEXT
;
	DB	82H	; >R
	DB	'>'
	DB	'R'+80H
	DW	LEAVE-8
TOR:	DW	$+2	;(R1) <- (S1)
	POP	D	; (DE) <- (S1)
	LHLD	RPP
	DCX	H	; (RP) <- (RP) - 2
	DCX	H
	SHLD	RPP
	MOV	M,E	; ((HL)) <- (DE)
	INX	H
	MOV	M,D
	JMP	NEXT
;
	DB	82H	; R>
	DB	'R'
	DB	'>'+80H
	DW	TOR-5
FROMR:	DW	$+2	;(S1) <- (R1)
	LHLD	RPP
	MOV	E,M	; (DE) <- (R1)
	INX	H
	MOV	D,M
	INX	H
	SHLD	RPP	; (RP) <- (RP) + 2
	PUSH	D	; (S1) <- (DE)
	JMP	NEXT
;
	DB	81H	; R
	DB	'R'+80H
	DW	FROMR-5
RR:	DW	IDO+2
;
	DB	82H	; 0=
	DB	'0'
	DB	'='+80H
	DW	RR-4
ZEQU:	DW	$+2
	POP	H	; (HL) <- (S1)
	MOV	A,L
	ORA	H	; IF (HL) = 0
	LXI	H,0	; THEN (HL) <- FALSE
	JNZ	ZEQU1
	INX	H	; ELSE (HL) <- TRUE
ZEQU1:	JMP	HPUSH	; (S1) <- (HL)
;
	DB	82H	; 0<
	DB	'0'
	DB	'<'+80H
	DW	ZEQU-5
ZLESS:	DW	$+2
	POP	H	; (HL) <- (S1)
	DAD	H	; IF (HL) >= 0
	LXI	H,0	; THEN (HL) <- FALSE
	JNC	ZLES1
	INX	H	; ELSE (HL) <- TRUE
ZLES1:	JMP	HPUSH	; (S1) <- (HL)
;
	DB	81H	; +
	DB	'+'+80H
	DW	ZLESS-5
PLUS:	DW	$+2	;(S1) <- (S1) + (S2)
	POP	D
	POP	H
	DAD	D
	JMP	HPUSH
;
	DB	82H	; D+	(4-2)
	DB	'D'	; XLW XHW  YLW YHW  ---  SLW SHW
	DB	'+'+80H	; S4  S3   S2  S1        S2  S1
	DW	PLUS-4
DPLUS:	DW	$+2
	LXI	H,6
	DAD	SP	; ((HL)) = XLW
	MOV	E,M	; (DE) = XLW
	MOV	M,C	; SAVE IP ON STACK
	INX	H
	MOV	D,M
	MOV	M,B
	POP	B	; (BC) <- YHW
	POP	H	; (HL) <- YLW
	DAD	D
	XCHG		; (DE) <- YLW + XLW = SUM.LW
	POP	H	; (HL) <- XHW
	MOV	A,L
	ADC	C
	MOV	L,A	; (HL) <- YHW + XHW + CARRY
	MOV	A,H
	ADC	B
	MOV	H,A
	POP	B	; RESTORE IP
	PUSH	D	; (S2) <- SUM.LW
	JMP	HPUSH	; (S1) <- SUM.HW
;
	DB	85H	; MINUS
	DB	'MINU'
	DB	'S'+80H
	DW	DPLUS-5
MINUS:	DW	$+2	;(S1) <- -(S1)	( 2'S COMPLEMENT )
	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	'S'+80H
	DW	MINUS-8
DMINU:	DW	$+2
	POP	H	; (HL) <- HW
	POP	D	; (DE) <- LW
	SUB	A
	SUB	E	; (DE) <- 0 - (DE)
	MOV	E,A
	MVI	A,0
	SBB	D
	MOV	D,A
	MVI	A,0
	SBB	L	; (HL) <- 0 - (HL)
	MOV	L,A
	MVI	A,0
	SBB	H
	MOV	H,A
	PUSH	D	; (S2) <- LW
	JMP	HPUSH	; (S1) <- HW
;
	DB	84H	; OVER
	DB	'OVE'
	DB	'R'+80H
	DW	DMINU-9
OVER:	DW	$+2
	POP	D
	POP	H
	PUSH	H
	JMP	DPUSH
;
	DB	84H	; DROP
	DB	'DRO'
	DB	'P'+80H
	DW	OVER-7
DROP:	DW	$+2
	POP	H
	JMP	NEXT
;
	DB	84H	; SWAP
	DB	'SWA'
	DB	'P'+80H
	DW	DROP-7
SWAP:	DW	$+2
	POP	H
	XTHL
	JMP	HPUSH
;
	DB	83H	; DUP
	DB	'DU'
	DB	'P'+80H
	DW	SWAP-7
DUP:	DW	$+2
	POP	H
	PUSH	H
	JMP	HPUSH
;
	DB	84H	; 2DUP
	DB	'2DU'
	DB	'P'+80H
	DW	DUP-6
TDUP:	DW	$+2
	POP	H
	POP	D
	PUSH	D
	PUSH	H
	JMP	DPUSH
;
	DB	82H	; PLUS STORE
	DB	'+'
	DB	'!'+80H
	DW	TDUP-7
PSTOR:	DW	$+2	;((S1)) <- ((S1)) + (S2)
	POP	H	; (HL) <- (S1) = ADDR
	POP	D	; (DE) <- (S2) = INCR
	MOV	A,M	; ((HL)) <- ((HL)) + (DE)
	ADD	E
	MOV	M,A
	INX	H
	MOV	A,M
	ADC	D
	MOV	M,A
	JMP	NEXT
;
	DB	86H	; TOGGLE
	DB	'TOGGL'
	DB	'E'+80H
	DW	PSTOR-5
TOGGL:	DW	$+2	;((S2)) <- ((S2)) XOR (S1)LB
	POP	D	; (E) <- BYTE MASK
	POP	H	; (HL) <- ADDR
	MOV	A,M
	XRA	E
	MOV	M,A	; (ADDR) <- (ADDR) XOR (E)
	JMP	NEXT
;
	DB	81H	; @
	DB	'@'+80H
	DW	TOGGL-9
AT:	DW	$+2	;(S1) <- ((S1))
	POP	H	; (HL) <- ADDR
	MOV	E,M	; (DE) <- (ADDR)
	INX	H
	MOV	D,M
	PUSH	D	; (S1) <- (DE)
	JMP	NEXT
;
	DB	82H	; C@
	DB	'C'
	DB	'@'+80H
	DW	AT-4
CAT:	DW	$+2	;(S1) <- ((S1))LB
	POP	H	; (HL) <- ADDR
	MOV	L,M	; (HL) <- (ADDR)LB
	MVI	H,0
	JMP	HPUSH
;
	DB	82H	; 2@
	DB	'2'
	DB	'@'+80H
	DW	CAT-5
TAT:	DW	$+2
	POP	H	; (HL) <- ADDR HW
	LXI	D,2
	DAD	D	; (HL) <- ADDR LW
	MOV	E,M	; (DE) <- LW
	INX	H
	MOV	D,M
	PUSH	D	; (S2) <- LW
	LXI	D,-3	; (HL) <- ADDR HW
	DAD	D
	MOV	E,M	; (DE) <- HW
	INX	H
	MOV	D,M
	PUSH	D	; (S1) <- HW
	JMP	NEXT
;
	DB	81H	; STORE
	DB	'!'+80H
	DW	TAT-5
STORE:	DW	$+2	;((S1)) <- (S2)
	POP	H	; (HL) <- (S1) = ADDR
	POP	D	; (DE) <- (S2) = VALUE
	MOV	M,E	; ((HL)) <- (DE)
	INX	H
	MOV	M,D
	JMP	NEXT
;
	DB	82H	; C STORE
	DB	'C'
	DB	'!'+80H
	DW	STORE-4
CSTOR:	DW	$+2	;((S1))LB <- (S2)LB
	POP	H	; (HL) <- (S1) = ADDR
	POP	D	; (DE) <- (S2) = BYTE
	MOV	M,E	; ((HL))LB <- (E)
	JMP	NEXT
;
	DB	82H	; 2 STORE
	DB	'2'
	DB	'!'+80H
	DW	CSTOR-5
TSTOR:	DW	$+2
	POP	H	; (HL) <- ADDR
	POP	D	; (DE) <- HW
	MOV	M,E	; (ADDR) <- HW
	INX	H
	MOV	M,D
	INX	H	; (HL) <- ADDR LW
	POP	D	; (DE) <- LW
	MOV	M,E	; (ADDR+2) <- LW
	INX	H
	MOV	M,D
	JMP	NEXT
;
	DB	0C1H	; :
	DB	':'+80H
	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	; (R1) <- (IP)
	MOV	M,B
	DCX	H	; (RP) <- (RP) - 2
	MOV	M,C
	SHLD	RPP
	INX	D	; (DE) <- CFA+2 = (W)
	MOV	C,E	; (IP) <- (DE) = (W)
	MOV	B,D
	JMP	NEXT
;
	DB	0C1H	; ;
	DB	';'+80H
	DW	COLON-4
SEMI:	DW	DOCOL
	DW	QCSP
	DW	COMP
	DW	SEMIS
	DW	SMUDG
	DW	LBRAC
	DW	SEMIS
;
	DB	84H	; NOOP
	DB	'NOO'
	DB	'P'+80H
	DW	SEMI-4
NOOP:	DW	DOCOL
	DW	SEMIS
 ;
	DB	88H	; CONSTANT
	DB	'CONSTAN'
	DB	'T'+80H
	DW	NOOP-7
CON:	DW	DOCOL
	DW	CREAT
	DW	SMUDG
	DW	COMMA
	DW	PSCOD
DOCON:	INX	D	; (DE) <- PFA
	XCHG
	MOV	E,M	; (DE) <- (PFA)
	INX	H
	MOV	D,M
	PUSH	D	; (S1) <- (PFA)
	JMP	NEXT
;
	DB	88H	; VARIABLE
	DB	'VARIABL'
	DB	'E'+80H
	DW	CON-0BH
VAR:	DW	DOCOL
	DW	CON
	DW	PSCOD
DOVAR:	INX	D	; (DE) <- PFA
	PUSH	D	; (S1) <- PFA
	JMP	NEXT
;
	DB	84H	; USER
	DB	'USE'
	DB	'R'+80H
	DW	VAR-0BH
USER:	DW	DOCOL
	DW	CON
	DW	PSCOD
DOUSE:	INX	D	; (DE) <- PFA
	XCHG
	MOV	E,M	; (DE) <- USER VARIABLE OFFSET
	MVI	D,0
	LHLD	UP	; (HL) <- USER VARIABLE BASE ADDR
	DAD	D	; (HL) <- (HL) + (DE)
	JMP	HPUSH	; (S1) <- BASE + OFFSET
;
	DB	81H	; 0
	DB	'0'+80H
	DW	USER-7
ZERO:	DW	DOCON
	DW	0
;
	DB	81H	; 1
	DB	'1'+80H
	DW	ZERO-4
ONE:	DW	DOCON
	DW	1
;
	DB	81H	; 2
	DB	'2'+80H
	DW	ONE-4
TWO:	DW	DOCON
	DW	2
;
	DB	81H	; 3
	DB	'3'+80H
	DW	TWO-4
THREE:	DW	DOCON
	DW	3
;
	DB	82H	; BL
	DB	'B'
	DB	'L'+80H
	DW	THREE-4
BL:	DW	DOCON
	DW	20H
;
	DB	83H	; C/L ( CHARACTERS/LINE )
	DB	'C/'
	DB	'L'+80H
	DW	BL-5
CSLL:	DW	DOCON
	DW	64
;
	DB	85H	; LIMIT
	DB	'LIMI'
	DB	'T'+80H
	DW	CSLL-6
LIMIT:	DW	DOCON
	DW	EM
;
	DB	87H	; +ORIGIN
	DB	'+ORIGI'
	DB	'N'+80H
	DW	LIMIT-8
PORIG:	DW	DOCOL
	DW	LIT
	DW	ORIG
	DW	PLUS
	DW	SEMIS
;
;	USER VARIABLES
;
	DB	82H	; S0
	DB	'S'
	DB	'0'+80H
	DW	PORIG-0AH
SZERO:	DW	DOUSE
	DW	6
;
	DB	82H	; R0
	DB	'R'
	DB	'0'+80H
	DW	SZERO-5
RZERO:	DW	DOUSE
	DW	8
;
	DB	83H	; TIB
	DB	'TI'
	DB	'B'+80H
	DW	RZERO-5
TIB:	DW	DOUSE
	DB	0AH
;
	DB	85H	; WIDTH
	DB	'WIDT'
	DB	'H'+80H
	DW	TIB-6
WIDTH:	DW	DOUSE
	DB	0CH
;
	DB	87H	; WARNING
	DB	'WARNIN'
	DB	'G'+80H
	DW	WIDTH-8
WARN:	DW	DOUSE
	DB	0EH
;
	DB	85H	; FENCE
	DB	'FENC'
	DB	'E'+80H
	DW	WARN-0AH
FENCE:	DW	DOUSE
	DB	10H
;
	DB	82H	; DP
	DB	'D'
	DB	'P'+80H
	DW	FENCE-8
DP:	DW	DOUSE
	DB	12H
;
	DB	88H	; VOC-LINK
	DB	'VOC-LIN'
	DB	'K'+80H
	DW	DP-5
VOCL:	DW	DOUSE
	DW	14H
;
	DB	82H	; IN
	DB	'I'
	DB	'N'+80H
	DW	VOCL-0BH
INN:	DW	DOUSE
	DB	18H
;
	DB	83H	; OUT
	DB	'OU'
	DB	'T'+80H
	DW	INN-5
OUTT:	DW	DOUSE
	DB	1AH
;
	DB	87H	; CONTEXT
	DB	'CONTEX'
	DB	'T'+80H
	DW	OUTT-6
CONT:	DW	DOUSE
	DB	20H
;
	DB	87H	; CURRENT
	DB	'CURREN'
	DB	'T'+80H
	DW	CONT-0AH
CURR:	DW	DOUSE
	DB	22H
;
	DB	85H	; STATE
	DB	'STAT'
	DB	'E'+80H
	DW	CURR-0AH
STATE:	DW	DOUSE
	DB	24H
;
	DB	84H	; BASE
	DB	'BAS'
	DB	'E'+80H
	DW	STATE-8
BASE:	DW	DOUSE
	DB	26H
;
	DB	83H	; DPL
	DB	'DP'
	DB	'L'+80H
	DW	BASE-7
DPL:	DW	DOUSE
	DB	28H
;
	DB	83H	; FLD
	DB	'FL'
	DB	'D'+80H
	DW	DPL-6
FLD:	DW	DOUSE
	DB	2AH
;
	DB	83H	; CSP
	DB	'CS'
	DB	'P'+80H
	DW	FLD-6
CSPP:	DW	DOUSE
	DB	2CH
;
	DB	82H	; R#
	DB	'R'
	DB	'#'+80H
	DW	CSPP-6
RNUM:	DW	DOUSE
	DB	2EH
;
	DB	83H	; HLD
	DB	'HL'
	DB	'D'+80H
	DW	RNUM-5
HLD:	DW	DOUSE
	DW	30H
;
;	END OF USER VARIABLES
;
	DB	82H	; 1+
	DB	'1'
	DB	'+'+80H
	DW	HLD-6
ONEP:	DW	DOCOL
	DW	ONE
	DW	PLUS
	DW	SEMIS
;
	DB	82H	; 2+
	DB	'2'
	DB	'+'+80H
	DW	ONEP-5
TWOP:	DW	DOCOL
	DW	TWO
	DW	PLUS
	DW	SEMIS
;
	DB	84H	; HERE
	DB	'HER'
	DB	'E'+80H
	DW	TWOP-5
HERE:	DW	DOCOL
	DW	DP
	DW	AT
	DW	SEMIS
;
	DB	85H	; ALLOT
	DB	'ALLO'
	DB	'T'+80H
	DW	HERE-7
ALLOT:	DW	DOCOL
	DW	DP
	DW	PSTOR
	DW	SEMIS
;
	DB	81H	; ,
	DB	','+80H
	DW	ALLOT-8
COMMA:	DW	DOCOL
	DW	HERE
	DW	STORE
	DW	TWO
	DW	ALLOT
	DW	SEMIS
;
	DB	82H	; C,
	DB	'C'
	DB	','+80H
	DW	COMMA-4
CCOMM:	DW	DOCOL
	DW	HERE
	DW	CSTOR
	DW	ONE
	DW	ALLOT
	DW	SEMIS
;
;	SUBROUTINE USED BY - AND <
;			; (HL) <- (HL) - (DE)
SSUB:	MOV	A,L	; LB
	SUB	E
	MOV	L,A
	MOV	A,H	; HB
	SBB	D
	MOV	H,A
	RET
;
	DB	81H	; -
	DB	'-'+80H
	DW	CCOMM-5
SUBB:	DW	$+2
	POP	D	; (DE) <- (S1) = Y
	POP	H	; (HL) <- (S2) = X
	CALL	SSUB
	JMP	HPUSH	; (S1) <- X - Y
;
	DB	81H	; =
	DB	'='+80H
	DW	SUBB-4
EQUAL:	DW	DOCOL
	DW	SUBB
	DW	ZEQU
	DW	SEMIS
;
	DB	81H	; <
	DB	'<'+80H		; X  <  Y
	DW	EQUAL-4		; S2    S1
LESS:	DW	$+2
	POP	D	; (DE) <- (S1) = Y
	POP	H	; (HL) <- (S2) = X
	MOV	A,D	; IF X & Y HAVE SAME SIGNS
	XRA	H
	JM	LES1
	CALL	SSUB	; (HL) <- X - Y
LES1:	INR	H	; IF (HL) >= 0
	DCR	H
	JM	LES2
	LXI	H,0	; THEN X >= Y
	JMP	HPUSH	; (S1) <- FALSE
LES2:	LXI	H,1	; ELSE X < Y
	JMP	HPUSH	; (S1) <- TRUE
;
	DB	82H	; U< ( UNSIGNED < )
	DB	'U'
	DB	'<'+80H
	DW	LESS-4
ULESS:	DW	DOCOL,TDUP
	DW	XORR,ZLESS
	DW	ZBRAN
	DW	ULES1-$	; IF
	DW	DROP,ZLESS
	DW	ZEQU
	DW	BRAN
	DW	ULES2-$
ULES1:	DW	SUBB,ZLESS	; ELSE
ULES2:	DW	SEMIS		; ENDIF
;
	DB	81H	; >
	DB	'>'+80H
	DW	ULESS-5
GREAT:	DW	DOCOL
	DW	SWAP
	DW	LESS
	DW	SEMIS
;
	DB	83H	; ROT
	DB	'RO'
	DB	'T'+80H
	DW	GREAT-4
ROT:	DW	$+2
	POP	D
	POP	H
	XTHL
	JMP	DPUSH
;
	DB	85H	; SPACE
	DB	'SPAC'
	DB	'E'+80H
	DW	ROT-6
SPACE:	DW	DOCOL
	DW	BL
	DW	EMIT
	DW	SEMIS
;
	DB	84H	; -DUP
	DB	'-DU'
	DB	'P'+80H
	DW	SPACE-8
DDUP:	DW	DOCOL
	DW	DUP
	DW	ZBRAN	; IF
	DW	DDUP1-$
	DW	DUP	; ENDIF
DDUP1:	DW	SEMIS
;
	DB	88H	; TRAVERSE
	DB	'TRAVERS'
	DB	'E'+80H
	DW	DDUP-7
TRAV:	DW	DOCOL
	DW	SWAP
TRAV1:	DW	OVER	; BEGIN
	DW	PLUS
	DW	LIT
	DW	7FH
	DW	OVER
	DW	CAT
	DW	LESS
	DW	ZBRAN	; UNTIL
	DW	TRAV1-$
	DW	SWAP
	DW	DROP
	DW	SEMIS
;
	DB	86H	; LATEST
	DB	'LATES'
	DB	'T'+80H
	DW	TRAV-0BH
LATES:	DW	DOCOL
	DW	CURR
	DW	AT
	DW	AT
	DW	SEMIS
;
	DB	83H	; LFA
	DB	'LF'
	DB	'A'+80H
	DW	LATES-9
LFA:	DW	DOCOL
	DW	LIT
	DW	4
	DW	SUBB
	DW	SEMIS
;
	DB	83H	; CFA
	DB	'CF'
	DB	'A'+80H
	DW	LFA-6
CFA:	DW	DOCOL
	DW	TWO
	DW	SUBB
	DW	SEMIS
;
	DB	83H	; NFA
	DB	'NF'
	DB	'A'+80H
	DW	CFA-6
NFA:	DW	DOCOL
	DW	LIT
	DW	5
	DW	SUBB
	DW	LIT
	DW	-1
	DW	TRAV
	DW	SEMIS
;
	DB	83H	; PFA
	DB	'PF'
	DB	'A'+80H
	DW	NFA-6
PFA:	DW	DOCOL
	DW	ONE
	DW	TRAV
	DW	LIT
	DW	5
	DW	PLUS
	DW	SEMIS
;
	DB	84H	; STORE CSP
	DB	'!CS'
	DB	'P'+80H
	DW	PFA-6
SCSP:	DW	DOCOL
	DW	SPAT
	DW	CSPP
	DW	STORE
	DW	SEMIS
;
	DB	86H	; ?ERROR
	DB	'?ERRO'
	DB	'R'+80H
	DW	SCSP-7
QERR:	DW	DOCOL
	DW	SWAP
	DW	ZBRAN	; IF
	DW	QERR1-$
	DW	ERROR
	DW	BRAN	; ELSE
	DW	QERR2-$
QERR1:	DW	DROP	; ENDIF
QERR2:	DW	SEMIS
;
	DB	85H	; ?COMP
	DB	'?COM'
	DB	'P'+80H
	DW	QERR-9
QCOMP:	DW	DOCOL
	DW	STATE
	DW	AT
	DW	ZEQU
	DW	LIT
	DW	11H
	DW	QERR
	DW	SEMIS
;
	DB	85H	; ?EXEC
	DB	'?EXE'
	DB	'C'+80H
	DW	QCOMP-8
QEXEC:	DW	DOCOL
	DW	STATE
	DW	AT
	DW	LIT
	DW	12H
	DW	QERR
	DW	SEMIS
;
	DB	86H	; ?PAIRS
	DB	'?PAIR'
	DB	'S'+80H
	DW	QEXEC-8
QPAIR:	DW	DOCOL
	DW	SUBB
	DW	LIT
	DW	13H
	DW	QERR
	DW	SEMIS
;
	DB	84H	; ?CSP
	DB	'?CS'
	DB	'P'+80H
	DW	QPAIR-9
QCSP:	DW	DOCOL
	DW	SPAT
	DW	CSPP
	DW	AT
	DW	SUBB
	DW	LIT
	DW	14H
	DW	QERR
	DW	SEMIS
;
	DB	87H	; COMPILE
	DB	'COMPIL'
	DB	'E'+80H
	DW	QCSP-7
COMP:	DW	DOCOL
	DW	QCOMP
	DW	FROMR
	DW	DUP
	DW	TWOP
	DW	TOR
	DW	AT
	DW	COMMA
	DW	SEMIS
;
	DB	0C1H	; [
	DB	'['+80H
	DW	COMP-0AH
LBRAC:	DW	DOCOL
	DW	ZERO
	DW	STATE
	DW	STORE
	DW	SEMIS
;
	DB	81H	; ]
	DB	']'+80H
	DW	LBRAC-4
RBRAC:	DW	DOCOL
	DW	LIT,0C0H
	DW	STATE,STORE
	DW	SEMIS
;
	DB	86H	; SMUDGE
	DB	'SMUDG'
	DB	'E'+80H
	DW	RBRAC-4
SMUDG:	DW	DOCOL
	DW	LATES
	DW	LIT
	DW	20H
	DW	TOGGL
	DW	SEMIS
;
	DB	83H	; HEX
	DB	'HE'
	DB	'X'+80H
	DW	SMUDG-9
HEX:	DW	DOCOL
	DW	LIT
	DW	10H
	DW	BASE
	DW	STORE
	DW	SEMIS
;
	DB	87H	; DECIMAL
	DB	'DECIMA'
	DB	'L'+80H
	DW	HEX-6
DEC:	DW	DOCOL
	DW	LIT
	DW	0AH
	DW	BASE
	DW	STORE
	DW	SEMIS
;
	DB	87H	; (;CODE)
	DB	'(;CODE'
	DB	')'+80H
	DW	DEC-0AH
PSCOD:	DW	DOCOL
	DW	FROMR
	DW	LATES
	DW	PFA
	DW	CFA
	DW	STORE
	DW	SEMIS
;
	DB	0C5H	; ;CODE
	DB	';COD'
	DB	'E'+80H
	DW	PSCOD-0AH
SEMIC:	DW	DOCOL
	DW	QCSP
	DW	COMP
	DW	PSCOD
	DW	LBRAC
SEMI1:	DW	NOOP	; ( ASSEMBLER )
	DW	SEMIS
;
	DB	87H	; <BUILDS
	DB	'<BUILD'
	DB	'S'+80H
	DW	SEMIC-8
BUILD:	DW	DOCOL
	DW	ZERO
	DW	CON
	DW	SEMIS
;
	DB	85H	; DOES>
	DB	'DOES'
	DB	'>'+80H
	DW	BUILD-0AH
DOES:	DW	DOCOL
	DW	FROMR
	DW	LATES
	DW	PFA
	DW	STORE
	DW	PSCOD
DODOE:	LHLD	RPP	; (HL) <- (RP)
	DCX	H
	MOV	M,B	; (R1) <- (IP) = PFA = (SUBSTITUTE CFA)
	DCX	H
	MOV	M,C
	SHLD	RPP	; (RP) <- (RP) - 2
	INX	D	; (DE) <- PFA = (SUBSTITUTE CFA)
	XCHG
	MOV	C,M	; (IP) <- (SUBSTITUTE CFA)
	INX	H
	MOV	B,M
	INX	H
	JMP	HPUSH	; (S1) <- PFA+2 = SUBSTITUTE PFA
;
	DB	85H	; COUNT
	DB	'COUN'
	DB	'T'+80H
	DW	DOES-8
COUNT:	DW	DOCOL
	DW	DUP
	DW	ONEP
	DW	SWAP
	DW	CAT
	DW	SEMIS
;
	DB	84H	; TYPE
	DB	'TYP'
	DB	'E'+80H
	DW	COUNT-8
TYPE:	DW	DOCOL
	DW	DDUP
	DW	ZBRAN	; IF
	DW	TYPE1-$
	DW	OVER
	DW	PLUS
	DW	SWAP
	DW	XDO	; DO
TYPE2:	DW	IDO
	DW	CAT
	DW	EMIT
	DW	XLOOP	; LOOP
	DW	TYPE2-$
	DW	BRAN	; ELSE
	DW	TYPE3-$
TYPE1:	DW	DROP	; ENDIF
TYPE3:	DW	SEMIS
;
	DB	84H	; (.")
	DB	'(."'
	DB	')'+80H
	DW	TYPE-7
PDOTQ:	DW	DOCOL
	DW	RR
	DW	COUNT
	DW	DUP
	DW	ONEP
	DW	FROMR
	DW	PLUS
	DW	TOR
	DW	TYPE
	DW	SEMIS
;
	DB	0C2H	; ."
	DB	'.'
	DB	'"'+80H
	DW	PDOTQ-7
DOTQ:	DW	DOCOL
	DW	LIT
	DW	22H
	DW	STATE
	DW	AT
	DW	ZBRAN	; IF
	DW	DOTQ1-$
	DW	COMP
	DW	PDOTQ
	DW	WORD
	DW	HERE
	DW	CAT
	DW	ONEP
	DW	ALLOT
	DW	BRAN	; ELSE
	DW	DOTQ2-$
DOTQ1:	DW	WORD
	DW	HERE
	DW	COUNT
	DW	TYPE	; ENDIF
DOTQ2:	DW	SEMIS
;
	DB	86H	; EXPECT
	DB	'EXPEC'
	DB	'T'+80H
	DW	DOTQ-5
EXPEC:	DW	DOCOL
	DW	OVER
	DW	PLUS
	DW	OVER
	DW	XDO	; DO
EXPE1:	DW	KEY
	DW	DUP
	DW	LIT
	DW	0EH
	DW	PORIG
	DW	AT
	DW	EQUAL
	DW	ZBRAN	; IF
	DW	EXPE2-$
	DW	DROP
	DW	DUP
	DW	IDO
	DW	EQUAL
	DW	DUP
	DW	FROMR
	DW	TWO
	DW	SUBB
	DW	PLUS
	DW	TOR
	DW	ZBRAN	; IF
	DW	EXPE6-$
	DW	LIT
	DW	BELL
	DW	BRAN	; ELSE
	DW	EXPE7-$
EXPE6:	DW	LIT
	DW	BSOUT	; ENDIF
EXPE7:	DW	BRAN	; ELSE
	DW	EXPE3-$
EXPE2:	DW	DUP
	DW	LIT
	DW	0DH
	DW	EQUAL
	DW	ZBRAN	; IF
	DW	EXPE4-$
	DW	LEAVE
	DW	DROP
	DW	BL
	DW	ZERO
	DW	BRAN	; ELSE
	DW	EXPE5-$
EXPE4:	DW	DUP	; ENDIF
EXPE5:	DW	IDO
	DW	CSTOR
	DW	ZERO
	DW	IDO
	DW	ONEP
	DW	STORE	; ENDIF
EXPE3:	DW	EMIT
	DW	XLOOP	; LOOP
	DW	EXPE1-$
	DW	DROP
	DW	SEMIS
;
	DB	85H	; QUERY
	DB	'QUER'
	DB	'Y'+80H
	DW	EXPEC-9
QUERY:	DW	DOCOL
	DW	TIB
	DW	AT
	DW	LIT
	DW	50H
	DW	EXPEC
	DW	ZERO
	DW	INN
	DW	STORE
	DW	SEMIS
;
	DB	0C1H	; 0 (NULL)
	DB	80H
	DW	QUERY-8
NULL:	DW	DOCOL
NULL1:	DW	FROMR
	DW	DROP
NULL3:	DW	SEMIS
;
	DB	84H	; FILL
	DB	'FIL'
	DB	'L'+80H
	DW	NULL-4
FILL:	DW	$+2
	MOV	L,C
	MOV	H,B
	POP	D
	POP	B
	XTHL
	XCHG
FILL1:	MOV	A,B	; BEGIN
	ORA	C
	JZ	FILL2	; WHILE
	MOV	A,L
	STAX	D
	INX	D
	DCX	B
	JMP	FILL1	; REPEAT
FILL2:	POP	B
	JMP	NEXT
;
	DB	85H	; ERASE
	DB	'ERAS'
	DB	'E'+80H
	DW	FILL-7
ERASEE:	DW	DOCOL
	DW	ZERO
	DW	FILL
	DW	SEMIS
;
	DB	86H	; BLANKS
	DB	'BLANK'
	DB	'S'+80H
	DW	ERASEE-8
BLANK:	DW	DOCOL
	DW	BL
	DW	FILL
	DW	SEMIS
;
	DB	84H	; HOLD
	DB	'HOL'
	DB	'D'+80H
	DW	BLANK-9
HOLD:	DW	DOCOL
	DW	LIT
	DW	-1
	DW	HLD
	DW	PSTOR
	DW	HLD
	DW	AT
	DW	CSTOR
	DW	SEMIS
;
	DB	83H	; PAD
	DB	'PA'
	DB	'D'+80H
	DW	HOLD-7
PAD:	DW	DOCOL
	DW	HERE
	DW	LIT
	DW	44H
	DW	PLUS
	DW	SEMIS
;
	DB	84H	; WORD
	DB	'WOR'
	DB	'D'+80H
	DW	PAD-6
WORD:	DW	DOCOL
WORD1:	DW	TIB
	DW	AT
WORD2:	DW	INN
	DW	AT
	DW	PLUS
	DW	SWAP
	DW	ENCL
	DW	HERE
	DW	LIT
	DW	22H
	DW	BLANK
	DW	INN
	DW	PSTOR
	DW	OVER
	DW	SUBB
	DW	TOR
	DW	RR
	DW	HERE
	DW	CSTOR
	DW	PLUS
	DW	HERE
	DW	ONEP
	DW	FROMR
	DW	CMOVE
	DW	SEMIS
;
	DB	88H	; (NUMBER)
	DB	'(NUMBER'
	DB	')'+80H
	DW	WORD-7
PNUMB:	DW	DOCOL
PNUM1:	DW	ONEP	; BEGIN
	DW	DUP
	DW	TOR
	DW	CAT
	DW	BASE
	DW	AT
	DW	DIGIT
	DW	ZBRAN	; WHILE
	DW	PNUM2-$
	DW	SWAP
	DW	BASE
	DW	AT
	DW	USTAR
	DW	DROP
	DW	ROT
	DW	BASE
	DW	AT
	DW	USTAR
	DW	DPLUS
	DW	DPL
	DW	AT
	DW	ONEP
	DW	ZBRAN	; IF
	DW	PNUM3-$
	DW	ONE
	DW	DPL
	DW	PSTOR	; ENDIF
PNUM3:	DW	FROMR
	DW	BRAN	; REPEAT
	DW	PNUM1-$
PNUM2:	DW	FROMR
	DW	SEMIS
;
	DB	86H	; NUMBER
	DB	'NUMBE'
	DB	'R'+80H
	DW	PNUMB-0BH
NUMB:	DW	DOCOL
	DW	ZERO
	DW	ZERO
	DW	ROT
	DW	DUP
	DW	ONEP
	DW	CAT
	DW	LIT
	DW	2DH
	DW	EQUAL
	DW	DUP
	DW	TOR
	DW	PLUS
	DW	LIT
	DW	-1
NUMB1:	DW	DPL	; BEGIN
	DW	STORE
	DW	PNUMB
	DW	DUP
	DW	CAT
	DW	BL
	DW	SUBB
	DW	ZBRAN	; WHILE
	DW	NUMB2-$
	DW	DUP
	DW	CAT
	DW	LIT
	DW	2EH
	DW	SUBB
	DW	ZERO
	DW	QERR
	DW	ZERO
	DW	BRAN	; REPEAT
	DW	NUMB1-$
NUMB2:	DW	DROP
	DW	FROMR
	DW	ZBRAN	; IF
	DW	NUMB3-$
	DW	DMINU	; ENDIF
NUMB3:	DW	SEMIS
;
	DB	85H	; -FIND	(0-3) SUCCESS
	DB	'-FIN'	; (0-1) FAILURE
	DB	'D'+80H
	DW	NUMB-9
DFIND:	DW	DOCOL
	DW	BL
	DW	WORD
	DW	HERE
	DW	CONT
	DW	AT
	DW	AT
	DW	PFIND
	DW	DUP
	DW	ZEQU
	DW	ZBRAN	; IF
	DW	DFIN1-$
	DW	DROP
	DW	HERE
	DW	LATES
	DW	PFIND	; ENDIF
DFIN1:	DW	SEMIS
;
	DB	87H	; (ABORT)
	DB	'(ABORT'
	DB	')'+80H
	DW	DFIND-8
PABOR:	DW	DOCOL
	DW	ABORT
	DW	SEMIS
;
	DB	85H	; ERROR
	DB	'ERRO'
	DB	'R'+80H
	DW	PABOR-0AH
ERROR:	DW	DOCOL
	DW	WARN
	DW	AT
	DW	ZLESS
	DW	ZBRAN	; IF
	DW	ERRO1-$
	DW	PABOR	; ENDIF
ERRO1:	DW	HERE
	DW	COUNT
	DW	TYPE
	DW	PDOTQ
	DB	2
	DB	'? '
	DW	MESS
;	DW	SPSTO		; XXX smbaker don't understand this...
;	CHANGE FROM FIG MODEL
;	DW	BLK,AT
;	DW	DDUP
;	DW	ZBRAN
;	DW	ERRO2-$	; IF
;	DW	INN,AT
;	DW	SWAP		; ENDIF
ERRO2:	DW	QUIT
;
	DB	83H	; ID.
	DB	'ID'
	DB	'.'+80H
	DW	ERROR-8
IDDOT:	DW	DOCOL
	DW	PAD
	DW	LIT
	DW	20H
	DW	LIT
	DW	5FH
	DW	FILL
	DW	DUP
	DW	PFA
	DW	LFA
	DW	OVER
	DW	SUBB
	DW	PAD
	DW	SWAP
	DW	CMOVE
	DW	PAD
	DW	COUNT
	DW	LIT
	DW	1FH
	DW	ANDD
	DW	TYPE
	DW	SPACE
	DW	SEMIS
;
	DB	86H	; CREATE
	DB	'CREAT'
	DB	'E'+80H
	DW	IDDOT-6
CREAT:	DW	DOCOL
	DW	DFIND
	DW	ZBRAN	; IF
	DW	CREA1-$
	DW	DROP
	DW	NFA
	DW	IDDOT
	DW	LIT
	DW	4
	DW	MESS
	DW	SPACE	; ENDIF
CREA1:	DW	HERE
	DW	DUP
	DW	CAT
	DW	WIDTH
	DW	AT
	DW	MIN
	DW	ONEP
	DW	ALLOT
	DW	DUP
	DW	LIT
	DW	0A0H
	DW	TOGGL
	DW	HERE
	DW	ONE
	DW	SUBB
	DW	LIT
	DW	80H
	DW	TOGGL
	DW	LATES
	DW	COMMA
	DW	CURR
	DW	AT
	DW	STORE
	DW	HERE
	DW	TWOP
	DW	COMMA
	DW	SEMIS
;
	DB	0C9H	; [COMPILE]
	DB	'[COMPILE'
	DB	']'+80H
	DW	CREAT-9
BCOMP:	DW	DOCOL
	DW	DFIND
	DW	ZEQU
	DW	ZERO
	DW	QERR
	DW	DROP
	DW	CFA
	DW	COMMA
	DW	SEMIS
;
	DB	0C7H	; LITERAL
	DB	'LITERA'
	DB	'L'+80H
	DW	BCOMP-0CH
LITER:	DW	DOCOL
	DW	STATE
	DW	AT
	DW	ZBRAN	; IF
	DW	LITE1-$
	DW	COMP
	DW	LIT
	DW	COMMA	; ENDIF
LITE1:	DW	SEMIS
;
	DB	0C8H	; DLITERAL
	DB	'DLITERA'
	DB	'L'+80H
	DW	LITER-0AH
DLITE:	DW	DOCOL
	DW	STATE
	DW	AT
	DW	ZBRAN	; IF
	DW	DLIT1-$
	DW	SWAP
	DW	LITER
	DW	LITER	; ENDIF
DLIT1:	DW	SEMIS
;
	DB	86H	; ?STACK
	DB	'?STAC'
	DB	'K'+80H
	DW	DLITE-0BH
QSTAC:	DW	DOCOL
	DW	SPAT
;;        DW      HEX, DUP, UDOT ; XXX
	DW	SZERO
	DW	AT
	DW	SWAP
	DW	ULESS
	DW	ONE
	DW	QERR
	DW	SPAT
	DW	HERE
	DW	LIT
	DW	80H
	DW	PLUS
	DW	ULESS
	DW	LIT
	DW	7
	DW	QERR
	DW	SEMIS
;
	DB	89H	; INTERPRET
	DB	'INTERPRE'
	DB	'T'+80H
	DW	QSTAC-9
INTER:	DW	DOCOL
INTE1:	DW	DFIND	; BEGIN
	DW	ZBRAN	; IF
	DW	INTE2-$
	DW	STATE
	DW	AT
	DW	LESS
	DW	ZBRAN	; IF
	DW	INTE3-$
	DW	CFA
	DW	COMMA
	DW	BRAN	; ELSE
	DW	INTE4-$
INTE3:	DW	CFA
	DW	EXEC	; ENDIF
INTE4:	DW	QSTAC
	DW	BRAN	; ELSE
	DW	INTE5-$
INTE2:	DW	HERE
	DW	NUMB
	DW	DPL
	DW	AT
	DW	ONEP
	DW	ZBRAN	; IF
	DW	INTE6-$
	DW	DLITE
	DW	BRAN	; ELSE
	DW	INTE7-$
INTE6:	DW	DROP
	DW	LITER	; ENDIF
INTE7:	DW	QSTAC	; ENDIF
INTE5:	DW	BRAN	; AGAIN
	DW	INTE1-$
;
	DB	89H	; IMMEDIATE
	DB	'IMMEDIAT'
	DB	'E'+80H
	DW	INTER-0CH
IMMED:	DW	DOCOL
	DW	LATES
	DW	LIT
	DW	40H
	DW	TOGGL
	DW	SEMIS
;

DOVOC:	DW	TWOP
	DW	CONT
	DW	STORE
	DW	SEMIS
;
	DB	8BH	; DEFINITIONS
	DB	'DEFINITION'
	DB	'S'+80H
	DW	IMMED-0CH
DEFIN:	DW	DOCOL
	DW	CONT
	DW	AT
	DW	CURR
	DW	STORE
	DW	SEMIS
;
	DB	0C1H	; (
	DB	'('+80H
	DW	DEFIN-0EH
PAREN:	DW	DOCOL
	DW	LIT
	DW	29H
	DW	WORD
	DW	SEMIS
;
	DB	84H	; QUIT
	DB	'QUI'
	DB	'T'+80H
	DW	PAREN-4
QUIT:	DW	DOCOL
	DW	LBRAC
QUIT1:	DW	RPSTO	; BEGIN
	DW	CR
	DW	QUERY
	DW	INTER
	DW	STATE
	DW	AT
	DW	ZEQU
	DW	ZBRAN	; IF
	DW	QUIT2-$
	DW	PDOTQ
	DB	2
	DB	'OK'	; ENDIF
QUIT2:	DW	BRAN	; AGAIN
	DW	QUIT1-$
;
	DB	85H	; ABORT
	DB	'ABOR'
	DB	'T'+80H
	DW	QUIT-7
ABORT:	DW	DOCOL
	DW	SPSTO				; SP = (S0)
	DW	DEC				; DECIMAL
	DW	QSTAC				; Error if SP>=(S0)
	DW	CR
	DW	PDOTQ
	DB	0DH
	DB	'fig-FORTH '
	DB	FIGREL+30H,ADOT,FIGREV+30H
	DW	SFORTH				; (WAS FORTH)
	DW	DEFIN
	DW	QUIT
;
WRM:	LXI	B,WRM1
	JMP	NEXT
WRM1:	DW	WARM
;
	DB	84H	; WARM
	DB	'WAR'
	DB	'M'+80H
	DW	ABORT-8
WARM:	DW	DOCOL
;	DW	MTBUF			; XXX smbaker turn off disk stuff
	DW	ABORT
;
CLD:	LHLD	ORIG+12H
	SPHL
	LXI	H, PATCH
	LXI	D, STARTP
	LXI	B, PATLEN
	CALL	MOVIT
IF (PROMP80)
	LXI	H,3FEEH			; Put "Forth" onto the prompt-80's display
	MVI	A,08BH			; Wastes 21 bytes of CSEG to do this
	MOV	M,A
	INX	H
	MVI	A,087H
	MOV	M,A
	INX	H
	MVI	A,0AFH
	MOV	M,A
	INX	H
	MVI	A,0A3H
	MOV	M,A
	INX	H
	MVI	A,08EH
	MOV	M,A
ENDIF
IF (ISIS)
	CALL	COPEN
ENDIF
	LXI	B,CLD1
	JMP	NEXT

MOVIT:	MOV	A,B			; Move BC bytes of memory from DE to HL
	ORA	C
	RZ
	MOV	A,M
	STAX	D
	INX	D
	INX	H
	DCX	B
	JMP	MOVIT

CLD1:	DW	COLD
;
	DB	84H	; COLD
	DB	'COL'
	DB	'D'+80H
	DW	WARM-7
COLD:	DW	DOCOL
	DW	LIT
	DW	ORIG+12H
	DW	LIT
	DW	UP
	DW	AT
	DW	LIT
	DW	6
	DW	PLUS
	DW	LIT
	DW	10H
	DW	CMOVE
	DW	LIT
	DW	ORIG+0CH
	DW	AT
	DW	LIT
	DW	SFVOC				; (WAS FORTH+6)
	DW	STORE
	DW	ABORT
;
	DB	84H	; S->D
	DB	'S->'
	DB	'D'+80H
	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	'-'+80H
	DW	STOD-7
PM:	DW	DOCOL
	DW	ZLESS
	DW	ZBRAN	; IF
	DW	PM1-$
	DW	MINUS	; ENDIF
PM1:	DW	SEMIS
;
	DB	83H	; D+-
	DB	'D+'
	DB	'-'+80H
	DW	PM-5
DPM:	DW	DOCOL
	DW	ZLESS
	DW	ZBRAN	; IF
	DW	DPM1-$
	DW	DMINU	; ENDIF
DPM1:	DW	SEMIS
;
	DB	83H	; ABS
	DB	'AB'
	DB	'S'+80H
	DW	DPM-6
ABS:	DW	DOCOL
	DW	DUP
	DW	PM
	DW	SEMIS
;
	DB	84H	; DABS
	DB	'DAB'
	DB	'S'+80H
	DW	ABS-6
DABS:	DW	DOCOL
	DW	DUP
	DW	DPM
	DW	SEMIS
;
	DB	83H	; MIN
	DB	'MI'
	DB	'N'+80H
	DW	DABS-7
MIN:	DW	DOCOL,TDUP
	DW	GREAT
	DW	ZBRAN	; IF
	DW	MIN1-$
	DW	SWAP	; ENDIF
MIN1:	DW	DROP
	DW	SEMIS
;
	DB	83H	; MAX
	DB	'MA'
	DB	'X'+80H
	DW	MIN-6
MAX:	DW	DOCOL,TDUP
	DW	LESS
	DW	ZBRAN	; IF
	DW	MAX1-$
	DW	SWAP	; ENDIF
MAX1:	DW	DROP
	DW	SEMIS
;
	DB	82H	; M*
	DB	'M'
	DB	'*'+80H
	DW	MAX-6
MSTAR:	DW	DOCOL,TDUP
	DW	XORR
	DW	TOR
	DW	ABS
	DW	SWAP
	DW	ABS
	DW	USTAR
	DW	FROMR
	DW	DPM
	DW	SEMIS
;
	DB	82H	; M/
	DB	'M'
	DB	'/'+80H
	DW	MSTAR-5
MSLAS:	DW	DOCOL
	DW	OVER
	DW	TOR
	DW	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	'*'+80H
	DW	MSLAS-5
STAR:	DW	DOCOL
	DW	MSTAR
	DW	DROP
	DW	SEMIS
;
	DB	84H	; /MOD
	DB	'/MO'
	DB	'D'+80H
	DW	STAR-4
SLMOD:	DW	DOCOL
	DW	TOR
	DW	STOD
	DW	FROMR
	DW	MSLAS
	DW	SEMIS
;
	DB	81H	; /
	DB	'/'+80H
	DW	SLMOD-7
SLASH:	DW	DOCOL
	DW	SLMOD
	DW	SWAP
	DW	DROP
	DW	SEMIS
;
	DB	83H	; MOD
	DB	'MO'
	DB	'D'+80H
	DW	SLASH-4
MODD:	DW	DOCOL
	DW	SLMOD
	DW	DROP
	DW	SEMIS
;
	DB	85H	; */MOD
	DB	'*/MO'
	DB	'D'+80H
	DW	MODD-6
SSMOD:	DW	DOCOL
	DW	TOR
	DW	MSTAR
	DW	FROMR
	DW	MSLAS
	DW	SEMIS
;
	DB	82H	; */
	DB	'*'
	DB	'/'+80H
	DW	SSMOD-8
SSLA:	DW	DOCOL
	DW	SSMOD
	DW	SWAP
	DW	DROP
	DW	SEMIS
;
	DB	85H	; M/MOD
	DB	'M/MO'
	DB	'D'+80H
	DW	SSLA-5
MSMOD:	DW	DOCOL
	DW	TOR
	DW	ZERO
	DW	RR
	DW	USLAS
	DW	FROMR
	DW	SWAP
	DW	TOR
	DW	USLAS
	DW	FROMR
	DW	SEMIS
;
	DB	87H	; MESSAGE
	DB	'MESSAG'
	DB	'E'+80H
	DW	MSMOD-8
MESS:	DW	DOCOL
MESS1:	DW	PDOTQ
	DB	6
	DB	'MSG # '
	DW	DOT	; ENDIF
MESS3:	DW	SEMIS
;------------------------------------------
;
;	8080 PORT FETCH AND STORE
;	( SELF MODIFYING CODE, NOT REENTRANT )
;
	DB	82H	; P@ "PORT @"
	DB	'P'
	DB	'@'+80H
	DW	MESS-0AH
PTAT:	DW	$+2
	POP	D	;E <- PORT#
	LXI	H,SINPAT+2
	MOV	M,E
	CALL	SINPAT	;( PORT# MODIFIED )
	MOV	L,A	;L <- (PORT#)
	MVI	H,0
	JMP	HPUSH
;
	DB	82H	; "PORT STORE"
	DB	'P'
	DB	'!'+80H
	DW	PTAT-5
PTSTO:	DW	$+2
	POP	D	;E <- PORT#
	LXI	H,SOUTPAT+2
	MOV	M,E
	POP	H	;H <- CDATA
	MOV	A,L
	CALL	SOUTPAT	;( PORT# MODIFIED )
	JMP	NEXT

; next word links to PTSTO-5

;
;-------------------------------------------------
;	FORTH TO SERIAL IO INTERFACE

; ---------- ISIS ------------

IF (ISIS)

CPOUT:	CALL	COUT	; OUTPUT (C) TO CONSOLE
	RET

PQTER:	CALL	CSTAT	; IF CHR TYPED
	LXI	H,0
	ORA	A
	JZ	PQTE1
	INR	L	; THEN (S1) <- TRUE
PQTE1:	JMP	HPUSH	; ELSE (S1) <- FALSE
;
PKEY:	CALL	CIN	; READ CHR FROM CONSOLE
	MOV	L,A
	MVI	H,0
	JMP	HPUSH	; (S1)LB <- CHR
ENDIF

; ---------- PROMPT-80 ------------

IF (PROMP80)
CPOUT:	MOV	A,C	; Mask off high bit
	ANI	07FH
	MOV	C,A
	JMP	07FAH	; The Prompt-80 COUT at 7FAH takes C as input and destroys A

PQTER:	CALL	07E5H	; The Prompt-80 subroutine at 7E5 returns A=0 if no character or A=FF if character
	LXI	H,0
	ORA	A
	JZ	PQTE1
	INR	L	; THEN (S1) <- TRUE
PQTE1:	JMP	HPUSH	; ELSE (S1) <- FALSE

PKEY:	CALL	07F4H	; The Prompt-80 CIN at 7F4H waits and returns character in A
	MOV	L,A
	MVI	H,0
	JMP	HPUSH	; (S1)LB <- CHR

ENDIF

;
PEMIT:	DW	$+2	; (EMIT)	ORPHAN
	POP	H	; (L) <- (S1)LB = CHR
	PUSH	B	; SAVE (IP)
	MOV	C,L
	CALL	CPOUT	; OUTPUT CHR TO CONSOLE
;			; & MAYBE PRINTER
	POP	B	; RESTORE (IP)
	JMP	NEXT
;
PCR:	PUSH	B	; SAVE (IP)
	MVI	C,ACR	; OUTPUT (CR) TO CONSOLE
	MOV	L,C
	CALL	CPOUT	; & MAYBE TO PRINTER
	MVI	C,LF	; OUTPUT (LF) TO CONSOLE
	MOV	L,C
	CALL	CPOUT	; & MAYBE TO PRINTER
	POP	B	; RESTORE (IP)
	JMP	NEXT
;
;----------------------------------------------------
;
	DB	0C1H	; '	( TICK )
	DB	0A7H
	DW	PTSTO-5
TICK:	DW	DOCOL
	DW	DFIND
	DW	ZEQU
	DW	ZERO
	DW	QERR
	DW	DROP
	DW	LITER
	DW	SEMIS
;
	DB	86H	; FORGET
	DB	'FORGE'
	DB	'T'+80H
	DW	TICK-4
FORG:	DW	DOCOL
	DW	CURR
	DW	AT
	DW	CONT
	DW	AT
	DW	SUBB
	DW	LIT
	DW	18H
	DW	QERR
	DW	TICK
	DW	DUP
	DW	FENCE
	DW	AT
	DW	LESS
	DW	LIT
	DW	15H
	DW	QERR
	DW	DUP
	DW	NFA
	DW	DP
	DW	STORE
	DW	LFA
	DW	AT
	DW	CONT
	DW	AT
	DW	STORE
	DW	SEMIS
;
	DB	84H	; BACK
	DB	'BAC'
	DB	'K'+80H
	DW	FORG-9
BACK:	DW	DOCOL
	DW	HERE
	DW	SUBB
	DW	COMMA
	DW	SEMIS
;
	DB	0C5H	; BEGIN
	DB	'BEGI'
	DB	'N'+80H
	DW	BACK-7
BEGIN:	DW	DOCOL
	DW	QCOMP
	DW	HERE
	DW	ONE
	DW	SEMIS
;
	DB	0C5H	; ENDIF
	DB	'ENDI'
	DB	'F'+80H
	DW	BEGIN-8
ENDIFF:	DW	DOCOL
	DW	QCOMP
	DW	TWO
	DW	QPAIR
	DW	HERE
	DW	OVER
	DW	SUBB
	DW	SWAP
	DW	STORE
	DW	SEMIS
;
	DB	0C4H	; THEN
	DB	'THE'
	DB	'N'+80H
	DW	ENDIFF-8
THEN:	DW	DOCOL
	DW	ENDIFF
	DW	SEMIS
;
	DB	0C2H	; DO
	DB	'D'
	DB	'O'+80H
	DW	THEN-7
DO:	DW	DOCOL
	DW	COMP
	DW	XDO
	DW	HERE
	DW	THREE
	DW	SEMIS
;
	DB	0C4H	; LOOP
	DB	'LOO'
	DB	'P'+80H
	DW	DO-5
LOOP:	DW	DOCOL
	DW	THREE
	DW	QPAIR
	DW	COMP
	DW	XLOOP
	DW	BACK
	DW	SEMIS
;
	DB	0C5H	; +LOOP
	DB	'+LOO'
	DB	'P'+80H
	DW	LOOP-7
PLOOP:	DW	DOCOL
	DW	THREE
	DW	QPAIR
	DW	COMP
	DW	XPLOO
	DW	BACK
	DW	SEMIS
;
	DB	0C5H	; UNTIL
	DB	'UNTI'
	DB	'L'+80H
	DW	PLOOP-8
UNTIL:	DW	DOCOL
	DW	ONE
	DW	QPAIR
	DW	COMP
	DW	ZBRAN
	DW	BACK
	DW	SEMIS
;
	DB	0C3H	; END
	DB	'EN'
	DB	'D'+80H
	DW	UNTIL-8
ENDD:	DW	DOCOL
	DW	UNTIL
	DW	SEMIS
;
	DB	0C5H	; AGAIN
	DB	'AGAI'
	DB	'N'+80H
	DW	ENDD-6
AGAIN:	DW	DOCOL
	DW	ONE
	DW	QPAIR
	DW	COMP
	DW	BRAN
	DW	BACK
	DW	SEMIS
;
	DB	0C6H	; REPEAT
	DB	'REPEA'
	DB	'T'+80H
	DW	AGAIN-8
REPEA:	DW	DOCOL
	DW	TOR
	DW	TOR
	DW	AGAIN
	DW	FROMR
	DW	FROMR
	DW	TWO
	DW	SUBB
	DW	ENDIFF
	DW	SEMIS
;
	DB	0C2H	; IF
	DB	'I'
	DB	'F'+80H
	DW	REPEA-9
IFF:	DW	DOCOL
	DW	COMP
	DW	ZBRAN
	DW	HERE
	DW	ZERO
	DW	COMMA
	DW	TWO
	DW	SEMIS
;
	DB	0C4H	; ELSE
	DB	'ELS'
	DB	'E'+80H
	DW	IFF-5
ELSEE:	DW	DOCOL
	DW	TWO
	DW	QPAIR
	DW	COMP
	DW	BRAN
	DW	HERE
	DW	ZERO
	DW	COMMA
	DW	SWAP
	DW	TWO
	DW	ENDIFF
	DW	TWO
	DW	SEMIS
;
	DB	0C5H	; WHILE
	DB	'WHIL'
	DB	'E'+80H
	DW	ELSEE-7
WHILE:	DW	DOCOL
	DW	IFF
	DW	TWOP
	DW	SEMIS
;
	DB	86H	; SPACES
	DB	'SPACE'
	DB	'S'+80H
	DW	WHILE-8
SPACS:	DW	DOCOL
	DW	ZERO
	DW	MAX
	DW	DDUP
	DW	ZBRAN	; IF
	DW	SPAX1-$
	DW	ZERO
	DW	XDO	; DO
SPAX2:	DW	SPACE
	DW	XLOOP	; LOOP	ENDIF
	DW	SPAX2-$
SPAX1:	DW	SEMIS
;
	DB	82H	; <#
	DB	'<'
	DB	'#'+80H
	DW	SPACS-9
BDIGS:	DW	DOCOL
	DW	PAD
	DW	HLD
	DW	STORE
	DW	SEMIS
;
	DB	82H	; #>
	DB	'#'
	DB	'>'+80H
	DW	BDIGS-5
EDIGS:	DW	DOCOL
	DW	DROP
	DW	DROP
	DW	HLD
	DW	AT
	DW	PAD
	DW	OVER
	DW	SUBB
	DW	SEMIS
;
	DB	84H	; SIGN
	DB	'SIG'
	DB	'N'+80H
	DW	EDIGS-5
SIGN:	DW	DOCOL
	DW	ROT
	DW	ZLESS
	DW	ZBRAN	; IF
	DW	SIGN1-$
	DW	LIT
	DW	2DH
	DW	HOLD	; ENDIF
SIGN1:	DW	SEMIS
;
	DB	81H	; #
	DB	'#'+80H
	DW	SIGN-7
DIG:	DW	DOCOL
	DW	BASE
	DW	AT
	DW	MSMOD
	DW	ROT
	DW	LIT
	DW	9
	DW	OVER
	DW	LESS
	DW	ZBRAN	; IF
	DW	DIG1-$
	DW	LIT
	DW	7
	DW	PLUS	; ENDIF
DIG1:	DW	LIT
	DW	30H
	DW	PLUS
	DW	HOLD
	DW	SEMIS
;
	DB	82H	; #S
	DB	'#'
	DB	'S'+80H
	DW	DIG-4
DIGS:	DW	DOCOL
DIGS1:	DW	DIG	; BEGIN
	DW	OVER
	DW	OVER
	DW	ORR
	DW	ZEQU
	DW	ZBRAN	; UNTIL
	DW	DIGS1-$
	DW	SEMIS
;
	DB	83H	; D.R
	DB	'D.'
	DB	'R'+80H
	DW	DIGS-5
DDOTR:	DW	DOCOL
	DW	TOR
	DW	SWAP
	DW	OVER
	DW	DABS
	DW	BDIGS
	DW	DIGS
	DW	SIGN
	DW	EDIGS
	DW	FROMR
	DW	OVER
	DW	SUBB
	DW	SPACS
	DW	TYPE
	DW	SEMIS
;
	DB	82H	; .R
	DB	'.'
	DB	'R'+80H
	DW	DDOTR-6
DOTR:	DW	DOCOL
	DW	TOR
	DW	STOD
	DW	FROMR
	DW	DDOTR
	DW	SEMIS
;
	DB	82H	; D.
	DB	'D'
	DB	'.'+80H
	DW	DOTR-5
DDOT:	DW	DOCOL
	DW	ZERO
	DW	DDOTR
	DW	SPACE
	DW	SEMIS
;
	DB	81H	; .
	DB	'.'+80H
	DW	DDOT-5
DOT:	DW	DOCOL
	DW	STOD
	DW	DDOT
	DW	SEMIS
;
	DB	81H	; ?
	DB	'?'+80H
	DW	DOT-4
QUES:	DW	DOCOL
	DW	AT
	DW	DOT
	DW	SEMIS
;
	DB	82H	; U.
	DB	'U'
	DB	'.'+80H
	DW	QUES-4
UDOT:	DW	DOCOL
	DW	ZERO
	DW	DDOT
	DW	SEMIS
;
	DB	85H	; VLIST
	DB	'VLIS'
	DB	'T'+80H
	DW	UDOT-5
VLIST:	DW	DOCOL
	DW	LIT
	DW	80H
	DW	OUTT
	DW	STORE
	DW	CONT
	DW	AT
	DW	AT
VLIS1:	DW	OUTT	; BEGIN
	DW	AT
	DW	CSLL
	DW	GREAT
	DW	ZBRAN	; IF
	DW	VLIS2-$
	DW	CR
	DW	ZERO
	DW	OUTT
	DW	STORE	; ENDIF
VLIS2:	DW	DUP
	DW	IDDOT
	DW	SPACE
	DW	SPACE
	DW	PFA
	DW	LFA
	DW	AT
	DW	DUP
	DW	ZEQU
	DW	QTERM
	DW	ORR
	DW	ZBRAN	; UNTIL
	DW	VLIS1-$
	DW	DROP
	DW	SEMIS
;
;------ EXIT CP/M  -----------------------
;
	DB	83H	; BYE
	DB	'BY'
	DB	'E'+80H
	DW	VLIST-8
BYE:	DW	$+2
IF (ISIS)
	CALL	CCLOSE
	CALL	EXIT
ENDIF
IF (PROMP80)
	JMP	0
ENDIF
;
;
;
PATCH:
RUP:	DW	INITR0
RRPP:	DW	INITR0
FORW:	DB	0C5H	; FORTH
	DB	'FORT'
	DB	'H'+80H
	DW	BYE-6
FORTH:	DW	DODOE
	DW	DOVOC
	DW	0A081H
FVOC:	DW	STASW	; COLD START VALUE ONLY
;			  CHANGED EACH TIME A DEF IS APPENDED
;			  TO THE FORTH VOCABULARY
	DW	0	; END OF VOCABULARY LIST

INPAT:	MOV	M, E	; Used by P@
	IN 	0
	RET
OUTPAT:	MOV	A,L	; Used by P!
	OUT	0
	RET

;-----------------------------------------------
;
;
TASW:	DB	84H	; TASK
	DB	'TAS'
	DB	'K'+80H
	DW	SFORW				; (WAS FORTH-8)
TASK:	DW	DOCOL
	DW	SEMIS
TASKE:
;

OUP	EQU	RUP-PATCH
ORPP	EQU	RRPP-PATCH
OFORW	EQU	FORW-PATCH			; offset of FORTH word
OFORTH	EQU	FORTH-PATCH			; offset of FORTH
OFVOC	EQU	FVOC-PATCH			; offset of vocabulary pointer in FORTH word
OINPAT	EQU	INPAT-PATCH			; offset of patch for IN
OOUTPAT EQU	OUTPAT-PATCH			; offset of patch for OUT
OTASW	EQU	TASW-PATCH			; offset of TASK word
OTASK	EQU	TASK-PATCH			; offset of TASK
OTASKE	EQU	TASKE-PATCH			; offset for first free dictionary entry
PATLEN	EQU	TASKE-PATCH			; length of patch to copy

SUP	EQU	STARTP + OUP
SRPP	EQU	STARTP + ORPP
SFORW	EQU	STARTP + OFORW
SFORTH	EQU	STARTP + OFORTH			; Change FORTH to SFORTH
SFVOC	EQU	STARTP + OFVOC			; Change FORTH+6 to SVOC
SINPAT	EQU	STARTP + OINPAT
SOUTPAT	EQU	STARTP + OOUTPAT
STASW	EQU	STARTP + OTASW			; Change TASK-7 to STASW
STASK	EQU	STARTP + OTASK
STASKE	EQU	STARTP + OTASKE			; Change MEMORY in INITDP TO STASKE

;;INITDP:	DS      8000H ;;DS	EM-$	;CONSUME MEMORY TO LIMIT

;
;		MEMORY MAP
;	( THE FOLLOWING EQUATES ARE NOT REFERENCED ELSEWHERE )
;
;		LOCATION	CONTENTS
;		--------	--------
MCOLD	EQU 	ORIG		;JMP TO COLD START
MWARM	EQU	ORIG+4		;JMP TO WARM START
MA2	EQU	ORIG+8		;COLD START PARAMETERS
MUP	EQU	UP		;USER VARIABLES' BASE 'REG'
MRP	EQU	RPP		;RETURN STACK 'REGISTER'
;
MDPUSH	EQU	DPUSH		;ADDRESS INTERPRETER
MHPUSH	EQU	HPUSH
MNEXT	EQU	NEXT
;
MDP0	EQU	DP0		;START FORTH DICTIONARY
MIDP	EQU	INITDP		;END INITIAL FORTH DICTIONARY
;				  = COLD (DP) VALUE
;				  = COLD (FENCE) VALUE
;				  |  NEW
;				  |  DEFINITIONS
;				  V
;
;				  ^
;				  |  DATA
;				  |  STACK
MIS0	EQU	INITS0		;  = COLD (SP) VALUE = (S0)
;				   = (TIB)
;				  |  TERMINAL INPUT
;				  |  BUFFER
;				  V
;
;				  ^
;				  |  RETURN
;				  |  STACK
MIR0	EQU	INITR0		;START USER VARIABLES
;				  = COLD (RP) VALUE = (R0)
;				  = (UP)
;				;END USER VARIABLES
MEND	EQU	EM-1		;END DISK BUFFERS
MLIMIT	EQU	EM		;LAST MEMORY LOC USED + 1
;				  = LIMIT
;
;
	END	ORIG