classic.asm

; NASM listing: Make some MASM directives harmless up front.
%macro IGNORE1 1+ ; One or more parameters
%endmacro
%define IGNORE   ; no parameters
%define PAGE IGNORE
%define CSEG IGNORE1
%define ASSUME IGNORE1
%define PROC IGNORE1
%define TITLE IGNORE1
%define OFFSET IGNORE
%define END IGNORE1
; ENDP can only be made harmless by commenting the whole line out
; `comment x' is replace by `%if 0' constructions.
	; PAGE  66,106
 TITLE   FIG-FORTH FOR IBM-PC   1.0
%if 0 
              FIG-FORTH
   implemented by:  Charlie Krajewski
                    205 ( BIG ) Blue Rd.
		    Middletown, CT  06457

        NASM assembler version by:
                Albert van der Horst
                HCC Forth user group
                The Netherlands
                www.forth.hccnet.nl

  This implementation supports only one 64k segment

  The listing has been made possible by the
  prior work of:
               Thomas Newman, Hayward, Ca.

 : other_acknowledgements
         John_Cassidy
         Kim_Harris
         George_Flammer
         Robert_D._Villwock ;
 To upgrade, modify, and understand Fig Forth, the
 value of the following book cannot be overstated:
         Systems Guide to FIG Forth
         C. H. Ting, PhD
 It is available through MVP.  See any recent issue
 of FORTH Dimensions for their ad.

No one who programs with FORTH can afford to be without:
  Starting Forth
  Leo Brodie
Get it.  Available through FORTH Interest Group.
Can also be found in many book stores.
Chapter 3 serves as a guide for the EDITOR that you
will probably type in from the FIG-Forth installation
manual.

Although there is much to be said for typing in your own
listing and getting it running, there is much to be said 
not typing in your own listing.  If you feel that 100+
pages of plinking is nutty, contact me for availability
of a disc with source & executable files.  Obtainable at
a bargain basement price, prepare yourself for bargain
basement support.

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:
       
               FORTH Interest Group
               P.O. Box 1105
               San Carlos, Ca.  94070
%endif
	PAGE
FIGREL	EQU	1	; FIG RELEASE #
FIGREV	EQU	0	;FIG REVISION #
USRVER  EQU     0  	; USER VERSION NUMBER
;
;	ASCII CHARACTER EQUIVALENTS
;
ABL	EQU	20H	; SPACE
ACR	EQU    	0DH	; CR
ADOT	EQU	2EH	; PERIOD
BELL	EQU	07H	; ^G
BSIN	EQU	08H	; INPUT DELETE CHARACTER
BSOUT	EQU	08H	; OUTPUT BACKSPACE ( ^H )
DLE	EQU	10H	; ( ^P )  MAKE PRINTER OUTPUT DEVICE
LF	EQU 	0AH	; LINE FEED
FF	EQU	0CH	; FORM FEED
;
;	MEMORY + I/O CONSTANTS
;
SEC_DSK	EQU	360
PRINTER_NO	EQU	0
EM	EQU	04000H	; END OF MEMORY + 1
NSCR	EQU	2	; NO. 1024 BYTE SCREENS
KBBUF	EQU	512	;DATA BYTES PER DISK BUFFER
US	EQU	40H	; USER VARIABLE SPACE
RTS	EQU	0A0H	; RETURN STACK & TERM BUFFER
;
CO	EQU	KBBUF+4		; DISK BUFFER + 4 BYTES
NBUF	EQU	NSCR*1024/KBBUF	; NO. OF BUFFERS
BUF1	EQU	EM-CO*NBUF	; FIRST DISK BUFFER
INITR0	EQU	BUF1-US		; ( RO )
INITS0	EQU	INITR0-RTS	; ( S0 )
;
 PAGE
 CSEG    SEGMENT PARA PUBLIC 'CODE'
	ASSUME CS:CSEG,DS:CSEG,SS:CSEG,ES:CSEG
	ORG	100H	; FOR EXE2BIN COMMAND AFTER LINK
;			  SEE PG 10-14 OF DOS 2.0 MANUAL
;                         FOR EXPLANATION OF EXE2BIN
ORIG	PROC	FAR	; SEE PG 5-31, MACRO ASSEMBLER
	NOP
	JMP	LCLD     ;VECTOR TO COLD START
	NOP
	JMP	WRM	; VECTOR TO WARM START
;
	DB	FIGREL	; FIG RELEASE #
	DB	FIGREV	; FIG REVISION #
	DB	USRVER	; USER REVISION #
	DB	0EH	; VERSION ATTRIBUTES
	DW	TASK-7	; TOP WORD IN FORTH VOCABULARY
	DW	BSIN	; BACKSPACE
	DW	INITR0	; INIT (UP)
;
;	<<<<< following used in COLD start >>>>>
;       <<<<< must be in same order as user variables >>>>>
;
	DW 	INITS0	; INIT (S0)
	DW 	INITR0	; INIT (R0)
	DW 	INITS0	; INIT (TIB)
	DW	32	;       INIT (WIDTH)
	DW	0	; 	INIT (WARNING)
	DW	INITDP	;	INIT (FENCE)
	DW	INITDP  ;	INIT (DP)
	DW	FORTH+6	;	INIT (VOC-LINK)
	;
;	<<<<< end of data used by cold start >>>>>
;
;	The following is the CPU's name, printed
;       during cold start.
;       The name is 32 bits in base 32.
;
	DW	5H,0B328H	; '8088'
UP	DW	INITR0	; USER AREA POINTER
RPP	DW	INITR0	; RETURNS STACK POINTER
	PAGE
%if 0
   FORTH REGISTERS

   FORTH   8088     FORTH PRESERVATION RULES
   -----   ----     ----- ------------ -----
    IP      SI      Interpreter pointer.  Must be preserved
                    across FORTH words.

     W      DX      Working register.  Jump to 'DPUSH' will
                    push contents onto the parameter stack
                    before executing 'APUSH'.
 
    SP      SP      Parameter stack pointer.  Must be preserved 
                    across FORTH words.
 
    RP      BP      Return stack.  Must be preserved across
                    FORTH words.

            AX      General register.  Must be preserved across
                    FORTH words.

            BX      General purpose register.
 
            CX      General purpose register.

            DI      General purpose register.

            CS      Segment register.  Must be preserved
                    across FORTH words.

            DS      ditto
        
            SS      ibid
 
            ES      Temporary segment register only used by
                    a few words.

---------------------------------------------------------- 
%endif
	PAGE
%if 0 
---------------------------------------------

   COMMENT CONVENTIONS
   ------- -----------

   =       IS EQUAL TO
   <-      ASSIGNMENT

  NAME        =  Address of name
  (NAME)      =  Contents of name
  ((NAME))    =  Indirect contents

  CFA         =  Address of CODE FIELD
  LFA         =  Address of LINK FIELD
  NFA         =  Address of NAME FIELD
  PFA         =  Address of PARAMETER FIELD

  S1          =  Parameter stack - 1st word
  S2          =  Parameter stack - 2nd word
  R1          =  Return stack    - 1st word
  R2          =  Return stack    - 2nd word

  LSB         =  Least significant bit
  MSB         =  Most  significant bit
  LB          =  Low byte
  HB          =  High byte
  LW          =  Low  word

------------------------------------------------------------ 
%endif
	PAGE
%if 0 
             DEBUG SUPPORT

THIS ROUTINE WILL ALLOW YOU TO STEP THRU FORTH PROGRAMS
EVERY TIME 'NEXT' IS EXECUTED.

IN ORDER TO USE THE STEP FEATURE YOU MUST DO THE FOLLOWING:

	1.  PATCH THE INSTRUCTION IN 'NEXT' WITH A JUMP
            TO 'TNEXT'
 
    	2.  PATCH YOUR BREAKPOINT ROUTINE AT
            LABEL   'BREAK'
	
	3.  SET VARIABLES, `BIP' & `BIPE' TO THE
            ADDRESSES YOU WANT TO STEP THRU.

THE CONTENTS OF THE 2 VARIABLES 'BIP` AND `BIPE'
ARE INTERPRETED AS FOLLOWS:

BIP	BIPE	DEBUG-CONDITION
---	----	---------------

  0	   X	OFF
 -1	   X    TRACE ALL `NEXT' CALLS
ADDR1      0    TRACE `ADDR1' ONLY
ADDR1  ADDR2    TRACE `ADDR1' TO `ADDR1'

NOTE:	THE ABOVE ADDRESSES CAN'T POINT TO A
	`CODE FIELD ADDRESS'. 
       	X = DON'T CARE

----------------------------------------------------- 
%endif

BIP	DW	0	; BREAKPOINT START ADDRESS
BIPE	DW	0	; BREAKPOINT END ADDR
	PAGE
;	THIS IS THE `NEXT' WITH DEBUG SUPPORT

TNEXT:  PUSHF		;SAVE REGISTER
	PUSH	AX
	MOV	AX,[BIP]  ; BREAKPOINT START ADDR
	OR	AX,AX	; ZERO?
	JZ	TNEXT2	; NO BREAKPOINT
	CMP	AX,-1
	JZ	TNEXT1	; STEP ALL POINTS
	CMP	AX,SI	; IN BREAKPOINT RANGE?
	JZ	TNEXT1	; STEP THIS LOCATION
	JA	TNEXT2	; NO
	MOV	AX,[BIPE] ; BREAKPOINT END ADDR
	OR	AX,AX	; ZERO?
	JZ	TNEXT2	; ONLY 1 LOCATION
	CMP	AX,SI	; IN RANGE STILL?
	JB	TNEXT2	; NO

;	PAUSE ON ADDRESS
;
TNEXT1: POPF
;
;********  ADD YOUR BREAKPOINT HERE  **********
;
BREAK:  JMP	SHORT	TNEXT3	;CONT WITH PROGRAM
;
;	NO BREAKPOINT PAUSE - RESTORE REGISTERS
;
TNEXT2:	POP	AX
	POPF
TNEXT3:	LODSW		; AX <- (IP)
	MOV	BX,AX
	JMP	SHORT	NEXT1
	PAGE
DPUSH:	PUSH	DX
APUSH:	PUSH	AX
%if 0

	Patch the next 3 locations
( using a DBUG monitor )
with a `JMP TNEXT' for tracing through
high level FORTH words.
%endif
NEXT:	LODSW		;AX <- (IP)
	MOV	BX,AX
;
;
NEXT1:	MOV	DX,BX	; (W) <- (IP)
	INC	DX	; (W) <- (W) + 1
	JMP     [BX]    ; TO `CFA'
	PAGE
DP0	DB	83H
	DB	'LI'
	DB	'T'+80H
	DW	0	; START OF DICTIONARY
LIT	DW	$+2	; (S1) <- ((IP))
	LODSW		; AX <- LITERAL
	JMP SHORT     APUSH   ; TO TOP OF STACK

;        EXECUTE
;
	DB	87H
	DB	'EXECUT'
	DB	'E'+80H
	DW	LIT-6
EXEC	DW	$+2
	POP	BX	; GET CFA
	JMP SHORT     NEXT1   ; EXECUTE NEXT
;
;	BRANCH
;
	DB	86H	; BRANCH
	DB	'BRANC'
	DB	'H'+80H
	DW	EXEC-0AH
BRAN	DW	$+2
BRAN1:	ADD	SI,[SI]
	JMP SHORT     NEXT    ; JUMP TO OFFSET
;
;	0BRANCH
;
	DB	87H
	DB	'0BRANC'
	DB	'H'+80H
	DW	BRAN-9
ZBRAN	DW	$+2
	POP	AX	; GET STACK VALUE
	OR	AX,AX	; ZERO?
	JZ	BRAN1	; YES, BRANCH
	INC	SI	; NO - CONTINUE...
	INC 	SI
	JMP SHORT     NEXT
;
	PAGE
;
;	(LOOP)
	DB	86H
	DB	'(LOOP'
	DB	')'+80H
	DW	ZBRAN-0AH
XLOOP	DW	$+2
	MOV	BX,1	; INCREMENT
XLOO1:	ADD	[BP],BX	; INDEX = INDEX + INCR
	MOV	AX,[BP]	; GET NEW INDEX
	SUB	AX,[2+BP]        ; COMPARE WITH LIMIT
	XOR	AX,BX	; TEST SIGN
	JS	BRAN1	; KEEP LOOPING
