; MINIFORTH  - Copyright 1988 by Ted Beach
;                                5112 Williamsburg Blvd.
;                                Arlington VA, 22207
;				 703-237-0295

; This is a VERY minimum version of FORTH that has several innovations -
; First, mini makes extensive use of TO variables, particularly as USER
; variables : BASE, >IN, COMPILING (STATE), S0, R0, BLK, BLOCK, etc.
; Second, there is incorporated a mechanism whereby conditionals (IF, THEN
; ELSE, BEGIN, UNTIL, etc.) can be executed directly from the keyboard with-
; out having to create a word (sometimes a dummy word) to compile them in.
; Simply key in the words as needed, then add a semicolon. The structure 
; will execute at HERE then be discarded. Should you ever make an error while
; compiling from the keyboard, your mistake will be automatically erased --
; you won't find the dictionary garbaged up with a partially compiled word.
; Source code MUST BE ASSEMBLED WITH A86 - make needed changes if you
; want to use MASM (ugh!).
; The file named MINI.MIN has certain needed structures. You will have to
; enter these from the keyboard. In order to save the extended version, run
; mini under DEBUG. Then, just before leaving mini, enter "HERE  .H"
; Note the number printed, type "BYE", then from DEBUG change CX to the number
; printed. Use DEBUG's W command to Write the program to disk.

;          ***************** NOTE ******************* 

; You are free to use this copyrighted material for your own personal
; needs. Commercial use is prohibited without the consent of the copyright
; holder. Contact the author at the address above for additional information.
; There is already available version 1.5 which adds a second (short) machine
; stack to help certain operations. Tutorial material is available on learning
; how to use miniforth. For those used to FORTH, this listing and the MINI.MIN
; file should provide adequate information on how to extend miniforth.

;         *******************************************

HEAD	MACRO
	DW LINK
	LINK=$-2
	DB #1+080
	DB #2
#EM

HEADI	MACRO
	DW LINK
	LINK=$-2
	DB #1+0C0
	DB #2
#EM

COLON	MACRO
	CALL DOCOLON
#EM
NEXT	MACRO
	LODSW
	JMP AX
#EM

VARI	MACRO
	JMP DOVAR
#EM

CONST	MACRO
	JMP DOCON
#EM

TOVAR	MACRO
	JMP DOTOVAR
#EM

VOCAB	MACRO
	JMP DOVOC
#EM

X	MACRO
	XCHG SP,BP
#EM

ORG	0100
	JMP INIT

; STORAGE LOCATIONS FOR USER VARIABLES

CHERE	DW DP
CTOIN	DW 0
CBLOCK	DW 0
CBASE	DW 10
CBLK	DW 0
CSPAN	DW 0
CCOMP	DW 0
CTDP	DW ABORT-6
CS0	DW -256
CR0	DW 0
CDBL	DW 0

TFL	DW 0
CSP	DW 0

BUF:	DB 80		; TIB FOR KEYBOARD
CNT	DB 81 DUP (0)

; HEADERLESS EXECUTION CODE GOES HERE

DOCOLON:
	X
	PUSH SI
	X
	POP SI
	NEXT
DOTOVAR:
	PUSH BX
	ADD AX,3
	MOV BX,AX
	MOV BX,[BX]
	MOV CX,TFL
	JCXZ FETCH
	OR CX,CX
	MOV W TFL,0
	JNS XSTORE
XPSTORE:
	POP AX
	ADD [BX],AX
	POP BX
	NEXT
XSTORE:
	POP AX
	MOV [BX],AX
	POP BX
	NEXT
DOCON:
	PUSH BX
	ADD AX,3
	MOV BX,AX
FETCH:
	MOV BX,[BX]
	NEXT
DOVAR:
	PUSH BX
	ADD AX,3
	MOV BX,AX
	NEXT
DOVOC:
	ADD AX,3
	MOV W CONT,AX
	NEXT
XEXEC:	MOV AX,BX
	POP BX
	JMP AX
XEXIT:
	X
	POP SI
	X
	NEXT
XTOR:	X
	PUSH BX
	X
	POP BX
	NEXT
XRFR:	PUSH BX
	X
	POP BX
	X
	NEXT
XTOR2:	POP AX
	X
	PUSH BX,AX
	X
	POP BX
	NEXT
XRFR2:	PUSH BX
	X
	POP AX,BX
	X
	PUSH AX
	NEXT
XTO:	INC W TFL
	NEXT
XPTO:	DEC W TFL
	NEXT
XDUP:	PUSH BX
	NEXT
XQDUP:	OR BX,BX
	JNZ XDUP
	NEXT
XDROP:	POP BX
	NEXT
XSWAP:	POP AX
	PUSH BX
	MOV BX,AX
	NEXT
XOVER:	POP AX
	PUSH AX,BX
	MOV BX,AX
	NEXT
XROT:	POP CX,DX
	PUSH CX,BX
	MOV BX,DX
	NEXT
XCAT:	MOV BL,[BX]
	MOV BH,0
	NEXT
XCSTORE:POP AX
	MOV [BX],AL
	POP BX
	NEXT
XDUP2:	PUSH BX
	MOV DI,SP
	PUSH [DI+2]
	NEXT
XDROP2:	POP BX,BX
	NEXT
