	TITLE	'8080 WORKING FORTH 2.5.0	17MAR82'
;
;		    WORKING FORTH  release 2.5
;		for a 8080 or Z80 processor system
;		with the CP/M (TM) operating system
;
;	(C) COPYRIGHT 1982 by LAXEN & HARRIS, INC.
;		ALL RIGHTS RESERVED.
;
;	This FORTH implementation is compatible with the
;	popular book "Starting FORTH" by Leo Brodie. 
;	This software was adapted from the fig-FORTH model
;	and retains full length names in the dictionary.
;	It is NOT compatible with the original fig-FORTH
;	model (ie, language) or with the FORTH-79 Standard.
;	It uses the "BIOS" part of the CP/M operating
;	system for access to the console terminal and disks.
;	It is NOT compatible with CP/M files; it accesses
;	disks directly using FORTH's word BLOCK.
;
;	CP/M is a registered trademark of Digital Research, Inc.
;
;
;	HOW TO GET   WORKING FORTH   STARTED:
;
;	1.  Boot CP/M
;
;	2.  Insert the  WORKING FORTH  disk in drive A.
;	    Enter the name of the  .COM  file containing
;	    the assembled machine code corresponding to
;	    this source file.
;		For example, enter   WFORTH25
;		to run WFORTH25.COM .
;	    After FORTH is loaded, you should see:
;		8080 WORKING FORTH 2.5.0
;
;	3.  Remove the  WORKING FORTH  disk from drive A.
;	    This software does not use CP/M's file system
;	    and could ruin such files if improperly used.
;	    Insert a  FORTH SCREENS DISK  in drive A.
;	    Initially this disk should be empty but
;	    formatted.  Use the EDITOR to save source code
;	    on the screens disk.  Be sure to FLUSH before
;	    removing this disk.  All FORTH words in this
;	    system require upper case letters.
;	    A printer may be activated at any time by
;	    entering a Control-P.  It is deactivated
;	    with another Control-P.  You can see a list
;	    of the FORTH words in the dictionary by
;	    entering  WORDS  and this may be stopped
;	    by entering any character.
;
;
	PAGE
;
;----------------------------------------------------------
;
;	RELEASE NUMBERS
;
KREL	EQU	2	; RELEASE #
KREV	EQU	5	; REVISION #
KVER	EQU	0	; VERSION #
;
;	ASCII CHARACTERS USED
;
KBL	EQU	20H	; SPACE
KCR	EQU	0DH	; CARRIAGE RETURN
KDOT	EQU	02EH	; PERIOD
KBELL	EQU	07H	; (^G)
KBSIN	EQU	08H	; INPUT BACKSPACE
KBSOUT	EQU	08H	; OUTPUT BACKSPACE (^H)
KDLE	EQU	10H	; (^P)
KLF	EQU	0AH	; LINE FEED
KFF	EQU	0CH	; FORM FEED (^L)
KDEL	EQU	07FH	; DELETE OR RUBOUT
;
;	MEMORY ALLOCATION
;	SPECIFY AT ASSEMBLY-TIME:
;
KLIMIT	EQU	32768	; TOP OF MEMORY + 1 = LIMIT
;			( FORMERLY  EM  )
KNBUF	EQU	4	; NUMBER OF 1024 BYTE BUFFERS = #BUFFERS
;			( FORMERLY  NSCR  &  NBUF  )
KBBUF	EQU	1024	; DATA BYTES PER DISK BUFFER = B/BUF
KBUSER	EQU	100	; BYTES IN USER VARIABLE AREA
;			( FORMERLY  US  )
KBRSTK	EQU	160	; BYTES IN RETURN STACK + TIB
;			( FORMERLY  RTS  )
;
;	CALCULATED FROM ABOVE:
;
KBBUFA	EQU	KBBUF+4		; BYTES IN DISK BUFFER +
;	 2 ( FOR THE HEADER ) + 2 ( FOR THE TAIL )
;				( FORMERLY  CO  )
KFIRST	EQU	KLIMIT-KBBUFA*KNBUF	; ADDR FIRST DISK BUFFER
;		= FIRST		( FORMERLY  BUF1  )
KR0	EQU	KFIRST-KBUSER	; INITIAL (R0)
;				( FORMERLY  INITR0  )
KS0	EQU	KR0-KBRSTK	; INITIAL (S0)
;				( FORMERLY  INITS0  )
;
	PAGE
;
;-------------------------------------------------------
;
	ORG	100H
; ENTRY FOR INITIAL EXECUTION AND COLD START
ORIG	NOP
	JMP	CLD	; VECTOR TO COLD START
; ENTRY FOR WARM START
	NOP
	JMP	WRM	; VECTOR TO WARM START
;
	DB	KREL	; RELEASE #
	DB	KREV	; REVISION #
	DB	KVER	; VERSION #
	DB	1DH	; IMPLEMENTATION ATTRIBUTES
OFOR	DW	FLAST	; TOPMOST WORD IN FORTH VOCABULARY
	DW	KBSIN	; BKSPACE CHARACTER
	DW	KR0	; INIT (UP)
;<<<<<< FOLLOWING USED BY COLD;
;	MUST BE IN SAME ORDER AS USER VARIABLES
OCLD0	DW	KS0	; INIT (S0)
	DW	KR0	; INIT (R0)
	DW	KS0	; INIT (TIB)
	DW	31	; INIT (WIDTH)
	DW	0	; INIT (WARNING)
	DW	TASK	; INIT (FENCE)
	DW	HCOLD	; INIT (H)
	DW	EDITV	; INIT (VOC-LINK)
OCLD1	EQU	$
;<<<<<< END DATA USED BY COLD
	DW	5H,0B320H	; CPU NAME	( HW,LW )
;				  ( 32 BIT, BASE 36 INTEGER )
OASM	DW	ALAST	; LAST ASSEMBLER DEF.
OED	DW	ELAST	; LAST EDITOR DEF.
;
;
;			+---------------+
;	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 }
;
	PAGE
;
;------------------------------------------------------
;
;	FORTH REGISTERS
;
;	FORTH	8080	FORTH PRESERVATION RULES
;	-----	----	------------------------
;	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	KR0	; USER AREA POINTER
RPP	DW	KR0	; RETURN STACK POINTER
;
;------------------------------------------------------
;
;	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 )
;
	PAGE
;
;---------------------------------------------------
;	DEBUG SUPPORT
;
;	TO USE:
;	(1)	SET 'BIP' TO IP VALUE TO HALT, CANNOT BE CFA
;	(2)	SET MONITOR'S BREAKPOINT PC TO 'BREAK'
;			OR PATCH 'HLT' INSTR. THERE
;	(3)	PATCH A 'JMP TNEXT' AT 'NEXT'
;	WHEN (IP) = (BIP) CPU WILL HALT
;
BIP	DW	0	; BREAKPOINT ON IP VALUE
;
TNEXT	LXI	H,BIP
	MOV	A,M	; LB
	CMP	C
	JNZ	TNEXT1
	INX	H
	MOV	A,M	; HB
	CMP	B
	JNZ	TNEXT1
BREAK	NOP		; PLACE BREAKPOINT HERE
	NOP
	NOP
TNEXT1	LDAX	B
	INX	B
	MOV	L,A
	JMP	NEXT+3
;
;--------------------------------------------------
;
;	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
;
	PAGE
;
;		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>
;				  ...
;
;
DBOTOM	DB	85H	; (LIT)		1.5
	DB	'(LIT'
	DB	')'+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	1.5
	DB	'EXECUT'
	DB	'E'+80H
	DW	LIT-8
EXEC	DW	$+2
	POP	H	; (HL) <- (S1) = PFA
	DCX	H	; 2- TO CFA
	DCX	H
	JMP	NEXT1
;
	DB	86H	; BRANCH
	DB	'BRANC'
	DB	'H'+80H
	DW	EXEC-10
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	; ?BRANCH	2.4
	DB	'?BRANC'
	DB	'H'+80H
	DW	BRAN-9
QBRAN	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)	1.3
	DB	'(LOOP'
	DB	')'+80H
	DW	QBRAN-10
XLOOP	DW	$+2
	LHLD	RPP	; ((HL)) = INDEX = (R1)
	MOV	E,M	; (DE) <- INDEX
	INX	H
	MOV	D,M
	INX	D	; INDEX <- INDEX + 1
	MOV	M,D	; (R1) <- NEW INDEX
	DCX	H
	MOV	M,E
	INX	H
	INX	H	; ((HL)) = LIMIT
	MOV	A,E	; IF INDEX < LIMIT
	SUB	M
	MOV	A,D
	INX	H
	SBB	M
	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)	2.5
	DB	'(+LOOP'
	DB	')'+80H
	DW	XLOOP-9
XPLOO	DW	$+2
	POP	D	; (DE) <- INCR
	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	; THEN (A) <- INDEX - LIMIT
	SUB	M
	MOV	A,D
	INX	H
	SBB	M
	JMP	XLOO3
XLOO2	MOV	A,M	; ELSE (A) <- LIMIT - INDEX - 1
	SUB	E
	MOV	E,A
	INX	H
	MOV	A,M
	SBB	D
	MOV	D,A
	MOV	A,E
	SUI	1
	MOV	A,D
	SBI	0
;			  IF (A) < 0
XLOO3	JM	BRAN1	; THEN LOOP AGAIN
	INX	H	; ELSE DONE
	SHLD	RPP	; DROP R1 AND R2
	INX	B	; SKIP BRANCH OFFSET
	INX	B
	JMP	NEXT
;
	DB	87H	; (/LOOP)		1.5
	DB	'(/LOOP'
	DB	')'+80H
	DW	XPLOO-10
XSLOOP	DW	$+2
	POP	D	; (DE) <- INCR
	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
	MOV	A,E	; (A) <- INDEX - LIMIT
	SUB	M
	MOV	A,D
	INX	H
	SBB	M
;			  IF (A) < 0
	JM	BRAN1	; THEN LOOP AGAIN
	INX	H	; ELSE DONE
	SHLD	RPP	; DROP R1 AND R2
	INX	B	; SKIP BRANCH OFFSET
	INX	B
	JMP	NEXT
;
	DB	84H	; (DO)
	DB	'(DO'
	DB	')'+80H
	DW	XSLOOP-10
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	82H	; R@	1.5
	DB	'R'
	DB	'@'+80H
	DW	XDO-7
RAT	DW	$+2	;(S1) <- (R1) , (R1) UNCHANGED
	LHLD	RPP
RAT1	MOV	E,M	; (DE) <- (R1)
	INX	H
	MOV	D,M
	PUSH	D	; (S1) <- (DE)
	JMP	NEXT
;
	DB	81H	; I	2.3
	DB	'I'+80H
	DW	RAT-5
IDO	DW	RAT+2
;
	DB	82H	; I'	1.5
	DB	'I'
	DB	27H+80H
	DW	IDO-4
IPRIM	DW	$+2
	LHLD	RPP
	INX	H
	INX	H	; ((HL)) = (R2)
	JMP	RAT1
;
	DB	81H	; J	1.5
	DB	'J'+80H
	DW	IPRIM-5
J	DW	$+2
	LHLD	RPP
	INX	H
	INX	H
	INX	H
	INX	H	; ((HL)) = (R3)
	JMP	RAT1
;
	DB	85H	; DIGIT		1.4
	DB	'DIGI'
	DB	'T'+80H
	DW	J-4
DIGIT	DW	$+2
	POP	H	; (L) <- (S1)LB = ASCII CHR TO BE
;			 CONVERTED
	MVI	H,0
	POP	D	; (DE) <- (S2) = BASE VALUE
	MOV	A,E	; (BASE) < 255 ASSUMED
	SUI	30H	; IF CHR > "0"
	CPI	0AH	; AND IF CHR > "9"
	JC	DIGI1	; THEN GO TEST BASE
	SUI	7
	CPI	0AH	; OR IF CHR >= "A"
	JC	DIGI2
;			; THEN VALID NUMERIC OR ALPHA CHR
DIGI1	CMP	L	; IF DIGIT VALUE < BASE VALUE
	MOV	E,A	; (E) <- CONVERTED DIGIT
	MVI	L,1	; (L) <- TRUE
	JC	DPUSH	; THEN SUCCESSFUL
;			  (S2) <- CONVERTED DIGIT
;			  (S1) <- TRUE
;			; ELSE INVALID DIGIT CHR
DIGI2	MOV	L,H	; (HL) <- FALSE
	JMP	HPUSH	; (S1) <- FALSE
;
	DB	87H	; <FIND?>	2.4
	DB	'<FIND?'  ;  ( ASTRING ANF -- APF 1   OR 0 )
	DB	'>'+80H
	DW	DIGIT-8
BFINDQ	DW	$+2
	POP	D	; (DE) <- NFA
BFIN1	POP	H	; (HL) <- STRING ADDR
	PUSH	H	; SAVE STRING ADDR FOR NEXT ITERATION
	LDAX	D
	XRA	M	; CHECK LENGTHS & SMUDGE BIT
	ANI	3FH
	JNZ	BFIN4	; LENGTHS DIFFERENT
;			; LENGTHS MATCH, CHECK EACH CHR
BFIN2	INX	H	; (HL) <- ADDR NEXT CHR IN STRING
	INX	D	; (DE) <- ADDR NEXT CHR IN NF
	LDAX	D
	XRA	M	; IGNORE MSB
	JZ	BFIN2	; MATCH SO FAR, LOOP AGAIN
	ADD	A
	JNZ	BFIN3	; NO MATCH
	LXI	H,5	; STRING MATCHES
	DAD	D	; ((SP)) <- PFA
	XTHL
;			; BACK UP TO LENGTH BYTE OF NF = NFA
BFIN6	DCX	D
	LDAX	D
	ORA	A
	JP	BFIN6	; IF MSB = 1 THEN (DE) = NFA
	LXI	H,1	; (HL) <- TRUE
	JMP	HPUSH  ; RETURN, FOUND
;	ABOVE NF NOT A MATCH, TRY ANOTHER
BFIN3	JC	BFIN5	; IF NOT END OF NF
BFIN4	INX	D	; THEN FIND END OF NF
	LDAX	D
	ORA	A
	JP	BFIN4
BFIN5	INX	D	; (DE) <- LFA
	XCHG
	MOV	E,M	; (DE) <- (LFA)
	INX	H
	MOV	D,M
	MOV	A,D
	ORA	E	; IF (LFA) <> 0
	JNZ	BFIN1	; THEN TRY PREVIOUS DICT. DEF.
;			; ELSE END OF DICTIONARY
	POP	H	; DISCARD STRING ADDR
	PUSH	D	; (S1) <- FALSE
	JMP	NEXT
;
	DB	87H	; ENCLOSE	1.3
;			( ASTRING C --
;				ASTRING #-C #END+1 #NEXT )
	DB	'ENCLOS'
	DB	'E'+80H
	DW	BFINDQ-10
ENCL	DW	$+2
	POP	D	; (DE) <- (S1) = DELIMITER CHAR
	POP	H	; (HL) <- (S2) = ADDR TEXT TO SCAN
	PUSH	H	; (S4) <- ADDR
	MOV	A,E	; (E) <- DELIM CHR
	LXI	D,-1	; INIT CHR OFFSET COUNTER
	DCX	H	; (HL) <- ADDR-1
;			; SKIP OVER LEADING DELIMITER CHRS
ENCL1	INX	H
	INX	D
	CMP	M	; IF TEXT CHR = DELIM CHR
	JZ	ENCL1	; THEN LOOP AGAIN
;			; ELSE NON-DELIM CHR FOUND
	PUSH	D	; (S3) <- (DE) = OFFSET TO 1ST NON-DELIM
	MOV	D,A	; SAVE A
	MOV	A,M	; IF 1ST NON-DELIM = NULL
	ANA	A
	MOV	A,D	; RESTORE A
	POP	D
	PUSH	D
	JNZ	ENCL2
	INX	D	; THEN (S2) <- OFFSET TO BYTE
	PUSH	D	;   FOLLOWING NULL
	DCX	D	; (S1) <- OFFSET TO NULL
	PUSH	D
	JMP	NEXT
;			; ELSE TEXT CONTAINS NON-DELIM &
;			  NON-NULL CHR
ENCL2	PUSH	B	; SAVE IP
	MOV	B,A	; (B) <- DELIM CHR
ENCL5	INX	H	; (HL) <- ADDR NEXT CHR
	INX	D	; (DE) <- OFFSET TO NEXT CHR
	MOV	A,M	; IF NEXT CHR <> DELIM CHR
	CMP	B
	JZ	ENCL4
	ANA	A	; AND IF NEXT CHR <> NULL
	JNZ	ENCL5	; THEN CONTINUE SCAN
;			; ELSE CHR = NULL
ENCL3	POP	B	; RESTORE IP
	PUSH	D	; (S2) <- OFFSET TO NULL
	PUSH	D	; (S1) <- OFFSET TO NULL
	JMP	NEXT
;			; ELSE CHR = DELIM CHR
ENCL4	POP	B	; RESTORE IP
	PUSH	D	; (S2) <- OFFSET TO BYTE
;			  FOLLOWING TEXT
	INX	D	; (S1) <- OFFSET TO 2 BYTES AFTER
;			    END OF WORD
	PUSH	D
	JMP	NEXT
;
	DB	84H	; EMIT		2.3
	DB	'EMI'
	DB	'T'+80H
	DW	ENCL-0AH
EMIT	DW	DOCOL
	DW	TEMIT,AT
	DW	EXEC
	DW	ONE,GOUT
	DW	PSTOR,EXIT
;
	DB	83H	; KEY		1.4
	DB	'KE'
	DB	'Y'+80H
	DW	EMIT-7
KEY	DW	DOCOL
	DW	TKEY,AT
	DW	EXEC,EXIT
;
	DB	84H	; KEY?		2.5
	DB	'KEY'
	DB	'?'+80H
	DW	KEY-6
KEYQ	DW	DOCOL
	DW	TQKEY,AT
	DW	EXEC,EXIT
;
	DB	89H	; ?TERMINAL		2.5
	DB	'?TERMINA'
	DB	'L'+80H
	DW	KEYQ-7
QTERM	DW	DOCOL
	DW	KEYQ,EXIT
;
	DB	82H	; CR		2.3
	DB	'C'
	DB	'R'+80H
	DW	QTERM-12
CR	DW	DOCOL
	DW	TCR,AT
	DW	EXEC
	DW	ZERO
	DW	GOUT,STORE
	DW	EXIT
;
	DB	84H	; PAGE		1.4
	DB	'PAG'
	DB	'E'+80H
	DW	CR-5
PAG	DW	DOCOL
	DW	TPAGE,AT
	DW	EXEC,EXIT
;
	DB	82H	; BS		2.2
	DB	'B'	; ( OUTPUT Back Space )
	DB	'S'+80H
	DW	PAG-7
BS	DW	DOCOL
	DW	LIT,KBSOUT
	DW	TEMIT,AT
	DW	EXEC
	DW	EXIT
;
	DB	85H	; CMOVE
	DB	'CMOV'
	DB	'E'+80H
	DW	BS-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	84H	; MOVE		1.5
	DB	'MOV'
	DB	'E'+80H
	DW	CMOVE-8
MOVE	DW	CMOVE+2
;
	DB	86H	; <CMOVE	2.3
	DB	'<CMOV'
	DB	'E'+80H
	DW	MOVE-7
LCMOV	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) TEMP.
	DAD	B	; (HL) <- END SOURCE ADDR
	DCX	H
	XCHG
	DAD	B
	DCX	H
	XCHG		; (DE) <- END DEST ADDR
	JMP	LCMOV2	; RETURN IF #CHRS = 0