;
;  END OF `DO' LOOP
	ADD	BP,BYTE 4    ; ADJ RETURN STACK
	INC	SI	; BYPASS BRANCH OFFSET
	INC	SI
	JMP SHORT     NEXT
;	DEBUG STUFF
;
	DB	84H
	DB	'NOO'
	DB	'P'+80H
	DW	XLOOP-9
NOOP	DW	$+4
NOP0	DW	$+2
	JMP SHORT     NEXT
NOP1	DW 	$+2
	JMP SHORT     NEXT
NOP2	DW	$+2
	JMP SHORT     NEXT
;
;	(+LOOP)
;
	DB	87H
	DB	'(+LOOP'
	DB	')'+80H
	DW	NOOP-7
XPLOO	DW	$+2
	POP	BX	; GET LOOP VALUE
	JMP SHORT     XLOO1
;
;	(DO)
;
	DB	84H
	DB	'(DO'
	DB	')'+80H
	DW	XPLOO-0AH
XDO	DW	$+2
	POP	DX	; INITIAL INDEX VALUE
	POP	AX	; LIMIT VALUE
	XCHG	BP,SP	; GET RETURN STACK
	PUSH	AX
	PUSH	DX
	XCHG	BP,SP	; GET PARAMETER STACK
	JMP	NEXT
	PAGE
;
;	I
;
	DB	81H
	DB	'I'+80H
	DW	XDO-7
IDO	DW	$+2	; (SI) <- (RI)
	MOV	AX,[BP]	; GET INDEX VALUE
	JMP	APUSH	; TO PARAMETER STACK
;
 	DB	85H
	DB	'DIGI'
	DB	'T'+80H
	DW	IDO-4
DIGIT	DW	$+2
	POP	DX	;NUMBER BASE
	POP	AX	;ASCII DIGIT
	SUB	AL,'0'
	JB	DIGI2	;NUMBER ERROR
	CMP	AL,9
	JBE	DIGI1	;NUMBER = 0 THRU 9
	SUB	AL,7
	CMP	AL,10	;NUMBER 'A' THRU 'Z'?
	JB	DIGI2	;NO
DIGI1:	CMP	AL,DL	; COMPARE NUMBER TO BASE
	JAE	DIGI2	;NUMBER ERROR
	SUB	DX,DX	;ZERO
	MOV	DL,AL	;NEW BINARY NUMBER
	MOV	AL,1	;TRUE FLAG
	JMP	DPUSH	;ADD TO STACK
;   NUMBER ERROR
DIGI2:	SUB	AX,AX	;FALSE FLAG
	JMP	APUSH
	PAGE
;
	DB	86H
	DB	'(FIND'
	DB	')'+80H
	DW	DIGIT-8
PFIND	DW	$+2
	MOV	AX,DS
	MOV	ES,AX	;ES = DS
	POP	BX	;NFA
	POP	CX	;STRING ADDR
;
;  SEARCH LOOP
PFIN1:  MOV	DI,CX	;GET ADDR
	MOV	AL,[BX]	;GET WORD LENGTH
	MOV	DL,AL	;SAVE WORD LENGTH
	XOR	AL,[DI]
	AND	AL,3FH	;CHECK LENGTHS
	JNZ	PFIN5	;LENGTHS DIFFER

;
;   LENGTHS MATCH - CHECK EACH CHARACTER IN NAME
PFIN2:	INC	BX
	INC	DI	; NEXT CHAR OF NAME
	MOV	AL,[BX]
	XOR	AL,[DI]	;COMPARE NAMES
	ADD	AL,AL	;THIS WILL BE TEST BIT 8
	JNZ	PFIN5	;NO MATCH
	JNB	PFIN2	;MATCH SO FAR - LOOP
;
;   FOUND END OF NAME (BIT 8 SET) - A MATCH
	ADD	BX,BYTE 5    ; BX = PFA
	PUSH	BX	; (S3) <- PFA
	MOV	AX,1	;TRUE VALUE
	SUB	DH,DH
	JMP	DPUSH
;
;   NO NAME MATCH - TRY ANOTHER
;
; GET NEXT LINK FIELD ADDR (LFA)
; ( ZERO = FIRST WORD OF DICTIONARY )
;
PFIN5:	INC	BX	;NEXT ADDR
	JB	PFIN6	;END OF NAME
	MOV	AL,[BX]	;GET NEXT CHAR
	ADD	AL,AL	;SET/RESET CARRY
	JMP SHORT     PFIN5   ;LOOP UNTIL FOUND
;
PFIN6:	MOV	BX,[BX]	; GET LINK FIELD ADDR
	OR	BX,BX	; START OF DICT ( 0 )
	JNZ	PFIN1	; NO , LOOK MORE
	MOV	AX,0	; FALSE FLAG
	JMP	APUSH	; DONE ( NO MATCH FOUND )
;
	PAGE
	DB	87H
	DB	'ENCLOS'
	DB	'E'+80H
	DW	PFIND-9
ENCL	DW	$+2
	POP	AX	;S1 - TERMINATOR CHAR
	POP	BX	;S2 - TEXT ADDR
	PUSH	BX	;ADDR - BACK TO STACK ( IT RHYMES )
	MOV	AH,0	;ZERO
	MOV	DX,-1	;CHAR OFFSET COUNTER
	DEC	BX	;ADDR -1
;
;   SCAN TO FIRST NON-TERMINATOR CHARACTER
ENCL1:	INC	BX	;ADDR+1
	INC	DX	;COUNT+1
	CMP	AL,[BX]
	JZ	ENCL1	;WAIT FOR NON-TERMINATOR
	PUSH	DX	;OFFSET TO 1ST TEXT CHAR
	CMP	AH,[BX]	;NULL CHAR?
	JNZ	ENCL2	;NO
;
;  FOUND NULL BEFORE 1ST NON-TERM CHAR
	MOV	AX,DX	;COPY COUNTER
	INC	DX	; +1
	JMP	DPUSH
;
;   FOUND FIRST TEXT CHAR - COUNT THE CHARS
ENCL2:	INC	BX	; ADDR+1
	INC	DX	;COUNT+1
	CMP	AL,[BX]	;TERMINATOR CHAR?
	JZ	ENCL4	;YES
	CMP	AH,[BX]	;NULL CHAR?
	JNZ	ENCL2	;NO, LOOP AGAIN
;
;   FOUND NULL AT END OF TEXT
ENCL3:	MOV	AX,DX	;COUNTERS ARE EQUAL
	JMP	DPUSH
;
;   FOUND TERMINATOR CHARACTER
ENCL4:	MOV	AX,DX
	INC	AX	;COUNT+1
	JMP	DPUSH
	PAGE
	; At line     LINE ~500
;	EMIT
	DB	84H
	DB	'EMI'
	DB	'T'+80H
	DW	ENCL-0AH
EMIT	DW	DOCOL
	DW	PEMIT
	DW	ONE,OUTT
	DW	PSTOR,SEMIS
;
;	KEY
	DB	83H
	DB	'KE'
	DB	'Y'+80H
	DW	EMIT-7
KEY	DW	$+2
	JMP	PKEY
;
;	?TERMINAL
	DB	89H
	DB	'?TERMINA'
	DB	'L'+80H
	DW	KEY-6
QTERM	DW	$+2
	JMP	PQTER
;
;	CR
	DB	82H
	DB	'C'
	DB	'R'+80H
	DW	QTERM-0CH
CR	DW	$+2
	JMP	PCR
	PAGE
;	CMOVE
	DB	85H
	DB	'CMOV'
	DB	'E'+80H
	DW	CR-5
LCMOVE   DW      $+2
	CLD             ;INC DIRECTION
	MOV	BX,SI	;SAVE IF
	POP	CX	;COUNT
	POP	DI	;DEST
	POP	SI	;SOURCE
	MOV	AX,DS
	MOV	ES,AX	;ES <- DS
	REP	MOVSB	;THAT'S THE MOVE
	MOV	SI,BX	;GET BACK IP
	JMP	NEXT
;
;	U*
;
	DB	82H
	DB	'U'
	DB	'*'+80H
	DW	LCMOVE-8
USTAR	DW	$+2
	POP	AX
	POP	BX
	MUL	BX	;UNSIGNED
	XCHG	AX,DX	;AX NOW = MSW
	JMP	DPUSH	;STORE DOUBLE WORD
;
;	U/
;
	DB	82H
	DB	'U'
	DB	'/'+80H
	DW	USTAR-5
USLAS	DW	$+2
	POP	BX	;DIVISOR
	POP	DX	;MSW OF DIVIDEND
	POP	AX	;LSW OF DIVIDEND
	CMP	DX,BX	;DICIDE BY 0?
	JNB	DZERO	; ERROR - ZERO DIVIDE
	DIV	BX	;16 BIT DIVIDE
	JMP	DPUSH	;STORE QUOT/REM
;
;	DIVIDE BY ZERO ERROR - SHOW MAX NUMBERS
DZERO:	MOV	AX,-1
	MOV	DX,AX
	JMP	DPUSH	;STORE QUOT/REM
	PAGE
;	AND
;
	DB	83H
	DB	'AN'
	DB	'D'+80H
	DW	USLAS-5
ANDD	DW	$+2
	POP	AX
	POP	BX
	AND	AX,BX
	JMP	APUSH
;
;	OR
;
	DB	82H
	DB	'O'
	DB	'R'+80H
	DW	ANDD-6
ORR	DW	$+2	; (S1) <- (S1) OR (S2)
	POP	AX
	POP	BX
	OR	AX,BX
	JMP	APUSH
;
;	XOR
;
	DB	83H
	DB	'XO'
	DB	'R'+80H
	DW	ORR-5
XORR	DW	$+2	; (S1) <- (S1) XOR (S2)
	POP	AX
	POP	BX
	XOR	AX,BX
	JMP	APUSH
	PAGE
;	SP@
;
	DB	83H
	DB	'SP'
	DB	'@'+80H
	DW	XORR-6
SPAT	DW	$+2	; (S1) <- (SP)
	MOV	AX,SP
	JMP	APUSH
;
;	SP!
;
	DB	83H
	DB	'SP'
	DB	'!'+80H
	DW	SPAT-6
SPSTO	DW	$+2
	MOV	BX,[UP]   ;USER VAR BASE ADDR
	MOV	SP,[6+BX]        ;RESET PARAM STACK POINTER
	JMP	NEXT
;
;	RP@
;
	DB	83H
	DB	'RP'
	DB	'@'+80H
	DW	SPSTO-6
RPAT	DW	$+2	;(S1) <- (RP)
	MOV	AX,BP	;RETURN STACK ADDR
	JMP	APUSH
;
;	RP!
;
	DB	83H
	DB	'RP'
	DB	'!'+80H
	DW	RPAT-6
RPSTO	DW	$+2
	MOV	BX,[UP]   ;(AX) <- USR VAR BASE
	MOV	BP,[8+BX]        ;RESET RETURN STACK PTR
	JMP	NEXT
;
	PAGE
;	;S
;
;   END OF SCREEN OR RUN TIME COLON WORDS
;
	DB	82H
	DB	';'
	DB	'S'+80H
	DW	RPSTO-6
SEMIS	DW	$+2
	MOV	SI,[BP]	;(IP) <- (R1)
	INC	BP
	INC	BP	;ADJUST STACK
	JMP	NEXT
;
;	LEAVE
;
	DB	85H
	DB	'LEAV'
	DB	'E'+80H
	DW	SEMIS-5
LLEAV   DW      $+2     ;LIMIT <- INDEX
	MOV	AX,[BP]	;GET INDEX
	MOV	[2+BP],AX        ;STORE IT AT LIMIT
	JMP	NEXT
	PAGE
;
;	>R
;
	DB	82H
	DB	'>'
	DB	'R'+80H
	DW	LLEAV-8
TOR	DW	$+2	; (R1) <- (S1)
	POP	BX	;GET STACK PARAMETER
	DEC	BP
	DEC	BP	;MOVE RETURN STACK DOWN
	MOV	[BP],BX	;ADD TO RETURN STACK
	JMP	NEXT
;
;	R>
;
	DB	82H
	DB	'R'
	DB	'>'+80H
	DW	TOR-5
FROMR	DW	$+2	;(S1) <- (R1)
	MOV	AX,[BP]	; GET RETURN STACK VALUE
	INC	BP	;DELETE FROM STACK
	INC	BP
	JMP	APUSH
;
;	R
;
	DB	81H
	DB	'R'+80H
	DW	FROMR-5
RR	DW	IDO+2
	PAGE
;	0=
;
	DB	82H
	DB	'0'
	DB	'='+80H
	DW	RR-4
ZEQU	DW	$+2
	POP	AX
	OR	AX,AX	;DO TEST
	MOV	AX,1	;TRUE
	JZ	ZEQU1	;IT'S 0
	DEC	AX	;FALSE
ZEQU1:	JMP	APUSH
;
;	0<
;
	DB	82H
	DB	'0'
	DB	'<'+80H
	DW	ZEQU-5
ZLESS	DW	$+2
	POP	AX
	OR	AX,AX	;SET FLAGS
	MOV	AX,1	;TRUE
	JS	ZLESS1
	DEC	AX	;FALSE
ZLESS1:	JMP	APUSH
;
;	+
;
	DB	81H
	DB	'+'+80H
	DW	ZLESS-5
PLUS	DW	$+2	;(S1) <- (S1) + (S2)
	POP	AX
	POP	BX
	ADD	AX,BX
	JMP	APUSH
	PAGE
;	D+
;
;  XLW  XHW    YLW  YHW  -->  SLW  SHW
;   S4   S3     S2   S1        S2   S1
;
	DB	82H
	DB	'D'
	DB	'+'+80H
	DW	PLUS-4
DPLUS	DW	$+2
	POP	AX	; YHW
	POP	DX	; YLW
	POP	BX	; XHW
	POP	CX	; XLW
	ADD	DX,CX	; SLW
	ADC	AX,BX	; SHW
	JMP	DPUSH
;
;	MINUS
;
	DB	85H
	DB	'MINU'
	DB	'S'+80H
	DW	DPLUS-5
MINUS	DW	$+2
	POP	AX
	NEG	AX
	JMP	APUSH
;
;	DMINUS
;
	DB	86H
	DB	'DMINU'
	DB	'S'+80H
	DW	MINUS-8
DMINU	DW	$+2
	POP	BX
	POP	CX
	SUB	AX,AX
	MOV	DX,AX
	SUB	DX,CX	; MAKE 2'S COMPLEMENT
	SBB	AX,BX	; HIGH WORD
	JMP	DPUSH
	PAGE
;
;	OVER
;
	DB	84H
	DB	'OVE'
	DB	'R'+80H
	DW	DMINU-9
OVER	DW	$+2
	POP	DX
	POP	AX
	PUSH	AX
	JMP	DPUSH
;
;	DROP
;
	DB	84H
	DB	'DRO'
	DB	'P'+80H
	DW	OVER-7
DROP	DW	$+2
	POP	AX
	JMP	NEXT
;
;	SWAP
;
	DB	84H
	DB	'SWA'
	DB	'P'+80H
	DW	DROP-7
SWAP	DW	$+2
	POP	DX
	POP	AX
	JMP	DPUSH
;
;	DUP
;
	DB	83H
	DB	'DU'
	DB	'P'+80H
	DW	SWAP-7
DUPE	DW	$+2
	POP	AX
	PUSH	AX
	JMP	APUSH
	PAGE
;	2DUP
;
	DB	84H
	DB	'2DU'
	DB	'P'+80H
	DW	DUPE-6
TDUP	DW 	$+2
	POP	AX
	POP	DX
	PUSH	DX
	PUSH	AX
	JMP	DPUSH
;
;	+!
;
	DB	82H
	DB	'+'
	DB	'!'+80H
	DW	TDUP-7
PSTOR	DW	$+2
	POP	BX	;ADDRESS
	POP	AX	;INCREMENT
	ADD	[BX],AX
	JMP	NEXT
;
;	TOGGLE
;
	DB	86H
	DB	'TOGGL'
	DB	'E'+80H
	DW	PSTOR-5
TOGGL	DW	$+2
	POP	AX	;BIT PATTERN
	POP	BX	;ADDR
	XOR	[BX],AL	;
	JMP	NEXT
;
;	@
;
	DB	81H
	DB	'@'+80H
	DW	TOGGL-9
FETCH      DW      $+2
	POP	BX
	MOV	AX,[BX]
	JMP	APUSH
	PAGE
;	C@
;
	DB	82H
	DB	'C'
	DB	'@'+80H
	DW	FETCH-4
CAT	DW	$+2
	POP	BX
	MOV	AL,[BX]
	SUB	AH,AH
	JMP	APUSH
;
;	2@
;
	DB	82H
	DB	'2'
	DB	'@'+80H
	DW	CAT-5
TAT	DW	$+2
	POP	BX	;ADDR
	MOV	AX,[BX]	;MSW
	MOV	DX,[2+BX]        ;LSW
	JMP	DPUSH
;
;	!
;
	DB	81H
	DB	'!'+80H
	DW	TAT-5
STORE	DW	$+2
	POP	BX	;ADDR
	POP	AX	;DATA
	MOV	[BX],AX
	JMP	NEXT
;
;	C!
;
	DB	82H
	DB	'C'
	DB	'!'+80H
	DW	STORE-4
CSTOR	DW	$+2
	POP	BX	;ADDR
	POP	AX	;DATA
	MOV	[BX],AL
	JMP	NEXT
;
;	2!
;
	DB	82H
	DB	'2'
	DB	'!'+80H
	DW	CSTOR-5
TSTOR	DW	$+2
	POP	BX	;ADDR
	POP	AX	;MSW
	MOV	[BX],AX
	POP	AX	;LSW
	MOV	[2+BX],AX
	JMP	NEXT
;
;	L@
;
	DB	82H	;( SEG# IP -- N )
	DB	'L'
	DB	'@'+80H
	DW	TSTOR-5
LAT     DW      $+2
	POP	BX	;MEM LOC
	POP	CX	;SEG REG VAL
	MOV	DX,DS
	MOV	DS,CX
	MOV	AX,[BX]
	MOV	DS,DX
	JMP	APUSH
;
;	L!
;
	DB	82H	;( N SEG# IP -- )
	DB	'L'
	DB	'!'+80H
	DW	LAT-5
LSTORE	DW	$+2
	POP	BX
	POP	CX
	MOV	DX,DS
	MOV	DS,CX
	POP	AX
	MOV	[BX],AX
	MOV	DS,DX
	JMP	NEXT
	PAGE
	; At line     LINE ~1000
;
;	:
;
	DB	0C1H
	DB	':'+80H
	DW	LSTORE-5
COLON	DW	DOCOL
	DW	QEXEC
	DW	SCSP
	DW	CURR
	DW	FETCH
	DW	CONT
	DW	STORE
	DW	CREAT
	DW	RBRAC
	DW	PSCOD
DOCOL:	INC	DX	;W=W+1
	DEC	BP
	DEC	BP	;(RP) <- (RP)-2
	MOV	[BP],SI	;R1 <- (RP)
	MOV	SI,DX	;(IP) <- (W)
	JMP	NEXT
;
;	;
;
	DB	0C1H
	DB	';'+80H
	DW	COLON-4
SEMI	DW	DOCOL
	DW	QCSP
	DW	COMP
	DW	SEMIS
	DW	SMUDG
	DW	LBRAC
	DW	SEMIS
	PAGE
;	CONSTANT
;
	DB	88H
	DB	'CONSTAN'
	DB	'T'+80H
	DW	SEMI-4
CON	DW	DOCOL
	DW	CREAT
	DW	SMUDG
	DW	COMMA
	DW	PSCOD
DOCON:	INC	DX	;PFA
	MOV	BX,DX
	MOV	AX,[BX]	;GET DATA
	JMP	APUSH
;
;	VARIABLE
;
	DB	88H
	DB	'VARIABL'
	DB	'E'+80H
	DW	CON-0BH
VAR	DW	DOCOL
	DW	CON
	DW	PSCOD
DOVAR:	INC	DX	;(DE) <- PFA
	PUSH	DX
	JMP	NEXT
;
;	USER
;
	DB	84H
	DB	'USE'
	DB	'R'+80H
	DW	VAR-0BH
USER	DW	DOCOL
	DW	CON
	DW	PSCOD
DOUSE:	INC	DX	;PFA
	MOV	BX,DX
	MOV	BL,[BX]
	SUB	BH,BH
	MOV	DI,[UP]   ;USER VAR ADDRESS
	LEA	AX,[BX+DI]	;ADDR OF VARIABLE
	JMP	APUSH
	PAGE
;	0
	DB	81H
	DB	'0'+80H
	DW	USER-7
ZERO	DW	$+2
	XOR	AX,AX
	JMP	APUSH
;
;	1
;
	DB	81H
	DB	'1'+80H
	DW	ZERO-4
ONE	DW	$+2
	MOV	AX,1
	JMP	APUSH
;
;	2
;
	DB	81H
	DB	'2'+80H
	DW	ONE-4
TWO	DW	$+2
	MOV	AX,2
	JMP	APUSH
;
;	3
;
	DB	81H
	DB	'3'+80H
	DW	TWO-4
THREE	DW	$+2
	MOV	AX,3
	JMP	APUSH
;
;	BL
;
;	THIS IS ONLY A SPAC
	DB	82H
	DB	'B'
	DB	'L'+80H
	DW	THREE-4
BLS	DW	DOCON
	DW	20H
;
;	C/L
;
	DB	83H	;CHARACTERS/LINE
	DB	'C/'
	DB	'L'+80H
	DW	BLS-5
CSLL	DW	DOCON
	DW	64
;
;	FIRST
;
	DB	85H
	DB	'FIRS'
	DB	'T'+80H
	DW	CSLL-6
FIRST	DW	DOCON
	DW	BUF1
;
;	LIMIT
;
	DB	85H
	DB	'LIMI'
	DB	'T'+80H
	DW	FIRST-8
LIMIT	DW	DOCON
	DW	EM
;
;	B/BUF
;
	DB	85H	;BYTES/BUFFER
	DB	'B/BU'
	DB	'F'+80H
	DW	LIMIT-8
BBUF	DW	DOCON
	DW	KBBUF
;
;	B/SCR
;
	DB	85H	;BUFFERS/SCREEN
	DB	'B/SC'
	DB	'R'+80H
	DW	BBUF-8
BSCR	DW	DOCON
	DW	400H/KBBUF
;
;	+ORIGIN
;
	DB	87H
	DB	'+ORIGI'
	DB	'N'+80H
	DW	BSCR-8
PORIG	DW	DOCOL
	DW	LIT
	DW	ORIG
	DW	PLUS
	DW	SEMIS
	PAGE
;
;	S0
;
	DB	82H
	DB	'S'
	DB	'0'+80H
	DW	PORIG-0AH
SZERO	DW	DOUSE
	DW	6
;
;	R0
;
	DB	82H
	DB	'R'
	DB	'0'+80H
	DW	SZERO-5
RZERO	DW	DOUSE
	DW	8
;
;	TIB
;
	DB	83H
	DB	'TI'
	DB	'B'+80H
	DW	RZERO-5
TIB	DW	DOUSE
	DW	0AH
;
;	WIDTH
;
	DB	85H
	DB	'WIDT'
	DB	'H'+80H
	DW	TIB-6
WIDTHE  DW	DOUSE
	DW	0CH
;
;	WARNING
;
	DB	87H
	DB	'WARNIN'
	DB	'G'+80H
	DW	WIDTHE-8
WARN	DW	DOUSE
	DW	0EH
;
;	FENCE
;
	DB	85H
	DB	'FENC'
	DB	'E'+80H
	DW	WARN-0AH
FENCE	DW	DOUSE
	DW	10H
;
;	DP
;
	DB	82H
	DB	'D'
	DB	'P'+80H
	DW	FENCE-8
DP	DW	DOUSE
	DW	12H
;
;	VOC-LINK
;
	DB	88H
	DB	'VOC-LIN'
	DB	'K'+80H
	DW	DP-5
VOCL	DW	DOUSE
	DW	14H
;
;	BLK
;
	DB	83H
	DB	'BL'
	DB	'K'+80H
	DW	VOCL-0BH
BLK	DW	DOUSE
	DW	16H
	PAGE
;
;	IN
;
	DB	82H
	DB	'I'
	DB	'N'+80H
	DW	BLK-6
INN	DW	DOUSE
	DW	18H
;
;	OUT
;
	DB	83H
	DB	'OU'
	DB	'T'+80H
	DW	INN-5
OUTT	DW	DOUSE
	DW	1AH
;
;	SCR
;
	DB	83H
	DB	'SC'
	DB	'R'+80H
	DW	OUTT-6
SCR	DW	DOUSE
	DW	1CH
;
;	OFFSET
;
	DB	86H
	DB	'OFFSE'
	DB	'T'+80H
	DW	SCR-6
OFSET	DW	DOUSE
	DW	0
;
;	CONTENT
;
	DB	87H
	DB	'CONTEX'
	DB	'T'+80H
	DW	OFSET-9
CONT	DW	DOUSE
	DW	20H
;
;	CURRENT
;
	DB	87H
	DB	'CURREN'
	DB	'T'+80H
	DW	CONT-0AH
CURR	DW	DOUSE
	DW	22H
;
;	STATE
;
	DB	85H
	DB	'STAT'
	DB	'E'+80H
	DW	CURR-0AH
STATE	DW	DOUSE
	DW	24H
;
;	BASE
;
	DB	84H
	DB	'BAS'
	DB	'E'+80H
	DW	STATE-8
BASE	DW	DOUSE
	DW	26H
;
;	DPL
;
	DB	83H
	DB	'DP'
	DB	'L'+80H
	DW	BASE-7
DPL	DW	DOUSE
	DW	28H
;
;	FLD
;
	DB	83H
	DB	'FL'
	DB	'D'+80H
	DW	DPL-6
LFLD     DW      DOUSE
	DW	2AH
;
;	CSP
;
	DB	83H
	DB	'CS'
	DB	'P'+80H
	DW	LFLD-6
CSPP	DW	DOUSE
	DW	2CH
;
;	R#
;
	DB	82H
	DB	'R'
	DB	'#'+80H
	DW	CSPP-6
RNUM	DW	DOUSE
	DW	2EH
;
;	HLD
;
	DB	83H
	DB	'HL'
	DB	'D'+80H
	DW	RNUM-5
HLD	DW	DOUSE
	DW	30H
;
;========== END USER VARIABLES =============;
	PAGE
;
;	1+
;
	DB	82H
	DB	'1'
	DB	'+'+80H
	DW	HLD-6
ONEP	DW	$+2
	POP	AX
	INC	AX
	JMP	APUSH
;
;	2+
;
	DB	82H
	DB	'2'
	DB	'+'+80H
	DW	ONEP-5
TWOP	DW	$+2
	POP	AX
	ADD	AX,2
	JMP	APUSH
;
;	HERE
;
	DB	84H
	DB	'HER'
	DB	'E'+80H
	DW	TWOP-5
HERE	DW	DOCOL
	DW	DP
	DW	FETCH
	DW	SEMIS
;
;	ALLOT
;
	DB	85H
	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
;
;	C,
;
	DB	82H
	DB	'C'
	DB	','+80H
	DW	COMMA-4
CCOMM	DW	DOCOL
	DW	HERE
	DW	CSTOR
	DW	ONE
	DW	ALLOT
	DW	SEMIS
;
;	-
;
	DB	81H
	DB	'-'+80H
	DW	CCOMM-5
SUBB	DW	$+2
	POP	DX	;S1
	POP	AX
	SUB	AX,DX
	JMP	APUSH	;S1 = S2 - S1
;
;	=
;
	DB	81H
	DB	'='+80H
	DW	SUBB-4
EQUAL	DW	DOCOL
	DW	SUBB
	DW	ZEQU
	DW	SEMIS
;
;	<
;
	DB	81H
	DB	'<'+80H
	DW	EQUAL-4
LESS	DW	$+2
	POP	DX	;S1
	POP	AX	;S2
	MOV	BX,DX
	XOR	BX,AX	;TEST FOR EQUAL SIGNS
	JS	LES1	;SIGNS ARE NOT THE SAME
	SUB	AX,DX
LES1:	OR	AX,AX	;TEST SIGN BIT
	MOV	AX,0	;ASSUME FALSE
	JNS	LES2	;NOT LESS THAN
	INC	AX	;TRUE (1)
LES2:	JMP	APUSH
;
;	U<
;
	DB	82H
	DB	'U'
	DB	'<'+80H
	DW	LESS-4
ULESS	DW	DOCOL,TDUP
	DW	XORR,ZLESS
	DW	ZBRAN
	DW	OFFSET ULES1-$	;IF
	DW	DROP,ZLESS
	DW	ZEQU
	DW	BRAN
	DW	OFFSET 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
;
;	ROT
;
	DB	83H
	DB	'RO'
	DB	'T'+80H
	DW	GREAT-4
ROT	DW	$+2
	POP	DX	;S1
	POP	BX	;S2
	POP	AX	;S3
	PUSH	BX
	JMP	DPUSH
;
;	SPACE
;
	DB	85H
	DB	'SPAC'
	DB	'E'+80H
	DW	ROT-6
SPACE	DW	DOCOL
	DW	BLS
	DW	EMIT
	DW	SEMIS
;
;	-DUP
;
	DB	84H
	DB	'-DU'
	DB	'P'+80H
	DW	SPACE-8
DDUP	DW	DOCOL
	DW	DUPE
	DW	ZBRAN	; IF
	DW	OFFSET DDUP1-$
	DW	DUPE	;ENDIF
DDUP1	DW	SEMIS
;
;	TRANVERSE
;
	DB	88H
	DB	'TRAVERS'
	DB	'E'+80H
	DW	DDUP-7
TRAV	DW	DOCOL
	DW	SWAP
TRAV1	DW	OVER	;BEGIN
	DW	PLUS
	DW	LIT,7FH
	DW	OVER
	DW	CAT
	DW	LESS
	DW	ZBRAN	;UNTIL
	DW	OFFSET TRAV1-$
	DW	SWAP
	DW	DROP
	DW	SEMIS
;
;	LATEST
;
	DB	86H
	DB	'LATES'
	DB	'T'+80H
	DW	TRAV-0BH
LATES	DW	DOCOL
	DW	CURR
	DW	FETCH
	DW	FETCH
	DW	SEMIS
;
;	LFA
;
	DB	83H
	DB	'LF'
	DB	'A'+80H
	DW	LATES-9
LFA	DW	DOCOL
	DW	LIT,4
	DW	SUBB
	DW	SEMIS
;	CFA
;
	DB	83H
	DB	'CF'
	DB	'A'+80H
	DW	LFA-6
CFA	DW	DOCOL
	DW	TWO
	DW	SUBB
	DW	SEMIS
;
;	NFA
;
	DB	83H
	DB	'NF'
	DB	'A'+80H
	DW	CFA-6
NFA	DW	DOCOL
	DW	LIT,5
	DW	SUBB
	DW	LIT,0FFFFH
	DW	TRAV
	DW	SEMIS
;
;	PFA
;
	DB	83H
	DB	'PF'
	DB	'A'+80H
	DW	NFA-6
PFA	DW	DOCOL
	DW	ONE
	DW	TRAV
	DW	LIT,5
	DW	PLUS
	DW	SEMIS
	PAGE
	; At line     LINE ~1500
;	!CSP
;
	DB	84H
	DB	'!CS'
	DB	'P'+80H
	DW	PFA-6
SCSP	DW	DOCOL
	DW	SPAT
	DW	CSPP
	DW	STORE
	DW	SEMIS
;
;	?ERROR
;
	DB	86H
	DB	'?ERRO'
	DB	'R'+80H
	DW	SCSP-7
QERR	DW	DOCOL
	DW	SWAP
	DW	ZBRAN	;IF
	DW	OFFSET QERR1-$
	DW	ERROR
	DW	BRAN	;ELSE
	DW	OFFSET QERR2-$
QERR1	DW	DROP	;ENDIF
QERR2	DW	SEMIS
;
;	?COMP
;
	DB	85H
	DB	'?COM'
	DB	'P'+80H
	DW	QERR-9
QCOMP	DW	DOCOL
	DW	STATE
	DW	FETCH
	DW	ZEQU
	DW	LIT,11H
	DW	QERR
	DW	SEMIS
	PAGE
;	?EXEC
;
	DB	85H
	DB	'?EXE'
	DB	'C'+80H
	DW	QCOMP-8
QEXEC	DW	DOCOL
	DW	STATE
	DW	FETCH
	DW	LIT,12H
	DW	QERR
	DW	SEMIS
;
;	?PAIRS
;
	DB	86H
	DB	'?PAIR'
	DB	'S'+80H
	DW	QEXEC-8
QPAIR	DW	DOCOL
	DW	SUBB
	DW	LIT,13H
	DW	QERR
	DW	SEMIS
;
;	?CSP
;
	DB	84H
	DB	'?CS'
	DB	'P'+80H
	DW	QPAIR-9
QCSP	DW	DOCOL
	DW	SPAT
	DW	CSPP
	DW	FETCH
	DW	SUBB
	DW	LIT,14H
	DW	QERR
	DW	SEMIS
;
;	?LOADING
;
	DB	88H
	DB	'?LOADIN'
	DB	'G'+80H
	DW	QCSP-7
QLOAD	DW	DOCOL
	DW	BLK
	DW	FETCH
	DW	ZEQU
	DW	LIT,16H
	DW	QERR
	DW	SEMIS
	PAGE
;	COMPILE
;
	DB	87H
	DB	'COMPIL'
	DB	'E'+80H
	DW	QLOAD-0BH
COMP	DW	DOCOL
	DW	QCOMP
	DW	FROMR
	DW	DUPE
	DW	TWOP
	DW	TOR
	DW	FETCH
	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
	DW	STORE
	DW	SEMIS
	PAGE
;	SMUDGE
;
	DB	86H
	DB	'SMUDG'
	DB	'E'+80H
	DW	RBRAC-4
SMUDG	DW	DOCOL
	DW	LATES
	DW	LIT,20H
	DW	TOGGL
	DW	SEMIS
;
;	HEX
;
	DB	83H
	DB	'HE'
	DB	'X'+80H
	DW	SMUDG-9
HEX	DW	DOCOL
	DW	LIT,16
	DW	BASE
	DW	STORE
	DW	SEMIS
;
;	DECIMAL
;
	DB	87H
	DB	'DECIMA'
	DB	'L'+80H
	DW	HEX-6
DECA	DW	DOCOL
	DW	LIT,10
	DW	BASE
	DW	STORE
	DW	SEMIS
;
;	(;CODE)
;
	DB	87H
	DB	'(;CODE'
	DB	')'+80H
	DW	DECA-0AH
PSCOD	DW	DOCOL
	DW	FROMR
	DW	LATES
	DW	PFA
	DW	CFA
	DW	STORE
	DW	SEMIS
;
;	;CODE
;
	DB	0C5H
	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
;
;	<BUILDS
;
	DB	87H
	DB	'<BUILD'
	DB	'S'+80H
	DW	SEMIC-8
BUILD	DW	DOCOL
	DW	ZERO
	DW	CON
	DW	SEMIS
;
;	DOES>
;
	DB	85H
	DB	'DOES'
	DB	'>'+80H
	DW	BUILD-0AH
DOES	DW	DOCOL
	DW	FROMR
	DW	LATES
	DW	PFA
	DW	STORE
	DW	PSCOD
DODOE:	XCHG	BP,SP	;GET RETURN STACK
	PUSH	SI	; (RP) <- (IP)
	XCHG	BP,SP
	INC	DX	;PFA
	MOV	BX,DX
	MOV	SI,[BX]	;NEW CFA
	INC	DX
	INC	DX
	PUSH	DX	;PFA
	JMP	NEXT
;
;	COUNT
;
	DB	85H
	DB	'COUN'
	DB	'T'+80H
	DW	DOES-8
COUNT	DW	DOCOL
	DW	DUPE
	DW	ONEP
	DW	SWAP
	DW	CAT
	DW	SEMIS
;
;	TYPE
;
	DB	84H
	DB	'TYP'
	DB	'E'+80H
	DW	COUNT-8
TYPES	DW	DOCOL
	DW	DDUP
	DW	ZBRAN	; IF
	DW	OFFSET TYPE1-$
	DW	OVER
	DW	PLUS
	DW	SWAP
	DW	XDO	; DO
TYPE2	DW	IDO
	DW	CAT
	DW	LIT,7FH
	DW	ANDD	;STRIP 80H FROM LAST CHAR
	DW	EMIT
	DW	XLOOP	; LOOP
	DW	OFFSET TYPE2-$
	DW	BRAN	; ELSE
	DW	OFFSET TYPE3-$
TYPE1	DW	DROP	; ENDIF
TYPE3	DW	SEMIS
;
;	-TRAILING
;
	DB	89H
	DB	'-TRAILIN'
	DB	'G'+80H
	DW	TYPES-7
DTRAI	DW	DOCOL
	DW	DUPE
	DW	ZERO
	DW	XDO	;DO
DTRA1	DW	OVER
	DW	OVER
	DW	PLUS
	DW	ONE
	DW	SUBB
	DW	CAT
	DW	BLS
	DW	SUBB
	DW	ZBRAN	;IF
	DW	OFFSET DTRA2-$
	DW	LLEAV
	DW	BRAN	; ELSE
	DW	OFFSET DTRA3-$
DTRA2	DW	ONE
	DW	SUBB	; ENDIF
DTRA3	DW	XLOOP	; LOOP
	DW	OFFSET DTRA1-$
	DW	SEMIS
	PAGE
	; At line     LINE ~2000
;	(.")
;
	DB	84H
	DB	'(."'
	DB	')'+80H
	DW	DTRAI-0CH
PDOTQ	DW	DOCOL
	DW	RR
	DW	COUNT
	DW	DUPE
	DW	ONEP
	DW	FROMR
	DW	PLUS
	DW	TOR
	DW	TYPES
	DW	SEMIS
;
;	."
;
	DB	0C2H
	DB	'.'
	DB	'"'+80H
	DW	PDOTQ-7
DOTQ	DW	DOCOL
	DW	LIT,22H
	DW	STATE
	DW	FETCH
	DW	ZBRAN	; IF
	DW	OFFSET DOTQ1-$
	DW	COMP
	DW	PDOTQ
	DW	WORDS
	DW	HERE
	DW	CAT
	DW	ONEP
	DW	ALLOT
	DW	BRAN	; ELSE
	DW	OFFSET DOTQ2-$
DOTQ1	DW	WORDS
	DW	HERE
	DW	COUNT
	DW	TYPES	; ENDIF
DOTQ2	DW	SEMIS
	PAGE
;	EXPECT
;
	DB	86H
	DB	'EXPEC'
	DB	'T'+80H
	DW	DOTQ-5
EXPEC	DW	DOCOL
	DW	OVER
	DW	PLUS
	DW	OVER
	DW	XDO	; DO
EXPE1	DW	KEY
	DW	DUPE
	DW	LIT,0EH
	DW	PORIG
	DW	FETCH
	DW	EQUAL
	DW	ZBRAN	; IF
	DW	OFFSET EXPE2-$
	DW	DROP
	DW	DUPE
	DW	IDO
	DW	EQUAL
	DW	DUPE
	DW	FROMR
	DW	TWO
	DW	SUBB
	DW	PLUS
	DW	TOR
	DW	ZBRAN	; IF
	DW	OFFSET EXPE6-$
	DW	LIT
	DW	BELL
	DW	BRAN	; ELSE
	DW	OFFSET EXPE7-$
EXPE6	DW	LIT
	DW	BSOUT	; ENDIF
EXPE7	DW	BRAN	; ELSE
	DW	OFFSET EXPE3-$
EXPE2	DW	DUPE
	DW	LIT,0DH
	DW	EQUAL
	DW	ZBRAN	; IF
	DW	OFFSET EXPE4-$
	DW	LLEAV
	DW	DROP
	DW	BLS
	DW	ZERO
	DW	BRAN	; ELSE
	DW	OFFSET EXPE5-$
EXPE4	DW	DUPE	; ENDIF
EXPE5	DW	IDO
	DW	CSTOR
	DW	ZERO
	DW	IDO
	DW	ONEP
	DW	STORE	; ENDIF
EXPE3	DW	EMIT
	DW	XLOOP	; LOOP
	DW	OFFSET EXPE1-$
	DW	DROP
	DW	SEMIS
;
;	QUERY
;
	DB	85H
	DB	'QUER'
	DB	'Y'+80H
	DW	EXPEC-9
QUERY	DW	DOCOL
	DW	TIB
	DW	FETCH
	DW	LIT,50H
	DW	EXPEC
	DW	ZERO
	DW	INN
	DW	STORE
	DW	SEMIS
	PAGE
	;	0 (NULL)
;
	DB	0C1H	; A BINARY ZERO
	DB	80H
	DW	QUERY-8
NULL	DW	DOCOL
	DW	BLK
	DW	FETCH
	DW	ZBRAN	; IF
	DW OFFSET NULL1-$
	DW	ONE
	DW	BLK
	DW	PSTOR
	DW	ZERO
	DW	INN
	DW	STORE
	DW	BLK
	DW	FETCH
	DW	BSCR
	DW	ONE
	DW	SUBB
	DW	ANDD
	DW	ZEQU
	DW	ZBRAN	; IF
	DW	OFFSET NULL2-$
	DW	QEXEC
	DW	FROMR
	DW	DROP	; ENDIF
NULL2	DW	BRAN	; ELSE
	DW	OFFSET NULL3-$
NULL1	DW	FROMR
	DW	DROP	; ENDIF
NULL3	DW	SEMIS
;
;	FILL
;
	DB	84H
	DB	'FIL'
	DB	'L'+80H
	DW	NULL-4
FILL	DW	$+2
	POP	AX	; FILL CHAR
	POP	CX	; FILL COUNT
	POP	DI	; BEGIN ADDR
	MOV	BX,DS
	MOV	ES,BX	; ES <- DS
	CLD		; INC DIRECTION
	REP	STOSB	;STORE BYTE
	JMP	NEXT
;
;	ERASE
;
	DB	85H
	DB	'ERAS'
	DB	'E'+80H
	DW	FILL-7
ERASEE	DW	DOCOL
	DW	ZERO
	DW	FILL
	DW	SEMIS
;
;	BLANKS
;
	DB	86H
	DB	'BLANK'
	DB	'S'+80H
	DW	ERASEE-8
BLANK	DW	DOCOL
	DW	BLS
	DW	FILL
	DW	SEMIS
;
;	HOLD
;
	DB	84H
	DB	'HOL'
	DB	'D'+80H
	DW	BLANK-9
HOLD	DW	DOCOL
	DW	LIT,-1
	DW	HLD
	DW	PSTOR
	DW	HLD
	DW	FETCH
	DW	CSTOR
	DW	SEMIS
;
;	PAD
;
	DB	83H
	DB	'PA'
	DB	'D'+80H
	DW	HOLD-7
PAD	DW	DOCOL
	DW	HERE
	DW	LIT,84
	DW	PLUS
	DW	SEMIS
;
;	WORD
;
	DB	84H
	DB	'WOR'
	DB	'D'+80H
	DW	PAD-6
WORDS	DW	DOCOL
	DW	BLK
	DW	FETCH
	DW	ZBRAN	; IF
	DW	OFFSET WORD1-$
	DW	BLK
	DW	FETCH
	DW	BLOCK
	DW	BRAN	; ELSE
	DW	OFFSET WORD2-$
WORD1	DW	TIB
	DW	FETCH      ; ENDIF
WORD2	DW	INN
	DW	FETCH
	DW	PLUS
	DW	SWAP
	DW	ENCL
	DW	HERE
	DW	LIT,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	LCMOVE
	DW	SEMIS
	PAGE
;	(NUMBER)
;
	DB	88H
	DB	'(NUMBER'
	DB	')'+80H
	DW	WORDS-7
PNUMB	DW	DOCOL
PNUM1	DW	ONEP	; BEGIN
	DW	DUPE
	DW	TOR
	DW	CAT
	DW	BASE
	DW	FETCH
	DW	DIGIT
	DW	ZBRAN	; WHILE
	DW	OFFSET PNUM2-$
	DW	SWAP
	DW	BASE
	DW	FETCH
	DW	USTAR
	DW	DROP
	DW	ROT
	DW	BASE
	DW	FETCH
	DW	USTAR
	DW	DPLUS
	DW	DPL
	DW	FETCH
	DW	ONEP
	DW	ZBRAN	; IF
	DW	OFFSET PNUM3-$
	DW	ONE
	DW	DPL
	DW	PSTOR	; ENDIF
PNUM3	DW	FROMR
	DW	BRAN	; REPEAT
	DW	OFFSET PNUM1-$
PNUM2	DW	FROMR
	DW	SEMIS
	PAGE
;	NUMBER
;
	DB	86H
	DB	'NUMBE'
	DB	'R'+80H
	DW	PNUMB-0BH
NUMB	DW	DOCOL
	DW	ZERO
	DW	ZERO
	DW	ROT
	DW	DUPE
	DW	ONEP
	DW	CAT
	DW	LIT,2DH
	DW	EQUAL
	DW	DUPE
	DW	TOR
	DW	PLUS
	DW	LIT,-1
NUMB1	DW	DPL	; BEGIN
	DW	STORE
	DW	PNUMB
	DW	DUPE
	DW	CAT
	DW	BLS
	DW	SUBB
	DW	ZBRAN	; WHILE
	DW	OFFSET NUMB2-$
	DW	DUPE
	DW	CAT
	DW	LIT,2EH
	DW	SUBB
	DW	ZERO
	DW	QERR
	DW	ZERO
	DW	BRAN	; REPEAT
	DW	OFFSET NUMB1-$
NUMB2	DW	DROP
	DW	FROMR
	DW	ZBRAN	; IF
	DW	OFFSET NUMB3-$
	DW	DMINU	; ENDIF
NUMB3	DW	SEMIS
	PAGE
;	-FIND
;
	DB	85H
	DB	'-FIN'
	DB	'D'+80H
	DW	NUMB-9
DFIND	DW	DOCOL
	DW	BLS
	DW	WORDS
	DW	HERE
	DW	CONT
	DW	FETCH
	DW	FETCH
	DW	PFIND
	DW	DUPE
	DW	ZEQU
	DW	ZBRAN	;IF
	DW	OFFSET DFIN1-$
	DW	DROP
	DW	HERE
	DW	LATES
	DW	PFIND	;ENDIF
DFIN1	DW	SEMIS
;
;	(ABORT)
;
	DB	87H
	DB	'(ABORT'
	DB	')'+80H
	DW	DFIND-8
PABOR	DW	DOCOL
	DW	ABORT
	DW	SEMIS
;
;	ERROR
;
	DB	85H
	DB	'ERRO'
	DB	'R'+80H
	DW	PABOR-0AH
ERROR	DW	DOCOL
	DW	WARN
	DW	FETCH
	DW	ZLESS
	DW	ZBRAN	;IF
	DW	OFFSET ERRO1-$
	DW	PABOR	;ENDIF
ERRO1	DW	HERE
	DW	COUNT
	DW	TYPES
	DW	PDOTQ
	DB	2
	DB	'? '
	DW	MESS
	DW	SPSTO
;
;	CHANGE FROM FIG MODEL
;	DW INN,FETCH,BLK,FETCH
;
	DW	BLK,FETCH
	DW	DDUP
	DW	ZBRAN	; IF
	DW	OFFSET ERRO2-$
	DW	INN,FETCH
	DW	SWAP	;ENDIF
ERRO2	DW	QUIT
;
;	ID.
;
	DB	83H
	DB	'ID'
	DB	'.'+80H
	DW	ERROR-8
IDDOT	DW	DOCOL
	DW	PAD
	DW	LIT,20H
	DW	LIT,5FH
	DW	FILL
	DW	DUPE
	DW	PFA
	DW	LFA
	DW	OVER
	DW	SUBB
	DW	PAD
	DW	SWAP
	DW	LCMOVE
	DW	PAD
	DW	COUNT
	DW	LIT,1FH
	DW	ANDD
	DW	TYPES
	DW	SPACE
	DW	SEMIS
	PAGE
;	CREATE
;
	DB	86H
	DB	'CREAT'
	DB	'E'+80H
	DW	IDDOT-6
CREAT	DW	DOCOL
	DW	DFIND
	DW	ZBRAN	;IF
	DW	OFFSET CREA1-$
	DW	DROP
	DW	NFA
	DW	IDDOT
	DW	LIT,4
	DW	MESS
	DW	SPACE	;ENDIF
CREA1	DW	HERE
	DW	DUPE
	DW	CAT
	DW	WIDTHE
	DW	FETCH
	DW	MIN
	DW	ONEP
	DW	ALLOT
	DW	DUPE
	DW	LIT,0A0H
	DW	TOGGL
	DW	HERE
	DW	ONE
	DW	SUBB
	DW	LIT,80H
	DW	TOGGL
	DW	LATES
	DW	COMMA
	DW	CURR
	DW	FETCH
	DW	STORE
	DW	HERE
	DW	TWOP
	DW	COMMA
	DW	SEMIS
	PAGE
;	[COMPILE]
;
	DB	0C9H
	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
;
;	LITERAL
;
	DB	0C7H
	DB	'LITERA'
	DB	'L'+80H
	DW	BCOMP-0CH
LITER	DW	DOCOL
	DW	STATE
	DW	FETCH
	DW	ZBRAN	;IF
	DW	OFFSET LITE1-$
	DW	COMP
	DW	LIT
	DW	COMMA	;ENDIF
LITE1	DW	SEMIS
	PAGE
;
;	DLITERAL
;
	DB	0C8H
	DB	'DLITERA'
	DB	'L'+80H
	DW	LITER-0AH
DLITE	DW	DOCOL
	DW	STATE
	DW	FETCH
	DW	ZBRAN	; IF
	DW	OFFSET DLIT1-$
	DW	SWAP
	DW	LITER
	DW	LITER	; ENDIF
DLIT1	DW	SEMIS
;
;	?STACK
;
	DB	86H
	DB	'?STAC'
	DB	'K'+80H
	DW	DLITE-0BH
QSTAC	DW	DOCOL
	DW	SPAT
	DW	SZERO
	DW	FETCH
	DW	SWAP
	DW	ULESS
	DW	ONE
	DW	QERR
	DW	SPAT
	DW	HERE
	DW	LIT,80H
	DW	PLUS
	DW	ULESS
	DW	LIT,7
	DW	QERR
	DW	SEMIS
	PAGE
	; At line     LINE ~2500
;	INTERPRET
;
	DB	89H
	DB	'INTERPRE'
	DB	'T'+80H
	DW	QSTAC-9
INTER	DW	DOCOL
INTE1	DW	DFIND	;BEGIN
	DW	ZBRAN	;IF
	DW	OFFSET INTE2-$
	DW	STATE
	DW	FETCH
	DW	LESS
	DW	ZBRAN	;IF
	DW	OFFSET INTE3-$
	DW	CFA
	DW	COMMA
	DW	BRAN	;ELSE
	DW	OFFSET INTE4-$
INTE3	DW	CFA
	DW	EXEC	;ENDIF
INTE4	DW	QSTAC
	DW	BRAN	;ELSE
	DW	OFFSET INTE5-$
INTE2	DW	HERE
	DW	NUMB
	DW	DPL
	DW	FETCH
	DW	ONEP
	DW	ZBRAN	;IF
	DW	OFFSET INTE6-$
	DW	DLITE
	DW	BRAN	;ELSE
	DW	OFFSET INTE7-$
INTE6	DW	DROP
	DW	LITER	;ENDIF
INTE7	DW	QSTAC	;ENDIF
INTE5	DW	BRAN	;AGAIN
	DW	OFFSET INTE1-$
	PAGE
;	IMMEDIATE
;
	DB	89H
	DB	'IMMEDIAT'
	DB	'E'+80H
	DW	INTER-0CH
IMMED	DW	DOCOL
	DW	LATES
	DW	LIT,40H
	DW	TOGGL
	DW	SEMIS
;
;	VOCABULARY
;
	DB	8AH
	DB	'VOCABULAR'
	DB	'Y'+80H
	DW	IMMED-0CH
VOCAB	DW	DOCOL
	DW	BUILD
	DW	LIT
	DW	0A081H
	DW	COMMA
	DW	CURR
	DW	FETCH
	DW	CFA
	DW	COMMA
	DW	HERE
	DW	VOCL
	DW	FETCH
	DW	COMMA
	DW	VOCL
	DW	STORE
	DW	DOES
DOVOC	DW	TWOP
	DW	CONT
	DW	STORE
	DW	SEMIS
	PAGE
;	FORTH
;
;   THE 'TASK-7' IS A COLD START VALUE ONLY.
;   IT IS CHANGED EACH TIME A DEFINITION IS
;   APPENDED TO THE 'FORTH' VOCABULARY.
;
	DB	0C5H
	DB	'FORT'
	DB	'H'+80H
	DW	VOCAB-0DH
FORTH	DW	DODOE
	DW	DOVOC
	DW	0A081H
	DW	TASK-7	;COLD START VALUE ONLY
	DW	0	; END OF VOCABULARY LIST
;
;	DEFINITIONS
;
	DB	8BH
	DB	'DEFINITION'
	DB	'S'+80H
	DW	FORTH-8
DEFIN	DW	DOCOL
	DW	CONT
	DW	FETCH
	DW	CURR
	DW	STORE
	DW	SEMIS
;
;	(
;
	DB	0C1H
	DB	'('+80H
	DW	DEFIN-0EH
PAREN	DW	DOCOL
	DW	LIT,')'
	DW	WORDS
	DW	SEMIS
	PAGE
;	QUIT
;
	DB	84H
	DB	'QUI'
	DB	'T'+80H
	DW	PAREN-4
QUIT	DW	DOCOL
	DW	ZERO
	DW	BLK
	DW	STORE
	DW	LBRAC
QUIT1	DW	RPSTO	;BEGIN
	DW	CR
	DW	QUERY
	DW	INTER
	DW	STATE
	DW	FETCH
	DW	ZEQU
	DW	ZBRAN	;IF
	DW	OFFSET QUIT2-$
	DW	PDOTQ
	DB	2
	DB	'OK'	;ENDIF
QUIT2	DW	BRAN	;AGAIN
	DW	OFFSET QUIT1-$
;
;	ABORT
;
	DB	85H
	DB	'ABOR'
	DB	'T'+80H
	DW	QUIT-7
ABORT	DW	DOCOL
	DW	SPSTO
	DW	DECA
	DW	QSTAC	; IT DID TO & INCL THIS
	DW	CR
	DW	DOTCPU
	DW	PDOTQ
	DB	20
	DB	'IBM-PC Fig-Forth '
	DB	FIGREL+30H,ADOT,FIGREV+30H
	DW	FORTH
	DW	DEFIN
	DW	QUIT
	PAGE
;	WARM START VECTOR COMES HERE
;
WRM:	MOV	SI,OFFSET WRM1
	JMP	NEXT
;
WRM1	DW	WARM
;
;	WARM
;
	DB	84H
	DB	'WAR'
	DB	'M'+80H
	DW	ABORT-8
WARM	DW	DOCOL
	DW	MTBUF
	DW	ABORT
;
;	COLD START VECTOR COMES HERE
;
LCLD:    MOV     SI,OFFSET CLD1  ; (IP) <-
	MOV	AX,0
	MOV	DS,AX		;TO VECTOR AREA
	MOV	BX,08CH
	LEA	AX,[WRM]
	MOV	[BX],AX		;JUMP TO WRM ON <CTRL-BREAK>
	INC	BX
	INC	BX
	MOV	[BX],CS
	MOV	AX,CS
	MOV	DS,AX		; SET DATA SEG
	MOV	SP,[ORIG+12H]    ;PARAM. STACK
	MOV	SS,AX		; SET STACK SEGMENT
	MOV	ES,AX		; SET EXTRA SEG
	CLD			; DIR = INC
	MOV	BP,[RPP]          ; RETURN STACK
	JMP	NEXT
;
CLD1	DW	COLD
;
;	COLD
;
	DB	84H
	DB	'COL'
	DB	'D'+80H
	DW	WARM-7
COLD	DW	DOCOL
	DW	MTBUF
	DW	FIRST
	DW	USE,STORE
	DW	FIRST
	DW	PREV,STORE
	DW	DRZER
	DW	LIT,0
	DW	LIT,EPRINT
	DW	STORE
	DW	LIT
	DW	ORIG+12H
	DW	LIT,UP
	DW	FETCH
	DW	LIT,6
	DW	PLUS
	DW	LIT,10H
	DW	LCMOVE
	DW	LIT,ORIG+0CH
	DW	FETCH
	DW	LIT,FORTH+6
	DW	STORE
	DW	ABORT
	PAGE
;	S->D
;
	DB	84H
	DB	'S->'
	DB	'D'+80H	; 1 WORD TO 2 WORDS
	DW	COLD-7
STOD	DW	$+2
	POP	DX	;S1
	SUB	AX,AX
	OR	DX,DX
	JNS	STOD1	;POS
	DEC	AX	;NEG
STOD1:	JMP	DPUSH
;
;	+-
;
	DB	82H
	DB	'+'
	DB	'-'+80H
	DW	STOD-7
PM	DW	DOCOL
	DW	ZLESS
	DW	ZBRAN	;IF
	DW	OFFSET PM1-$
	DW	MINUS	;ENDIF
PM1	DW	SEMIS
;
;	D+-
;
	DB	83H
	DB	'D+'
	DB	'-'+80H
	DW	PM-5
DPM	DW	DOCOL
	DW	ZLESS
	DW	ZBRAN	;IF
	DW	OFFSET DPM1-$
	DW	DMINU	;ENDIF
DPM1	DW	SEMIS
;
;	ABS
;
	DB	83H
	DB	'AB'
	DB	'S'+80H
	DW	DPM-6
ABS1	DW	DOCOL
	DW	DUPE
	DW	PM
	DW	SEMIS
;
;	DABS
;
	DB	84H
	DB	'DAB'
	DB	'S'+80H
	DW	ABS1-6
DABS	DW	DOCOL
	DW	DUPE
	DW	DPM
	DW	SEMIS
;
;	MIN
;
	DB	83H
	DB	'MI'
	DB	'N'+80H
	DW	DABS-7
MIN	DW	DOCOL,TDUP
	DW	GREAT
	DW	ZBRAN	;IF
	DW	OFFSET MIN1-$
	DW	SWAP	;ENDIF
MIN1	DW	DROP
	DW	SEMIS
;
;	MAX
;
	DB	83H
	DB	'MA'
	DB	'X'+80H
	DW	MIN-6
MAX	DW	DOCOL,TDUP
	DW	LESS
	DW	ZBRAN	;IF
	DW	OFFSET MAX1-$
	DW	SWAP	;ENDIF
MAX1	DW	DROP
	DW	SEMIS
	PAGE
;	M*
;
	DB	82H
	DB	'M'
	DB	'*'+80H
	DW	MAX-6
MSTAR	DW	DOCOL,TDUP
	DW	XORR
	DW	TOR
	DW	ABS1
	DW	SWAP
	DW	ABS1
	DW	USTAR
	DW	FROMR
	DW	DPM
	DW	SEMIS
;
;	M/
;
	DB	82H
	DB	'M'
	DB	'/'+80H
	DW	MSTAR-5
MSLAS	DW	DOCOL
	DW	OVER
	DW	TOR
	DW	TOR
	DW	DABS
	DW	RR
	DW	ABS1
	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
;
;	/MOD
;
	DB	84H
	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
;
;	MOD
;
	DB	83H
	DB	'MO'
	DB	'D'+80H
	DW	SLASH-4
MODD	DW	DOCOL
	DW	SLMOD
	DW	DROP
	DW	SEMIS
;
;	*/MOD
;
	DB	85H
	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
;
;	M/MOD
;
	DB	85H
	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
	PAGE
;	(LINE)
;
	DB	86H
	DB	'(LINE'
	DB	')'+80H
	DW	MSMOD-8
PLINE	DW	DOCOL
	DW	TOR
	DW	LIT,64
	DW	BBUF
	DW	SSMOD
	DW	FROMR
	DW	BSCR
	DW	STAR
	DW	PLUS
	DW	BLOCK
	DW	PLUS
	DW	LIT,64
	DW	SEMIS
;
;	.LINE
;
	DB	85H
	DB	'.LIN'
	DB	'E'+80H
	DW	PLINE-9
DLINE	DW	DOCOL
	DW	PLINE
	DW	DTRAI
	DW	TYPES
	DW	SEMIS
;
;	MESSAGE
;
	DB	87H
	DB	'MESSAG'
	DB	'E'+80H
	DW	DLINE-8
MESS	DW	DOCOL
	DW	WARN
	DW	FETCH
	DW	ZBRAN	;IF
	DW	OFFSET MESS1-$
	DW	DDUP
	DW	ZBRAN	;IF
	DW	OFFSET MESS2-$
	DW	LIT,4
	DW	OFSET
	DW	FETCH
	DW	BSCR
	DW	SLASH
	DW	SUBB
	DW	DLINE
	DW	SPACE	;ENDIF
MESS2	DW	BRAN	;ELSE
	DW	OFFSET MESS3-$
MESS1	DW	PDOTQ
	DB	6
	DB	'MSG # '
	DW	DOT	;ENDIF
MESS3	DW	SEMIS
	PAGE
	; At line     LINE ~3000
;--------------------------------------------
;
;	8086/88 PORT FETCH AND STORE
;
;--------------------------------------------
;
;	PC@
;
; FETCH CHARACTER (BYTE) FROM PORT
;
	DB	83H
	DB	'PC'
	DB	'@'+80H
	DW	MESS-0AH
PTCAT	DW	$+2
	POP	DX	; PORT ADDR
	IN	AL,DX	; BYTE INPUT
	SUB	AH,AH
	JMP	APUSH
;
;	PC!
;
; STORE CHARACTER (BYTE) FETCH PORT
;
	DB	83H
	DB	'PC'
	DB	'!'+80H
	DW	PTCAT-6
PTCSTO	DW	$+2
	POP	DX	;PORT ADDR
	POP	AX	;DATA
	OUT	DX,AL	; BYTE OUTPUT
	JMP	NEXT
;
;	P@
; FETCH WORD FROM PORT
;
	DB	82H
	DB	'P'
	DB	'@'+80H
	DW	PTCSTO-6
PTAT	DW	$+2
	POP	DX	;PORT ADDR
	IN	AX,DX	;WORD INPUT
	JMP	APUSH
;
;	PC!
; STORE WORD FETCH PORT
;
	DB	82H
	DB	'P'
	DB	'!'+80H
	DW	PTAT-5
PTSTO	DW	$+2
	POP	DX	;PORT ADDR
	POP	AX	;DATA
	OUT	DX,AX	;WORD OUTPUT
	JMP	NEXT
;
BPS	EQU	512	;BYTES PER SECTOR
MXDRV	EQU	2	; MAX # DRIVES
;
;
;	USE
;
	DB	83H	;ADDR OF NEXT BUFR TO USE
	DB	'US'
	DB	'E'+80H
	DW	PTSTO-5
USE	DW	DOVAR
	DW BUF1
;
;	PREV
;
	DB	84H	;ADDR OF PREV USED BUFR
	DB	'PRE'
	DB	'V'+80H
	DW	USE-6
PREV	DW	DOVAR
	DW	BUF1
;
;	SEC/BLK
;
	DB	87H	;# SECTORS/BLOCK
	DB	'SEC/BL'
	DB	'K'+80H
	DW	PREV-7
SPBLK	DW	DOCON
	DW	KBBUF/BPS
	PAGE
;	#BUFF
;
	DB	85H	;NO. OF BUFFERS
	DB	'#BUF'
	DB	'F'+80H
	DW	SPBLK-10
NOBUF	DW	DOCON,NBUF
;
;	+BUF
;
	DB	84H
	DB	'+BU'
	DB	'F'+80H
	DW	NOBUF-8
PBUF	DW	DOCOL
	DW	LIT,CO
	DW	PLUS,DUPE
	DW	LIMIT,EQUAL
	DW	ZBRAN
	DW	OFFSET PBUF1-$
	DW	DROP,FIRST
PBUF1	DW	DUPE,PREV
	DW	FETCH,SUBB
	DW	SEMIS
;
;	UPDATE
;
	DB	86H
	DB	'UPDAT'
	DB	'E'+80H
	DW	PBUF-7
UPDAT	DW	DOCOL,PREV
	DW	FETCH,FETCH
	DW	LIT,8000H
	DW	ORR
	DW	PREV,FETCH
	DW	STORE,SEMIS
;
;	EMPTY-BUFFERS
;
	DB	8DH
	DB	'EMPTY-BUFFER'
	DB	'S'+80H
	DW	UPDAT-9
MTBUF	DW	DOCOL,FIRST
	DW	LIMIT,OVER
	DW	SUBB,ERASEE
	DW	SEMIS
	PAGE
;	DR0
;
	DB	83H
	DB	'DR'
	DB	'0'+80H
	DW	MTBUF-16
DRZER	DW	DOCOL,ZERO
	DW	OFSET,STORE
	DW	SEMIS
;
;	BUFFER
;
; NOTE: THIS WORD WON'T WORK IF ONLY
;	USING SINGLE BUFFER
;
	DB	86H
	DB	'BUFFE'
	DB	'R'+80H
	DW	DRZER-6
BUFFE	DW	DOCOL,USE
	DW	FETCH,DUPE
	DW	TOR
BUFF1	DW	PBUF
	DW	ZBRAN
	DW	OFFSET BUFF1-$
	DW	USE,STORE
	DW	RR,FETCH
	DW	ZLESS
	DW	ZBRAN
	DW	OFFSET BUFF2-$
	DW	RR,TWOP
	DW	RR,FETCH
	DW	LIT,7FFFH
	DW	ANDD,ZERO
	DW	RSLW
BUFF2	DW	RR,STORE
	DW	RR,PREV
	DW	STORE,FROMR
	DW	TWOP,SEMIS
	PAGE
;	BLOCK
;
	DB	85H
	DB	'BLOC'
	DB	'K'+80H
	DW	BUFFE-9
BLOCK	DW	DOCOL,OFSET
	DW	FETCH,PLUS
	DW	TOR,PREV
	DW	FETCH,DUPE
	DW	FETCH,RR
	DW	SUBB
	DW	DUPE,PLUS
	DW	ZBRAN
	DW	OFFSET BLOC1-$
BLOC2	DW	PBUF,ZEQU
	DW	ZBRAN
	DW	OFFSET BLOC3-$
	DW	DROP,RR
	DW	BUFFE,DUPE
	DW	RR,ONE
	DW	RSLW
	DW	TWO,SUBB
BLOC3	DW	DUPE,FETCH
	DW	RR,SUBB
	DW	DUPE,PLUS
	DW	ZEQU
	DW	ZBRAN
	DW	OFFSET BLOC2-$
	DW	DUPE,PREV
	DW	STORE
BLOC1	DW	FROMR,DROP
	DW	TWOP,SEMIS
	PAGE
WERR	DB  	'DISK WRITE ERROR  $'
RERR	DB  	'DISK READ ERROR   $'
;
SSEC	PROC	NEAR
;	( ADDR  SEC# -- )
;	THIS ROUTINE WILL SELECT THE HEAD & DRIVE
	POP	DI	;SAVE RETURN
	POP	AX	;SECTOR #
	CMP	AX,SEC_DSK	;B DRIVE?
	JB	LDR0
	SUB	AX,SEC_DSK
	MOV	DX,AX	;LOAD LOGICAL SECTOR #
	MOV	AL,1	;SELECT DR B
	JMP	GSEC1
LDR0:    MOV     DX,AX   ;DR A
	MOV	AL,0	;SELECT DR A
GSEC1:	POP	BX	;TRANSFER ADDR
	MOV	CX,1	;READ 1 SECTOR
	PUSH	DI	;GET THAT RETURN BACK
	RET
;SSEC    ENDP
;
;	RSEC
;
	DB	84H
	DB	'RSE'
	DB	'C'+80H
	DW	BLOCK-8
RSEC	DW	$+2
	CALL	SSEC
	PUSH	SI	;PRESERVE INTERPRETER POINTER
	PUSH	BP	;RETURN POINTER
	INT	25H
	JNC	DOK	;NO ERRORS
	LEA	DX,[RERR]
	JMP	DERR
;
;	WSEC
;
	DB	84H
	DB	'WSE'
	DB	'C'+80H
	DW	RSEC-7
WSEC	DW	$+2
    	CALL	SSEC
	PUSH	SI
	PUSH	BP
	INT	26H
	JNC	DOK
	LEA	DX,[WERR]
DERR:	PUSH	AX
	MOV	AH,9	;STRING WRITE FNCN
	INT	21H
	POP	AX	;ERROR CODE IN AX
;  WRITE ERROR MESSAGE HERE
;
DOK:	POPF		;POP FLAGS
	POP	BP	;RETURN STACK
	POP	SI	;INTERPRETER PNTR
	JMP	NEXT
;
;	R/W
;
;	( ADDR  SECTOR#  FLAG (0=W, 1=R) --- )
 	DB	83H
	DB	'R/'
	DB	'W'+80H
	DW	WSEC-7
RSLW	DW	DOCOL
	DW	ZBRAN
	DW	OFFSET RSLW1-$
	DW	RSEC
	DW	BRAN
	DW	OFFSET RSLW2-$
RSLW1	DW	WSEC
RSLW2	DW	SEMIS
	PAGE
;	FLUSH
;
	DB	85H
	DB	'FLUS'
	DB	'H'+80H
	DW	RSLW-6
FLUSH	DW	DOCOL
	DW	NOBUF,ONEP
	DW	ZERO,XDO
FLUS1	DW	ZERO,BUFFE
	DW	DROP
	DW	XLOOP
	DW	OFFSET FLUS1-$
	DW	SEMIS
;
;	LOAD
;
	DB	84H
	DB	'LOA'
	DB	'D'+80H
	DW	FLUSH-8
LOAD	DW	DOCOL,BLK
	DW	FETCH,TOR
	DW	INN,FETCH
	DW	TOR,ZERO
	DW	INN,STORE
	DW	BSCR,STAR
	DW	BLK,STORE	;BLK <- SCR * B/SCR
	DW	INTER	;INTERPRET FROM OTHER
SCREEN	DW	FROMR,INN
	DW	STORE
	DW	FROMR,BLK
	DW	STORE
	DW	SEMIS
	PAGE
;	-->
;
	DB	0C3H
	DB	'--'
	DB	'>'+80H
	DW	LOAD-7
ARROW	DW	DOCOL
	DW	QLOAD
	DW	ZERO
	DW	INN
	DW	STORE
	DW	BSCR
	DW	BLK
	DW	FETCH
	DW	OVER
	DW	MODD
	DW	SUBB
	DW	BLK
	DW	PSTOR
	DW	SEMIS
	PAGE
;
;------------------------------------
; QUERY KEYBOARD FOR KEY PRESSED
;------------------------------------
;
; ( TRUE = CHAR READY, FALSE = NO CHAR )
;
; CALLED FROM  "?TERMINAL"
;
; USE 'KEY' TO GET KEY VALUE
;
PQTER:	CALL	CSTAT	;TEST FOR KEY
	OR	AL,AL	;ANY KEY?
	JZ	PQTER1	;NO
	MOV	AL,1	;TRUE = CHAR FOUND
PQTER1:	MOV	AH,0	;MAKE 16 BITS
	JMP	APUSH	;SAVE STATUS
;
;----------------------------
; CONSOLE INPUT ROUTINE
;----------------------------
;
; WAITS FOR A KEYBOARD CHAR
;
; CTRL-P WILL TOGGLE PRINTER ECHO FLAG
;
; CALLED FROM 'KEY'
;
PKEY:	CALL	CI	;CONSOLE INPUT
	CMP	AL,DLE	;PRINTER TOGGLE?
	JNE	PKEY1	;NO
	XOR BYTE      [EPRINT], 1        ;TOGGLE ECHO
	JMP	PKEY	;GET ANOTHER KEY
PKEY1:	MOV	AH,0	;MAKE 16 BITS
	JMP	APUSH	;SAVE KEY VALUE
;
;---------------------------------------
; CONSOLE/PRINTER CHAR OUTPUT
;---------------------------------------
;
; CALLED FROM 'EMIT'
;
PEMIT	DW	$+2
	POP	AX	;GET CHAR
	CALL	POUT	;CHAR OUTPUT
	JMP	NEXT
	PAGE
;------------------------------
; CRLF TO CONSOLE/PRINTER
;------------------------------
;
; CALLED FROM 'CR'
;
PCR:	MOV	AL,ACR
	CALL	POUT	;CHAR OUTPUT
	MOV	AL,LF
	CALL	POUT
	JMP	NEXT
;
;-------------------------------------
; TRUE CONSOLE/PRINTER OUTPUT ROUTINE
;-------------------------------------
;
POUT	PROC	NEAR
     	CALL	CHO	;CONSOLE OUT
	TEST BYTE   [EPRINT],1        ;PRINTER ECHO?
        NOP     ; To get the same code layout as with MASM
	JZ	POUT1	;OFF
	CALL	LO	;LIST OUTPUT
POUT1:	RET
;POUT    ENDP
;
; PRINTER ECHO FLAG
;
; VALUE: 0 = OFF, 1 = ON
;
EPRINT	DB	0,0
;
;------------------------
; GET KEYBOARD STATUS
;------------------------
;
; RETURNS KEYBOARD STATUS
;
;
; EXIT: REG AL = 0 IF NO KEY PRESSED
;       REG AL = CHAR IF  KEY PRESSED
;
CSTAT	PROC	NEAR
	PUSH	DX
	MOV	DX,0FFH
	MOV	AX,0600H
	INT	21H
	POP	DX
STATRT: RET
;CSTAT   ENDP
;
;-------------------------
; CONSOLE INPUT
;-------------------------
;
; WAITS FOR KEY FROM KEYBOARD
;
CI	PROC	NEAR
   	MOV	AH,0	; READ CHAR FUNCTION
	INT	16H
	RET
;CI      ENDP
	PAGE
;--------------------
; CONSOLE OUTPUT
;--------------------
;
; OUTPUTS CHAR IN REG AL TO CONSOLE
;
; EXIT:	REG AL = CHAR
;
CHO	PROC	NEAR
	PUSH	DX
    	PUSH	AX	;SAVE CHAR
	MOV	DL,AL	;CHAR TO WRITE
	MOV	AH,2	;CHAR OUT FUNCTION
	INT	21H	;DOS
	POP	AX
	POP	DX
	RET
;CHO     ENDP
;
;----------------------
;	LIST OUTPUT
;----------------------
;
; OUTPUTS CHAR IN REG AL TO
; LIST DEVICE (PRINTER)
;
; EXIT: REG AL = CHAR
;
LO	PROC	NEAR
   	PUSH	AX	;SAVE CHAR
	PUSH	DX
	MOV	DX,PRINTER_NO
	MOV	AH,0	;PRINT CHAR
	INT	17H
	POP	DX
	POP	AX
	RET
;LO      ENDP
	PAGE
	; At line     LINE ~3500
;	'
;
	DB	0C1H
	DB	0A7H
	DW	ARROW-6
TICK	DW	DOCOL
	DW	DFIND
	DW	ZEQU
	DW	ZERO
	DW	QERR
	DW	DROP
	DW	LITER
	DW	SEMIS
;
;	FORGET
;
	DB	86H
	DB	'FORGE'
	DB	'T'+80H
	DW	TICK-4
FORG	DW	DOCOL
	DW	CURR
	DW	FETCH
	DW	CONT
	DW	FETCH
	DW	SUBB
	DW	LIT,18H
	DW	QERR
	DW	TICK
	DW	DUPE
	DW	FENCE
	DW	FETCH
	DW	LESS
	DW	LIT,15H
	DW	QERR
	DW	DUPE
	DW	NFA
	DW	DP
	DW	STORE
	DW	LFA
	DW	FETCH
	DW	CONT
	DW	FETCH
	DW	STORE
	DW	SEMIS
	PAGE
;	BACK
;
	DB	84H
	DB	'BAC'
	DB	'K'+80H
	DW	FORG-9
BACK	DW	DOCOL
	DW	HERE
	DW	SUBB
	DW	COMMA
	DW	SEMIS
;
;	BEGIN
;
	DB	0C5H
	DB	'BEGI'
	DB	'N'+80H
	DW	BACK-7
BEGIN	DW	DOCOL
	DW	QCOMP
	DW	HERE
	DW	ONE
	DW	SEMIS
;
;	ENDIF
;
	DB	0C5H
	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
	PAGE
;	THEN
;
	DB	0C4H
	DB	'THE'
	DB	'N'+80H
	DW	ENDIFF-8
THEN	DW	DOCOL
	DW	ENDIFF
	DW	SEMIS
;
;	DO
;
	DB	0C2H
	DB	'D'
	DB	'O'+80H
	DW	THEN-7
DO	DW	DOCOL
	DW	COMP
	DW	XDO
	DW	HERE
	DW	THREE
	DW	SEMIS
;
;	LOOP
;
	DB	0C4H
	DB	'LOO'
	DB	'P'+80H
	DW	DO-5
LOOPC	DW	DOCOL
	DW	THREE
	DW	QPAIR
	DW	COMP
	DW	XLOOP
	DW	BACK
	DW	SEMIS
	PAGE
;	+LOOP
;
	DB	0C5H
	DB	'+LOO'
	DB	'P'+80H
	DW	LOOPC-7
PLOOP	DW	DOCOL
	DW	THREE
	DW	QPAIR
	DW	COMP
	DW	XPLOO
	DW	BACK
	DW	SEMIS
;
;	UNTIL
;
	DB	0C5H
	DB	'UNTI'
	DB	'L'+80H
	DW	PLOOP-8
UNTIL	DW	DOCOL
	DW	ONE
	DW	QPAIR
	DW	COMP
	DW	ZBRAN
	DW	BACK
	DW	SEMIS
;
;	END
;
	DB	0C3H
	DB	'EN'
	DB	'D'+80H
	DW	UNTIL-8
ENDD	DW	DOCOL
	DW	UNTIL
	DW	SEMIS
	PAGE
;	AGAIN
;
	DB	0C5H
	DB	'AGAI'
	DB	'N'+80H
	DW	ENDD-6
AGAIN	DW	DOCOL
	DW	ONE
	DW	QPAIR
	DW	COMP
	DW	BRAN
	DW	BACK
	DW	SEMIS
;
;	REPEAT
;
	DB	0C6H
	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
;
;	IF
;
	DB	0C2H
	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
	PAGE
;	ELSE
;
	DB	0C4H
	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
;
;	WHILE
;
	DB	0C5H
	DB	'WHIL'
	DB	'E'+80H
	DW	ELSEE-7
WHILE	DW	DOCOL
	DW	IFF
	DW	TWOP
	DW	SEMIS
	PAGE
;	SPACES
;
	DB	86H
	DB	'SPACE'
	DB	'S'+80H
	DW	WHILE-8
SPACS	DW	DOCOL
	DW	ZERO
	DW	MAX
	DW	DDUP
	DW	ZBRAN
	DW	OFFSET SPAX1-$
	DW	ZERO
	DW	XDO	;DO
SPAX2	DW	SPACE
	DW	XLOOP	;LOOP
	DW	OFFSET 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	FETCH
	DW	PAD
	DW	OVER
	DW	SUBB
	DW	SEMIS
	PAGE
;	SIGN
;
	DB	84H
	DB	'SIG'
	DB	'N'+80H
	DW	EDIGS-5
SIGN	DW	DOCOL
	DW	ROT
	DW	ZLESS
	DW	ZBRAN	;IF
	DW	OFFSET SIGN1-$
	DW	LIT,2DH
	DW	HOLD	;ENDIF
SIGN1	DW	SEMIS
;
;	#
;
	DB	81H
	DB	'#'+80H
	DW	SIGN-7
DIG	DW	DOCOL
	DW	BASE
	DW	FETCH
	DW	MSMOD
	DW	ROT
	DW	LIT,9
	DW	OVER
	DW	LESS
	DW	ZBRAN	;IF
	DW	OFFSET DIG1-$
	DW	LIT,7
	DW	PLUS	;ENDIF
DIG1	DW	LIT,30H
	DW	PLUS
	DW	HOLD
	DW	SEMIS
;
;	#S
;
	DB	82H
	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	OFFSET DIGS1-$
	DW	SEMIS
;
;	D.R.
;
	DB	83H
	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	TYPES
	DW	SEMIS
;
;	.R
;
	DB	82H
	DB	'.'
	DB	'R'+80H
	DW	DDOTR-6
DOTR	DW	DOCOL
	DW	TOR
	DW	STOD
	DW	FROMR
	DW	DDOTR
	DW	SEMIS
	PAGE
;	D.
;
	DB	82H
	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	FETCH
	DW	DOT
	DW	SEMIS
;
;	U.
;
	DB	82H
	DB	'U'
	DB	'.'+80H
	DW	QUES-4
UDOT	DW	DOCOL
	DW	ZERO
	DW	DDOT
	DW	SEMIS
	PAGE
	; At line     LINE ~4000
;	VLIST
;
	DB	85H
	DB	'VLIS'
	DB	'T'+80H
	DW	UDOT-5
VLIST	DW	DOCOL
	DW	LIT,80H
	DW	OUTT
	DW	STORE
	DW	CONT
	DW	FETCH
	DW	FETCH
VLIS1	DW	OUTT	;BEGIN
	DW	FETCH
	DW	CSLL
	DW	GREAT
	DW	ZBRAN	;IF
	DW	OFFSET VLIS2-$
	DW	CR
	DW	ZERO
	DW	OUTT
	DW	STORE	;ENDIF
VLIS2	DW	DUPE
	DW	IDDOT
	DW	SPACE
	DW	SPACE
	DW	PFA
	DW	LFA
	DW	FETCH
	DW	DUPE
	DW	ZEQU
	DW	QTERM
	DW	ORR
	DW	ZBRAN	;UNTIL
	DW	OFFSET VLIS1-$
	DW	DROP
	DW	SEMIS
;
;	BYE
;
; EXIT TO PC-DOS
;
	DB	83H
	DB	'BY'
	DB	'E'+80H
	DW	VLIST-8
BYE	DW	$+2
	INT	27H	;I'M HISTORY
	PAGE
;	LIST
;
	DB	84H
	DB	'LIS'
	DB	'T'+80H
	DW	BYE-6
LISTC	DW	DOCOL,DECA
	DW	CR,DUPE
	DW	SCR,STORE
	DW	PDOTQ
	DB	6,'SCR # '
	DW	DOT
	DW	LIT,10H
	DW	ZERO,XDO
LIST1	DW	CR,IDO
	DW	LIT,3
	DW	DOTR,SPACE
	DW	IDO,SCR
	DW	FETCH,DLINE
	DW	QTERM	; ?TERMINAL
	DW	ZBRAN
	DW	OFFSET LIST2-$	;IF
	DW	LLEAV
LIST2	DW	XLOOP
	DW	OFFSET LIST1-$	;ENDIF
	DW	CR,SEMIS
;
;	INDEX
;
	DB	85H
	DB	'INDE'
	DB	'X'+80H
	DW	LISTC-7
INDEX	DW	DOCOL
	DW	LIT,FF
	DW	EMIT,CR
	DW	ONEP,SWAP
	DW	XDO
INDE1	DW	CR,IDO
	DW	LIT,3
	DW	DOTR,SPACE
	DW	ZERO,IDO
	DW	DLINE,QTERM
	DW	ZBRAN
	DW	OFFSET INDE2-$
	DW	LLEAV
INDE2	DW	XLOOP
	DW	OFFSET INDE1-$
	DW	SEMIS
	PAGE
;	TRIAD
;
	DB	85H
	DB	'TRIA'
	DB	'D'+80H
	DW	INDEX-8
TRIAD	DW	DOCOL
	DW	LIT,FF
	DW	EMIT
	DW	LIT,3
	DW	SLASH
	DW	LIT,3
	DW	STAR
	DW	LIT,3
	DW	OVER,PLUS
	DW	SWAP,XDO
TRIA1	DW	CR,IDO
	DW	LISTC
	DW	QTERM	; ?TERMINAL
	DW	ZBRAN
	DW	OFFSET TRIA2-$	;IF
	DW	LLEAV   ;LEAVE
TRIA2	DW	XLOOP	;ENDIF
	DW	OFFSET TRIA1-$
	DW	CR
	DW	SEMIS
;
;	.CPU
;
; PRINT CPU TYPE (8088)
;
	DB	84H
	DB	'.CP'
	DB	'U'+80H
	DW	TRIAD-8
DOTCPU	DW	DOCOL
	DW	BASE,FETCH
	DW	LIT,36
	DW	BASE,STORE
	DW	LIT,22H
	DW	PORIG,TAT
	DW	DDOT
	DW	BASE,STORE
	DW	SEMIS
	PAGE
%if 0 

            CODE LEVEL "MATCH" DEFINITIONS

 STACK PARAMETERS:

 ( cursor:addr   byte:left   str:addr  str:len
           ---   flag  new:cursor:offset         )

 This version of MATCH will handle string lengths
      up to 65535 bytes in length.

%endif
	DB	85H	; MATCH
	DB	'MATC'
	DB	'H'+80H
	DW	DOTCPU-7
MATCH	DW	$+2
	MOV	DI,SI	; SAVE IP
	POP	CX	; STRING COUNT
	POP	BX	;STRING ADDR
	POP	DX	;BYTES LEFT TO SEARCH
	POP	SI	;CURSOR ADDR
	PUSH	SI	;SAVE COPY
MAT1:	LODSB		;GET FIRST BYTE
	CMP	AL,[BX]	;MATCH?
	JNZ	MAT3	;NO
	PUSH	BX	;SAVE STRING ADDR
	PUSH	CX	; &   STRING COUNT
	PUSH	SI	; &   CURSOR ADDR
; TRY TO MATCH REMAINING CHARS IN STRING
;
MAT2:	DEC	CX	;STR. COUNT -1
	JZ	MATCHOK	;EXIT - MATCH FOUND
	DEC	DX	;BYTES LEFT -1
	JZ	NOMATCH	;EXIT - NO MATCH
	INC	BX	;NEXT STR CHAR ADDR
	LODSB		;GET FIRST BYTE
	CMP	AL,[BX]	;MATCH?
	JZ	MAT2	;YES, GET MORE
; NO MATCH YET
	POP	SI
	POP	CX
	POP	BX	;RESTORE POINTERS
MAT3:	DEC	DX	;BYTE LEFT COUNT -1
	JNZ	MAT1	;START OVER
	JMP	MAT4	;EXIT...NO MATCH
MATCHOK:
NOMATCH:
	POP	CX	;ADJUST STACK
	POP	CX	;FOR EXIT
	POP	CX
; EXIT HERE: DX = TRUE/FALSE FLAG ( 0=NO MATCH)
;
MAT4:	MOV	AX,SI	;NEW CURSOR ADDR
	POP	SI	;GET STARTING ADDR
	SUB	AX,SI	;COMPUTE CURSOR OFFSET
	MOV	SI,DI	;GET BACK UP
	JMP	DPUSH	; BYE..BYE
	PAGE
;
;**** LAST DICTIONARY WORD ****
;            T A S K
;
	DB	84H
	DB	'TAS'
	DB	'K'+80H
	DW	MATCH-8
TASK	DW	DOCOL
	DW	SEMIS
;
INITDP	EQU	$	;SHOW END OF DICTIONARY
;
%if 0 

The remaining memory ( up to 'EM' ) is 
used for:

	1. EXTENSION DICTIONARY
	2. PARAMETER STACK
	3. TERMINAL INPUT BUFFER
	4. RETURN STACK
	5. USER VARIABLE AREA
	6. DISK BUFFERS


%endif
					
	RESB    EM-($-$$)    ; Make EM The last location.
 CSEG    ENDS
; ORIG    ENDP
	PAGE
%if 0 

  MISC. NOTES AND SCATTERED THOUGHTS

- This source will assemble on all platforms where NASM is available by the
  command line:
  nasm -fbin fig86.asm -o fig86.exe
  The result will run on MSDOS systems only.

- When in FORTH, <Ctrl> P  will echo all output to the
  printer.

- Use the installation manual.  Descriptions for all FIG
  words are given.  Those ERROR messages you get in FORTH
  correspond to the relative line numbers in blocks
  4 and 5 of the installation manual's model.  

- Remember that all the FORTH words in this version are
  upper case letters.  Use <CAPS LOCK> when in FORTH.

- Changing variable EM will allow you to create a larger
  dictionary space.  However I suggest you develop and
  DEBUG with EM set to 4000H.  Setting it to a larger value
  will result in a larger FORTH.EXE file, and you may
  need to run EXE2BIN ( Chap 10, DOS 2.0 ) to get enough
  disk space.  Once you are satisfied with what you have,
  then by all means take that extra memory.

- Reading the section on batch files may speed up your
  developement.  See the example files that came with
  the Macro Assembler.

- Subscribe to FORTH Dimensions.  It is a valuable source
  of system and application ideas.  Talking with fellow
  FORTH programmers is sure to stir up some exciting ideas.
  Consider joining a FIG chapter.  See the back of FORTH
  Dimensions for more info.

- <Ctrl-Break> will vector to WARM start ( Label WRM: )

%endif

	END	ORIG