XSWAP2: POP AX,CX,DX
	PUSH AX,BX,DX
	MOV BX,CX
	NEXT
XPLUS:	POP AX
	ADD BX,AX
	NEXT
XSUBT:	POP AX
	NEG BX
	ADD BX,AX
	NEXT
XZEQ:	XOR AX,AX
	OR BX,BX
	JNZ X1
X2:	DEC AX
X1:	XCHG AX,BX
	NEXT
XZLESS:	XOR AX,AX
	OR BX,BX
	JNS X1
	JS X2
XZGRT:	XOR AX,AX
	OR BX,BX
	JZ X1
	JS X1
	JMP X2
XZNE:	MOV AX,-1
	OR BX,BX
	JZ >L0
	MOV BX,AX
L0:	NEXT
XPLOOP:	X
	POP AX,CX
	INC AX
	INC CX
	JO EXLP
L1:	PUSH CX,AX
	X
XBRAN:	MOV SI,[SI]
	NEXT
XPPLOOP:
	POP DI
	X
	POP AX,CX
	ADD AX,BX
	ADD CX,BX
	MOV BX,DI
	JNO L1
EXLP:	X
L3:	ADD SI,2
	NEXT
XZBRAN:	OR BX,BX
	POP BX
	JZ XBRAN
	JNZ L3
XI:
XRAT:	PUSH BX
	X
	POP BX
	PUSH BX
	X
	NEXT
XOF:	POP AX
	CMP AX,BX
	JZ >L1
	MOV BX,AX
	JMP XBRAN
L1:	POP BX
	ADD SI,2
	NEXT
XOVER2:	POP AX,CX,DX
	PUSH DX,CX,AX,BX,DX
	MOV BX,CX
	NEXT
XONEPL:	INC BX
	NEXT
XTWOPL:	ADD BX,2
	NEXT
XTHREEPL:
	ADD BX,3
	NEXT
XONEMI:	DEC BX
	NEXT
XTWOMI:	SUB BX,2
	NEXT
XTHREEMI:SUB BX,3
	NEXT
XTWOSLS:SAR BX,1
	NEXT
XTWOSTAR:
	SHL BX,1
	NEXT
XUMSTAR:POP AX
	MUL BX
	PUSH AX
	MOV BX,DX
	NEXT
XUMSLSM:POP DX
	XOR AX,AX
	CMP DX,BX
	JNB >L0
	POP AX
	DIV BX
	PUSH DX
L0:	MOV BX,AX
	NEXT
XDPLUS:	POP AX,CX,DX
	ADD DX,AX
	PUSH DX
	ADC BX,CX
	NEXT
XDNEGATE:POP AX
	NEG AX
	PUSH AX
	XCHG AX,BX
	MOV BX,0
	SBB BX,AX
	NEXT
XNEGATE:NEG BX
	NEXT
XAND:	POP AX
	AND BX,AX
	NEXT
XORE:	POP AX
	OR BX,AX
	NEXT
XXORX:	POP AX
	XOR BX,AX
	NEXT
XLIT:	PUSH BX
	LODSW
	MOV BX,AX
	NEXT
XULESS:	POP AX
	SUB AX,BX
	MOV BX,-1
	JB >L0
	INC BX
L0:	NEXT
XLESS:	POP AX
	SUB AX,BX
	MOV BX,-1
	JL  >L0
	INC BX
L0:	NEXT
XTWOAT:	PUSH [BX+2]
	MOV BX,[BX]
	NEXT
XTWOSTORE:POP [BX]
	POP [BX+2]
	POP BX
	NEXT
XPICK:	SHL BX,1
	ADD BX,SP
	MOV BX,[BX]
	NEXT
XEQUAL:	POP AX
	CMP BX,AX
	MOV BX,-1
	JZ >L0
	INC BX
L0:	NEXT
XCR:	MOV DL,0D
	MOV AH,2
	INT 021
	MOV DL,0A
	INT 021
	NEXT
XQKEY:	PUSH BX
	MOV AH,0B
	INT 021
	CBW
	MOV BX,AX
	NEXT
XKEY:	PUSH BX
	MOV AH,7
	INT 021
	XOR AH,AH
	MOV BX,AX
	NEXT
XEMIT:	MOV DL,BL
	MOV AH,2
	INT 021
	POP BX
	NEXT
XTYPE:	POP DX
	MOV CX,BX
	JCXZ >L0
	MOV AH,040
	MOV BX,1
	INT 021
L0:	POP BX
	NEXT

LINK=0
	; START OF MINIFORTH WITH ITS HEADERS
MINE:	DW LINK
	DB 0E4,'MINI'	; BIT 6 SET FOR IMMEDIATE, BIT 5 FOR VOCABULARY
MINI:	VOCAB   
RUTE:	DW LAST		; HOLDER FOR LAST
	DW MINE		; VOCABULARY STOPPER
LINK=$-2		; WORDS LINK INTO ROOT VOCABULARY, 'MINI'.
	HEAD 4,'EXIT'	; ( 0/0)
EXIT:	JMP XEXIT
	HEAD 1,'!'	; (2/0)
STORE:	JMP XSTORE	
	HEAD 2,'+!'	; (2/0)
PSTOR:	JMP XPSTORE
	HEAD 1,'@'	; (1/1)