LCMOV1	MOV	A,M	; ((DE)) <- ((HL))
	DCX	H	; DECR SOURCE ADDR
	STAX	D
	DCX	D	; DECR DEST ADDR
	DCX	B	; DECR #CHRS
LCMOV2	MOV	A,B	; IF #CHRS LEFT <> 0
	ORA	C
	JNZ	LCMOV1	; THEN LOOP AGAIN
	POP	B	; RESTORE IP
	JMP	NEXT
;
	DB	82H	; U*		1.3
;			  ( U1 U2 -- UD )
;				16X16 UNSIGNED MULTIPLY
	DB	'U'	; AVG EXECUTION TIME = 880 CYCLES
	DB	'*'+80H
	DW	LCMOV-9
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 SUBROUTINE
;		(AHL) <- (A) * (DE)
;	#BITS =	 24	  8	16
MPYX	LXI	H,0	; (HL) <- 0 = PARTIAL PRODUCT.LW
	MVI	C,4	; 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	DAD	H
	RAL
	JNC	MPYX3
	DAD	D
	ACI	0
MPYX3	DCR	C	; IF NOT LAST MPLIER BIT
	JNZ	MPYX1	; THEN LOOP AGAIN
	RET		; ELSE DONE
;
	DB	85H	; U/MOD		2.4
	DB	'U/MO'	;  ( UD U1 -- UREM UQUOT )
	DB	'D'+80H
	DW	USTAR-5
USLMOD	DW	$+2
	MOV	H,B
	MOV	L,C	; (HL) <- (IP)
	POP	B	; (BC) <- (S1) = DENOMINATOR
	POP	D	; (DE) <- (S2) = NUMERATOR.HIGH
	XTHL		; (S1) <- (IP)
	XCHG		; (HLDE) = NUMERATOR, 32 BITS
	MOV	A,L
	SUB	C
	MOV	A,H	; IF OVERFLOW
	SBB	B
	JNC	USBAD	; THEN RETURN BAD VALUE
	MOV	A,H
	MOV	H,L
	MOV	L,D	; (AHL) <- 24 BITS OF NUMERATOR
	MVI	D,8	; (D) <- INIT COUNTER
	PUSH	D	; SAVE D & E
	CALL	USLA	; PARTIAL DIVISION
	POP	D	; RESTORE COUNTER & NUM.MSBYTE
	PUSH	H	; (S1) <- (L) = BYTE OF QUOTIENT
	MOV	L,E
	CALL	USLA
	MOV	D,A
	MOV	E,H	; (DE) <- REMAINDER
	POP	B	; RESTORE QUOTIENT.HIGH
	MOV	H,C	; (HL) <- QUOTIENT
	POP	B	; RESTORE (IP)
	JMP	DPUSH	; SUCCESSFULLY DONE
;
;	DIVIDE PRIMITIVE SUBROUTINE
;
USL0	MOV	E,A
	MOV	A,H
	SUB	C
	MOV	H,A
	MOV	A,E
	SBB	B
	JNC	USL1	; IF CARRY
	MOV	A,H	; THEN ADD (BC) INTO (AH)
	ADD	C
	MOV	H,A
	MOV	A,E
	DCR	D
	RZ		; RETURN FROM USLA
;
USLA	DAD	H	; 24BIT LEFT-SHIFT ( *2 )
	RAL
	JNC	USL0	; SUBTRACT & TEST
	MOV	E,A
	MOV	A,H
	SUB	C	; (AH) <- (AH) - (BC)
	MOV	H,A
	MOV	A,E
	SBB	B
USL1	INR	L	; 1 BIT OF QUOT INTO RIGHT SIDE
	DCR	D	;   OF (AHL)
	JNZ	USLA	; CONTINUE DIVISION
	RET		; ALL 8 TRIAL COMPLETE
;
;	END OF DIVIDE SUBROUTINE
;
USBAD	LXI	H,-1	; OVERFLOW, RETURN 32BIT -1
	POP	B	; RESTORE (IP)
	PUSH	H
	JMP	HPUSH
