;
	JMP	UFORTH
;
UAREA:	DB	0	; ?
S0:		DW	5	; PTR TO ADDRESS OF PARAMETER STACK
BASE:	DB	7	; RADIX FOR NUMBER BASE
DP:		DW	8	; DICTIONARY PTR
CONTEXT:	DW	0AH	; ADDRESS OF TOP OF VOCAB TO SEARCH FIRST
CURRENT:	DW	0CH	; PTR TO TOP OF THE VOCAB TO ADD NEW DEFS
STATE:	DB	0EH	; FLAG EXECUTE/COMPILE
INP:	DW	0FH	; PTR TO REL LOCATION IN INPUT STREAM BUFFER
BLK:	DW	10H	; CURRENT BLOCK DURING LOAD
SCR:	DW	14H	; CURRENT EDITOR SCREEN NUMBER
		DW	16H	; ?
RPTR:		DW	18H	; RAM PTR TO FREE SPACE

UFORTH:					; ASSUME ALL DEVICES AND MEMORY INITIALIZED
S2D:	DB	1,2DH	; DICTIONARY ENTRY FOR "-"
		DW	0		; BOTTOM OF THE DICTIONARY
		DW	SD20	; CODE PTR
SD20:	POP	D
		MOV	A,E
		CMA
	MOV	E,A
	MOV	A,D
	CMA	
	MOV	D,A
	INX	D
	CPI	0D1H
	POP	H
	DAD	D
	JMP	NEXT
;
S21:	DB	1,21H	; DICTIONARY ENTRY FOR !
		DW	S2D		; LINK DOWN
		DW	S210	; CODE PTR
S210:	POP	H
		POP	D
		MOV	M,E
		INX	H
		MOV	M,D
		JMP	NEXT
; 
; (MATCH) SEARCHES FOR THE 1ST OCCURANCE OF A STRING-A IN STRING-B
; FOR A COUNT OF CHARACTERS. RETURNS ADDRESS+1 OF LAST MATCHED
; CHARACTER IN STRING-B AND A NON-ZERO ON STACK TOP IF A MATCH
; FOUND, OTHERWISE 0.
;
; STACK TOP STRING-A
;		2ND	COUNT-A
;		3RD STRING-B
;		4TH	COUNT-B
;		
; RETURNS	TOP	NOT-0 IF MATCH
; 			2ND ADDRESS OF LAST MATCHED CHARACTER IN STRING-B
;	
MATCH:	DB	7,28H,'MATCH',29H
		DW	S21	; DOWNWARD LINK
		DW	MATCH0	; CODE PTR
MATCH0:	MOV	H,B		; SAVE BC
 		MOV	L,C
		POP	B		; POP COUNT-B
		MOV	A,C		; SAVE COUNT-B IN A
		POP	B		; POP STRING-B
		POP	D		; POP COUNT-A
		MOV	D,A		; SAVE COUNT-B IN D, COUNT-A IN E
		XTHL		; SAVE HL ON STACK, POP STRING-A TO HL
;
MATCH1:					; BEGIN OUTER LOOP
		LDAX	B		; FETCH CHARA OF STRING-B
		CMP		M		; COMPARE TO CHAR OF STRING-A
		JNZ		MATCH5	; QUIT EARLY NO MATCH
		PUSH	B		; PUSH STRING-B TO STACK
		PUSH	D		; PUSH CNT-A IN E, CNT-B IN D 
		PUSH	H		; PUSH STRING-A TO STACK
MATCH2:		
		INX		H		; POINT TO NEXT IN STRING-A
		INX		B		; POINT TO NEXT IN STRING-B
		DCR		D		; REDUCE CNT-B
		JNZ		MATCH3	; IF DONE THEN DO RETURN
		POP		D		; TAKE 3 OFF THE STACK
		POP		D		; DE IS GOING TO RETURN AS NON-ZERO
		POP		B	
		JMP		WHPUSH	; BUT RETURN WITH LAST STRING-A
MATCH3:					; MORE TO DO
		DCR		E		; REDUCE CNT-A
		JNZ		MATCH4	; IF NO MORE IN STRING-A 
		POP		B		; CLEAR THE 4 OFF THE STACK
		POP		B
		POP		B
MATCH6:
		POP		B		;
		MOV		D,E		; E WAS ZERO, NOW D IS TOO, PUSH 0 ON STACK
		JMP		WHPUSH	; NO MATCH FOUND
MATCH4:
		LDAX	B		; GET NEXT IN STRING-B
		CMP		M		; SAME AS IN STRING-A?
		JNZ		MATCH2		; LOOP IF MATCHED
		POP		H		; OTHERWISE QUIT. POP OFF THE STACK
		POP		D
		POP		B
MATCH5:
		INX		H		; POINT TO NEXT IN STRING-A
		DCR		E		; REDUCE CNT-A
		JNZ		MATCH1		; OUTER LOOP, E SAYS MORE
		JMP		MATCH6		; E WAS ZERO, RETURN 0 (NO MATCH)
;
~3BS:					; REALLY, CODE ;S STOPS THE LOADING OF A SCREEN
		DB		3BH,'S'	; HEAD
		DW		MATCH	; DOWNWARD LINK
		DW		~3BS0	; CODE POINTER
~3BS0:
		LHLD	R		; GET POINTER R
		MOV		C,M		; USE THAT TO RESTORE BC POINTER
		INX		H
		MOV		B,M
		INX		H
		SHLD	R		; NEW R
		JMP		NEXT
;
3FDD:	DB	3,3FH,'DD'	; FOR INTEL SBC-202 DD DISK CONTROLLER
		DW	~3BS			; DOWNWARD LINK
		DW	~3FDD0		; CODE PTR
3FDD0:
		IN	78H
		LXI	H,0		; PREPARE RESULT
		ANI	10H		; MAKE READY BIT
		JNZ	HPSUSH	; QUIT EARLY
		INX	H		; MAKE RESULT = 1
		JMP	HPUSH	; NOW RETURN
;
AT:		DB		1,40H	; "@" GETS DATA AT THE ADDRESS ON STACK
		DW		3FDD	; DOWNWARD LINK
		DW		AT0
AT0:
		POP		H
		MOV		E,M
		INX		H
		MOV		D,M
		PUSH	D
		JMP		NEXT


			
WHPUSH:	PUSH	D
HPUSH:	PUSH	H
NEXT:

END