ATT:	JMP FETCH
	HEAD 2,'>R'	; (1/0)
TOR:	JMP XTOR
	HEAD 2,'R>'	; (0/1)
RFR:	JMP XRFR
	HEAD 3,'2>R'	; (2/0)
TOR2:	JMP XTOR2
	HEAD 3,'2R>'	; (0/2)
RFR2:	JMP XRFR2
	HEAD 2,'to'	; (1/0)
TO:	JMP XTO
	HEAD 3,'+to'	; (1/0)
PTO:	JMP XPTO
	HEAD 3,'DUP'	; (1/2)
DUPE:	JMP XDUP
	HEAD 4,'?DUP'	; (1/2/0)
QDUP:	JMP XQDUP
	HEAD 4,'DROP'	; (1/0)
DROP:	JMP XDROP
	HEAD 4,'SWAP'	; (2/2)
SWAP:	JMP XSWAP
	HEAD 4,'OVER'	; (2/3)
OVER:	JMP XOVER
	HEAD 3,'ROT'	; (3/3)
ROT:	JMP XROT
	HEAD 2,'C@'	; (1/1)
CAT:	JMP XCAT
	HEAD 2,'C!'	; (2/0)
CSTORE:	JMP XCSTORE
	HEAD 4,'2DUP'	; (2/4)
DUP2:	JMP XDUP2
	HEAD 5,'2DROP'	; (2/0)
DROP2:	JMP XDROP2
	HEAD 5,'2SWAP'	; (4/4)
SWAP2:	JMP XSWAP2
	HEAD 5,'2OVER'	; (4/6)
OVER2:	JMP XOVER2
	HEAD 1,'+'	; (2/1)
PLUS:	JMP XPLUS
	HEAD 1,'-'	; (2/1)
SUBT:	JMP XSUBT
	HEAD 2,'0='	; (1/1)
ZEQ:	JMP XZEQ
	HEAD 2,'0<'	; (1/1)
ZLESS:	JMP XZLESS
	HEAD 2,'0>'	; (1/1)
ZGRT:	JMP XZGRT
	HEAD 3,'0<>'	; (1/1)
ZNE:	JMP XZNE
	HEAD 1,'='	; (2/1)
EQUAL:	JMP XEQUAL
	HEAD 3,'0br'	; (1/0)
ZBRAN:	JMP XZBRAN
	HEAD 2,'br'	; (0/0)
BRAN:	JMP XBRAN
	HEAD 2,'lp'	; (0/0)
PLOOP:	JMP XPLOOP
	HEAD 3,'+lp'	; (1/0)
PPLOOP: JMP XPPLOOP
	HEAD 1,'I'	; (0/1)
I:	JMP XI
	HEAD 2,'R@'	; (0/1)
RAT:	JMP XRAT
	HEAD 2,'of'	; (2/0/1)
OF:	JMP XOF
	HEAD 2,'1+'	; (1/1)
ONEPL:	JMP XONEPL
	HEAD 2,'2+'	; (1/1)
TWOPL:	JMP XTWOPL
	HEAD 2,'3+'	; (1/1)
THREEPL:JMP XTHREEPL
	HEAD 2,'1-'	; (1/1)
ONEMI:	JMP XONEMI
	HEAD 2,'2-'	; (1/1)
TWOMI:	JMP XTWOMI
	HEAD 2,'3-'	; (1/1)
THREEMI:JMP XTHREEMI
	HEAD 2,'2/'	; (1/1)
TWOSLS:	JMP XTWOSLS
	HEAD 2,'2*'	; (1/1)
TWOSTAR:JMP XTWOSTAR
	HEAD 3,'UM*'	; (2/2)
UMSTAR:	JMP XUMSTAR
	HEAD 6,'UM/MOD'	; (3/2)
UMSLSM:	JMP XUMSLSM
	HEAD 2,'D+'	; (4/2)
DPLUS:	JMP XDPLUS
	HEAD 7,'DNEGATE'; (2/2)
DNEGATE:JMP XDNEGATE
	HEAD 6,'NEGATE'	; (1/1)
NEGATE:	JMP XNEGATE
	HEAD 3,'AND'	; (2/1)
ANDD:	JMP XAND
	HEAD 2,'OR'	; (2/1)
ORE:	JMP XORE
	HEAD 3,'XOR'	; (2/1)
XORX:	JMP XXORX
	HEAD 3,'LIT'	; (1/0)
LIT:	JMP XLIT
	HEAD 2,'U<'	; (2/1)
ULESS:	JMP XULESS
	HEAD 1,'<'	; (2/1)
LESS:	JMP XLESS
	HEAD 2,'2@'	; (1/2)
TWOAT:	JMP XTWOAT
	HEAD 2,'2!'	; (3/0)
TWOSTORE:JMP XTWOSTORE
	HEAD 4,'PICK'	; (1/1)
PICK:	JMP XPICK
	HEAD 2,'CR'	; (0/0)
CR:	JMP XCR
	HEAD 4,'?KEY'	; (0/1)
QKEY:	JMP XQKEY
	HEAD 3,'KEY'	; (0/1)
KEY:	JMP XKEY
	HEAD 4,'EMIT'	; (1/0)
EMIT:	JMP XEMIT
	HEAD 4,'TYPE'	; (2/0)