;
	DB	83H	; AND
	DB	'AN'
	DB	'D'+80H
	DW	USLMOD-8
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	'R'+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	84H	; FLIP		2.1
	DB	'FLI'	; ( n - 1's complement of n )
	DB	'P'+80H
	DW	XORR-6
FLIP	DW	DOCOL
	DW	LIT,-1
	DW	XORR
	DW	EXIT
;
	DB	83H	; SP@
	DB	'SP'
	DB	'@'+80H
	DW	FLIP-7
SPAT	DW	$+2	;(S1) <- (SP)
	LXI	H,0
	DAD	SP	; (HL) <- (SP)
	JMP	HPUSH	; (S1) <- (HL)
;
	DB	82H	; 'S		1.5
	DB	27H
	DB	'S'+80H
	DW	SPAT-6
TS	DW	SPAT+2
;
	DB	83H	; STACK POINTER STORE
	DB	'SP'
	DB	'!'+80H
	DW	TS-5
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	84H	; EXIT		1.5
	DB	'EXI'
	DB	'T'+80H
	DW	RPSTO-6
EXIT	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	EXIT-7
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	82H	; 0=
	DB	'0'
	DB	'='+80H
	DW	FROMR-5
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	83H	; NOT		1.3
	DB	'NO'
	DB	'T'+80H
	DW	ZEQU-5
NOTT	DW	ZEQU+2
;
	DB	82H	; 0<
	DB	'0'
	DB	'<'+80H
	DW	NOTT-6
ZLESS	DW	$+2
	POP	PSW	; (A) <- (S1.HIGH)
	ORA	A	; IF (A) < 0
	LXI	H,0
	JP	HPUSH	; THEN (S1) <- FALSE
	INR	L
	JMP	HPUSH	; ELSE (S1) <- TRUE
;
	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	86H	; NEGATE	2.3
	DB	'NEGAT'
	DB	'E'+80H
	DW	DPLUS-5
NEG	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	87H	; DNEGATE	2.3
	DB	'DNEGAT'
	DB	'E'+80H
	DW	NEG-9
DNEG	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	82H	; D-		1.5
	DB	'D'
	DB	'-'+80H
	DW	DNEG-10
DSUB	DW	DOCOL
	DW	DNEG,DPLUS
	DW	EXIT
;
	DB	82H	; T+		2.1
	DB	'T'	; ( t1 t2 - tsum )
	DB	'+'+80H
	DW	DSUB-5
TPLUS	DW	DOCOL
	DW	TOR,ROT
	DW	TOR,TOR
	DW	SWAP,TOR
	DW	ZERO,SWAP
	DW	ZERO,DPLUS
	DW	ZERO,FROMR
	DW	ZERO,DPLUS
	DW	FROMR,ZERO
	DW	DPLUS,FROMR
	DW	PLUS,FROMR
	DW	PLUS
	DW	EXIT
;
	DB	87H	; TNEGATE	2.1
	DB	'TNEGAT' ; ( t - -t )
	DB	'E'+80H
	DW	TPLUS-5
TNEG	DW	DOCOL
	DW	TOR,TOR
	DW	FLIP,FROMR
	DW	FLIP,FROMR
	DW	FLIP,ONE
	DW	ZEROD,TPLUS
	DW	EXIT
;
	DB	82H	; T-		2.1
	DB	'T'	; ( t1 t2 - tdiff )
	DB	'-'+80H
	DW	TNEG-10
TSUB	DW	DOCOL
	DW	TNEG,TPLUS
	DW	EXIT
;
	DB	83H	; MT*		2.1
	DB	'MT'	; ( d n - t )
	DB	'*'+80H
	DW	TSUB-5
MTSTAR	DW	DOCOL
	DW	ROT
	DW	TOR,TOR
	DW	RAT,MSTAR
	DW	ZERO,DROT
	DW	FROMR,FROMR
	DW	OVER,USTAR
	DW	ROT,DPM	
	DW	STOD,TPLUS
	DW	EXIT
;
	DB	84H	; TABS		2.1
	DB	'TAB'	; ( t1 - t2 )
	DB	'S'+80H
	DW	MTSTAR-6
TABS	DW	DOCOL
	DW	DUP,ZLESS
	DW	QBRAN,TABS1-$	; IF
	DW	TNEG		; THEN
TABS1	DW	EXIT
;
	DB	83H	; MT/		2.3
	DB	'MT'	; ( t1 n - t2 )
	DB	'/'+80H
	DW	TABS-7
MTSL	DW	DOCOL
	DW	OVER
	DW	TOR,TOR
	DW	TABS,RAT
	DW	ABS,USLMOD
	DW	RAT,SWAP
	DW	TOR,USLMOD
	DW	FROMR,FROMR
	DW	RAT,XORR
	DW	DPM,ROT
	DW	FROMR,PM
	DW	EXIT
;
	DB	83H	; M*/		2.1
	DB	'M*'	; ( d1 n1 n2 - d2 )
	DB	'/'+80H
	DW	MTSL-6
MSSLA	DW	DOCOL
	DW	TOR,MTSTAR
	DW	FROMR,MTSL
	DW	DROP,EXIT
;
	DB	84H	; OVER
	DB	'OVE'
	DB	'R'+80H
	DW	MSSLA-6
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	85H	; 2DROP		1.3
	DB	'2DRO'
	DB	'P'+80H
	DW	TDUP-7
TDROP	DW	$+2
	POP	H
	POP	H
	JMP	NEXT
;
	DB	85H	; 2SWAP		1.4
	DB	'2SWA'
	DB	'P'+80H
	DW	TDROP-8
TSWAP	DW	$+2
	POP	H	; (HL) <- (S1)
	POP	D	; (DE) <- (S2)
	XTHL		; (HL) <- (S3)
;			; (S3) <- (HL)
	PUSH	H
	LXI	H,5
	DAD	SP
	MOV	A,M
	MOV	M,D
	MOV	D,A
	DCX	H
	MOV	A,M
	MOV	M,E
	MOV	E,A
	POP	H
	JMP	DPUSH	; (S1) <- (HL)
;			; (S2) <- (DE)
;
	DB	85H	; 2OVER		1.4
	DB	'2OVE'
	DB	'R'+80H
	DW	TSWAP-8
TOVER	DW	$+2
	LXI	H,7
	DAD	SP
	MOV	D,M
	DCX	H
	MOV	E,M
	PUSH	D
	DCX	H
	MOV	D,M
	DCX	H
	MOV	E,M
	PUSH	D
	JMP	NEXT
;
	DB	82H	; PLUS STORE
	DB	'+'
	DB	'!'+80H
	DW	TOVER-8
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	081H	; :		2.3
	DB	':'+80H	;  ( NOT IMMEDIATE )
	DW	TSTOR-5
COLON	DW	DOCOL
	DW	SCSP
	DW	CURR
	DW	AT
	DW	CONT
	DW	STORE
	DW	CREAT
	DW	SMUDG
	DW	RBRAC
	DW	PSCOD
;	EXECUTION-TIME CODE:
DOCOL	LHLD	RPP	;			1.3
	DCX	H	; (RP) <- (RP) - 2
	DCX	H
	SHLD	RPP
	MOV	M,C
	INX	H
	MOV	M,B	; (R1) <- (IP)
	INX	D	; (DE) <- CFA+2 = (W)
	MOV	C,E	; (IP) <- (DE) = (W)
	MOV	B,D
	JMP	NEXT
;
	DB	86H	; 0STATE	2.5
	DB	'0STAT'
	DB	'E'+80H
	DW	COLON-4
ZSTATE	DW	DOCOL,ZERO
	DW	STATE,STORE
	DW	EXIT
;
	DB	0C1H	; ;		2.5
	DB	';'+80H
	DW	ZSTATE-9
SEMI	DW	DOCOL
	DW	QCSP
	DW	COMP
	DW	EXIT
	DW	SMUDG
	DW	ZSTATE
	DW	FROMR,DROP
	DW	EXIT
;
	DB	84H	; NOOP		2.5
	DB	'NOO'
	DB	'P'+80H
	DW	SEMI-4
NOOP	DW	$+2
	JMP	NEXT
 ;
	DB	88H	; CONSTANT	1.5
	DB	'CONSTAN'
	DB	'T'+80H
	DW	NOOP-7
CON	DW	DOCOL
	DW	CREAT
	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	89H	; 2CONSTANT	1.4
	DB	'2CONSTAN'
	DB	'T'+80H
	DW	CON-11
TCON	DW	DOCOL
	DW	SWAP,CON
	DW	COMMA
	DW	PSCOD
DOTCON	INX	D	; (DE) <- PFA
	XCHG
	MOV	E,M	; (DE) <- (PFA)
	INX	H
	MOV	D,M
	PUSH	D	; (S2) <- (PFA)
	INX	H
	MOV	E,M	; (DE) <- (PFA+2)
	INX	H
	MOV	D,M
	PUSH	D	; (S1) <- (PFA+2)
	JMP	NEXT
;
	DB	88H	; VARIABLE	1.5
	DB	'VARIABL'
	DB	'E'+80H
	DW	TCON-12
VAR	DW	DOCOL
	DW	CREAT
	DW	LIT,2
	DW	ALLOT
	DW	EXIT
;
	DB	89H	; 2VARIABLE	1.5
	DB	'2VARIABL'
	DB	'E'+80H
	DW	VAR-11
TVAR	DW	DOCOL
	DW	CREAT
	DW	LIT,4
	DW	ALLOT
	DW	EXIT
;
	DB	84H	; USER
	DB	'USE'
	DB	'R'+80H
	DW	TVAR-12
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
	PAGE
;
;	SYSTEM CONSTANTS
;
	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	; 0.		1.5
	DB	'0'
	DB	'.'+80H
	DW	THREE-4
ZEROD	DW	DOTCON
	DW	0,0
;
	DB	82H	; BL	1.5
	DB	'B'
	DB	'L'+80H
	DW	ZEROD-5
BL	DW	DOCON
	DW	KBL
;
	DB	83H	; C/L ( CHARACTERS/LINE )
	DB	'C/'
	DB	'L'+80H
	DW	BL-5
CSLL	DW	DOCON
	DW	64
;
	DB	85H	; FIRST		1.5
	DB	'FIRS'
	DB	'T'+80H
	DW	CSLL-6
FIRST	DW	DOCON
	DW	KFIRST
;
	DB	85H	; LIMIT		1.5
	DB	'LIMI'
	DB	'T'+80H
	DW	FIRST-8
LIMIT	DW	DOCON
	DW	KLIMIT
;
	DB	85H	; B/BUF
	DB	'B/BU'	; ( BYTES/BUFFER )
	DB	'F'+80H
	DW	LIMIT-8
BBUF	DW	DOCON
	DW	KBBUF
;
	DB	87H	; BUF/SCR	1.5
	DB	'BUF/SC'	; ( BUFFERS/SCREEN )
	DB	'R'+80H
	DW	BBUF-8
BUFSCR	DW	DOCON
	DW	1
;
	DB	88H	; MESSAGES	1.5
	DB	'MESSAGE'	; ( SCR # OF ERROR MESSAGES )
	DB	'S'+80H
	DW	BUFSCR-10
MSGS	DW	DOCON,4
;
	DB	87H	; INITIAL	2.3
	DB	'INITIA'
	DB	'L'+80H
	DW	MSGS-11
INIT	DW	DOCON
	DW	9	; INITIAL LOAD SCREEN #
;
	DB	85H	; GIVEN		1.5
	DB	'GIVE'
	DB	'N'+80H
	DW	INIT-10
GIVEN	DW	DOCON
	DW	HCOLD	; ADDRESS OF TOP OF GIVEN DICT
;
	DB	87H	; +ORIGIN
	DB	'+ORIGI'
	DB	'N'+80H
	DW	GIVEN-8
PORIG	DW	DOCOL
	DW	LIT
	DW	ORIG
	DW	PLUS
	DW	EXIT
	PAGE
;
;	USER VARIABLES
;
;	FOLLOWING INITIALIZED BY COLD
;		USING +ORIGIN VALUES
;
	DB	82H	; S0
	DB	'S'
	DB	'0'+80H
	DW	PORIG-10
SZERO	DW	DOUSE
	DB	6
;
	DB	82H	; R0
	DB	'R'
	DB	'0'+80H
	DW	SZERO-5
RZERO	DW	DOUSE
	DB	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-10
FENCE	DW	DOUSE
	DB	10H
;
	DB	81H	; H		2.3
	DB	'H'+80H
	DW	FENCE-8
HP	DW	DOUSE
	DB	12H
;
	DB	88H	; VOC-LINK
	DB	'VOC-LIN'
	DB	'K'+80H
	DW	HP-4
VOCL	DW	DOUSE
	DB	14H
;
;	END OF INIT USING +ORIGIN VALUES
;
	DB	83H	; BLK
	DB	'BL'
	DB	'K'+80H
	DW	VOCL-0BH
BLK	DW	DOUSE
	DB	16H	; INIT BY QUIT
;
	DB	83H	; >IN		1.4
	DB	'>I'
	DB	'N'+80H
	DW	BLK-6
GIN	DW	DOUSE
	DB	18H
;
	DB	84H	; >OUT		1.5
	DB	'>OU'
	DB	'T'+80H
	DW	GIN-6
GOUT	DW	DOUSE
	DB	1AH
;
	DB	83H	; SCR
	DB	'SC'
	DB	'R'+80H
	DW	GOUT-7
SCR	DW	DOUSE
	DB	1CH	; INIT BY COLD
;
	DB	86H	; OFFSET
	DB	'OFFSE'
	DB	'T'+80H
	DW	SCR-6
OFSET	DW	DOUSE
	DB	1EH	; INIT BY COLD
;
	DB	87H	; CONTEXT
	DB	'CONTEX'
	DB	'T'+80H
	DW	OFSET-9
CONT	DW	DOUSE
	DB	20H	; INIT BY START
;
	DB	87H	; CURRENT
	DB	'CURREN'
	DB	'T'+80H
	DW	CONT-10
CURR	DW	DOUSE
	DB	22H	; INIT BY START
;
	DB	85H	; STATE
	DB	'STAT'
	DB	'E'+80H
	DW	CURR-0AH
STATE	DW	DOUSE
	DB	24H	; INIT BY QUIT
;
	DB	84H	; BASE
	DB	'BAS'
	DB	'E'+80H
	DW	STATE-8
BASE	DW	DOUSE
	DB	26H	; INIT BY START
;
	DB	83H	; PTR		2.3
	DB	'PT'
	DB	'R'+80H
	DW	BASE-7
PTR	DW	DOUSE
	DB	28H	; INIT BY (NUMBER)
;
	DB	82H	; H0		2.3
	DB	'H'
	DB	'0'+80H
	DW	PTR-6
H0	DW	DOUSE
	DB	2AH
;
	DB	83H	; CSP
	DB	'CS'
	DB	'P'+80H
	DW	H0-5
CSPP	DW	DOUSE
	DB	2CH	; INIT BY :
;
	DB	82H	; R#
	DB	'R'
	DB	'#'+80H
	DW	CSPP-6
RNUM	DW	DOUSE
	DB	2EH	; INIT BY COLD
;
	DB	83H	; HLD
	DB	'HL'
	DB	'D'+80H
	DW	RNUM-5
HLD	DW	DOUSE
	DB	30H	; INIT BY <#
;
;	FOLLOWING INITIALIZED BY COLD
;
	DB	83H	; 'CR		1.4
	DB	27H
	DB	'C'
	DB	'R'+80H
	DW	HLD-6
TCR	DW	DOUSE
	DB	32H
;
	DB	85H	; 'EMIT		1.4
	DB	27H
	DB	'EMI'
	DB	'T'+80H
	DW	TCR-6
TEMIT	DW	DOUSE
	DB	34H
;
	DB	84H	; 'KEY		1.4
	DB	27H
	DB	'KE'
	DB	'Y'+80H
	DW	TEMIT-8
TKEY	DW	DOUSE
	DB	36H
;
	DB	85H	; 'PAGE		1.4
	DB	27H
	DB	'PAG'
	DB	'E'+80H
	DW	TKEY-7
TPAGE	DW	DOUSE
	DB	38H
;
	DB	85H	; '?KEY		2.5
	DB	27H
	DB	'?KE'
	DB	'Y'+80H
	DW	TPAGE-8
TQKEY	DW	DOUSE
	DB	3AH
;
	DB	87H	; 'CREATE	1.4
	DB	27H
	DB	'CREAT'
	DB	'E'+80H
	DW	TQKEY-8
TCREAT	DW	DOUSE
	DB	3CH
;
	DB	87H	; 'NUMBER	1.4
	DB	27H
	DB	'NUMBE'
	DB	'R'+80H
	DW	TCREAT-10
TNUMB	DW	DOUSE
	DB	3EH
;
	DB	87H	; '(QUIT)	1.5
	DB	27H,'(QUIT'
	DB	')'+80H
	DW	TNUMB-10
TPQUIT	DW	DOUSE
	DB	40H
;
	DB	86H	; BLOCKS	1.5
	DB	'BLOCK'	; WRITE ENABLE LIMITS
	DB	'S'+80H	; CONTAINS  BLOCK#
	DW	TPQUIT-10  ; FOR 1ST AND LAST LIMIT
BLOCKS	DW	DOUSE
	DB	42H	; ALSO 44H
;
	DB	89H	; '(ABORT")	2.3
	DB	27H,'(ABORT"'
	DB	')'+80H
	DW	BLOCKS-9
TPABOR	DW	DOUSE
	DB	46H
;
	DB	85H	; 'WORD		2.3
	DB	27H,'WOR'
	DB	'D'+80H
	DW	TPABOR-12
TWORD	DW	DOUSE
	DB	48H
;
	DB	86H	; '?FIND	2.3
	DB	27H,'?FIN'
	DB	'D'+80H
	DW	TWORD-8
TQFIND	DW	DOUSE
	DB	4AH
;
	DB	86H	; LENGTH	2.3
	DB	'LENGT'
	DB	'H'+80H
	DW	TQFIND-9
LENGTH	DW	DOUSE
	DB	4CH
;
;	END OF INITIALIZED BY COLD
;
;	END OF USER VARIABLES
;	NEXT AVAILABLE USER BYTE AT	4EH = 78
;
	DB	82H	; 1+
	DB	'1'
	DB	'+'+80H
	DW	LENGTH-9
ONEP	DW	$+2
	POP	H
	INX	H
	JMP	HPUSH
;
	DB	82H	; 2+
	DB	'2'
	DB	'+'+80H
	DW	ONEP-5
TWOP	DW	$+2
	POP	H
	INX	H
	INX	H
	JMP	HPUSH
;
	DB	82H	; 1-		1.3
	DB	'1'
	DB	'-'+80H
	DW	TWOP-5
ONEM	DW	$+2
	POP	H
	DCX	H
	JMP	HPUSH
;
	DB	82H	; 2-		1.3
	DB	'2'
	DB	'-'+80H
	DW	ONEM-5
TWOM	DW	$+2
	POP	H
	DCX	H
	DCX	H
	JMP	HPUSH
;
	DB	82H	; 2*		1.4
	DB	'2'
	DB	'*'+80H
	DW	TWOM-5
TWOT	DW	$+2
	POP	H
	DAD	H
	JMP	HPUSH
;
	DB	82H	; 2/		1.3
	DB	'2'
	DB	'/'+80H
	DW	TWOT-5
TWOD	DW	$+2
	POP	H
	MOV	A,H
	RLC
	RRC
	RAR
	MOV	H,A
	MOV	A,L
	RAR
	MOV	L,A
	JMP	HPUSH
;
	DB	84H	; HERE		2.3
	DB	'HER'
	DB	'E'+80H
	DW	TWOD-5
HERE	DW	DOCOL
	DW	HP,AT
	DW	EXIT
;
	DB	85H	; ALLOT		2.3
	DB	'ALLO'
	DB	'T'+80H
	DW	HERE-7
ALLOT	DW	DOCOL
	DW	HP,PSTOR
	DW	EXIT
;
	DB	81H	; ,
	DB	','+80H
	DW	ALLOT-8
COMMA	DW	DOCOL
	DW	HERE
	DW	STORE
	DW	TWO
	DW	ALLOT
	DW	EXIT
;
	DB	82H	; C,
	DB	'C'
	DB	','+80H
	DW	COMMA-4
CCOMM	DW	DOCOL
	DW	HERE
	DW	CSTOR
	DW	ONE
	DW	ALLOT
	DW	EXIT
;
;	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	EXIT
;
	DB	82H	; <>		1.3
	DB	'<'
	DB	'>'+80H
	DW	EQUAL-4
NEQU	DW	DOCOL
	DW	SUBB
	DW	ZEQU
	DW	ZEQU
	DW	EXIT
;
	DB	81H	; <
	DB	'<'+80H		; X  <  Y
	DW	NEQU-5		; 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	QBRAN,ULES1-$	; IF
	DW	DROP,ZLESS
	DW	ZEQU
	DW	BRAN,ULES2-$
ULES1	DW	SUBB,ZLESS	; ELSE
ULES2	DW	EXIT		; THEN
;
	DB	81H	; >
	DB	'>'+80H
	DW	ULESS-5
GREAT	DW	DOCOL
	DW	SWAP
	DW	LESS
	DW	EXIT
;
	DB	82H	; 0>		1.3
	DB	'0'
	DB	'>'+80H
	DW	GREAT-4
ZGREA	DW	DOCOL
	DW	ZERO,GREAT
	DW	EXIT
;
	DB	86H	; WITHIN	1.5
	DB	'WITHI'
	DB	'N'+80H
	DW	ZGREA-5
WITHIN	DW	DOCOL
	DW	TOR,ONEM
	DW	OVER,LESS
	DW	SWAP,FROMR
	DW	LESS,ANDD
	DW	EXIT
;
	DB	83H	; ROT
	DB	'RO'
	DB	'T'+80H
	DW	WITHIN-9
ROT	DW	$+2
	POP	D
	POP	H
	XTHL
	JMP	DPUSH
;
	DB	84H	; -ROT		1.3
	DB	'-RO'
	DB	'T'+80H
	DW	ROT-6
DROT	DW	DOCOL
	DW	ROT,ROT
	DW	EXIT
;
	DB	85H	; SPACE
	DB	'SPAC'
	DB	'E'+80H
	DW	DROT-7
SPACE	DW	DOCOL
	DW	BL
	DW	EMIT
	DW	EXIT
;
	DB	84H	; ?DUP		2.3
	DB	'?DU'
	DB	'P'+80H
	DW	SPACE-8
QDUP	DW	DOCOL
	DW	DUP
	DW	QBRAN,QDUP1-$	; IF
	DW	DUP	; THEN
QDUP1	DW	EXIT
;
	DB	88H	; TRAVERSE
	DB	'TRAVERS'
	DB	'E'+80H
	DW	QDUP-7
TRAV	DW	DOCOL
	DW	SWAP
TRAV1	DW	OVER	; BEGIN
	DW	PLUS
	DW	LIT
	DW	7FH
	DW	OVER
	DW	CAT
	DW	LESS
	DW	QBRAN	; UNTIL
	DW	TRAV1-$
	DW	SWAP
	DW	DROP
	DW	EXIT
;
	DB	86H	; LATEST
	DB	'LATES'
	DB	'T'+80H
	DW	TRAV-0BH
LATES	DW	DOCOL
	DW	CURR
	DW	AT
	DW	AT
	DW	EXIT
;
	DB	83H	; LFA
	DB	'LF'
	DB	'A'+80H
	DW	LATES-9
LFA	DW	DOCOL
	DW	LIT
	DW	4
	DW	SUBB
	DW	EXIT
;
	DB	83H	; CFA
	DB	'CF'
	DB	'A'+80H
	DW	LFA-6
CFA	DW	DOCOL
	DW	TWO
	DW	SUBB
	DW	EXIT
;
	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	EXIT
;
	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	EXIT
;
	DB	84H	; STORE CSP
	DB	'!CS'
	DB	'P'+80H
	DW	PFA-6
SCSP	DW	DOCOL
	DW	SPAT
	DW	CSPP
	DW	STORE
	DW	EXIT
;
;			  ?ERROR REMOVED	2.1
;
	DB	85H	; ?COMP		2.1
	DB	'?COM'
	DB	'P'+80H
	DW	SCSP-7
QCOMP	DW	DOCOL
	DW	STATE
	DW	AT
	DW	ZEQU
	DW	PABORT
	DB	30,'Must be used inside definition'
	DW	EXIT
;
	DB	85H	; ?EXEC		2.1
	DB	'?EXE'
	DB	'C'+80H
	DW	QCOMP-8
QEXEC	DW	DOCOL
	DW	STATE,AT
	DW	PABORT
	DB	32,'Cannot be used inside definition'
	DW	EXIT
;
	DB	86H	; ?PAIRS	2.1
	DB	'?PAIR'
	DB	'S'+80H
	DW	QEXEC-8
QPAIR	DW	DOCOL
	DW	SUBB
	DW	PABORT
	DB	24,'Missing conditional word'
	DW	EXIT
;
	DB	84H	; ?CSP		2.1
	DB	'?CS'
	DB	'P'+80H
	DW	QPAIR-9
QCSP	DW	DOCOL
	DW	SPAT
	DW	CSPP
	DW	AT
	DW	SUBB
	DW	PABORT
	DB	34,'Incomplete or incorrect definition'
	DW	EXIT
;
	DB	88H	; ?LOADING	2.1
	DB	'?LOADIN'
	DB	'G'+80H
	DW	QCSP-7
QLOAD	DW	DOCOL
	DW	BLK
	DW	AT
	DW	ZEQU
	DW	PABORT
	DB	29,'Can only be used when LOADing'
	DW	EXIT
;
	DB	87H	; COMPILE	2.4
	DB	'COMPIL'
	DB	'E'+80H
	DW	QLOAD-0BH
COMP	DW	DOCOL
	DW	FROMR
	DW	DUP
	DW	TWOP
	DW	TOR
	DW	AT
	DW	COMMA
	DW	EXIT
;
	DB	8AH	; IMMEDIATE?	2.5
	DB	'IMMEDIATE'
	DB	'?'+80H	;  ( PFA -- F )
	DW	COMP-10
IMMEDQ	DW	DOCOL
	DW	NFA,CAT
	DW	LIT,40H
	DW	ANDD,EXIT
;
	DB	0C1H	; [		2.5
	DB	'['+80H
	DW	IMMEDQ-13
LBRAC	DW	DOCOL
	DW	ZSTATE
	DW	FROMR,DROP
	DW	EXIT
;
	DB	81H	; ]		2.5
	DB	']'+80H
	DW	LBRAC-4
RBRAC	DW	DOCOL
	DW	LIT,0C0H
	DW	STATE,STORE
RBRAC1	DW	FINDQ		; BEGIN
	DW	QBRAN,RBRAC2-$  ;   IF
	DW	DUP,IMMEDQ
	DW	QBRAN,RBRAC3-$	;     IF
	DW	EXEC
	DW	BRAN,RBRAC4-$	;     ELSE
RBRAC3	DW	CFA,COMMA	;     THEN
	DW	BRAN,RBRAC4-$	;   ELSE
RBRAC2	DW	HERE,NUMB
	DW	PTR,AT
	DW	ZLESS
	DW	QBRAN,RBRAC5-$	;     IF
	DW	DROP,LITER
	DW	BRAN,RBRAC4-$	;     ELSE
RBRAC5	DW	DLITE		;     THEN
RBRAC4	DW	QSTAC,PABORT	;   THEN
	DB	17,'Stack underflowed'
	DW	BRAN,RBRAC1-$	; AGAIN
	DW	EXIT
;
	DB	86H	; SMUDGE
	DB	'SMUDG'
	DB	'E'+80H
	DW	RBRAC-4
SMUDG	DW	DOCOL
	DW	LATES
	DW	LIT
	DW	20H
	DW	TOGGL
	DW	EXIT
;
	DB	83H	; HEX
	DB	'HE'
	DB	'X'+80H
	DW	SMUDG-9
HEX	DW	DOCOL
	DW	LIT
	DW	10H
	DW	BASE
	DW	STORE
	DW	EXIT
;
	DB	87H	; DECIMAL
	DB	'DECIMA'
	DB	'L'+80H
	DW	HEX-6
DEC	DW	DOCOL
	DW	LIT
	DW	0AH
	DW	BASE
	DW	STORE
	DW	EXIT
;
	DB	86H	; BINARY	1.3
	DB	'BINAR'
	DB	'Y'+80H
	DW	DEC-10
BIN	DW	DOCOL
	DW	LIT,2
	DW	BASE,STORE
	DW	EXIT
;
	DB	85H	; OCTAL		1.5
	DB	'OCTA'
	DB	'L'+80H
	DW	BIN-9
OCTAL	DW	DOCOL
	DW	LIT,8
	DW	BASE,STORE
	DW	EXIT
;
	DB	87H	; (;CODE)
	DB	'(;CODE'
	DB	')'+80H
	DW	OCTAL-8
PSCOD	DW	DOCOL
	DW	FROMR
	DW	LATES
	DW	PFA
	DW	CFA
	DW	STORE
	DW	EXIT
;
	DB	0C5H	; ;CODE		2.5
	DB	';COD'
	DB	'E'+80H
	DW	PSCOD-0AH
SEMIC	DW	DOCOL
	DW	QCSP,SMUDG
	DW	COMP
	DW	PSCOD
	DW	ZSTATE
	DW	FROMR,DROP
	DW	ASMB
	DW	EXIT
;
	DB	0C5H	; DOES>		1.5
	DB	'DOES'
	DB	'>'+80H
	DW	SEMIC-8
DOES	DW	DOCOL
	DW	QCSP
	DW	COMP,PSCOD
	DW	LIT,0CDH	; CALL OP-CODE
	DW	CCOMM
	DW	LIT,PDOES+2
	DW	COMMA,EXIT
;
	DB	87H	; (DOES>)	1.5
	DB	'(DOES>'
	DB	')'+80H
	DW	DOES-8
PDOES	DW	$+2
	INX	D	; (W) = PFA MEMBER
	LHLD	RPP	; PUSH (IP) ONTO R STACK
	DCX	H
	MOV	M,B
	DCX	H
	MOV	M,C
	SHLD	RPP
	POP	B	; (IP) <- (S1) = CELL AFTER
;			  DOES> IN DEFINING WORD'S DEF
	PUSH	D	; (S1) <- (W) = PFA MEMBER
	JMP	NEXT
;
	DB	85H	; COUNT
	DB	'COUN'
	DB	'T'+80H
	DW	PDOES-10
COUNT	DW	DOCOL
	DW	DUP
	DW	ONEP
	DW	SWAP
	DW	CAT
	DW	EXIT
;
	DB	84H	; TYPE		2.3
	DB	'TYP'
	DB	'E'+80H
	DW	COUNT-8
TYPE	DW	DOCOL
	DW	QDUP
	DW	QBRAN	; 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	; THEN
TYPE3	DW	EXIT
;
	DB	85H	; >TYPE		1.5
	DB	'>TYP'
	DB	'E'+80H
	DW	TYPE-7
GTYPE	DW	DOCOL
	DW	TOR
	DW	PAD,RAT
	DW	CMOVE
	DW	PAD,FROMR
	DW	TYPE
	DW	EXIT
;
	DB	89H	; -TRAILING	2.1
	DB	'-TRAILIN'
	DB	'G'+80H
	DW	GTYPE-8
DTRAI	DW	DOCOL
	DW	DUP
	DW	ZERO
	DW	XDO	; DO
DTRA1	DW	TDUP
	DW	PLUS
	DW	ONEM
	DW	CAT
	DW	BL
	DW	SUBB
	DW	QBRAN	; IF
	DW	DTRA2-$
	DW	LEAVE
	DW	BRAN	; ELSE
	DW	DTRA3-$
DTRA2	DW	ONEM	; THEN
DTRA3	DW	XLOOP	; LOOP
	DW	DTRA1-$
	DW	EXIT
;
	DB	84H	; (.")
	DB	'(."'
	DB	')'+80H
	DW	DTRAI-0CH
PDOTQ	DW	DOCOL
	DW	RAT
	DW	COUNT
	DW	DUP
	DW	ONEP
	DW	FROMR
	DW	PLUS
	DW	TOR
	DW	TYPE
	DW	EXIT
;
	DB	0C2H	; ."		1.5
	DB	'.'
	DB	'"'+80H
	DW	PDOTQ-7
DOTQ	DW	DOCOL
	DW	LIT
	DW	22H
	DW	STATE
	DW	AT
	DW	QBRAN	; IF
	DW	DOTQ1-$
	DW	COMP
	DW	PDOTQ
	DW	WORD
	DW	CAT
	DW	ONEP
	DW	ALLOT
	DW	BRAN	; ELSE
	DW	DOTQ2-$
DOTQ1	DW	WORD
	DW	COUNT
	DW	TYPE	; THEN
DOTQ2	DW	EXIT
;
	DB	86H	; EXPECT	2.2
	DB	'EXPEC'
	DB	'T'+80H
	DW	DOTQ-5
EXPEC	DW	DOCOL
	DW	OVER
	DW	PLUS
	DW	OVER
	DW	XDO		; DO
EXPEC1	DW	KEY
	DW	DUP
	DW	LIT,14		; INPUT BACK SPACE
	DW	PORIG
	DW	AT
	DW	EQUAL
	DW	OVER		; OR DELETE CHR
	DW	LIT,KDEL
	DW	EQUAL,ORR
	DW	QBRAN,EXPEC2-$	; IF
	DW	DROP
	DW	DUP
	DW	IDO
	DW	EQUAL
	DW	DUP
	DW	FROMR
	DW	TWOM
	DW	PLUS
	DW	TOR
	DW	QBRAN,EXPEC6-$	; IF
	DW	LIT,KBELL
	DW	EMIT
	DW	BRAN,EXPEC7-$	; ELSE
EXPEC6	DW	BS		; THEN
EXPEC7	DW	BRAN,EXPEC3-$	; ELSE
EXPEC2	DW	DUP
	DW	LIT,KCR
	DW	EQUAL
	DW	QBRAN,EXPEC4-$	; IF
	DW	LEAVE
	DW	DROP
	DW	BL
	DW	ZERO
	DW	BRAN,EXPEC5-$	; ELSE
EXPEC4	DW	DUP		; THEN
EXPEC5	DW	IDO
	DW	CSTOR
	DW	ZERO
	DW	IDO
	DW	ONEP
	DW	STORE		; THEN
	DW	EMIT
EXPEC3	DW	XLOOP,EXPEC1-$	; LOOP
	DW	DROP
	DW	EXIT
;
	DB	85H	; QUERY		2.3
	DB	'QUER'
	DB	'Y'+80H
	DW	EXPEC-9
QUERY	DW	DOCOL
	DW	TIB
	DW	AT
	DW	LIT,80
	DW	EXPEC
	DW	ZERO
	DW	GIN,STORE
	DW	EXIT
;
;			  THE NULL WORD
;		  LISTED AS   X   IN FORTH SOURCE
	DB	0C1H	; 0		1.5
	DB	80H
	DW	QUERY-8
NULL	DW	DOCOL
	DW	BLK
	DW	AT
	DW	QBRAN	; IF
	DW	NULL1-$
	DW	QEXEC
NULL1	DW	FROMR
	DW	DROP	; THEN
NULL3	DW	EXIT
;
	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	EXIT
;
	DB	85H	; BLANK		1.5
	DB	'BLAN'
	DB	'K'+80H
	DW	ERASEE-8
BLANK	DW	DOCOL
	DW	BL,FILL
	DW	EXIT
;
	DB	84H	; HOLD
	DB	'HOL'
	DB	'D'+80H
	DW	BLANK-8
HOLD	DW	DOCOL
	DW	LIT
	DW	-1
	DW	HLD
	DW	PSTOR
	DW	HLD
	DW	AT
	DW	CSTOR
	DW	EXIT
;
	DB	83H	; PAD		1.5
	DB	'PA'
	DB	'D'+80H
	DW	HOLD-7
PAD	DW	DOCOL
	DW	HERE
	DW	LIT,84
	DW	PLUS
	DW	EXIT
;
	DB	84H	; WORD		2.2
	DB	'WOR'
	DB	'D'+80H
	DW	PAD-6
WORD	DW	DOCOL
	DW	TWORD,AT
	DW	EXEC
	DW	EXIT
;
	DB	86H	; (WORD)	2.3
	DB	'(WORD'
	DB	')'+80H
	DW	WORD-7
PWORD	DW	DOCOL
	DW	BLK
	DW	AT
	DW	QBRAN,PWORD1-$	; IF
	DW	BLK
	DW	AT
	DW	BLOCK
	DW	BRAN,PWORD2-$	; ELSE
PWORD1	DW	TIB
	DW	AT	; THEN
PWORD2	DW	GIN
	DW	AT
	DW	PLUS
	DW	SWAP
	DW	ENCL
;;	DW	HERE,LIT,84,BLANK
	DW	GIN
	DW	PSTOR
	DW	OVER
	DW	SUBB
	DW	TOR
	DW	RAT
	DW	HERE
	DW	CSTOR
	DW	PLUS
	DW	HERE
	DW	ONEP
	DW	RAT,CMOVE
	DW	LIT,2020H
	DW	FROMR
	DW	HERE,PLUS
	DW	ONEP,STORE
	DW	HERE
	DW	EXIT
;
	DB	87H	; CONVERT	2.3
	DB	'CONVER'  ; ( FORMERLY (NUMBER) )
	DB	'T'+80H
	DW	PWORD-9
CONV	DW	DOCOL
CONV1	DW	ONEP	; BEGIN
	DW	DUP
	DW	TOR
	DW	CAT
	DW	BASE
	DW	AT
	DW	DIGIT
	DW	QBRAN,CONV2-$	; WHILE
	DW	SWAP
	DW	BASE
	DW	AT
	DW	USTAR
	DW	DROP
	DW	ROT
	DW	BASE
	DW	AT
	DW	USTAR
	DW	DPLUS
	DW	PTR,AT
	DW	ONEP
	DW	QBRAN,CONV3-$	; IF
	DW	ONE
	DW	PTR,PSTOR	; THEN
CONV3	DW	FROMR
	DW	BRAN,CONV1-$	; REPEAT
CONV2	DW	FROMR
	DW	EXIT
;
	DB	87H	; >BINARY	1.5
	DB	'>BINAR'
	DB	'Y'+80H
	DW	CONV-10
TBIN	DW	DOCOL
	DW	CONV,EXIT
;
	DB	86H	; NUMBER		1.4
	DB	'NUMBE'
	DB	'R'+80H
	DW	TBIN-10
NUMB	DW	DOCOL
	DW	TNUMB,AT
	DW	EXEC,EXIT
;
	DB	88H	; (NUMBER)	2.3
	DB	'(NUMBER'
	DB	')'+80H
	DW	NUMB-9
PNUMB	DW	DOCOL
	DW	ZERO
	DW	ZERO
	DW	ROT
	DW	DUP
	DW	ONEP
	DW	CAT
	DW	LIT,'-'
	DW	EQUAL
	DW	DUP
	DW	TOR
	DW	PLUS
	DW	LIT
	DW	-1
PNUMB1	DW	PTR,STORE	; BEGIN
	DW	CONV,DUP
	DW	CAT
	DW	BL
	DW	SUBB
	DW	QBRAN,PNUMB2-$	; WHILE
	DW	DUP
	DW	CAT
	DW	DUP
	DW	LIT,':'
	DW	EQUAL,SWAP
	DW	LIT,','
	DW	LIT,'/'+1
	DW	WITHIN
	DW	ORR,NOTT
	DW	PABORT
	DB	1,'?'
PNUMB4	DW	ZERO
	DW	BRAN,PNUMB1-$	; REPEAT
PNUMB2	DW	DROP
	DW	FROMR
	DW	QBRAN,PNUMB3-$	; IF
	DW	DNEG	; THEN
PNUMB3	DW	EXIT
;
	DB	85H	; FIND?		2.3
	DB	'FIND'
	DB	'?'+80H
	DW	PNUMB-11
FINDQ	DW	DOCOL
	DW	TQFIND,AT
	DW	EXEC
	DW	EXIT
;
	DB	87H	; (FIND?)	2.4
	DB	'(FIND?'
	DB	')'+80H
	DW	FINDQ-8
PFINDQ	DW	DOCOL
	DW	BL
	DW	WORD
	DW	DUP,TOR
	DW	CONT
	DW	AT
	DW	AT
	DW	BFINDQ,QDUP
	DW	ZEQU
	DW	QBRAN,PFINQ1-$	; IF
	DW	FROMR
	DW	LATES,BFINDQ
	DW	BRAN,PFINQ2-$
PFINQ1	DW	FROMR,DROP	; ELSE
PFINQ2	DW	EXIT		; THEN
;
	DB	82H	; -'		2.3
	DB	'-'
	DB	27H+80H
	DW	PFINDQ-10
DTICK	DW	DOCOL,FINDQ
	DW	QBRAN,DTICK1-$	; IF
	DW	ZERO
	DW	BRAN,DTICK2-$
DTICK1	DW	HERE,ONE	; ELSE
DTICK2	DW	EXIT		; THEN
;
;			 (ABORT) REMOVED 2.1
;			 ERROR   REMOVED 2.1
;			   SEE (ABORT")
;
	DB	86H	; CREATE		1.4
	DB	'CREAT'
	DB	'E'+80H
	DW	DTICK-5
CREAT	DW	DOCOL
	DW	TCREAT,AT
	DW	EXEC,EXIT
;
	DB	88H	; (CREATE)		2.3
	DB	'(CREATE'
	DB	')'+80H
	DW	CREAT-9
PCREAT	DW	DOCOL
	DW	FINDQ
	DW	QBRAN	; IF
	DW	CREA1-$
	DW	DUP
	DW	LIT,NULL+2
	DW	EQUAL,PABORT
	DB	10,'Needs name'
	DW	THREE,SPACS
	DW	NFA
	DW	IDDOT
	DW	PDOTQ
	DB	13,'Isn',27H,'t unique.'
	DW	SPACE	; THEN
CREA1	DW	HERE
	DW	DUP
	DW	CAT
	DW	WIDTH
	DW	AT
	DW	MIN
	DW	ONEP
	DW	ALLOT
	DW	DUP
	DW	LIT
	DW	80H	; NO SMUDGE
	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	ZERO
	DW	COMMA
	DW	PSCOD
DOVAR	INX	D	; (DE) <- PFA
	PUSH	D	; (S1) <- PFA
	JMP	NEXT
;
	DB	87H	; VCREATE	2.1
	DB	'VCREAT'
	DB	'E'+80H
	DW	PCREAT-11
VCREAT	DW	DOCOL
	DW	BLK,AT
	DW	COMMA
	DW	PCREAT
	DW	EXIT
;
	DB	0C9H	; [COMPILE]	2.4
	DB	'[COMPILE'
	DB	']'+80H
	DW	VCREAT-10
BCOMP	DW	DOCOL
	DW	FINDQ
	DW	ZEQU
	DW	PABORT
	DB	1,'?'
	DW	CFA
	DW	COMMA
	DW	EXIT
;
	DB	0C7H	; LITERAL
	DB	'LITERA'
	DB	'L'+80H
	DW	BCOMP-0CH
LITER	DW	DOCOL
	DW	STATE
	DW	AT
	DW	QBRAN	; IF
	DW	LITE1-$
	DW	COMP
	DW	LIT
	DW	COMMA	; THEN
LITE1	DW	EXIT
;
	DB	0C8H	; DLITERAL
	DB	'DLITERA'
	DB	'L'+80H
	DW	LITER-0AH
DLITE	DW	DOCOL
	DW	STATE
	DW	AT
	DW	QBRAN	; IF
	DW	DLIT1-$
	DW	SWAP
	DW	LITER
	DW	LITER	; THEN
DLIT1	DW	EXIT
;
	DB	86H	; ?STACK	2.1
	DB	'?STAC'
	DB	'K'+80H
	DW	DLITE-11
QSTAC	DW	DOCOL
	DW	SPAT
	DW	SZERO
	DW	AT
	DW	SWAP
	DW	ULESS
	DW	EXIT
;
	DB	89H	; INTERPRET	2.5
	DB	'INTERPRE'
	DB	'T'+80H
	DW	QSTAC-9
INTER	DW	DOCOL
INTE1	DW	FINDQ		; BEGIN
	DW	QBRAN,INTE2-$	;  IF
	DW	EXEC
	DW	BRAN,INTE3-$	;  ELSE
INTE2	DW	HERE,NUMB
	DW	PTR,AT
	DW	ZLESS
	DW	QBRAN,INTE3-$	;   IF
	DW	DROP		;   THEN
INTE3	DW	QSTAC,PABORT	;  THEN
	DB	17,'Stack underflowed'
	DW	BRAN,INTE1-$	; AGAIN
	DW	EXIT
;
	DB	89H	; IMMEDIATE
	DB	'IMMEDIAT'
	DB	'E'+80H
	DW	INTER-0CH
IMMED	DW	DOCOL
	DW	LATES
	DW	LIT
	DW	40H
	DW	TOGGL
	DW	EXIT
;
	DB	8AH	; VOCABULARY		2.3
	DB	'VOCABULAR'
	DB	'Y'+80H
	DW	IMMED-0CH
VOCAB	DW	DOCOL,CREAT
	DW	LIT,0A081H
	DW	COMMA
	DW	CURR
	DW	AT
	DW	CFA
	DW	COMMA
	DW	HERE
	DW	VOCL
	DW	AT
	DW	COMMA
	DW	VOCL
	DW	STORE
	DW	PSCOD
DOVOC	CALL	PDOES+2
	DW	TWOP
	DW	CONT
	DW	STORE
	DW	EXIT
;
	DB	85H	; FORTH		2.1
	DB	'FORT'
	DB	'H'+80H
	DW	VOCAB-13
FORTH	DW	DOVOC
FORTHN	DW	0A081H
FORTHP	DW	FLAST	;   COLD START VALUE ONLY
;			  CHANGED EACH TIME A DEF IS APPENDED
;			  TO THE FORTH VOCABULARY
FORTV	DW	0	; END OF VOCABULARY LIST
;
	DB	8BH	; DEFINITIONS
	DB	'DEFINITION'
	DB	'S'+80H
	DW	FORTH-8
DEFIN	DW	DOCOL
	DW	CONT
	DW	AT
	DW	CURR
	DW	STORE
	DW	EXIT
;
	DB	0C1H	; (		1.5
	DB	'('+80H
	DW	DEFIN-14
PAREN	DW	DOCOL
	DW	LIT,')'
	DW	WORD
	DW	DROP
	DW	EXIT
;
	DB	86H	; (QUIT)	1.5
	DB	'(QUIT'
	DB	')'+80H
	DW	PAREN-4
PQUIT	DW	DOCOL
	DW	TPQUIT,AT
	DW	EXEC,EXIT
;
	DB	84H	; QUIT		2.5
	DB	'QUI'
	DB	'T'+80H
	DW	PQUIT-9
QUIT	DW	DOCOL
	DW	ZERO
	DW	BLK
	DW	STORE
	DW	ZSTATE
QUIT1	DW	RPSTO	; BEGIN
	DW	PQUIT	; EXECUTE USER SUPPLIED ROUTINE
	DW	CR
	DW	QUERY
	DW	INTER
	DW	STATE
	DW	AT
	DW	ZEQU
	DW	QBRAN	; IF
	DW	QUIT2-$
	DW	PDOTQ
	DB	2
	DB	'ok'	; THEN
QUIT2	DW	BRAN	; AGAIN
	DW	QUIT1-$
	DW	EXIT
;
	DB	85H	; START		2.3
	DB	'STAR'	; FORMERLY ABORT
	DB	'T'+80H
	DW	QUIT-7
START	DW	DOCOL
	DW	SPSTO
	DW	DEC
	DW	CR
	DW	DOTCPU
	DW	PDOTQ
	DB	19,'WORKING FORTH '
	DB	KREL+30H
	DB	KDOT,KREV+30H
	DB	KDOT,KVER+30H
	DW	CR,PDOTQ
	DB	42,'(C) Copyright 1982 by Laxen & Harris, Inc.'
	DW	FORTH
	DW	DEFIN
	DW	QUIT
	DW	EXIT
;
	DB	88H	; (ABORT")	2.1
	DB	'(ABORT"'
	DB	')'+80H
	DW	START-8
PABORT	DW	DOCOL
	DW	QBRAN,PABOR1-$		; IF
	DW	TPABOR,AT
	DW	EXEC
PABOR1	DW	FROMR,COUNT
	DW	PLUS,TOR
	DW	EXIT
;
	DB	85H	; ABORT		2.3
	DB	'ABOR'
	DB	'T'+80H
	DW	PABORT-11
ABORT	DW	DOCOL
	DW	SPSTO
	DW	BLK,AT
	DW	QDUP
	DW	QBRAN,ABOR1-$		;  IF
	DW	GIN,AT
	DW	SWAP,DWHERE		;  THEN
ABOR1	DW	QUIT
	DW	EXIT
;
	DB	88H	; <ABORT">	2.3
	DB	'<ABORT"'
	DB	'>'+80H
	DW	ABORT-8
BABORT	DW	DOCOL
	DW	THREE,SPACS
	DW	HERE,COUNT
	DW	TYPE,SPACE
	DW	IPRIM,COUNT
	DW	TYPE,ABORT
	DW	EXIT
;
	DB	0C6H	; ABORT"	2.1
	DB	'ABORT'
	DB	'"'+80H
	DW	BABORT-11
ABORTQ	DW	DOCOL
	DW	QCOMP
	DW	COMP,PABORT
	DW	LIT,'"'
	DW	WORD,CAT
	DW	ONEP,ALLOT
	DW	EXIT
	PAGE
;
;	FORTH SYSTEM INITIALIZATION
;
;	WARM START    ( SAVES DICTIONARY )
;
;	MACHINE EXECUTION ENTRY TO WARM		2.3
WRM	LXI	B,WRM1   ; INITIALIZE (IP)
	JMP	NEXT
WRM1	DW	WARM
;
	DB	84H	; WARM		2.2
	DB	'WAR'
	DB	'M'+80H
	DW	ABORTQ-9
WARM	DW	DOCOL
	DW	MTBUF
	DW	START
;	------------------------------------
;
;	COLD START	( INITIALIZES EVERYTHING )
;
;	MACHINE EXECUTION ENTRY TO COLD		2.3
CLD	LXI	B,CLD1    ; INITIALIZE (IP)
	LHLD	ORIG+12H  ;  INITIALIZE (SP)
	SPHL
	LHLD	ORIG+14H  ;  INITIALIZE (RP)
	XCHG
	LXI	H,RPP
	MOV	M,E
	INX	H
	MOV	M,D
	JMP	NEXT
CLD1	DW	COLD
;	-------------------------------------
;
	DB	84H	; COLD		2.5
	DB	'COL'
	DB	'D'+80H
	DW	WARM-7
COLD	DW	DOCOL
	DW	LIT,10H	; INITIALIZE (UP)
	DW	PORIG,AT
	DW	LIT,UP
	DW	STORE
	DW	MTBUF	; DISK INTERFACE
	DW	DRZER
	DW	FIRST
	DW	USE,STORE
	DW	FIRST
	DW	PREV,STORE
	DW	LIT
ISKEW	DW	1		; ?SKEW INITIAL VALUE
	DW	QSKEW,STORE
	DW	ZERO
	DW	DRV,STORE
;			  SET BLOCKS FOR WRITE PROTECTION
	DW	ZERO
	DW	CAP,AT
	DW	NDRIVE,AT
	DW	STAR
	DW	BLOCKS,TSTOR
;
	DW	ZERO	; CONSOLE INTERFACE
	DW	EPRINT,STORE
;
	DW	TOP	; EDITOR
	DW	INIT
	DW	SCR,STORE
;
;			INIT SOME USER VARIABLES
	DW	LIT,OCLD0
	DW	LIT,UP
	DW	AT
	DW	LIT,6
	DW	PLUS
	DW	LIT,OCLD1-OCLD0
	DW	CMOVE
;
	DW	DEC
	DW	LIT,80
	DW	LENGTH,STORE
	DW	LIT,HCOLD
	DW	H0,STORE
;
;			INIT VOCAB POINTERS
	DW	LIT,OFOR	; FORTH
	DW	AT
	DW	LIT,FORTHP
	DW	STORE
	DW	LIT,OASM	; ASSEMBLER
	DW	AT
	DW	LIT,ASMBP
	DW	STORE
	DW	LIT,OED		; EDITOR
	DW	AT
	DW	LIT,EDITP
	DW	STORE
;
;	INIT EXECUTION VECTORS
	DW	LIT,PCR+2
	DW	TCR,STORE
	DW	LIT,PEMIT+2
	DW	TEMIT,STORE
	DW	LIT,PKEY+2
	DW	TKEY,STORE
	DW	LIT,PPAGE+2
	DW	TPAGE,STORE
	DW	LIT,PKEYQ+2
	DW	TQKEY,STORE
	DW	LIT,VCREAT+2
	DW	TCREAT,STORE
	DW	LIT,PNUMB+2
	DW	TNUMB,STORE
	DW	LIT,NOOP+2
	DW	TPQUIT,STORE
	DW	LIT,BABORT+2
	DW	TPABOR,STORE
	DW	LIT,PWORD+2
	DW	TWORD,STORE
	DW	LIT,PFINDQ+2
	DW	TQFIND,STORE
;
	DW	START,EXIT
;	---------------------------------------
;
	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	QBRAN	; IF
	DW	PM1-$
	DW	NEG	; THEN
PM1	DW	EXIT
;
	DB	83H	; D+-
	DB	'D+'
	DB	'-'+80H
	DW	PM-5
DPM	DW	DOCOL
	DW	ZLESS
	DW	QBRAN	; IF
	DW	DPM1-$
	DW	DNEG	; THEN
DPM1	DW	EXIT
;
	DB	83H	; ABS
	DB	'AB'
	DB	'S'+80H
	DW	DPM-6
ABS	DW	DOCOL
	DW	DUP
	DW	PM
	DW	EXIT
;
	DB	84H	; DABS
	DB	'DAB'
	DB	'S'+80H
	DW	ABS-6
DABS	DW	DOCOL
	DW	DUP
	DW	DPM
	DW	EXIT
;
	DB	83H	; MIN
	DB	'MI'
	DB	'N'+80H
	DW	DABS-7
MIN	DW	DOCOL,TDUP
	DW	GREAT
	DW	QBRAN	; IF
	DW	MIN1-$
	DW	SWAP	; THEN
MIN1	DW	DROP
	DW	EXIT
;
	DB	83H	; MAX
	DB	'MA'
	DB	'X'+80H
	DW	MIN-6
MAX	DW	DOCOL,TDUP
	DW	LESS
	DW	QBRAN	; IF
	DW	MAX1-$
	DW	SWAP	; THEN
MAX1	DW	DROP
	DW	EXIT
;
	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	EXIT
;
	DB	85H	; M/MOD		2.3
	DB	'M/MO'	;  ( FORMERLY M/ )
	DB	'D'+80H	;  ( D N -- NREM NQUOT )
	DW	MSTAR-5
MSLMOD	DW	DOCOL
	DW	OVER
	DW	TOR
	DW	TOR
	DW	DABS
	DW	RAT
	DW	ABS
	DW	USLMOD
	DW	FROMR
	DW	RAT
	DW	XORR
	DW	PM
	DW	SWAP
	DW	FROMR
	DW	PM
	DW	SWAP
	DW	EXIT
;
	DB	82H	; M/		2.3
	DB	'M'	;  ( D N -- NQUOT )
	DB	'/'+80H
	DW	MSLMOD-8
MSLASH	DW	DOCOL
	DW	MSLMOD
	DW	SWAP,DROP
	DW	EXIT
;
	DB	81H	; *
	DB	'*'+80H
	DW	MSLASH-5
STAR	DW	DOCOL
	DW	MSTAR
	DW	DROP
	DW	EXIT
;
	DB	84H	; /MOD		2.3
	DB	'/MO'
	DB	'D'+80H
	DW	STAR-4
SLMOD	DW	DOCOL
	DW	TOR
	DW	STOD
	DW	FROMR,MSLMOD
	DW	EXIT
;
	DB	81H	; /
	DB	'/'+80H
	DW	SLMOD-7
SLASH	DW	DOCOL
	DW	SLMOD
	DW	SWAP
	DW	DROP
	DW	EXIT
;
	DB	83H	; MOD
	DB	'MO'
	DB	'D'+80H
	DW	SLASH-4
MODD	DW	DOCOL
	DW	SLMOD
	DW	DROP
	DW	EXIT
;
	DB	85H	; */MOD		2.3
	DB	'*/MO'
	DB	'D'+80H
	DW	MODD-6
SSMOD	DW	DOCOL
	DW	TOR
	DW	MSTAR
	DW	FROMR
	DW	MSLMOD
	DW	EXIT
;
	DB	82H	; */
	DB	'*'
	DB	'/'+80H
	DW	SSMOD-8
SSLA	DW	DOCOL
	DW	SSMOD
	DW	SWAP
	DW	DROP
	DW	EXIT
;
	DB	86H	; UM/MOD	2.3
	DB	'UM/MO'	;  ( FORMERLY M/MOD )
	DB	'D'+80H	;  ( UD1 U2 -- UREM UQUOT )
	DW	SSLA-5
UMSMOD	DW	DOCOL
	DW	TOR
	DW	ZERO
	DW	RAT
	DW	USLMOD
	DW	FROMR
	DW	SWAP
	DW	TOR
	DW	USLMOD
	DW	FROMR
	DW	EXIT
;
	DB	82H	; M+		2.3
	DB	'M'
	DB	'+'+80H
	DW	UMSMOD-9
MPLUS	DW	DOCOL
	DW	STOD,DPLUS
	DW	EXIT
;
	DB	83H	; D0=		1.5
	DB	'D0'
	DB	'='+80H
	DW	MPLUS-5
D0EQU	DW	DOCOL
	DW	ORR,ZEQU
	DW	EXIT
;
	DB	82H	; D=		1.5
	DB	'D'
	DB	'='+80H
	DW	D0EQU-6
DEQU	DW	DOCOL
	DW	DSUB,D0EQU
	DW	EXIT
;
	DB	83H	; D0<		1.5
	DB	'D0'
	DB	'<'+80H
	DW	DEQU-5
D0LESS	DW	DOCOL
	DW	ZLESS
	DW	SWAP,DROP
	DW	EXIT
;
	DB	82H	; D<		1.5
	DB	'D'
	DB	'<'+80H
	DW	D0LESS-6
DLESS	DW	DOCOL
	DW	DSUB,D0LESS
	DW	EXIT
;
	DB	83H	; DU<		1.5
	DB	'DU'
	DB	'<'+80H
	DW	DLESS-5
DULESS	DW	DOCOL
	DW	DLESS,EXIT
;
	DB	84H	; DMIN		1.5
	DB	'DMI'
	DB	'N'+80H
	DW	DULESS-6
DMIN	DW	DOCOL
	DW	TOVER,TOVER
	DW	DLESS,NOTT
	DW	QBRAN,DMIN1-$	; IF
	DW	TSWAP
DMIN1	DW	TDROP		; THEN
	DW	EXIT
;
	DB	84H	; DMAX		1.5
	DB	'DMA'
	DB	'X'+80H
	DW	DMIN-7
DMAX	DW	DOCOL
	DW	TOVER,TOVER
	DW	DLESS
	DW	QBRAN,DMAX1-$	; IF
	DW	TSWAP
DMAX1	DW	TDROP		; THEN
	DW	EXIT
;
	DB	86H	; (LINE)	1.5
	DB	'(LINE'
	DB	')'+80H
	DW	DMAX-7
PLINE	DW	DOCOL
	DW	TOR
	DW	LIT,64
	DW	BBUF
	DW	SSMOD
	DW	FROMR
	DW	BUFSCR
	DW	STAR
	DW	PLUS
	DW	BLOCK
	DW	PLUS
	DW	LIT,64
	DW	EXIT
;
	DB	85H	; .LINE
	DB	'.LIN'
	DB	'E'+80H
	DW	PLINE-9
DLINE	DW	DOCOL
	DW	PLINE
	DW	DTRAI
	DW	TYPE
	DW	EXIT
;
	DB	87H	; MESSAGE	2.3
	DB	'MESSAG'
	DB	'E'+80H
	DW	DLINE-8
MESS	DW	DOCOL
	DW	WARN
	DW	AT
	DW	QBRAN	; IF
	DW	MESS1-$
	DW	QDUP
	DW	QBRAN	; IF
	DW	MESS2-$
	DW	MSGS
;	DW	OFSET,AT,BUFSCR,SLASH,SUBB	; REMOVED
	DW	DLINE
	DW	SPACE	; THEN
MESS2	DW	BRAN	; ELSE
	DW	MESS3-$
MESS1	DW	PDOTQ
	DB	10,'Message # '
	DW	DOT	; THEN
MESS3	DW	EXIT
;
	DB	87H	; ?ENOUGH	2.1
	DB	'?ENOUG' ;	( # - )
	DB	'H'+80H	; ABORTS IF NOT # PARAMS ON STACK
	DW	MESS-10
QENUF	DW	DOCOL
	DW	DEPTH,ONEM
	DW	GREAT
	DW	PABORT
	DB	21,'Not enough parameters'
	DW	EXIT
;
	PAGE
;------------------------------------------
;
;	8080 PORT FETCH AND STORE
;	( SELF MODIFYING CODE, NOT REENTRANT
;		OR ROM-ABLE )
;
	DB	82H	; P@ "PORT @"
	DB	'P'
	DB	'@'+80H
	DW	QENUF-10
PTAT	DW	$+2
	POP	D	;E <- PORT#
	LXI	H,$+5
	MOV	M,E
	IN	0	;( 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,$+7
	MOV	M,E
	POP	H	;H <- CDATA
	MOV	A,L
	OUT	0	;( PORT# MODIFIED )
	JMP	NEXT
	PAGE
;------------------------------------------------------
;	FORTH DISK INTERFACE
;
;	MAPPING DISK SECTORS ONTO FORTH BUFFERS & SCREENS
;	   ( THE FOLLOWING DIAGRAM IS ONLY AN EXAMPLE )
;
;	DISK					   MEMORY
;
;  =============+   ----^-------^-------^----	+============
;	 SECTOR I	I	I	I	I
;	     ===+	I	I  SECTORS/BUF	I  BUFFER
;      TRACK	I	I	I	I	I
;	     ===+   ----I-------I-------V----   +====  SCREEN
;		I	I	I		I
;	========+	I  SECTORS/SCREEN	I
;		I	I	I		I
;	     ===+   ----I-------V------------	+============
;  D		I	I			I
;  R	     ===+    SCREENS			I
;  I		I    -------			I
;  V	========+     DRIVE			+====
;  E		I	I			I
;	     ===+	I			I
;		I	I			I
;	     ===+   ----V--------------------   +============
;    ////////// I   <----- NOT USED BY FORTH
;  =============+
;
;----------------------------------------------------
KNDRIV	EQU	2		; # DRIVES	= #DRIVES
;				  ( FORMERLY MXDRV )
KFRSEC	EQU	1		; FIRST SECTOR # ANY TRACK
;				  ( FORMERLY FRSEC )
;
;	SINGLE DENSITY 8" FLOPPY CAPACITIES
KBSEC1	EQU	128		; BYTES/SECTOR	= B/SEC
;				  ( FORMERLY BPS1 )
KSETR1	EQU	26		; SECTORS/TRACK	= SEC/TRK
;				  ( FORMERLY SEPTR1 )
KTRDR1	EQU	77		; TRACKS/DRIVE	= TRK/DRV
;				  ( FORMERLY TRPDR1 )
KSEBL1	EQU	KBBUF/KBSEC1	; SECTORS/BLOCK	= SEC/BLK
;				  ( FORMERLY SEPBU1 )
KSCDR1	EQU	KSETR1*KTRDR1/KSEBL1  ; SCREENS/DRIVE
;					= CAPACITY
;				  ( FORMERLY SCPDR1 )
KSEDR1	EQU	KSCDR1*KSEBL1	; USABLE SECTORS/DRIVE
;				  = SEC/DRV
;				  ( FORMERLY USPDR1 )
	PAGE
;	FORTH VARIABLES AND CONSTANTS USED IN DISK INTERFACE
;
	DB	87H	; #DRIVES	1.5
	DB	'#DRIVE'
	DB	'S'+80H
	DW	PTSTO-5
NDRIVE	DW	DOVAR
	DW	KNDRIV
;
	DB	85H	; B/SEC		1.5
	DB	'B/SE'
	DB	'C'+80H
	DW	NDRIVE-10
BSEC	DW	DOVAR
	DW	KBSEC1
;
	DB	87H	; SEC/TRK	1.5
	DB	'SEC/TR'
	DB	'K'+80H
	DW	BSEC-8
SECTRK	DW	DOVAR
	DW	KSETR1
;
	DB	87H	; TRK/DRV	1.5
	DB	'TRK/DR'
	DB	'V'+80H
	DW	SECTRK-10
TRKDRV	DW	DOVAR
	DW	KTRDR1
;
	DB	87H	; SEC/BLK	1.5
	DB	'SEC/BL'
	DB	'K'+80H
	DW	TRKDRV-10
SECBLK	DW	DOVAR
	DW	KSEBL1
;
	DB	87H	; SEC/DRV	1.5
	DB	'SEC/DR'
	DB	'V'+80H
	DW	SECBLK-10
SECDRV	DW	DOVAR
	DW	KSEDR1
;
	DB	88H	; CAPACITY	1.5
	DB	'CAPACIT'	; ( # SCREENS/DRIVE )
	DB	'Y'+80H
	DW	SECDRV-10
CAP	DW	DOVAR
	DW	KSCDR1
;
;	SECTOR SKEW TABLE
;	LOOKUP PHYSICAL SECTOR # USING LOGICAL SECTOR #
;
	DB	85H	; SKEWS		1.5
	DB	'SKEW'
	DB	'S'+80H
	DW	CAP-11
SKEWS	DW	DOVAR
;	SINGLE DENSITY, CP/M STYLE SKEWING BY 6
	DB	0	; SKIP SECTOR "0" IF KFRSEC = 1
;	OMIT ABOVE BYTE IF  KFRSEC = 0
	DB	1,7,13,19,25	; ODD SECTORS
	DB	5,11,17,23
	DB	3,9,15,21
	DB	2,8,14,20,26	; EVEN SECTORS
	DB	6,12,18,24
	DB	4,10,16,22
;
;	FILL TABLE TO 64 BYTES
KSKSIZ	EQU	$-SKEWS-2
	DS	64-KSKSIZ
;
;
	DB	83H	; DRV		2.2
	DB	'DR'	; ( LAST DRIVE # REFENCED )
	DB	'V'+80H
	DW	SKEWS-8
DRV	DW	DOVAR
	DS	2	; INIT BY COLD
;
	DB	83H	; SEC	( SECTOR # )
	DB	'SE'
	DB	'C'+80H
	DW	DRV-6
SEC	DW	DOVAR
	DW	0	; NEXT LOGICAL SEC #
	DW	0	; LAST PHYSICAL (IE, SKEWED) SEC #
;
	DB	85H	; TRACK	( TRACK # )
	DB	'TRAC'
	DB	'K'+80H
	DW	SEC-6
TRACK	DW	DOVAR,0
;
	DB	83H	; USE		2.2
	DB	'US'	; ( ADDR OF NEXT BUFFER TO BE REPLACED )
	DB	'E'+80H
	DW	TRACK-8
USE	DW	DOVAR
	DS	2	; INIT BY COLD
;
	DB	84H	; 'SEC		2.4
	DB	27H,'SE'  ; ( TEMP USED BY R/W )
	DB	'C'+80H
	DW	USE-6
TSEC	DW	DOVAR
	DW	0
;
	DB	84H	; PREV		2.2
;	( ADDR OF BUFFER PREVIOUSLY ACCESSED BY CPU )
	DB	'PRE'
	DB	'V'+80H
	DW	TSEC-7
PREV	DW	DOVAR
	DS	2	; INIT BY COLD
;
	DB	88H	; #BUFFERS		1.5
	DB	'#BUFFER'
	DB	'S'+80H
	DW	PREV-7
NBUFF	DW	DOCON,KNBUF
;
	DB	8AH	; DISK-ERROR  ( DISK ERROR STATUS )
	DB	'DISK-ERRO'
	DB	'R'+80H
	DW	NBUFF-11
DSKERR	DW	DOVAR,0
;
	DB	85H	; ?SKEW		2.2
	DB	'?SKE'	; 0 = NONE; 1 = USE TABLE
	DB	'W'+80H
	DW	DSKERR-13
QSKEW	DW	DOVAR
	DS	2	; INIT BY COLD
;
;	DISK INTERFACE HIGH-LEVEL ROUTINES
;
	DB	84H	; +BUF	( ADVANCE BUFFER )	1.5
	DB	'+BU'
	DB	'F'+80H
	DW	QSKEW-8
PBUF	DW	DOCOL
	DW	LIT,KBBUFA
	DW	PLUS,DUP
	DW	LIMIT,EQUAL
	DW	QBRAN,PBUF1-$
	DW	DROP,FIRST
PBUF1	DW	DUP,PREV
	DW	AT,SUBB
	DW	EXIT
;
	DB	86H	; UPDATE
	DB	'UPDAT'
	DB	'E'+80H
	DW	PBUF-7
UPDAT	DW	DOCOL,PREV
	DW	AT,AT
	DW	LIT,8000H
	DW	ORR
	DW	PREV,AT
	DW	STORE,EXIT
;
	DB	8DH	; EMPTY-BUFFERS
	DB	'EMPTY-BUFFER'
	DB	'S'+80H
	DW	UPDAT-9
MTBUF	DW	DOCOL,FIRST
	DW	LIMIT,OVER
	DW	SUBB,ERASEE
	DW	EXIT
;
	DB	83H	; DR0
	DB	'DR'
	DB	'0'+80H
	DW	MTBUF-16
DRZER	DW	DOCOL,ZERO
	DW	OFSET,STORE
	DW	EXIT
;
	DB	83H	; DR1		1.5
	DB	'DR'
	DB	'1'+80H
	DW	DRZER-6
DRONE	DW	DOCOL
	DW	CAP,AT
	DW	OFSET,STORE
	DW	EXIT
;
	DB	85H	; DRIVE		1.5
	DB	'DRIV'	; ( #DRIVE -- )
	DB	'E'+80H
	DW	DRONE-6
DRIVE	DW	DOCOL
	DW	ONE,QENUF
	DW	NDRIVE,AT
	DW	ONEM,MIN
	DW	CAP,AT
	DW	STAR
	DW	OFSET,STORE
	DW	EXIT
;
	DB	88H	; (BUFFER)	2.2
	DB	'(BUFFER'
	DB	')'+80H
	DW	DRIVE-8
PBUFFE	DW	DOCOL,USE
	DW	AT,DUP
	DW	TOR
PBUFF1	DW	PBUF		; WON'T WORK IF SINGLE BUFFER
	DW	QBRAN,PBUFF1-$	; WHEN NOT PREV BUFFER
	DW	USE,STORE
	DW	RAT,AT
	DW	ZLESS
	DW	QBRAN,PBUFF2-$	; IF OLD BUFFER UPDATED
	DW	RAT,TWOP
	DW	RAT,AT
	DW	LIT,7FFFH
	DW	ANDD,DUP
	DW	BLOCKS,TAT
	DW	WITHIN,NOTT
	DW	QBRAN,PBUFF3-$	; IF NOT OK TO WRITE
	DW	DOT,DROP	; IGNORE WRITE
	DW	PDOTQ
	DB	16,'Write protected '
	DW	BRAN,PBUFF2-$
PBUFF3	DW	ZERO,RSLW	; ELSE WRITE OLD BLOCK
;				; THEN
;		IDENTIFY BUFFER WITH NEW BLOCK #
PBUFF2	DW	RAT,STORE	
	DW	RAT,PREV
	DW	STORE,FROMR
	DW	TWOP,EXIT
;
	DB	86H	; BUFFER	1.5
	DB	'BUFFE'
	DB	'R'+80H
	DW	PBUFFE-11
BUFFE	DW	DOCOL
	DW	OFSET,AT
	DW	PLUS,PBUFFE
	DW	EXIT
;
	DB	85H	; BLOCK		1.4
	DB	'BLOC'
	DB	'K'+80H
	DW	BUFFE-9
BLOCK	DW	DOCOL
	DW	ZERO,DSKERR
	DW	STORE
	DW	OFSET
	DW	AT,PLUS
	DW	TOR,PREV
	DW	AT,DUP
	DW	AT,RAT
	DW	SUBB
	DW	TWOT
	DW	QBRAN,BLOC1-$
BLOC2	DW	PBUF,ZEQU
	DW	QBRAN,BLOC3-$
	DW	DROP,RAT
	DW	PBUFFE,DUP
	DW	RAT,ONE
	DW	RSLW
	DW	TWO,SUBB
BLOC3	DW	DUP,AT
	DW	RAT,SUBB
	DW	DUP,PLUS
	DW	ZEQU
	DW	QBRAN,BLOC2-$
	DW	DUP,PREV
	DW	STORE
BLOC1	DW	FROMR,DROP
	DW	TWOP,EXIT
	PAGE
;
;-------------------------------------------------------
;	CP/M DISK INTERFACE
;
;	CP/M BIOS CALLS USED
;	( NOTE EQU'S ARE 3 LOWER THAN DOCUMENTED OFFSETS
;	  BECAUSE BASE ADDR IS BIOS+3 )
;
RITSEC	EQU	39
RDSEC	EQU	36
SETDMA	EQU	33
SETSEC	EQU	30
SETTRK	EQU	27
SETDSK	EQU	24
;
;	CP/M INTERFACE ROUTINES
;
;		SERVICE REQUEST
;
IOS	LHLD	1	; (HL) <- BIOS TABLE ADDR+3
	DAD	D	; + SERVICE REQUEST OFFSET
	PCHL		; EXECUTE REQUEST
;	RET FUNCTION PROVIDED BY CP/M
;
	DB	86H	; SET-IO	2.4
;			( ASSIGN SECTOR, TRACK FOR BDOS )
	DB	'SET-I'
	DB	'O'+80H
	DW	BLOCK-8
SETIO	DW	$+2
	PUSH	B	; SAVE (IP)
	LHLD	TSEC+2	; (BC) <- ADDR BUFFER
	MOV	B,H
	MOV	C,L
	LXI	D,SETDMA ; SEND BUFFER ADDR TO CP/M
	CALL	IOS
;
	LHLD	SEC+2	; (C) <- (SEC) = SECTOR #
	MOV	C,L
	MVI	B,0
	LDA	QSKEW+2		; IF (SKEW) <> 0
	ORA	A
	JZ	SETIO2
	LXI	H,SKEWS+2	; THEN SKEW SECTOR #
	DAD	B		; CALC TABLE ADDR
	XRA	A		; GET PHYS SEC #
	ADD	M
	MOV	C,A
SETIO2	MOV	A,C		; RECORD PHYSICAL SEC #
	STA	SEC+4
	LXI	D,SETSEC	; SEND SECTOR # TO CP/M
	CALL	IOS
;
	LHLD	TRACK+2	; (BC) <- (TRACK) = TRACK #
	MOV	B,H
	MOV	C,L
	LXI	D,SETTRK
	CALL	IOS
;
	POP	B	; RESTORE (IP)
	JMP	NEXT
;
	DB	89H	; SET-DRIVE	1.5
	DB	'SET-DRIV'
	DB	'E'+80H
	DW	SETIO-9
SETDRV	DW	$+2
	PUSH	B	; SAVE (IP)
	LDA	DRV+2	; (C) <- (DRV) = DRIVE #
	MOV	C,A
	LXI	D,SETDSK   ; SEND DRIVE # TO CP/M
	CALL	IOS
	POP	B	; RESTORE (IP)
	JMP	NEXT
;
;	T&SCALC		( CALCULATES DRIVE#, TRACK#, & SECTOR# )
;	OUTPUT: VARIABLES DRIVE, TRACK, & SEC
;
	DB	87H	; T&SCALC	2.3
	DB	'T&SCAL'  ; ( SECTORS-INTO-DISKS -- )
	DB	'C'+80H
	DW	SETDRV-12
TSCALC	DW	DOCOL
	DW	SECDRV,AT
	DW	SLMOD
	DW	DUP
	DW	NDRIVE,AT
	DW	LESS
	DW	QBRAN,TSCAL5-$
	DW	DUP,DRV
	DW	AT,EQUAL
	DW	QBRAN,TSCAL3-$
	DW	DROP
	DW	BRAN,TSCAL4-$
TSCAL3	DW	DRV,STORE
	DW	SETDRV
TSCAL4	DW	SECTRK,AT
	DW	SLMOD,TRACK
	DW	STORE
	DW	LIT,KFRSEC
	DW	PLUS
	DW	SEC,STORE
	DW	EXIT
TSCAL5	DW	PABORT
	DB	15,'Block # too big'
	DW	EXIT
;
;	SEC-READ
;	( READ A SECTOR SETUP BY 'SET-DRIVE' & 'SETIO' )
;
	DB	88H	; SEC-READ	1.4
	DB	'SEC-REA'
	DB	'D'+80H
	DW	TSCALC-10
SECRD	DW	$+2
	PUSH	B	; SAVE (IP)
	LXI	D,RDSEC	; ASK CP/M TO READ SECTOR
	CALL	IOS
	LXI	H,DSKERR+2
	ORA	M
	STA	DSKERR+2	; (DSKERR) <- ERROR STATUS
	POP	B	; RESTORE (IP)
	JMP	NEXT
;
;	SEC-WRITE
;	( WRITE A SECTOR SETUP BY 'SET-DRIVE' & 'SETIO' )
;
	DB	89H	; SEC-WRITE	1.4
	DB	'SEC-WRIT'
	DB	'E'+80H
	DW	SECRD-11
SECWT	DW	$+2
	PUSH	B	; SAVE (IP)
	LXI	D,RITSEC	; ASK CP/M TO WRITE SECTOR
	CALL	IOS
	LXI	H,DSKERR+2
	ORA	M
	STA	DSKERR+2	; (DSKERR) <- ERROR STATUS
	POP	B	; RESTORE (IP)
	JMP	NEXT
;
	DB	86H	; +TRACK  ( ADVANCE TRACK )	2.2
	DB	'+TRAC'
	DB	'K'+80H
	DW	SECWT-12
PTRAC	DW	$+2
	LDA	SECTRK+2	; FETCH SECTORS/TRACK
	SUI	1-KFRSEC	; 1-
	LHLD	SEC+2		; IF NOT AT END OF TRACK
	CMP	L
	JNZ	NEXT		; THEN DONE
;				; ELSE RESET SECTOR #
	MVI	A,KFRSEC-1 AND 0FFH
	STA	SEC+2
	LDA	TRACK+2		;   AND INCR TRACK #
	INR	A
	STA	TRACK+2
	JMP	NEXT
;
	DB	87H	; +SECTOR ( ADVANCE SECTOR )	2.4
	DB	'+SECTO'
	DB	'R'+80H
	DW	PTRAC-9
PSEC	DW	$+2
	LDA	SEC+2	; INCR SECTOR #
	INR	A
	STA	SEC+2
	PUSH	D	; SAVE W
	LHLD	TSEC+2	; INCR 'SEC BY #BYTES/SEC
	XCHG
	LHLD	BSEC+2
	DAD	D
	SHLD	TSEC+2
	POP	D	; RESTORE W
	JMP	NEXT
;
	DB	84H	; ?R/W  	1.4
	DB	'?R/'	; ( SELECT READ OR WRITE )
	DB	'W'+80H	;  ( F - F )
	DW	PSEC-10
QRW	DW	$+2
	XTHL		; (HL) <- (S1) = R/W FLAG
	MOV	A,L	; IF FLAG = 0
	ORA	H
	XTHL
	JZ	SECWT+2	; THEN WRITE SECTOR
;	( ABOVE AND BELOW ARE NONSTANDARD CALLS )
	JMP	SECRD+2	; ELSE READ SECTOR
;
	DB	83H	; R/W	( FORTH DISK PRIMITIVE ) 2.4
	DB	'R/'	; ( BUF-ADR  PHYSICAL-BLOCK#  F -- )
	DB	'W'+80H
	DW	QRW-7
RSLW	DW	DOCOL
	DW	SWAP
	DW	SECBLK,AT
	DW	STAR,ROT
	DW	TSEC,STORE
	DW	TSCALC
	DW	SECBLK,AT
	DW	ZERO
	DW	XDO		; DO
RSLW1	DW	NOOP
	DW	SETIO		; SET-IO
	DW	QRW		; ?R/W
	DW	PTRAC		; +TRACK
	DW	PSEC		; +SECTOR
	DW	XLOOP,RSLW1-$	; LOOP
	DW	DROP
	DW	EXIT
;
;--------------------------------------------------------
;
	DB	85H	; FLUSH		1.5
	DB	'FLUS'
	DB	'H'+80H
	DW	RSLW-6
FLUSH	DW	DOCOL
	DW	NBUFF,ONEP
	DW	ZERO,XDO
FLUS1	DW	ZERO,BUFFE
	DW	DROP
	DW	XLOOP,FLUS1-$
	DW	EXIT
;
	DB	8CH	; SAVE-BUFFERS		1.4
	DB	'SAVE-BUFFER'
	DB	'S'+80H
	DW	FLUSH-8
SAVE	DW	DOCOL
	DW	FLUSH
	DW	EXIT
;
	DB	84H	; LOAD		2.3
	DB	'LOA'
	DB	'D'+80H
	DW	SAVE-15
LOAD	DW	DOCOL
	DW	ONE,QENUF
	DW	BLK
	DW	AT,TOR
	DW	GIN,AT
	DW	TOR,ZERO
	DW	GIN,STORE
	DW	BUFSCR,STAR
	DW	BLK,STORE	; BLK <- SCR * BUF/SCR
	DW	INTER		; INTERPRET FROM OTHER SCREEN
	DW	FROMR,GIN
	DW	STORE
	DW	FROMR,BLK
	DW	STORE
	DW	EXIT
;
	DB	0C3H	; -->		2.3
	DB	'--'
	DB	'>'+80H
	DW	LOAD-7
ARROW	DW	DOCOL
	DW	QLOAD
	DW	ZERO
	DW	GIN,STORE
	DW	BUFSCR
	DW	BLK
	DW	AT
	DW	OVER
	DW	MODD
	DW	SUBB
	DW	BLK
	DW	PSTOR
	DW	EXIT
;
	DB	84H	; THRU		1.5
	DB	'THR'
	DB	'U'+80H
	DW	ARROW-6
THRU	DW	DOCOL
	DW	TWO,QENUF
	DW	ONEP,SWAP
	DW	XDO		; DO
THRU1	DW	IDO,LOAD
	DW	XLOOP,THRU1-$	; LOOP
	DW	EXIT
;
	PAGE
;-------------------------------------------------
;
;	CP/M CONSOLE & PRINTER INTERFACE
;
;	CP/M BIOS CALLS USED
;	( NOTE: BELOW OFFSETS ARE 3 LOWER THAN CP/M
;	  DOCUMENTATION SINCE BASE ADDR = BIOS+3 )
;
KCSTAT	EQU	3	; CONSOLE STATUS
KCIN	EQU	6	; CONSOLE INPUT
KCOUT	EQU	9	; CONSOLE OUTPUT
KPOUT	EQU	0CH	; PRINTER OUTPUT
;
	DB	86H	; ?PRINT		1.4
	DB	'?PRIN'
	DB	'T'+80H
	DW	THRU-7
EPRINT	DW	DOVAR,0	; ENABLE PRINTER VARIABLE
;			; 0 = DISABLED, 1 = ENABLED
;
;	BELOW BIOS CALLS USE 'IOS' IN DISK INTERFACE
;
CSTAT	PUSH	B	; CONSOLE STATUS
	LXI	D,KCSTAT  ; CHECK IF ANY CHR HAS BEEN TYPED
	CALL	IOS
	POP	B	; IF CHR TYPED THEN (A) <- 0FFH
	RET		; ELSE (A) <- 0
;			; CHR IGNORED
;
CIN	PUSH	B	; CONSOLE INPUT
	LXI	D,KCIN	; WAIT FOR CHR TO BE TYPED
	CALL	IOS	; (A) <- CHR, (MSB) <- 0
	POP	B
	RET
;
COUT	PUSH	H	; CONSOLE OUTPUT
	LXI	D,KCOUT	; WAIT UNTIL READY
	CALL	IOS	; THEN OUTPUT (C)
	POP	H
	RET
;
POUT	LXI	D,KPOUT	; PRINTER OUTPUT
	CALL	IOS	; WAIT UNTIL READY
	RET		; THEN OUTPUT (C)
;
CPOUT	CALL	COUT	; OUTPUT (C) TO CONSOLE		1.4
	XCHG
	LXI	H,EPRINT+2
	MOV	A,M	; IF (EPRINT) <> 0
	ORA	A
	JZ	CPOU1
	MOV	C,E	; THEN OUTPUT (C) TO PRINTER
	CALL	POUT
CPOU1	RET
;
;	FORTH TO CP/M SERIAL IO INTERFACE
;
	DB	86H	; (KEY?)	2.5
	DB	'(KEY?'
	DB	')'+80H
	DW	EPRINT-9
PKEYQ	DW	$+2
	LXI	H,0
	CALL	CSTAT	; IF CHR TYPED
	LXI	H,0
	ORA	A
	JZ	PKEYQ1
	INR	L	; THEN (S1) <- TRUE
PKEYQ1	JMP	HPUSH	; ELSE (S1) <- FALSE
;
	DB	85H	; (KEY)		1.5
	DB	'(KEY'
	DB	')'+80H
	DW	PKEYQ-9
PKEY	DW	$+2
	CALL	CIN	; READ CHR FROM CONSOLE	
	CPI	KDLE	; IF CHR = (^P)
	MOV	E,A
	JNZ	PKEY1
	LXI	H,EPRINT+2  ; THEN TOGGLE (EPRINT)LSB
	MVI	E,KBL	; CHR <- BLANK
	MOV	A,M
	XRI	1
	MOV	M,A
PKEY1	MOV	L,E
	MVI	H,0
	JMP	HPUSH	; (S1)LB <- CHR
;
	DB	86H	; (EMIT)	1.4
	DB	'(EMIT'
	DB	')'+80H
	DW	PKEY-8
PEMIT	DW	$+2
	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
;
	DB	84H	; (CR)		1.5
	DB	'(CR'
	DB	')'+80H
	DW	PEMIT-9
PCR	DW	$+2
	PUSH	B	; SAVE (IP)
	MVI	C,KCR	; OUTPUT (CR) TO CONSOLE
	MOV	L,C
	CALL	CPOUT	; & MAYBE TO PRINTER
	MVI	C,KLF	; OUTPUT (LF) TO CONSOLE
	MOV	L,C
	CALL	CPOUT	; & MAYBE TO PRINTER
	POP	B	; RESTORE (IP)
	JMP	NEXT
;
	DB	86H	; (PAGE)	2.2
	DB	'(PAGE'
	DB	')'+80H
	DW	PCR-7
PPAGE	DW	DOCOL
	DW	CR
	DW	LIT,KFF
	DW	EMIT,CR
	DW	EXIT
;
;----------------------------------------------------
	PAGE
;
	DB	81H	; '	( TICK )	2.4
	DB	0A7H
	DW	PPAGE-9
TICK	DW	DOCOL
	DW	FINDQ
	DW	ZEQU
	DW	PABORT
	DB	1,'?'
	DW	EXIT
;
	DB	0C3H	; [']		1.5
	DB	'[',27H
	DB	']'+80H
	DW	TICK-4
BTICK	DW	DOCOL
	DW	TICK,LITER
	DW	EXIT
;
	DB	88H	; (FORGET)	2.3
	DB	'(FORGET'	; ( anf - )
	DB	')'+80H
	DW	BTICK-6
PFORG	DW	DOCOL
	DW	DUP
	DW	FENCE
	DW	AT
	DW	ULESS
	DW	PABORT
	DB	26,'Is in protected dictionary'
	DW	TOR
	DW	VOCL,AT
FORG1	DW	RAT,OVER	; BEGIN
	DW	ULESS
	DW	QBRAN,FORG2-$	; WHILE
	DW	FORTH,DEFIN
	DW	AT
	DW	BRAN,FORG1-$	; REPEAT
FORG2	DW	DUP
	DW	VOCL,STORE
FORG3	DW	DUP		; BEGIN
	DW	LIT,4
	DW	SUBB
FORG4	DW	PFA,LFA		;   BEGIN
	DW	AT,DUP
	DW	RAT,ULESS
	DW	QBRAN,FORG4-$	;   UNTIL
	DW	OVER,TWOM
	DW	STORE,AT
	DW	QDUP,ZEQU
	DW	QBRAN,FORG3-$	; UNTIL
	DW	FROMR
	DW	HP,STORE
	DW	EXIT
;
	DB	86H	; FORGET	2.1
	DB	'FORGE'
	DB	'T'+80H
	DW	PFORG-11
FORG	DW	DOCOL
	DW	TICK,NFA
	DW	PFORG
	DW	EXIT
;
	DB	85H	; EMPTY		2.1
	DB	'EMPT'
	DB	'Y'+80H
	DW	FORG-9
EMPTY	DW	DOCOL
	DW	GIVEN,PFORG
	DW	EXIT
;
	DB	85H	; >MARK		2.4
	DB	'>MAR'
	DB	'K'+80H
	DW	EMPTY-8
FMARK	DW	DOCOL,HERE
	DW	ZERO,COMMA
	DW	EXIT
;
	DB	88H	; >RESOLVE	2.4
	DB	'>RESOLV'
	DB	'E'+80H
	DW	FMARK-8
FRESOL	DW	DOCOL
	DW	HERE,OVER
	DW	SUBB,SWAP
	DW	STORE,EXIT
;
	DB	85H	; <MARK		2.4
	DB	'<MAR'
	DB	'K'+80H
	DW	FRESOL-11
BMARK	DW	DOCOL
	DW	HERE,EXIT
;
	DB	88H	; <RESOLVE	2.4
	DB	'<RESOLV'
	DB	'E'+80H
	DW	BMARK-8
BRESOL	DW	DOCOL
	DW	HERE,SUBB
	DW	COMMA,EXIT
;
	DB	0C5H	; BEGIN		2.4
	DB	'BEGI'
	DB	'N'+80H
	DW	BRESOL-11
BEGIN	DW	DOCOL
	DW	QCOMP,BMARK
	DW	ONE
	DW	EXIT
;
	DB	0C4H	; THEN		2.4
	DB	'THE'
	DB	'N'+80H
	DW	BEGIN-8
THEN	DW	DOCOL
	DW	QCOMP
	DW	TWO
	DW	QPAIR
	DW	FRESOL
	DW	EXIT
;
	DB	0C2H	; DO		2.4
	DB	'D'
	DB	'O'+80H
	DW	THEN-7
DO	DW	DOCOL,QCOMP
	DW	COMP
	DW	XDO,BMARK
	DW	THREE
	DW	EXIT
;
	DB	0C4H	; LOOP		2.4
	DB	'LOO'
	DB	'P'+80H
	DW	DO-5
LOOP	DW	DOCOL,QCOMP
	DW	THREE
	DW	QPAIR
	DW	COMP
	DW	XLOOP,BRESOL
	DW	EXIT
;
	DB	0C5H	; +LOOP		2.4
	DB	'+LOO'
	DB	'P'+80H
	DW	LOOP-7
PLOOP	DW	DOCOL,QCOMP
	DW	THREE
	DW	QPAIR
	DW	COMP
	DW	XPLOO,BRESOL
	DW	EXIT
;
	DB	0C5H	; /LOOP		2.4
	DB	'/LOO'
	DB	'P'+80H
	DW	PLOOP-8
SLOOP	DW	DOCOL,QCOMP
	DW	THREE,QPAIR
	DW	COMP,XSLOOP
	DW	BRESOL,EXIT
;
	DB	0C5H	; UNTIL		2.4
	DB	'UNTI'
	DB	'L'+80H
	DW	SLOOP-8
UNTIL	DW	DOCOL,QCOMP
	DW	ONE
	DW	QPAIR
	DW	COMP
	DW	QBRAN,BRESOL
	DW	EXIT
;
	DB	0C5H	; AGAIN		2.4
	DB	'AGAI'
	DB	'N'+80H
	DW	UNTIL-8
AGAIN	DW	DOCOL,QCOMP
	DW	ONE
	DW	QPAIR
	DW	COMP
	DW	BRAN,BRESOL
	DW	EXIT
;
	DB	0C6H	; REPEAT	2.4
	DB	'REPEA'
	DB	'T'+80H
	DW	AGAIN-8
REPEA	DW	DOCOL,QCOMP
	DW	TOR
	DW	TOR
	DW	AGAIN
	DW	FROMR
	DW	FROMR
	DW	TWOM
	DW	THEN
	DW	EXIT
;
	DB	0C2H	; IF		2.4
	DB	'I'
	DB	'F'+80H
	DW	REPEA-9
IFF	DW	DOCOL,QCOMP
	DW	COMP
	DW	QBRAN,FMARK
	DW	TWO
	DW	EXIT
;
	DB	0C4H	; ELSE		2.4
	DB	'ELS'
	DB	'E'+80H
	DW	IFF-5
ELSEE	DW	DOCOL,QCOMP
	DW	TWO
	DW	QPAIR
	DW	COMP
	DW	BRAN,FMARK
	DW	SWAP
	DW	TWO
	DW	THEN
	DW	TWO
	DW	EXIT
;
	DB	0C5H	; WHILE
	DB	'WHIL'
	DB	'E'+80H
	DW	ELSEE-7
WHILE	DW	DOCOL
	DW	IFF
	DW	TWOP
	DW	EXIT
;
	DB	86H	; SPACES	2.3
	DB	'SPACE'
	DB	'S'+80H
	DW	WHILE-8
SPACS	DW	DOCOL
	DW	ZERO
	DW	MAX
	DW	QDUP
	DW	QBRAN	; IF
	DW	SPAX1-$
	DW	ZERO
	DW	XDO	; DO
SPAX2	DW	SPACE
	DW	XLOOP	; LOOP	THEN
	DW	SPAX2-$
SPAX1	DW	EXIT
;
	DB	86H	; SIGNED	2.5
	DB	'SIGNE'	;  ( N -- N UD )
	DB	'D'+80H
	DW	SPACS-9
SIGNED	DW	DOCOL
	DW	DUP,ABS
	DW	ZERO,EXIT
;
	DB	88H	; UNSIGNED	2.5
	DB	'UNSIGNE' ;  ( U -- UD )
	DB	'D'+80H
	DW	SIGNED-9
UNSIGN	DW	DOCOL
	DW	ZERO,EXIT
;
	DB	87H	; DSIGNED	2.5
	DB	'DSIGNE'
	DB	'D'+80H
	DW	UNSIGN-11
DSIGN	DW	DOCOL
	DW	SWAP,OVER
	DW	DABS,EXIT
;
	DB	89H	; DUNSIGNED	2.5
	DB	'DUNSIGNE'
	DB	'D'+80H
	DW	DSIGN-10
DUSIGN	DW	DOCOL,EXIT
;
	DB	82H	; <#
	DB	'<'
	DB	'#'+80H
	DW	DUSIGN-12
BDIGS	DW	DOCOL
	DW	PAD
	DW	HLD
	DW	STORE
	DW	EXIT
;
	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	EXIT
;
	DB	84H	; SIGN
	DB	'SIG'
	DB	'N'+80H
	DW	EDIGS-5
SIGN	DW	DOCOL
	DW	ROT
	DW	ZLESS
	DW	QBRAN	; IF
	DW	SIGN1-$
	DW	LIT,'-'
	DW	HOLD	; THEN
SIGN1	DW	EXIT
;
	DB	81H	; #		2.3
	DB	'#'+80H
	DW	SIGN-7
DIG	DW	DOCOL
	DW	BASE
	DW	AT
	DW	UMSMOD
	DW	ROT
	DW	LIT
	DW	9
	DW	OVER
	DW	LESS
	DW	QBRAN	; IF
	DW	DIG1-$
	DW	LIT
	DW	7
	DW	PLUS	; THEN
DIG1	DW	LIT
	DW	30H
	DW	PLUS
	DW	HOLD
	DW	EXIT
;
	DB	82H	; #S		1.3
	DB	'#'
	DB	'S'+80H
	DW	DIG-4
DIGS	DW	DOCOL
DIGS1	DW	DIG	; BEGIN
	DW	TDUP
	DW	ORR
	DW	ZEQU
	DW	QBRAN	; UNTIL
	DW	DIGS1-$
	DW	EXIT
;
	DB	84H	; (U.)		2.5
	DB	'(U.'
	DB	')'+80H
	DW	DIGS-5
PUDOT	DW	DOCOL
	DW	UNSIGN,BDIGS
	DW	DIGS,EDIGS
	DW	EXIT
;
	DB	82H	; U.		2.5
	DB	'U'
	DB	'.'+80H
	DW	PUDOT-7
UDOT	DW	DOCOL
	DW	PUDOT,TYPE
	DW	SPACE,EXIT
;
	DB	83H	; U.R		2.5
	DB	'U.'
	DB	'R'+80H
	DW	UDOT-5
UDOTR	DW	DOCOL
	DW	TOR,PUDOT
	DW	FROMR,OVER
	DW	SUBB,SPACS
	DW	TYPE,EXIT
;
	DB	83H	; (.)		2.5
	DB	'(.'
	DB	')'+80H
	DW	UDOTR-6
PDOT	DW	DOCOL
	DW	SIGNED,BDIGS
	DW	DIGS,SIGN
	DW	EDIGS,EXIT
;
	DB	81H	; .		2.5
	DB	'.'+80H
	DW	PDOT-6
DOT	DW	DOCOL
	DW	PDOT,TYPE
	DW	SPACE,EXIT
;
	DB	82H	; .R		2.5
	DB	'.'
	DB	'R'+80H
	DW	DOT-4
DOTR	DW	DOCOL
	DW	TOR,PDOT
	DW	FROMR,OVER
	DW	SUBB,SPACS
	DW	TYPE,EXIT
;
	DB	81H	; ?
	DB	'?'+80H
	DW	DOTR-5
QUES	DW	DOCOL
	DW	AT
	DW	DOT
	DW	EXIT
;
	DB	85H	; (UD.)		2.5
	DB	'(UD.'
	DB	')'+80H
	DW	QUES-4
PUDDOT	DW	DOCOL
	DW	DUSIGN,BDIGS
	DW	DIGS,EDIGS
	DW	EXIT
;
	DB	83H	; UD.		2.5
	DB	'UD'
	DB	'.'+80H
	DW	PUDDOT-8
UDDOT	DW	DOCOL
	DW	PUDDOT,TYPE
	DW	SPACE,EXIT
;
	DB	84H	; (D.)		2.5
	DB	'(D.'
	DB	')'+80H
	DW	UDDOT-6
PDDOT	DW	DOCOL
	DW	DSIGN,BDIGS
	DW	DIGS,SIGN
	DW	EDIGS,EXIT
;
	DB	82H	; D.		2.5
	DB	'D'
	DB	'.'+80H
	DW	PDDOT-7
DDOT	DW	DOCOL
	DW	PDDOT,TYPE
	DW	SPACE,EXIT
;
	DB	83H	; D.R		2.5
	DB	'D.'
	DB	'R'+80H
	DW	DDOT-5
DDOTR	DW	DOCOL
	DW	TOR,PDDOT
	DW	FROMR,OVER
	DW	SUBB,SPACS
	DW	TYPE,EXIT
;
	DB	0C5H	; ASCII		1.5
	DB	'ASCI'
	DB	'I'+80H
	DW	DDOTR-6
ASCII	DW	DOCOL
	DW	BL,WORD
	DW	ONEP,CAT
	DW	LITER,EXIT
;
	DB	82H	; *S		2.3
	DB	'*'
	DB	'S'+80H
	DW	ASCII-8
STARS	DW	DOCOL
	DW	DUP,ZGREA
	DW	QBRAN,STARS1-$	; IF
	DW	ZERO,XDO	;   DO
STARS2	DW	LIT,'*'
	DW	EMIT
	DW	XLOOP,STARS2-$	;   LOOP
	DW	BRAN,STARS3-$	; ELSE
STARS1	DW	DROP		; THEN
STARS3	DW	EXIT
;
	DB	83H	; ID.		2.3
	DB	'ID'
	DB	'.'+80H
	DW	STARS-5
IDDOT	DW	DOCOL
	DW	DUP,CAT
	DW	LIT,3FH
	DW	ANDD
	DW	DUP,TOR
	DW	ZERO,XDO	; DO
IDDOT1	DW	ONEP,DUP
	DW	CAT,DUP
	DW	LIT,7FH
	DW	ANDD,EMIT
	DW	LIT,80H
	DW	ANDD
	DW	QBRAN,IDDOT2-$	;   IF
	DW	LEAVE,DROP
	DW	IDO,ONEP	;   THEN
IDDOT2	DW	XLOOP,IDDOT1-$	; LOOP
	DW	FROMR,SWAP
	DW	SUBB,STARS
	DW	SPACE
	DW	EXIT
;
	DB	87H	; (WORDS)	2.3
	DB	'(WORDS' ;  ( A -- )
	DB	')'+80H
	DW	IDDOT-6
PWORDS	DW	DOCOL
	DW	CR,CR
	DW	TWOM,NFA
	DW	IDDOT,PDOTQ
	DB	7,' words:'
	DW	CR,EXIT
;
	DB	85H	; WORDS		2.3
	DB	'WORD'
	DB	'S'+80H
	DW	PWORDS-10
WORDS	DW	DOCOL
	DW	CONT
	DW	AT
	DW	DUP,PWORDS
	DW	AT
WORDS1	DW	DUP,CAT		; BEGIN
	DW	LIT,3FH
	DW	ANDD
	DW	GOUT,AT
	DW	PLUS
	DW	LENGTH,AT
	DW	LIT,4
	DW	SUBB
	DW	GREAT
	DW	QBRAN,WORDS2-$	; IF
	DW	CR		; THEN
WORDS2	DW	DUP
	DW	AT
	DW	LIT,0A081H
	DW	EQUAL
	DW	QBRAN,WORDS4-$	;  IF
	DW	DUP,PWORDS	;  THEN
WORDS4	DW	DUP
	DW	IDDOT
	DW	TWO,SPACS
	DW	PFA
	DW	LFA
	DW	AT
	DW	DUP,KEYQ
	DW	QBRAN,WORDS3-$	; IF
	DW	DROP,ZERO	; THEN
WORDS3	DW	ZEQU
	DW	QBRAN,WORDS1-$	; UNTIL
	DW	DROP
	DW	EXIT
;
	DB	85H	; VLIST		2.4
	DB	'VLIS'
	DB	'T'+80H
	DW	WORDS-8
VLIST	DW	DOCOL
	DW	PDOTQ
	DB	9,'Use WORDS'
	DW	CR,WORDS
	DW	EXIT
;
	DB	84H	; LIST		2.5
	DB	'LIS'
	DB	'T'+80H
	DW	VLIST-8
LIST	DW	DOCOL
	DW	ONE,QENUF
	DW	CR,DUP
	DW	SCR,STORE
	DW	PDOTQ
	DB	9,'Screen # '
	DW	DOT
	DW	LIT,16
	DW	ZERO,XDO
LIST1	DW	CR,IDO
	DW	THREE
	DW	DOTR,SPACE
	DW	IDO,SCR
	DW	AT,DLINE
	DW	KEYQ		; KEY?
	DW	QBRAN,LIST2-$	; IF
	DW	LEAVE		; LEAVE
LIST2	DW	XLOOP,LIST1-$	; THEN
	DW	CR,EXIT
;
	DB	85H	; INDEX		2.5
	DB	'INDE'
	DB	'X'+80H
	DW	LIST-7
INDEX	DW	DOCOL
	DW	ONE,QENUF
	DW	DEPTH
	DW	TWO,LESS
	DW	QBRAN,INDE3-$	; IF
	DW	CAP,AT		; THEN
INDE3	DW	ONEP,SWAP
	DW	XDO
INDE1	DW	CR
	DW	IDO,THREE
	DW	MODD,ZEQU
	DW	QBRAN,INDE4-$	; IF
	DW	CR		; THEN
INDE4	DW	IDO
	DW	THREE
	DW	DOTR,SPACE
	DW	ZERO,IDO
	DW	DLINE,KEYQ
	DW	QBRAN,INDE2-$
	DW	LEAVE
INDE2	DW	XLOOP,INDE1-$
	DW	EXIT
;
	DB	85H	; TRIAD		2.5
	DB	'TRIA'
	DB	'D'+80H
	DW	INDEX-8
TRIAD	DW	DOCOL
	DW	PAG
	DW	THREE,SLASH
	DW	THREE,STAR
	DW	THREE
	DW	OVER,PLUS
	DW	SWAP,XDO
TRIA1	DW	CR,IDO
	DW	LIST,KEYQ	; KEY?
	DW	QBRAN,TRIA2-$	; IF
	DW	LEAVE		; LEAVE
TRIA2	DW	XLOOP,TRIA1-$	; THEN
	DW	CR
	DW	LIT,15
	DW	MESS,CR
	DW	EXIT
;
	DB	84H	; SHOW		2.5
	DB	'SHO'
	DB	'W'+80H
	DW	TRIAD-8
SHOW	DW	DOCOL
	DW	TWO,QENUF
	DW	ONEP,SWAP
	DW	THREE,SLASH
	DW	THREE,STAR
	DW	XDO
SHOW1	DW	IDO
	DW	TRIAD,KEYQ
	DW	QBRAN,SHOW2-$
	DW	LEAVE
SHOW2	DW	THREE
	DW	XPLOO,SHOW1-$
	DW	EXIT
;
	DB	84H	; .CPU
	DB	'.CP'
	DB	'U'+80H
	DW	SHOW-7
DOTCPU	DW	DOCOL
	DW	BASE,AT
	DW	LIT,36
	DW	BASE,STORE
	DW	LIT,22H
	DW	PORIG,TAT
	DW	DDOT
	DW	BASE,STORE
	DW	EXIT
;
	DB	85H	; DEPTH		2.5
	DB	'DEPT'	; ( - # WORDS ON STACK )
	DB	'H'+80H
	DW	DOTCPU-7
DEPTH	DW	DOCOL
	DW	SPAT
	DW	SZERO
	DW	AT
	DW	SWAP
	DW	SUBB
	DW	TWOD
	DW	EXIT
;
	DB	82H	; .S		2.5
	DB	'.'	; ( NONDESTRUCTIVE STACK PRINT )
	DB	'S'+80H
	DW	DEPTH-8
DOTS	DW	DOCOL
	DW	DEPTH
	DW	QBRAN,DOTS2-$	; IF
	DW	SPAT
	DW	SZERO,AT
	DW	TWOM
	DW	XDO
DOTS1	DW	IDO,AT
	DW	DOT
	DW	LIT,-2
	DW	XPLOO,DOTS1-$
	DW	BRAN,DOTS3-$
DOTS2	DW	PDOTQ		; ELSE
	DB	6,'Empty '
DOTS3	DW	EXIT		; THEN
;
	DB	84H	; DUMP		2.1
	DB	'DUM'
	DB	'P'+80H
	DW	DOTS-5
DUMP	DW	DOCOL
	DW	LIT,2
	DW	QENUF
	DW	OVER,PLUS
	DW	SWAP,XDO
DUMP1	DW	CR,IDO		; DO
	DW	LIT,5
	DW	UDOTR,SPACE
	DW	IDO
	DW	LIT,16
	DW	PLUS,IDO
	DW	XDO		;   DO
DUMP2	DW	IDO,CAT
	DW	LIT,4
	DW	DOTR
	DW	XLOOP,DUMP2-$	;   LOOP
	DW	LIT,16
	DW	XSLOOP,DUMP1-$	; /LOOP
	DW	EXIT
;
	DB	84H	; VIEW		2.3
	DB	'VIE'
	DB	'W'+80H
	DW	DUMP-7
VIEW	DW	DOCOL
	DW	TICK,DUP
	DW	LIT,TASK+2
	DW	ONEP,ULESS
	DW	PABORT
	DB	18,'Can',27H,'t, precompiled'
	DW	NFA,TWOM
	DW	AT,DUP
	DW	ZEQU
	DW	PABORT
	DB	20,'Can',27H,'t, from keyboard'
	DW	LIST
	DW	EXIT
;
	DB	86H	; LOCATE	2.3
	DB	'LOCAT'
	DB	'E'+80H
	DW	VIEW-7
LOCAT	DW	DOCOL
	DW	VIEW,EXIT
;
	DB	84H	; TEXT		2.3
	DB	'TEX'
	DB	'T'+80H
	DW	LOCAT-9
TEXT	DW	DOCOL
	DW	HERE
	DW	LIT,80
	DW	BLANK
	DW	WORD,COUNT
	DW	PAD,SWAP
	DW	CMOVE
	DW	EXIT
;
	DB	84H	; LINE		2.1
	DB	'LIN'
	DB	'E'+80H
	DW	TEXT-7
LINE	DW	DOCOL
	DW	DUP
	DW	LIT
	DW	0FFF0H
	DW	ANDD
	DW	PABORT
	DB	15,'Bad line number'
	DW	SCR
	DW	AT
	DW	PLINE
	DW	DROP
	DW	EXIT
;
	DB	86H	; .WHERE	2.3
	DB	'.WHER'
	DB	'E'+80H
	DW	LINE-7
DWHERE	DW	DOCOL
	DW	TWO,QENUF
	DW	DUP
	DW	BUFSCR
	DW	SLASH
	DW	DUP
	DW	SCR
	DW	STORE
	DW	PDOTQ
	DB	9,'Screen # '
	DW	DEC
	DW	DOT
	DW	SWAP
	DW	CSLL
	DW	SLMOD
	DW	CSLL
	DW	STAR
	DW	ROT
	DW	BLOCK
	DW	PLUS
	DW	CR
	DW	CSLL
	DW	TYPE
	DW	CR
	DW	HERE
	DW	CAT
	DW	SUBB
	DW	SPACS
	DW	LIT,'^'
	DW	EMIT
	DW	EDITOR
	DW	QUIT
	DW	EXIT
;
	DB	81H	; L	1.5
	DB	'L'+80H
	DW	DWHERE-9
EL	DW	DOCOL
	DW	SCR,AT
	DW	LIST,EXIT
;
	DB	81H	; N	1.5
	DB	'N'+80H
	DW	EL-4
EN	DW	DOCOL
	DW	ONE
	DW	SCR,PSTOR
	DW	EXIT
;
	DB	81H	; B	1.5
	DB	'B'+80H
	DW	EN-4
EB	DW	DOCOL
	DW	LIT,-1
	DW	SCR,PSTOR
	DW	EXIT
;
	PAGE
;
;	STRING OPERATIONS
;
	DB	86H	; DELETE	2.3
	DB	'DELET' ; ( am #m # - )
	DB	'E'+80H	; DELETE # CHRS FROM STRING
	DW	EB-4	; AT am WITH LENGTH #m
SDEL	DW	DOCOL
	DW	OVER,MIN
	DW	TOR,IDO
	DW	SUBB,DUP
	DW	ZGREA
	DW	QBRAN,SDEL1-$
	DW	TDUP,SWAP
	DW	DUP,IDO
	DW	PLUS,DROT
	DW	SWAP,CMOVE
SDEL1	DW	PLUS
	DW	FROMR,BLANK
	DW	EXIT
;
	DB	86H	; INSERT	2.3
	DB	'INSER' ; ( as #s am #m - )
	DB	'T'+80H	; INSERT SUBSTRING AT as FOR #s CHRS
	DW	SDEL-9	; INTO MAIN STRING AT am FOR #m 
SINS	DW	DOCOL
	DW	ROT,OVER
	DW	MIN,TOR
	DW	IDO,SUBB
	DW	OVER,DUP
	DW	IDO,PLUS
	DW	ROT,LCMOV
	DW	FROMR,CMOVE
	DW	EXIT
;
	DB	86H	; MATCH?	2.3
	DB	'MATCH'	; ( am #m as - f )
	DB	'?'+80H	; COMPATE 2 STRINGS AT am AND as
	DW	SINS-9	; FOR #m CHRS.  RETURN TRUE IF =
SMATCH	DW	DOCOL
	DW	SWAP,QDUP
	DW	QBRAN,SMAT4-$
	DW	OVER,PLUS
	DW	SWAP,XDO
SMAT1	DW	DUP,CAT
	DW	IDO,CAT
	DW	SUBB
	DW	QBRAN,SMAT2-$
	DW	ZEQU,LEAVE
	DW	BRAN,SMAT3-$
SMAT2	DW	ONEP
SMAT3	DW	XLOOP,SMAT1-$
	DW	EXIT
SMAT4	DW	DROP,ZEQU
	DW	EXIT
;
	DB	86H	; SEARCH	2.3
	DB	'SEARC' ; ( as #s am #m -- a f )
	DB	'H'+80H	; SEARCH FOR A SUBSTRING AT as
	DW	SMATCH-9 ; WITH LENGTH #s IN A MAIN
SEARCH	DW	DOCOL	; STRING AT am FOR #m .
;			IF FOUND, RETURN true AND
;			   NEXT MAIN STRING ADDRESS
;			ELSE RETURN false AND
;			   MAIN STRING ADDRESS OF 1ST
;			   NON-MATCHING CHARACTER
	DW	OVER,PLUS
	DW	DUP,TOR
	DW	SWAP,XDO
SEARC1	DW	TDUP,IDO	; DO
	DW	SMATCH
	DW	QBRAN,SEARC2-$	; IF
	DW	IDO,PLUS
	DW	SWAP,ZEQU
	DW	LEAVE
SEARC2	DW	XLOOP,SEARC1-$	; THEN  LOOP
	DW	QBRAN,SEARC3-$	; IF
	DW	DROP,FROMR
	DW	ZERO
	DW	BRAN,SEARC4-$
SEARC3	DW	FROMR,DROP	; ELSE
	DW	ONE
SEARC4	DW	EXIT		; THEN
;
	DB	85H	; -TEXT		1.5
	DB	'-TEX'	; ( am # as - f )
	DB	'T'+80H	; SIMILAR TO MATCH?
	DW	SEARCH-9 ; f = 0 IF MATCHED,
DTEXT	DW	DOCOL	;	<0 IF (am) < (as)
;				>0 IF (am) > (as)
	DW	SWAP,QDUP
	DW	QBRAN,DTEXT5-$	; IF
	DW	OVER,PLUS
	DW	SWAP,XDO
DTEXT1	DW	DUP,CAT		;   DO
	DW	IDO,CAT
	DW	SUBB,QDUP
	DW	QBRAN,DTEXT2-$	;     IF
	DW	SWAP,DROP
	DW	ZERO,LEAVE
	DW	BRAN,DTEXT3-$
DTEXT2	DW	ONEP		;     ELSE
DTEXT3	DW	XLOOP,DTEXT1-$	;     THEN
;				;   LOOP
	DW	QBRAN,DTEXT4-$	;   IF
	DW	ZERO
DTEXT4	DW	EXIT		;   THEN
DTEXT5	DW	TDROP,ZERO	; ELSE
DTEXT6	DW	EXIT		; THEN
;
	DB	87H	; REPLACE	2.5
	DB	'REPLAC'
	DB	'E'+80H
	DW	DTEXT-8
REPLAC	DW	DOCOL
	DW	ROT,MIN
	DW	CMOVE,EXIT
;
	PAGE
;
	DB	89H	; ASSEMBLER		2.1
	DB	'ASSEMBLE'
	DB	'R'+80H
	DW	REPLAC-10
ASMB	DW	DOVOC
ASMBN	DW	0A081H
ASMBP	DW	ALAST	; INIT VALUE ONLY
;			  CHANGED EACH TIME ASSM. DEF ADDED
ASMBV	DW	FORTV	; VOCAB BACK LINK
;
;	ASSEMBLER DEFINITIONS
;
	DB	84H	; NEXT		1.5
	DB	'NEX'	; ( NEXT'S ADDRESS )
	DB	'T'+80H
	DW	FORTHN	; CHAIN TO FORTH VOCABULARY
ANEXT	DW	DOCON
	DW	NEXT
;
	DB	82H	; UP		1.4
	DB	'U'	; ( UP'S ADDRESS )
	DB	'P'+80H
	DW	ANEXT-7
AUP	DW	DOCON
	DW	UP
;
ALAST	DB	81H	; R		1.4
	DB	'R'+80H	; ( RPP'S ADDRESS )
	DW	AUP-5
AR	DW	DOCON
	DW	RPP
;
;	END OF ASSEMBLERS' WORDS AT COLD START
;
	PAGE
	DB	86H	; EDITOR		2.1
	DB	'EDITO'
	DB	'R'+80H
	DW	ASMB-12
EDITOR	DW	DOVOC
EDITN	DW	0A081H
EDITP	DW	ELAST	; COLD START VALUE ONLY
;		CHANGED WHEN NEW EDITOR DEF ADDED
EDITV	DW	ASMBV	; VOCAB BACK LINK
;
;	EDITOR DEFINITIONS
;
	DB	83H	; TOP		1.5
	DB	'TO'
	DB	'P'+80H
	DW	FORTHN	; CHAIN EDITOR VOCAB TO FORTH VOCAB
TOP	DW	DOCOL
	DW	ZERO
	DW	RNUM
	DW	STORE
	DW	EXIT
;
	DB	84H	; WIPE		1.5
	DB	'WIP'
	DB	'E'+80H
	DW	TOP-6
WIPE	DW	DOCOL
	DW	SCR,AT
	DW	BLOCK
	DW	LIT,1024
	DW	BLANK,UPDAT
	DW	EXIT
;
	DB	84H	; COPY		1.5
	DB	'COP'
	DB	'Y'+80H
	DW	WIPE-7
COPY	DW	DOCOL
	DW	TWO
	DW	QENUF
	DW	OFSET
	DW	AT
	DW	PLUS
	DW	SWAP
	DW	BLOCK
	DW	TWOM
	DW	STORE
	DW	UPDAT
	DW	EXIT
;
	DB	87H	; 'INSERT	1.5
	DB	27H,'INSER'
	DB	'T'+80H
	DW	COPY-7
TINS	DW	DOCOL
	DW	PAD
	DW	LIT,68
	DW	PLUS,EXIT
;
	DB	85H	; 'FIND		1.5
	DB	27H,'FIN'
	DB	'D'+80H
	DW	TINS-10
TFIND	DW	DOCOL
	DW	TINS
	DW	LIT,68
	DW	PLUS,EXIT
;
	DB	86H	; CURSOR	1.5
	DB	'CURSO'	;  ( -- A-IN-SCREEN #IN-LINE )
	DB	'R'+80H
	DW	TFIND-8
CURSOR	DW	DOCOL
	DW	SCR,AT
	DW	BLOCK
	DW	RNUM,AT
	DW	LIT,1023
	DW	ANDD,PLUS
	DW	CSLL
	DW	RNUM,AT
	DW	LIT,63
	DW	ANDD,SUBB
	DW	EXIT
;
	DB	85H	; <LINE		1.5
	DB	'<LIN'	;  ( -- A-IN-SCREEN #-IN-LINE )
	DB	'E'+80H	;  ( MOVE CURSOR TO START OF LINE )
	DW	CURSOR-9
LLINE	DW	DOCOL
	DW	RNUM,AT
	DW	LIT,-64
	DW	ANDD
	DW	RNUM,STORE
	DW	CURSOR,EXIT
;
	DB	84H	; KEEP		1.5
	DB	'KEE'
	DB	'P'+80H
	DW	LLINE-8
KEEP	DW	DOCOL
	DW	LLINE,TINS
	DW	TDUP,CSTOR
	DW	ONEP,SWAP
	DW	CMOVE,EXIT
;
	DB	81H	; K		1.5
	DB	'K'+80H
	DW	KEEP-7
EK	DW	DOCOL
	DW	TFIND,PAD
	DW	LIT,68
	DW	CMOVE
	DW	TINS,TFIND
	DW	LIT,68
	DW	CMOVE
	DW	PAD,TINS
	DW	LIT,68
	DW	CMOVE,EXIT
;
	DB	85H	; #LINE		1.5
	DB	'#LIN'	;  ( -- # )
	DB	'E'+80H
	DW	EK-4
NLINE	DW	DOCOL
	DW	RNUM,AT
	DW	LIT,1023
	DW	ANDD
	DW	CSLL,SLASH
	DW	EXIT
;
	DB	85H	; ?TEXT		1.5
	DB	'?TEX'	;  ( A -- A+1 )
	DB	'T'+80H
	DW	NLINE-8
QTEXT	DW	DOCOL
	DW	TOR
	DW	LIT,'^'
	DW	WORD,DUP
	DW	ONEP,CAT
	DW	QBRAN,QTEXT1-$	; IF
	DW	RAT
	DW	LIT,65
	DW	BLANK
	DW	RAT,OVER
	DW	CAT,ONEP
	DW	CMOVE
	DW	BRAN,QTEXT2-$
QTEXT1	DW	DROP		; ELSE
QTEXT2	DW	FROMR,ONEP	; THEN
	DW	EXIT
;
	DB	87H	; #BEFORE	1.5
	DB	'#BEFOR'  ;  ( # -- 64-# )
	DB	'E'+80H
	DW	QTEXT-8
NBEFOR	DW	DOCOL
	DW	CSLL,SWAP
	DW	SUBB,EXIT
;
	DB	8AH	; #REMAINING	1.5
	DB	'#REMAININ'  ;  ( -- #TO-END-SCREEN )
	DB	'G'+80H
	DW	NBEFOR-10
NREM	DW	DOCOL
	DW	LIT,1024
	DW	RNUM,AT
	DW	SUBB,EXIT
;
	DB	85H	; WHERE		2.3
	DB	'WHER'
	DB	'E'+80H
	DW	NREM-13
WHERE	DW	DOCOL
	DW	CR,SPACE
	DW	CURSOR,NBEFOR
	DW	TOR,RAT
	DW	SUBB,FROMR
	DW	TYPE
	DW	LIT,'^'
	DW	EMIT
	DW	CURSOR,TYPE
	DW	NLINE,DOT
	DW	EXIT
;
	DB	81H	; T		2.3
	DB	'T'+80H
	DW	WHERE-8
ET	DW	DOCOL
	DW	ONE,QENUF
	DW	LIT,15
	DW	ANDD
	DW	CSLL,STAR
	DW	RNUM,STORE
	DW	WHERE
	DW	EXIT
;
	DB	81H	; P		2.3
	DB	'P'+80H
	DW	ET-4
EP	DW	DOCOL
	DW	TINS,QTEXT
	DW	LLINE,CMOVE
	DW	UPDAT
	DW	WHERE
	DW	EXIT
;
	DB	81H	; X		2.3
	DB	'X'+80H
	DW	EP-4
EX	DW	DOCOL
	DW	KEEP,LLINE
	DW	NREM,SWAP
	DW	SDEL,UPDAT
	DW	WHERE
	DW	EXIT
;
	DB	81H	; U		2.3
	DB	'U'+80H
	DW	EX-4
EU	DW	DOCOL
	DW	TINS,QTEXT
	DW	CSLL
	DW	RNUM,PSTOR
	DW	LLINE,SWAP
	DW	NREM,SINS
	DW	UPDAT,WHERE
	DW	EXIT
;
	DB	81H	; M		2.3
	DB	'M'+80H
	DW	EU-4
EM	DW	DOCOL
	DW	TWO,QENUF
	DW	KEEP
	DW	RNUM,AT
	DW	CSLL,PLUS
	DW	TOR
	DW	SCR,AT
	DW	TOR
	DW	CSLL,STAR
	DW	RNUM,STORE
	DW	SCR,STORE
	DW	EU,FROMR
	DW	SCR,STORE
	DW	FROMR
	DW	RNUM,STORE
	DW	WHERE
	DW	EXIT
;
	DB	86H	; FOUND?	2.3
	DB	'FOUND'	;  ( -- F )
	DB	'?'+80H
	DW	EM-4
FOUNDQ	DW	DOCOL
	DW	TFIND,QTEXT
	DW	ONEM,COUNT
	DW	CURSOR,DROP
	DW	NREM,SEARCH
	DW	DUP
	DW	QBRAN,FONDQ1-$	; IF
	DW	SWAP
	DW	CURSOR,DROP
	DW	SUBB
	DW	RNUM,PSTOR
	DW	BRAN,FONDQ2-$
FONDQ1	DW	SWAP,DROP	; ELSE
FONDQ2	DW	EXIT		; THEN
;
	DB	85H	; FOUND		2.3
	DB	'FOUN'
	DB	'D'+80H
	DW	FOUNDQ-9
FOUND	DW	DOCOL
	DW	FOUNDQ,NOTT
	DW	QBRAN,FOUND1-$	; IF
	DW	TFIND,COUNT
	DW	TYPE,PDOTQ
	DB	4,'none'
	DW	QUIT
FOUND1	DW	EXIT		; THEN
;
	DB	81H	; F		2.3
	DB	'F'+80H
	DW	FOUND-8
EF	DW	DOCOL
	DW	FOUND
	DW	WHERE
	DW	EXIT
;
	DB	84H	; TILL		2.3
	DB	'TIL'
	DB	'L'+80H
	DW	EF-4
TILL	DW	DOCOL
	DW	RNUM,AT
	DW	FOUND
	DW	RNUM,AT
	DW	SWAP,DUP
	DW	RNUM,STORE
	DW	SUBB,CURSOR
	DW	ROT,SDEL
	DW	UPDAT,WHERE
	DW	EXIT
;
	DB	81H	; E		2.3
	DB	'E'+80H
	DW	TILL-7
EE	DW	DOCOL
	DW	TFIND,CAT
	DW	DUP,NEG
	DW	RNUM,PSTOR
	DW	CURSOR,ROT
	DW	SDEL,UPDAT
	DW	WHERE
	DW	EXIT
;
	DB	81H	; D		2.3
	DB	'D'+80H
	DW	EE-4
ED	DW	DOCOL
	DW	FOUND,EE
	DW	EXIT
;
	DB	81H	; I		2.3
	DB	'I'+80H
	DW	ED-4
EII	DW	DOCOL
	DW	TINS,QTEXT
	DW	TINS,CAT
	DW	CURSOR
	DW	SINS
	DW	UPDAT
	DW	TINS,CAT
	DW	RNUM,PSTOR
	DW	WHERE
	DW	EXIT
;
	DB	81H	; R		1.5
	DB	'R'+80H
	DW	EII-4
ER	DW	DOCOL
	DW	EE,EII
	DW	EXIT
;
ELAST	DB	81H	; S		2.3
	DB	'S'+80H
	DW	ER-4
ES	DW	DOCOL
	DW	ONE,QENUF
	DW	DUP
	DW	SCR,AT
	DW	XDO
ES1	DW	FOUNDQ,NOTT	; DO
	DW	QBRAN,ES2-$	; IF
	DW	EN,TOP
	DW	BRAN,ES3-$
ES2	DW	WHERE		; ELSE
	DW	SCR,QUES
	DW	LEAVE,DUP
ES3	DW	XLOOP,ES1-$	; THEN  LOOP
	DW	DROP
	DW	EXIT
;
	PAGE
;
;	FORTH DEFINITIONS (CONTINUED)
;
	DB	89H	; PERMANENT	2.5
	DB	'PERMANEN'	
	DB	'T'+80H
	DW	EDITOR-9
PERM	DW	DOCOL
;		SAVE VALUES OF USER VARIABLES
	DW	LIT,UP
	DW	AT
	DW	LIT,6
	DW	PLUS
	DW	LIT,12H
	DW	PORIG
	DW	LIT,OCLD1-OCLD0
	DW	CMOVE
;
;		SAVE VOCABULARY'S POINTERS
	DW	EDITOR	; EDITOR
	DW	CONT,AT
	DW	AT
	DW	LIT,OED
	DW	STORE
	DW	ASMB	; ASSEMBLER
	DW	CONT,AT
	DW	AT
	DW	LIT,OASM
	DW	STORE
	DW	FORTH,DEFIN	; FORTH
	DW	CONT,AT
	DW	AT
	DW	LIT,OFOR
	DW	STORE
;
;		CALCULATE DICTIONARY SIZE
;		IN # OF 256 BYTE 'PAGES'
;		FOR CP/M 'SAVE' COMMAND
	DW	HERE,ZERO
	DW	LIT,256
	DW	USLMOD
	DW	ONEP,DOT
	DW	DROP,PDOTQ
	DB	6,'Pages '
	DW	EXIT
;
;
	DB	83H	; BYE		2.3
	DB	'BY'	;  ( PATCH FORTH FOR A 'SAVE'
	DB	'E'+80H	;    THEN LEAVE CP/M )
	DW	PERM-12
BYE	DW	DOCOL
	DW	PERM
	DW	ZERO,HERE	; RETURN TO CP/M
	DW	STORE		; JMP 0
	DW	HERE,TWOP
	DW	EXEC
;
	DB	82H	; OK		2.3
	DB	'O'
	DB	'K'+80H
	DW	BYE-6
OK	DW	DOCOL
	DW	SETDRV
	DW	INIT,LOAD
	DW	EXIT
;
FLAST	DB	84H	; TASK
	DB	'TAS'
	DB	'K'+80H
	DW	OK-5
TASK	DW	DOCOL
	DW	EXIT
;
HCOLD	DS	KLIMIT-$	;CONSUME MEMORY TO LIMIT
;
	PAGE
;
;		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'
;
MBIP	EQU	BIP		;DEBUG SUPPORT
MDPUSH	EQU	DPUSH		;ADDRESS INTERPRETER
MHPUSH	EQU	HPUSH
MNEXT	EQU	NEXT
;
MDBOT	EQU	DBOTOM		;START FORTH DICTIONARY
MISKEW	EQU	ISKEW		  ;?SKEW COLD VALUE
MDIO	EQU	NDRIVE		  ;CP/M DISK INTERFACE
MCIO	EQU	EPRINT		  ;CONSOLE & PRINTER INTERFACE
MIDP	EQU	HCOLD		;END GIVEN FORTH DICTIONARY
;				  = COLD (H) VALUE
;				  = COLD (FENCE) VALUE
;				  |  NEW
;				  |  DEFINITIONS
;				  V
;
;				  ^
;				  |  DATA
;				  |  STACK
MIS0	EQU	KS0		;  = COLD (SP) VALUE = (S0)
;				   = (TIB)
;				  |  TEXT INPUT
;				  |  BUFFER
;				  V
;
;				  ^
;				  |  RETURN
;				  |  STACK
MIR0	EQU	KR0		;START USER VARIABLES
;				  = COLD (RP) VALUE = (R0)
;				  = (UP)
;				;END USER VARIABLES
MFIRST	EQU	KFIRST		;START DISK BUFFERS
;				  = FIRST
MEND	EQU	KLIMIT-1	;END DISK BUFFERS
MLIMIT	EQU	KLIMIT		;LAST MEMORY LOC USED + 1
;				  = LIMIT
;
;
	END	ORIG