TYPEE:	JMP XTYPE
	HEAD 2,'<>'	; (2/1)
NEQ:	COLON
	DW EQUAL,ZEQ,EXIT

	HEAD 5,'CMOVE'
CMOVE:	JMP LONG CM1	; (3/0)
	DW CM2
CM1:	POP DI,AX
	PUSH SI
	MOV SI,AX
	MOV CX,BX
	JCXZ >L0
	REP MOVSB
L0:	POP SI,BX
	NEXT
CM2=$-CM1
 
	HEAD 1,'0'
ZERO:	CONST		; (0/1)
	DW 0
	HEAD 1,'1'
ONE:	CONST		; (0/1)
	DW 1
	HEAD 1,'2'
TWO:	CONST		; (0/1)
	DW 2
	HEAD 2,'-1'
MIONE:	CONST		; (0/1)
	DW -1
	HEAD 3,'$40'
H40:	CONST		; (0/1)
	DW 040
	HEAD 3,'$80'
H80:	CONST		; (0/1)
	DW 080
	HEAD 2,'1F'
ONEF:	CONST		; (0/1)
	DW 01F
	HEAD 2,'7F'
SEVENF:	CONST		; (0/1)
	DW 07F
	HEAD 2,'BL'
BLANK:	CONST		; (0/1)
	DW 020
	HEAD 4,'ROOT'
ROOT:	CONST 		; (0/1)
	DW RUTE
	HEAD 7,'CURRENT'
CURRENT:VARI		; (0/1)
	DW RUTE
	HEAD 7,'CONTEXT'
CONTEXT:VARI		; (0/1)
CONT	DW RUTE

;    : LATEST CURRENT @ @ ;   (0/1)

	HEAD 6,'LATEST'
LATEST:	COLON
	DW CURRENT,ATT,ATT,EXIT

;     : CLATEST CONTEXT @ @ ; (0/1)

	HEAD 7,'CLATEST'
CLATEST:COLON
	DW CONTEXT,ATT,ATT,EXIT

;    : PATCH  1+ DUP >R 2+ - R> ! ;  (2/0)

	HEAD 5,'PATCH'
PATCH:	COLON
	DW ONEPL,DUPE,TOR,TWOPL,SUBT,RFR,STORE,EXIT

	HEAD 3,'>IN'
TOIN:	TOVAR		; (0/1)
	DW OFFSET CTOIN
	HEAD 4,'HERE'
HERE:	TOVAR		; (0/1)
	DW OFFSET CHERE
	HEAD 4,'SPAN'
SPAN:	TOVAR		; (0/1)
	DW OFFSET CSPAN
	HEAD 3,'BLK'
BLK:	TOVAR		; (0/1)
	DW OFFSET CBLK
	HEAD 5,'BLOCK'
BLOCK:	TOVAR		; (0/1)
	DW OFFSET CBLOCK
	HEAD 4,'BASE'
BASE:	TOVAR		; (0/1)
	DW OFFSET CBASE
	HEAD 9,'COMPILING'
COMP:	TOVAR		; (0/1)
	DW OFFSET CCOMP
	HEAD 3,'TDP'
TDP:	TOVAR		; (0/1)
	DW OFFSET CTDP
	HEAD 2,'R0'
R0:	TOVAR		; (0/1)
	DW OFFSET CR0
	HEAD 2,'S0'
S0:	TOVAR		; (0/1)
	DW OFFSET CS0
	HEAD 3,'DBL'
DBL:	TOVAR		; (0/1)
	DW OFFSET CDBL


	HEADI 1,'['	; : [  0 TO COMPILING ; (0/0)
LBRAK:	COLON
	DW ZERO,TO,COMP,EXIT
	HEAD 1,']'
RBRAK:	COLON
	DW MIONE,TO,COMP,EXIT
	HEAD 5,'SPACE'	; : BL EMIT ; (0/0)
SPACE:	COLON
	DW BLANK,EMIT,EXIT

	HEAD 5,'COUNT'	; (1/2)
COUNT:	JMP LONG COUNT1
	DW COUNT2
COUNT1:	MOV AX,BX
	INC AX
	PUSH AX
	MOV BL,[BX]
	MOV BH,0
	NEXT
COUNT2=$-COUNT1

;    : .W   HERE COUNT 1F AND TYPE SPACE ; (0/0)

	HEAD 2,'.W'
DOTW:	COLON
	DW HERE,COUNT,ONEF,ANDD,TYPEE,SPACE,EXIT

;    : LL  TDP 2- ;  (0/1)

	HEAD 2,'LL'
LL:	COLON
	DW TDP,TWOMI,EXIT

;    : ?EX  LL @ = ;  (1/1)

	HEAD 3,'?EX'
QEX:	COLON
	DW LL,ATT,EQUAL,EXIT

;     : ILT  R> COUNT 2DUP + >R TYPE ; (0/0)

	HEAD 3,'ILT'
ILT:	COLON
	DW RFR,COUNT,DUP2,PLUS,TOR,TYPEE,EXIT
	HEAD 5,'ALLOT' ; : ALLOT +TO HERE ; (1/0)
ALLOT:	COLON
	DW PTO,HERE,EXIT
	HEAD 1,','	; : , HERE ! 2 ALLOT ;  (1/0)
COMMA:	COLON
	DW HERE,STORE,TWO,ALLOT,EXIT
	HEAD 2,'C,'	; : C, HERE C! 1 ALLOT ; (1/0)
CCOMMA:	COLON
	DW HERE,CSTORE,ONE,ALLOT,EXIT
	HEAD 4,'!CSP'	; (0/0)
STCSP:	JMP LONG STCSP1
	DW STCSP2
STCSP1:	MOV AX,SP
	MOV CSP,AX
	NEXT
STCSP2=$-STCSP1
	HEAD 4,'CSP?'	; RETURNS 'TRUE' IF CSP <> SP
CSPQ:	JMP LONG CSPQ1	; (0/1)
	DW CSPQ2
CSPQ1:	MOV AX,SP
	PUSH BX
	XOR BX,BX
	CMP AX,CSP
	JZ >L0
	DEC BX
L0:	NEXT
CSPQ2=$-CSPQ1

;  : ?CSP  CSP? ABORT" Unbalanced" ;  (0/0)

	HEAD 4,'?CSP'
QCSP:	COLON
	DW CSPQ,QER,
	DB 11,' Unbalanced'
	DW EXIT

;      : :,  $E8 C, LIT DOCOLON HERE 2+ - , ; (0/0)

	HEAD 2,':,'
COLCOM: COLON
	DW LIT,0E8,CCOMMA,LIT,DOCOLON,HERE,TWOPL,SUBT,COMMA,EXIT

;     : ?C  COMPILING 0=      (0/0)
;		IF 1 , HERE TO TDP :, !CSP ] THEN ;

	HEAD 2,'?C'
QC:	COLON
	DW COMP,ZEQ,ZBRAN,QC1,ONE,COMMA,HERE,TO,TDP,COLCOM,STCSP,RBRAK
QC1:	DW EXIT

;    : COMPILE  ?C R> DUP @ , 2+ >R ; (0/0)

	HEAD 7,'COMPILE'
COMPILE:COLON
	DW QC,RFR,DUPE,ATT,COMMA,TWOPL,TOR,EXIT

	HEAD 3,'CXR'	; XOR CHAR AT ADDR WITH BYTE: (ADDR BYTE... )
CXR:	JMP LONG CXR1	; (2/0)
	DW CXR2
CXR1:	POP DI
	XOR [DI],BL
	POP BX
	NEXT
CXR2=$-CXR1
	HEAD 3,'SP!'	; (1/0)
SPST:	JMP LONG SPST1
	DW SPST2
SPST1:  POP AX
	MOV SP,BX
	MOV BX,AX
	NEXT
SPST2=$-SPST1
	HEAD 3,'RP!'	; (1/0)
RPST:	JMP LONG RPST1
	DW RPST2
RPST1:	MOV BP,BX
	POP BX
	NEXT
RPST2=$-RPST1
	HEAD 3,'CLR'
CLR:	COLON		;  : CLR  S0 SP! ; (0/0)
	DW S0,SPST,EXIT
	HEAD 7,'EXECUTE'
EXECUTE:JMP XEXEC

	HEAD 5,'ERROR'
ERROR:	DB 0E9		; VECTORED ERROR HANDLER - PRESENTLY CLEARS STACK
	DW CLR-($+2)
;     : HEX  16 TO BASE ;   (0/0)

	HEAD 3,'HEX'
HEXX:	COLON
	DW LIT,16,TO,BASE,EXIT

;       : DECIMAL  10 TO BASE ;  (0/0)

	HEAD 7,'DECIMAL'
DECIM:	COLON
	DW LIT,10,TO,BASE,EXIT


;     : LITERAL  COMPILING 		(1/0 COMPILING)
;	IF COMPILE LIT , THEN ;		(0/0 NON-COMPILING)

	HEADI 7,'LITERAL'
LITERAL:COLON
	DW COMP,ZBRAN,LI1,COMPILE,LIT,COMMA
LI1:	DW EXIT

;      : LINK LL CURRENT @ ! ;		(0/0)

	HEAD 4,'LINK'
LYNK:	COLON
	DW LL,CURRENT,ATT,STORE,EXIT

;     : RID  LL TO HERE ;		(0/0)

	HEAD 3,'RID'
RID:	COLON
	DW LL,TO,HERE,EXIT

	HEAD 3,'0TO'	;  RESET THE 'TO' FLAG TO ZERO (0/0)
ZEROTO:	JMP LONG ZT1
	DW ZT2
ZT1:	MOV W TFL,0
	NEXT
ZT2=$-ZT1


	HEAD 4,'find'		;    (2/2)
FINDE:	JMP LONG FIND1
	DW FIND2
FIND1:	POP DX			; ADDRESS OF 'HERE'
	PUSH SI			; SAVE IP FOR LATER
L0:	MOV BX,[BX]		; START OF SEARCH
	OR BX,BX		; DONE IF LINK = 0
	JZ >L2
	MOV DI,DX		; ADDR TO DI
	MOV SI,BX		; AND SI
	ADD SI,2		; STEP TO NAME FIELD
	MOV CL,[SI]		; NAME LENGTH
	AND CX,01F		; REDUCED TO 31 MAX BYTES
	CMP CL,[DI]		; LENGTHS MATCH?
	JNZ L0			; NO, GET NEXT NAME
	INC SI			; YES, STEP TO FIRST CHAR IN NAME
	INC DI
	REPZ CMPSB		; COMPARE THEM
	JNZ L0			; NO MATCH - GO GET NEXT
	POP CX			; NAMES HIT! RESTORE SI
	PUSH SI			; SI = CODE ADDRESS OF WORD
	MOV SI,CX		; IP ONCE AGAIN = SI
	TEST B[BX+2],040	; CHACK FOR IMMEDIATE WORD
	MOV BX,-1		; TRUE FLAG BUT -1
	JZ >L1
	NEG BX			; TRUE FLAG BUT +1 IF IMMEDIATE
L1:	NEXT			; ALL DONE
L2:	POP SI			; DID NOT FIND WORD SO RECOVER IP
	PUSH DX			; BX = 0 FOR FALSE FLAG, DX = 'HERE'
	NEXT			; AND WE'RE DONE
FIND2=$-FIND1

	HEAD 2,'.H'	; PRINT 4 DIGIT UNSIGNED HEX NUMBER AND SPACE
DOTH:	MOV CX,4	;  (1/0)
	CALL PRH
	POP BX
	NEXT
	HEAD 3,'.HC'	; PRINT 2 DIGIT UNSGNED HEX NUMBER AND SPACE
DOTHC:	MOV CX,2	;  (1/0)
	CALL PRH
	POP BX
	NEXT
PRH:	MOV DI,CX
	MOV AX,BX
	MOV BX,16
L0:	XOR DX,DX
	DIV BX
	XCHG AX,DX
	ADD AL,090
	DAA
	ADC AL,040
	DAA
	PUSH AX
	XCHG AX,DX
	LOOP L0
	MOV CX,DI
	MOV AH,2
L1:	POP DX
	INT 021
	LOOP L1
	MOV DL,' '
	INT 021
	RET

	HEAD 5,'DEPTH'	; RETURN STACK DEPTH   (0/1)
DEPTH:	JMP LONG D1
	DW D2
D1:	PUSH BX
	MOV BX,CS0
	SUB BX,SP
	SAR BX,1
	DEC BX		; ACCOUNT FOR NUMBER JUST PUSHED
	NEXT
D2=$-D1

	HEAD 4,'BDOS'	; RUN DOS SERVICE $21
BDOS:	JMP LONG BDOS1	; ENTER WITH BX,CX,DX AND # ON STACK (4/1)
	DW BDOS2	; RETURNS FALSE IF NO ERROR - AX,BX,CX,DX
BDOS1:	MOV AX,BX	; FUNCTION IN AH
	POP BX,CX,DX
	INT 021
	PUSH DX,CX,BX,AX
	MOV BX,0
	JNC >L0
	DEC BX
L0:	NEXT
BDOS2=$-BDOS1

	HEAD 2,'DU'	; CONVERT STRING AT ADDRESS TO AN (1/3)
DU:	JMP LONG DU1	; UNSIGNED DOUBLE NUMBER PLUS FLAG
	DW DU2		; TRUE IF SUCCESSFUL CONVERSION
DU1:	MOV DI,BX
	XOR AX,AX
	MOV DX,AX	; CLEAR DOUBLE ACCUMULATOR
	MOV CDBL,AX	; CLEAR DOUBLE PRECISION FLAG
	MOV CX,CBASE	; CX = NUMBER BASE
L0:	MOV BL,[DI]	; ASCII CHARACTER TO CONVERT
	MOV BH,0
	SUB BX,030	; REMOVE ASCII BIAS
	JB EX		; DONE IF <0
	CMP BX,10
	JB >L1
	SUB BX,7	; -7 IF >= 10
	CMP BX,10
	JB EX		; DONE IF < 10
L1:	CMP BX,CX
	JNB EX		; DONE IF >= BASE
	PUSH BX		; SAVE NUMBER
	PUSH DX		; AND MSH OF PRODUCT
	MUL CX
	MOV BX,AX	; SAVE LSH OF PRODUCT
	POP AX		; RECOVER MSH OF PRODUCT
	PUSH DX		; SAVE OVERFLOW
	MUL CX
	POP DX
	ADD DX,AX	; ADD OVERFLOW TO MSH
	MOV AX,BX	; RECOVER LSH
	POP BX		; AND NUMBER
	ADD AX,BX	; ADD IT IN  16-BIT TO 32-BIT ADD
	ADC DX,0
	INC DI
	JMP L0
EX:	PUSH AX,DX	; SAVE DOUBLE NUMBER
	MOV BX,-1	; TRUE FLAG
	CMP B[DI],'.'
	JNZ >L2
	MOV CDBL,BX	; DOUBLE PRECISION IF DELIMITER IS A PERIOD
	INC DI
L2:	CMP B[DI],' '	; MUST BE A SPACE FOR VALID NUMBER
	JZ >L3		; OK
	INC BX		; FALSE FLAG
L3:	NEXT
DU2=$-DU1

;    : DS COUNT ASCII - = DUP >R 0= + DU	( 1/3)
;	IF R>  IF DENEGATE -1 THEN
;	ELSE R> DROP 0
;	THEN ;

	HEAD 2,'DS'
DS0:	COLON
	DW COUNT,LIT,02D,EQUAL,DUPE,TOR,ZEQ,PLUS,DU,ZBRAN,DS1
	DW RFR,ZBRAN,DS2,DNEGATE
DS2:	DW MIONE,BRAN,DS3
DS1:	DW RFR,DROP,ZERO
DS3:	DW EXIT

;     : $DS BASE >R COUNT ASCII $ = DUP		( 1/3)
;	IF HEX THEN 0= + DS R> TO BASE ;

	HEAD 3,'$DS'
HDS:	COLON
	DW BASE,TOR,COUNT,LIT,024,EQUAL,DUPE,ZBRAN,HDS1,HEXX
HDS1:	DW ZEQ,PLUS,DS0,RFR,TO,BASE,EXIT

	HEAD 2,'NU'	; VECTORED WORD FOR 'NUMBER' INITIALIZED 
NU:	DB 0E9
	DW HDS-($+2)	; TO POINT TO '$DS' FOR HEX ENTRY
	HEAD 2,'??'
QQ:	COLON		;    : ??  0= IF .W  -1  ABORT" ?" ;  ( 1/0)
	DW ZEQ,ZBRAN,QQ1,DOTW,MIONE,QER
	DB 2,' ?'
QQ1:	DW EXIT

;    : ?NU   NU  ?? ;		( 1/3/0)

	HEAD 3,'?NU'
QNU:	COLON
	DW NU,QQ,EXIT

 	HEAD 3,'KBD'	; ACCEPT UP TO 80 CHARACTERS FROM THE KEYBOARD
KBD:	JMP LONG KBD1	; SPAN HOLDS THE ACTUAL COUNT OF KEYSTROKES
	DW KBD2		;  ( 0/0)
KBD1:	MOV DX,BUF
	MOV AH,10
	INT 021
	MOV AL,CNT B
	CBW
	MOV CSPAN,AX
	NEXT
KBD2=$-KBD1

;     : RF ROOT find ;	 ( 1/2)

	HEAD 2,'RF'
RF:	COLON
	DW ROOT,FINDE,EXIT
	HEAD 4,'FIND'
FIND:	DB 0E9		; 'FIND' VECTORED TO 'RF' INITIALLY
	DW RF-($+2)

;     (1/1) FOR WORD

	HEAD 4,'WORD'	; GET NEXT WORD FROM INPUT TO 'HERE'. LEAVE
XWORD:	JMP LONG WORD1	; 'HERE' ON STACK. ALSO ACCEPTS TAB, CR, AND LF
	DW WORD2	; AS ABSOLUTE DELIMITERS IN ADDITION TO CHAR ON STK
WORD1:	MOV AH,9	; TAB CHARACTER
	MOV DX,0D0A	; CR AND LF CHARACTERS
	MOV AL,BL	; SCAN CHARACTER
	MOV BX,BUF+2	; START OF KEYBOARD BUFFER
	MOV CX,CBLK W	; 0 IF KEYBOARD
	JCXZ >L0
	MOV BX,CBLOCK	; ELSE GET BLOCK ADDRESS
	XOR CX,CX	; AND SET CX COUNT TO 0
L0:	ADD BX,CTOIN	; OFFSET INTO BUFFER
	JMP >L1
L2:	INC CX
	INC BX
L1:	CMP [BX],AL
	JZ L2
	CMP [BX],AH
	JZ L2
	CMP [BX],DL
	JZ L2
	CMP [BX],DH
	JZ L2		; SKIP BUT COUNT LEADING CHARS
	PUSH SI		; SAVE THE IP
	MOV SI,BX	; SI -> FIRST CHAR OF WORD
	JMP >L0
L1:	INC CX
	INC BX
L0:	CMP [BX],AH
	JZ >L3
	CMP [BX],DL
	JZ >L3
	CMP [BX],DH
	JZ >L3
	CMP [BX],AL
	JNZ L1		; SCAN FOR DELIMITER
L3:	INC CX		; STEP PAST DELIMITER
	ADD CTOIN,CX	; ADVANCE >IN BY CX
	SUB BX,SI	; ACTUAL COUNT OF WORD
	MOV CX,BX	; INTO CX
	MOV DI,CHERE	; MOVE TO HERE
	MOV BX,DI	; TOS ALSO = HERE ON EXIT
	MOV AL,CL	; WORD LENGTH
	STOSB
	REP MOVSB	; AND STRING MOVED TO HERE
	MOV AL,' '	; FOLLOWED BY A SPACE
	STOSB
	POP SI		; RESTORE THE IP
	NEXT
WORD2=$-WORD1

;	: W,  WORD C@ 1+ ALLOT ;  (1/0)

	HEAD 2,'W,'
WCOMMA:	COLON
	DW XWORD,CAT,ONEPL,ALLOT,EXIT

;    : HEAD  LATEST , HERE TO TDP BL W, TDP $80 CXR ; (0/0)

	HEAD 4,'HEAD'
HED:	COLON
	DW LATEST,COMMA,HERE,TO,TDP,BLANK,WCOMMA
	DW TDP,H80,CXR,EXIT

;      : CREATE  HEAD $E9 C, LIT DOVAR HERE 2+ - , ; (0/0)

	HEAD 6,'CREATE'
VCREATE:COLON
	DW HED,LIT,0E9,CCOMMA,LIT,DOVAR,HERE,TWOPL,SUBT,COMMA,EXIT


;     :  :  HEAD :, !CSP ] ;  (0/0)

	HEAD 1,':'
COLN:	COLON
	DW HED,COLCOM,STCSP,RBRAK,EXIT

;   :  ;  IMMEDIATE ?CSP COMPILE EXIT 1 ?EX  (0/0)
;		IF 2 LL !
;		ELSE LINK
;		THEN [ ;

	HEADI 1,';'
SEMI:	COLON
	DW QCSP,COMPILE,EXIT,ONE,QEX,ZBRAN,SE1,TWO,LL,STORE,BRAN,SE2
SE1:	DW LYNK
SE2:	DW LBRAK,EXIT

;   : LOCATE  BL WORD FIND ;   (0/2)

	HEAD 6,'LOCATE'
LOCATE:	COLON
	DW BLANK,XWORD,FIND,EXIT

;    : NUMBER  1+ ?NU COMPILING		( 1/0 COMPILING)
;	IF DBL	IF SWAP LITERAL LITERAL ( 1/1 NON-COMPILING)
;		ELSE DROP LITERAL
;		THEN
;	ELSE DBL 0= IF DROP THEN
;	THEN ;

	HEAD 6,'NUMBER'
NUMB:	COLON
	DW ONEPL,QNU,COMP,ZBRAN,NN1,DBL,ZBRAN,NN2,SWAP
	DW LITERAL,LITERAL,BRAN,NN4
NN2:	DW DROP,LITERAL,BRAN,NN4
NN1:	DW DBL,ZEQ,ZBRAN,NN4,DROP
NN4:	DW EXIT

;      : BYE   0 EXECUTE ; (0/0)

	HEAD 3,'BYE'
BYE:	COLON
	DW ZERO,EXECUTE,EXIT

;   : INTERPRET COMPILING	(1/0)
;	IF 1+ 	IF EXECUTE
;		ELSE ,
;		THEN
;	ELSE DROP EXECUTE
;	THEN ;

	HEAD 9,'INTERPRET'
INTERP:	COLON
	DW COMP,ZBRAN,IN1,ONEPL,ZBRAN,IN2,EXECUTE,BRAN,IN3
IN2:	DW COMMA
IN3:	DW BRAN,IN4
IN1:	DW DROP,EXECUTE
IN4:	DW EXIT

;	: RUN 	CR BEGIN >IN SPAN <	( 0/0)
;		   WHILE 0TO LOCATE ?DUP
;			IF INTERPRET
;			ELSE NUMBER
;			THEN DEPTH 0< $80 DEPTH < OR ABORT" Stack?"
;		   REPEAT    
;		   2 ?EX 	IF TDP EXECUTE RID [ THEN ;

	HEAD 3,'RUN'
RUN:	COLON
	DW CR
RU1:	DW TOIN,SPAN,LESS,ZBRAN,RU4,ZEROTO,LOCATE,QDUP,ZBRAN,RU3
	DW INTERP,BRAN,RU2
RU3:	DW NUMB
RU2:	DW DEPTH,ZLESS,H80,DEPTH,LESS,ORE,QER
	DB 7,' Stack?'
	DW BRAN,RU1
RU4:	DW TWO,QEX,ZBRAN,RU5,TDP,EXECUTE,RID,LBRAK
RU5:	DW EXIT

;	: QUIT R0 RP! [			( 0/0)
;	BEGIN CR 0 TO BLK KBD 0 TO >IN RUN
;	   COMPILING 0= IF ." ok" THEN
;	AGAIN ;

	HEAD 4,'QUIT'
QUIT:	COLON
	DW R0,RPST,LBRAK
QUI:	DW CR,ZERO,TO,BLK,KBD,ZERO,TO,TOIN,RUN,COMP,ZEQ
	DW ZBRAN,QU1,ILT
	DB 3,' ok'
QU1:	DW BRAN,QUI,EXIT

;   : ?ER 0TO			(1/0)
;	IF COMPILING IF RID THEN
;	  R> COUNT TYPE ERROR QUIT
;	ELSE R> COUNT + >R
;	THEN ;

	HEAD 3,'?ER'
QER:	COLON
	DW ZEROTO,ZBRAN,QER3,COMP,ZBRAN,QER2,RID
QER2:	DW RFR,COUNT,TYPEE,ERROR,QUIT,BRAN,QER1
QER3:	DW RFR,COUNT,PLUS,TOR
QER1:	DW EXIT

;    : ABORT  [ -1 ABORT" MINIFORTH V1.0 - 8/8/88" ; (0/0)

LAST:	HEAD 5,'ABORT'
ABORT:	COLON
	DW LBRAK,MIONE,QER
	DB CT
CT1:	DB 'MINIFORTH V1.0 - 8/8/88'
CT=$-CT1
	DW EXIT


INIT:	CLD
	XOR AX,AX
	MOV BX,AX
	MOV CR0,AX
	MOV BP,AX
	SUB AX,256
	MOV CS0,AX
	MOV SP,AX
	MOV AX,10
	MOV CBASE,AX
	MOV CCOMP,BX
	MOV SI,ABORT+3
	NEXT
DP=$