$PAGELENGTH(66) XREF DEBUG PRINT(:LP:)
;
;	LLL/CHERNACK BASIC INTERPRETER - MAIN MODULE
;
	NAME	BASIC1

;	REVISED 12/22/77



	EXTRN	RUN,CRLF
	EXTRN	PRINT,LIST,HELP,EXIT
	EXTRN	DCOMP,CVB,CHK1,LENGTH,PTVAL,SYMSRT

	PUBLIC	ALPHA		; TEST IF A-REG IS BETWEEN 0-9
	PUBLIC	CLOSE		; FILE CLOSE ROUTINE FOR <LOAD/LIST>
	PUBLIC	ICE80		; CHECK IF IN ICE80/DEBUG MODE
	PUBLIC	MEMFUL		; TEST FOR 50 MORE BYTES IN RAM??
	PUBLIC	NUMB		; TEST IF A-REG IS BETWEEN 0-9
	PUBLIC	OPEN		; FILE OPEN ROUTINE FOR <LOAD/LIST>
	PUBLIC	READY		; <READY> ENTRY POINT
	PUBLIC	TTYIN		; READ LINE FOR <INPUT>
	PUBLIC	STLINE		; => FIRST LINE USER PROGRAM
	PUBLIC	STPNT		; STORE POINTERS
	PUBLIC	WHAT		; PRINT <WHAT> ON CRT
	
ISIS	EQU	40H
CI	EQU	0F803H
CO	EQU	0F809H


MEMST	EQU	03200H			; MUST BE ON PAGE BOUNDARY
OBUFF	EQU	MEMST
STLINE	EQU	MEMST+111Q		; FIRST LINE OF USER PROGRAM
NLINE	EQU	MEMST+113Q		; POINTER TO NEW LINE OF USER TEXT
NL2	EQU	MEMST+115Q		; BINARY VALUE OF NEW LINE NUMBER
NL6	EQU	MEMST+121Q		; LENGTH OF NEW LINE
KLINE	EQU	MEMST+122Q		; POINTER TO CURRENT LINE - LINE INSERT
KL2	EQU	MEMST+124Q		; BINARY EQUIVALENT OF CURRENT LINE #
KL4	EQU	MEMST+126Q		; FORWARD POINTER OF CURRENT LINE
PLINE	EQU	MEMST+131Q		; PREVIOUS LINE POINTER, LINE INSERTION


MEMCHK	EQU	0F81BH



	CSEG

$EJECT TITLE('BASIC MAIN MODULE 12/22/77')

;	*********************
;	INTERRUPT ENTRY POINT
;	*********************

INT:	MVI	A,20H	; RE-ENABLE INTELLEC INTERRUPT
	OUT	0FDH
	LXI	H,OBUFF	; CLEAR OUTPUT BUFFER
	MVI	M,1	;   BY SETTING LENGTH TO <1>
	EI
	JMP	READY	;   AND GOTO <READY>


;	************************
;	MAIN PROGRAM ENTRY POINT
;	************************

BASIC:	MVI	A,0C3H	; SET 38H =>
	STA	38H
	LXI	H,INT
	SHLD	39H	;    <JMP INT>

	IN	0FCH	; ENABLE INTERRUPT SWITCH 7
	ANI	7FH
	OUT	0FCH	;   BY CLEARING BIT 7

	LXI	SP,6000H; TEMPORARY VALUE UNTIL <READY>
SCR:	LXI	H,OBUFF	; <PROCESS SCR COMMAND>
	MVI	M,1
	LXI	H,0FFFFH; SET <STLINE> = FFFFH
	SHLD	STLINE

	LXI	H,MEMORY; HL => FWA MEMORY
	CALL	ICE80	; IF IN <ICE80 DEBUG MODE>
TP0:	LXI	H,5000H	;   THEN HL => 5000H
	SHLD	NLINE	; STORE IN FREE SPACE POINTER

$EJECT
;	***************
;	PROCESS <READY>
;	***************

READY:	CALL	MEMCHK	; CALL MONITOR ROUTINE <MEMCHK>
	MOV	H,B
	MOV	L,A
	CALL	ICE80	; IF IN <ICE80 DEBUG MODE>
TP1:	LXI	H,0E000H;   THEN SP <= E000H
	SPHL		; SP <= BA  --- <END OF MEMORY>

	LXI	H,MESS1	; WRITE
	CALL	PRINT	;   <'READY'>
	CALL	UNLOAD	; <RESET> INPUT TO <CI>, DISABLE LOAD

M3:	LHLD	NLINE	; <GET NEXT INPUT LINE>
	INX	H	; SPACE OVER 16-BIT LINE NUMBER (HOLE)
	INX	H
	INX	H	; SPACE OVER 16-BIT POINTER TO NEXT LINE
	INX	H
	INX	H	; SPACE OVER 8-BIT LENGTH CHARACTER
	CALL	READI	; READ LINE INTO <NLINE+5>...
	MOV	C,A	; IF <LINE LENGTH> = 0
	ORA	A
	JZ	M3	;   THEN GOTO <M3>

	CALL	ALPHA	; IF CHARACTER AT <NLINE+5> = A-Z
	JC	M4	;   THEN <M4> -- DECODE COMMAND
	CALL	NUMB	; IF CHARACTER AT <NLINE+5> .NE. 0-9
	JNC	WHAT	;   THEN <'WHAT'>
	CALL	INSERT	; <INSERT> LINE INTO PROGRAM
	JMP	M3	;   AND GET NEXT LINE

M4:	CALL	UNLOAD	; RESET <INPUT> TO :CI: AFTER ALPHA INPUT
	XRA	A	; SEARCH FOR <COMMAND> BY
	CALL	SYMSRT	;   CALLING <SYMSRT><A=0>
	CPI	-1	; IF <A> = <-1>
	JZ	WHAT	;   THEN <'WHAT'>
	ORA	A	; IF <A> = <0>
	JZ	RUN	;   THEN <RUN>	'RUN'
	CPI	1	; IF <A> = 1
	JZ	HELP	;   THEN <HELP>	'HELP'
	CPI	2	; IF <A> = 2
	JZ	LIST	;   THEN <LIST>  'LIST [:FN:XXXXX.XXX]'
	CPI	3	; IF <A> = 3
	JZ	SCR	;   THEN <SCR>  'SCR'
	CPI	4	; IF <A> = 4
	JZ	EXIT	;   THEN <EXIT> 'EXIT'
	CPI	5	; IF <A> = 5
	JZ	LOAD	;   THEN <LOAD> 'LOAD :FN:XXXXXX.XXX'
;
	JMP	WHAT	;   ELSE <'WHAT'>

$EJECT
;	LINE <READ> SUBROUTINES:
;
;	THESE SUBROUTINES WILL READ A LINE FROM 

;		1) :CI: USING ISIS-II SYSTEM CALL
;		2) :FX:XXXXXX.XXX USING ISIS-II SYSTEM CALL
;		3) MDS MONITOR SUBROUTINE <CI> IF IN ICE80/DEBUG

;
;	IF MEMORY LOCATON 40H (ISIS) = 76H (HLT) THEN ALTERNATIVE #3.
;	IF <LDFLAG> THEN ALTERNATIVE #2.
;	ELSE, ALTERNATIVE #1.

;	THREE BUFFERS ARE USED IN THIS PROCESS:

;		1) HL - SUPPLIED BY USER WHEN CALL <READI> EXECUTED.
;
;			THE FINAL INPUT LINE IS PLACED IN THIS BUFFER,
;			AND THE A-REG IS SET TO THE CHARACTER COUNT, OR
;			ZERO IF NOTHING IS READ IN.
;			ALL BLANKS ARE REMOVED BY <MOVE0> EXCEPT FOR
;			THOSE BLANKS BETWEEN <"> CHARACTERS.
;
;
;		2) INBUF(80)
;
;			THE RAW INPUT LINE, FROM :CI: OR <CI> IS PUT
;			IN HERE. A CRLF WILL BE PLACED IN HERE TOO. THIS
;			BUFFER ALLOWS <MOVE0> TO COMPRESS THE LINE, AND
;			ALSO ALLOWS MORE THAN ONE DISC READ IF A LINE
;			IS NOT READ INTO <INBUF> BEFORE <DBUFF> IS EXHAUSTED.
;
;
;		3) DBUFF(128)
;
;			THIS BUFFER IS USED BY <LOAD :FN:XXXXXX.XXX> AS
;			A SOURCE OF CHARACTERS TO BE DRAWN UPON BY <READL>
;			AS ADDITIONAL CHARACTERS ARE NEEDED. WHEN THIS
;			BUFFER IS EMPTIED, <READL> WILL CALL
;			<DREAD> TO REFILL IT.

;	ON RETURN, HL IS RESTORED TO POINT TO USER BUFFER
;		   A = # OF CHARACTERS READ

;	ON RETURN, AN UNCOMPRESSED VERSION OF THE INPUT LINE IS
;	LEFT IN <INBUF> AND <GCHAR>/<GETST> ARE INITIALIZED FOR
;	CHARACTER SCANS.

$EJECT

;	(1) READ FROM <CI> AFTN USING ISIS-II SYSTEM CALL

TTYIN:
READI:	PUSH	H	; SAVE USER BUFFER ADDRESS IN STACK
	CALL	ICE80	; IF IN <ICE80 DEBUG MODE>
	JMP	READ	;   THEN USE <READ>

	LDA	LDFLAG	; IF <LDFLAG> = TRUE (NOT ZERO)
	ORA	A
	JNZ	READL	;   THEN USE <READL> -- READ/LOAD :FN:XXXXXX.XXX

	LXI	H,INBUF	; RESET <CPTR>
	SHLD	CPTR	;   TO => <INBUF>

	MVI	C,3	; <READ>
	LXI	D,RAFT
	CALL	ISIS

	JMP	MOVE0

RAFT:	DW	1	; FILE <CI>
CPTR:	DW	INBUF	; ADDRESS OF CAPTIVE INPUT BUFFER
	DW	RBUFFL	; LENGTH OF CAPTIVE INPUT BUFFER
	DW	STAT1	; ACTUAL INPUT LENGTH
	DW	STAT2	; INPUT STATUS

STAT1:	DW 	0
STAT2:	DW	0

$EJECT
;	(2) READ SUBROUTINE -- READ FROM MDS MONITOR SUBROUTINE <CI>

READ:	MVI	B,0
	LXI	H,INBUF	; READ INTO <INTERNAL> BUFFER
READ1:	CALL	CI
	ANI	7FH
	CPI	7FH	; IF <RUB-OUT>
	JZ	READ2	;   THEN <READ2>
	CPI	LF	; IF <LF>
	JZ	READ1	;   THEN IGNORE
	CPI	CR	; IF <CR>
	JZ	READ3	;   THEN <READ3>
	CPI	12H	; IF <CNTL-R>
	JZ	READ4	;   THEN <READ4> -- REPEAT LINE

	CALL	PUTIN	; PUT CHARACTER IN BUFFER

	MOV	A,B	; IF <B> .NE. <72>
	CPI	RBUFFL-2
	JNZ	READ1	;   THEN <READ1>
	MVI	C,87H	;   ELSE PRINT<BELL><CR><LF>
	CALL	CO
READ3:	MVI	A,CR	; PUT <CR><LF> IN BUFFER
	CALL	PUTIN
	MVI	A,LF
	CALL	PUTIN	;   AND ECHO CHARACTERS
	JMP	MOVE0	;      AND GOTO <MOVE0>

READ2:			; <RUBOUT>:
	MOV	A,B	; IF <B> = <0>
	ORA	A
	JZ	READ21	;   THEN <READ21>
	DCX	H	;   ELSE REMOVE AND ECHO CHARACTER 
	MOV	C,M 
	CALL	CO
	DCR	B	; IF (B = B-1) .GE. <0>
	JP	READ1	;   THEN GET MORE CHARACTERS
READ21:	XRA	A	;   ELSE <A = 0>
	POP	H
	RET		;      AND <RETURN>


PUTIN:	MOV	C,A
	CALL	CO
	MOV	M,A
	INX	H
	INR	B
	RET

$EJECT



READ4:			; <CNTL-R>:
	PUSH	H	; SAVE CURRENT INSERT POSITION
	PUSH	B	; SAVE CHARACTER COUNTER

	CALL	CRLF	; PRINT <CR><LF>

	MOV	A,B	; IF <B> = 0
	ORA	A
	JZ	READ42	;   THEN <READ42> -- RETURN

	LXI	H,INBUFA; HL => <LEN><MESSAGE>
	MOV	M,B	; INBUFA <= B
	CALL	PRINT	; ECHO ENTIRE MESSAGE

READ42:	POP	B	; RESTORE CHARACTER COUNTER
	POP	H	; RESTORE CURRENT INSERT POINTER
	JMP	READ1

$EJECT
;	(3) READL - READ CHARACTERS FROM FILE <:FN:XXXXXX.XXX>


READL:	XRA	A	; A <= 0
	MOV	C,A	; C <= # OF CHARACTERS MOVED INTO INBUFF
	LXI	D,INBUF	; DE => DESTINATION BUFFER

READL1:	LDA	DCTR	; A <= # OF CHARACTERS LEFT IN <DBUFF>
	MOV	B,A	; B <= # OF CHARACTERS LEFT IN <DBUFF>
	LHLD	DPTR	; HL => NEXT CHARACTER

READL2:	MOV	A,M	; A <= NEXT CHARACETER FROM <DBUFF>
	CPI	LF	; IF <LF>
	JZ	READL3	;   THEN <READL3> -- IGNORE
	STAX	D	; MOVE TO DESTINAION BUFFER
	INX	D	; UP DESTINATION POINTER
	INR	C	; UP DESTINATION COUNTER

	MOV	A,C	; IF LINE TOO LONG
	CPI	RBUFFL
	JNZ	READL3
	LXI	H,MESS2	;   THEN <'LINE TOO LONG'>
	CALL	PRINT
	JMP	READY	;   AND <READY>

READL3:	MOV	A,M	; RESTORE CHAR TO A-REG
	INX	H	; UP SOURCE POINTER
	DCR	B	; DECREMENT SOURCE COUNTER
	CPI	CR	; IF <CR>
	JZ	READL4	;   THEN <READL4> -- END-OF-LINE
	MOV	A,B	; IF <DBUFF NOT EMPTY>
	ORA	A
	JNZ	READL2	;   THEN <GET NEXT CHARACTER>
	CALL	DREAD	;   ELSE <REFILL DBUFF>
	JMP	READY	;   (READY IF <EOF>)
	JMP	READL1	;   THEN CONTINUE TRANSFER


READL4:	SHLD	DPTR	; SAVE POINTER TO <DBUFF>
	MOV	A,B 
	STA	DCTR	; SAVE SOURCE COUNTER
	JMP	MOVE0	; FINISH THE JOB WITH <MOVE0>



$EJECT
;	MOVE CHARACTERS FROM <SOURCE BUFFER><INBUF> 
;	 TO <DESTINATION BUFFER> <HL=TOS> AND 
;	  REMOVE ALL BLANKS EXCEPT THOSE BETWEN <">'S.
;	TERMINATE MOVE AT <CR>.

MOVE0:	XRA	A
	MOV	C,A	; C <= # OF CHARACTERS MOVED TO DESTINATION
	MOV	B,A	; B <= 0   (FALSE = NOT BETWEEN QUOTES)
	LXI	D,INBUF	; DE => <SOURCE> BUFFER <INBUF>
	POP	H
	PUSH	H	; HL => <DESTINATION BUFFER><HL>

MOVE1:	LDAX	D	; A <= NEXT SOURCE CHARACTER

	CPI	'"'	; IF <CHAR> = <">
	JNZ	MOVE2
	MOV	A,B
	CMA
	MOV	B,A	;   THEN <B> <= NOT<B>

MOVE2:	MOV	A,B	; IF <B> = <TRUE>
	ORA	A
	JNZ	MOVE3	;   THEN <MOVE3>

	LDAX	D	; IF <CHAR> = <BLANK>
	CPI	' '
	JZ	MOVE4	;   THEN <MOVE4> -- IGNORE IT

	CPI	CR	; IF <CR>
	JZ	MOVE5	;   THEN <MOVE5> -- TERMINATE MOVE

MOVE3:	LDAX	D	; ADD PARITY BIT TO <CHAR>
	ORI	80H
	MOV	M,A	;   AND PUT IN DESTINATION BUFFER
	INX	H	; UP DESTINATION POINTER
	INR	C	; UP DESTINATION COUNTER
	
MOVE4:	INX	D	; UP SOURCE POINTER
	JMP	MOVE1	; GET NEXT CHARACTER

MOVE5:	MOV	A,C	; A <= # OF CHARACTERS IN DESTINAION BUFFER
	POP	H	; HL => USER BUFFER
	RET

$EJECT
;	PROCESS  <LOAD :FN:XXXXXX.XXX>

;	THE LOAD PROCESSOR WILL CLOSE ANY OPEN FILE BECAUSE ONLY
;	ONE FILE IS PRESENTLY ALLOWED OPEN BY <BASIC>. IT WILL THEN
;	OPEN THE REQUESTED FILE FOR <READ/ONLY> ACCESS.

;	<DREAD> WILL BE CALLED TO READ THE FIRST 128 BYTES FROM 
;	DISC AND THEN SUBSEQUENT CALLS TO <READL> WILL READ LINES
;	FROM THE BUFFER INTO <INBUF>. THESE CALLS SHALL OPERATE 
;	IN THE SAME MANNER AS <READ> AND <READI> CALLS.

;	IF AN <EOF> IS DETECTED, THEN THE <LDFLAG> WILL BE CLEARED
;	AND THE FILE <CLOSED>. IF A LINE IS READ WHICH DOES NOT
;	START WITH A NUMBER, I.E., IT IS NOT A BASIC STATEMENT,
;	THEN <UNLOAD> WILL BE CALLED FROM <M4>.

LOAD:	CALL	ICE80	; IF IN <ICE80 DEBUG MODE>
	JMP	READY	;   THEN <READY>

	MVI	A,1	; 1 => FILE TO BE READ-ONLY
	CALL	OPEN	; PROCESS <LOAD :FN:XXXXXX.XXX>
	JMP	READY	; <READY> IF <NO FILE NAME> OR <ERROR>

	MVI	A,0FFH	; SET <LDFLAG> =
	STA	LDFLAG	;   TRUE
	INR	A	; A <= 0
	STA	EOFLAG	; EOFLAG <= FALSE

	CALL	DREAD	; PREPARE FOR <READL> CALLS
	JMP	READY	;   <EOF> ALREADY!

	JMP	M3	; -- <STATEMENTS NOW FROM FILE> --

;
;	UNLOAD SUBROUTINE - DISABLE <LOAD> FUNCTION DEFAULT TO <CI>
;
UNLOAD:	PUSH	PSW
	PUSH	B
	PUSH	H
	LDA	LDFLAG	; IF <LDFLAG> = <FALSE>
	ORA	A
	JZ	UNLOA1	;   THEN <RETURN>

	XRA	A	;   ELSE
	STA	LDFLAG	;      <LDFLAG> <= <FALSE>
	CALL	CLOSE	;   AND <CLOSE> DISC FILE
UNLOA1:	POP	H
	POP	B
	POP	PSW
	RET

LDFLAG:	DB	0	; 0 = FALSE, FFH = TRUE
EOFLAG:	DB	0	; 0 = FALSE, FFH = TRUE

$EJECT
;	<OPEN SUBROUTINE> - OPEN :FX:XXXXXX.XXX

;	MVI	A,ACCESS	; (1-READ, 2-WRITE, 3-UPDATE)
;	CALL	OPEN		; OPEN THE FILE IN <OAFT>
;	(P+3)			; <ERROR RETURN>
;	(P+6)			; <NORMAL RETURN>  <HL = OAFT>
;


OPEN:	STA	ACCESS	; ACCESS <= A   (1,2,3)

	LDA	CAFT	; IF <ANY FILE NOW OPEN>
	ORA	A
	CNZ	CLOSE	;   THEN <CLOSE>

	MVI	A,15	; A = LENGTH OF OFILE
	LXI	H,OFILE	; HL => OFILE
	CALL	GETST	; GET FILE NAME FROM INPUT BUFFER
;
	LDA	OFILE	; IF <NO FILE NAME>
	CPI	' '
	RZ		;   THEN (P+3) RETURN

	MVI	C,0	; 0 = <OPEN>
	LXI	D,OBLK	; DE => OBLK
	CALL	ISIS	; CALL <ISIS><OPEN>

	LDA	STAT1
	CALL	ETEST	; CHECK FOR STATUS ERROR
	RNZ		;   AND (P+3) RETURN IF ERROR

	LHLD	OAFT	; SET-UP FOR <CLOSE>---<DREAD>
	SHLD	CAFT	; CAFT <= OAFT
	SHLD	RDBLK	; RDBLK <= OPEN FILE AFTN

	JMP	RPLUS	; (P+6) RETURN



OBLK:	DW	OAFT		; OBLK => FILE NUMBER ASSIGNED BY ISIS
	DW	OFILE		; OFILE => 'FILE NAME' TO BE OPENED
ACCESS:	DW	1		; ACCESS <= (1-READ, 2-WRITE, 3-UPDATE)
ECHO:	DW	0		; ECHO <= 0 OR FILE # TO ECHO INPUT ON
	DW	STAT1


OAFT:	DW	0		; OAFT <= AFT (FILE #) OF FILE SELECTED
OFILE:	DS	15		; <:FN:XXXXXX.XXX>  FROM <LOAD> COMMAND


$EJECT
;	<DREAD SUBROUTINE> - PREPARE FOR <READL> CALLS
;	CALL	DREAD
;	<EOF RETURN>	(P+3)
;	<OK  RETURN>	(P+6)

;	<BC,DE> SAVED.


DREAD:
	LDA	EOFLAG	; IF <EOFLAG> = <TRUE>
	ORA	A
	RNZ		;   THEN (P+3) RETURN

	PUSH	B
	PUSH	D

	MVI	C,3	; <READ>
	LXI	D,RDBLK	; READ/DISC BLOCK
	CALL	ISIS
	LDA	STATUS
	CALL	ETEST	; CHECK FOR STATUS ERROR

	LXI	H,DBUFF	; HL => DBUFF
	SHLD	DPTR	; DPTR => DBUFF

	LDA	ACTUAL	; DCTR <=
	STA	DCTR	;          ACTUAL INPUT LENGTH
	PUSH	PSW	; SAVE ACTUAL LENGTH
	CPI	128	; IF <ACTUAL> .NE. <128>
	JZ	DREAD1
	MVI	A,0FFH
	STA	EOFLAG	;   THEN <EOFLAG> <= <TRUE>
	CALL	CLOSE	;   AND <CLOSE> THE FILE

DREAD1:	POP	PSW
	POP	D
	POP	B

	ORA	A	; IF <ACTUAL> = <0>
	RZ		;   THEN (P+3) RETURN
	JMP	RPLUS	;   ELSE (P+6) RETURN

RDBLK:	DW	0	; OPEN FILE AFTN
	DW	DBUFF	; => DISC INPUT BUFFER
	DW	128	; LENGTH OF DBUFF
	DW	ACTUAL	; => ACTUAL LENGTH AFTER READ
	DW	STATUS	; READ STATUS

DBUFF:	DS	128	; 128 BYTES
ACTUAL:	DS	2
STATUS:	DW	0
DPTR:	DW	0	; POINTER TO NEXT CHARACTER IN <DBUFF>
DCTR:	DB	0	; REMAINING CHARACTER COUNTER IN <DBUFF>

$EJECT
;	<CLOSE SUBROUTINE> - CLOSE

;	CLOSE THE FILE OPENED BY THE <OPEN> CALL ABOVE.


CLOSE:	CALL	ICE80	; IF IN <ICE80 DEBUG MODE>
	RET		;   THEN <RET>

	LDA	CAFT	; IF <NO FILE OPEN>
	ORA	A
	RZ		;   THEN <RETURN>

	MVI	C,1	; 1 = <CLOSE>
	LXI	D,CAFT
	CALL	ISIS

	XRA	A
	STA	CAFT	; CAFT <= 0  -- [NO FILE OPEN]

	LDA	STAT
	CALL	ETEST
	RET



CAFT:	DW	0		; CAFT = FILE AFTN (FILE #)
	DW	STAT

$EJECT
;
FILL:	CMA
FILL1:	INR	A	; IF REMAINING LENGTH .GE. 0
	RP		;  THEN RETURN
	MOV	M,B	; M[HL] = 'B'
	INX	H
	JMP	FILL1


;	<GET CHARACTER FROM INPUT BUFFER>
;
;	CHARACTER RETURNED IN A-REG
;	(P+3) RETURN - OUT OF DATA
;	(P+6) RETURN - CHARACTER IN A-REG
;
GCHAR:	LHLD	CPTR
	MOV	A,M
	INX	H	; CPTR <=
	SHLD	CPTR	;          CPTR+1
	ORA	A	; IF CHARACTER = NULL
	RZ		;  THEN (P+3) RETURN
	CPI	CR	; IF CHARACTER = <CR>
	RZ		;   THEN (P+6) RETURN
	POP	H
	INX	H
	INX	H
	INX	H
	PCHL		;  ELSE (P+3) RETURN

$EJECT
;
;	<GET STRING SUBROUTINE>
;
;	THIS SUBROUTINE WILL SCAN THE INPUT BUFFER FOR THE FIRST
;	BLANK <DELIMITER>. IT WILL THEN SCAN FOR THE FIRST NON-
;	BLANK <DELIMETER>, AND THEN WILL MOVE <A> CHARACTERS FROM
;	THE INPUT BUFFER TO THE DESTINATION BUFFER <HL>. 
;
;	INITIALLY, THE <A> CHARACTERS OF THE DESTINATION BUFFER
;	WILL BE FILLED WITH BLANKS.
;
;	THE SUBROUTINE IS USEFUL FOR TAKING APART COMMANDS SUCH
;	AS <LOAD :FN:XXXXXX.XXX>. 
;

GETST:	PUSH	PSW	; SAVE A-REG <LENGTH OF DESTINATION BUFFER>
	PUSH	H	; SAVE HL-REG <ADDRESS OF DESTINATION BUFFER>
	MVI	B,' '	; FILL DESTINATION BUFFER
	CALL	FILL	;   WITH BLANKS
;
GETS1:	CALL	GCHAR	; GET CHARACTER FROM INPUT BUFFER
	JMP	GEMPTY	; IF <EMPTY> THEN <GEMPTY>
	CPI	' '	; IF <NON-BLANK>
	JNZ	GETS1	;   THEN <GETS1>
;
GETS2:	CALL	GCHAR	; GET CHARACTER
	JMP	GEMPTY	; IF <EMPTY> THEN <GEMPTY>
	CPI	' '	; IF <BLANK>
	JZ	GETS2	;   THEN GETS2
;
	POP	D	; DE => DESTINATION ADDRESS
	POP	B	; B = CHARACTER COUNT
GETS3:	STAX	D	; MOVE CHARACTER TO DESTINATION BUFFER
	INX	D	; DE <= DE+1
	DCR	B	; IF DESTINATION BUFFER FULL
	RZ		;   THEN RETURN
	CALL	GCHAR	;   ELSE <GCHAR>
	JMP	GRET	; IF <EMPTY> THEN <GRET>
	JMP	GETS3	; PUT CHAR IN BUFFER
;
GEMPTY:	POP	H	; CLEAN UP STACK
	POP	PSW
GRET:	RET

$EJECT
;	<ERROR PROCESSING>
;
ETEST:	ORA	A	; IF <A> = 0
	RZ		;   THEN <RET>
	PUSH	PSW	; SAVE A-REG AND FLAGS AFTER (ORA A)
;
	LXI	H,MSG5	; <FILE ALREADY EXISTS>
	CPI	12	; IF <A> = 12
	JZ	ETES1	;   THEN <ETES1>
;
	LXI	H,MSG4	; <ERROR>---UNSPECIFIED
ETES1:	CALL	PRINT
	POP	PSW
	RET

$EJECT
;	<CONSTANTS AND VARIABLES AND MESSAGES AND BUFFERS>

CR	EQU	0DH	; ASCII <CR>
LF	EQU	0AH	; ASCII <LF>
STAT:	DS	2	; RETURN STATUS
RBUFFL	EQU	80	; LENGTH OF INPUT BUFFER
INBUFA:	DB	0	; MUST PRECEED INBUF
INBUF:	DS	RBUFFL	; INPUT BUFFER
	DB	0	; NULL AT END OF INPUT BUFFER

MSG4:	DB	9,CR,LF,'ERROR',CR,LF
MSG5:	DB	19,'FILE ALREADY OPEN',CR,LF
$EJECT
INSERT:	DCX	H
	MOV	M,C
	INX	H
	CALL	CVB
	CPI	5
	JC	ISR1A
	CNZ	WHAT
	MOV	A,E
	RAL
	CC	WHAT
ISR1A:	LHLD	NLINE
	MOV	M,D
	INX	H
	MOV	M,E
	LXI	H,NLINE
	CALL	PTVAL
	LHLD	STLINE
	CALL	CHK1
	JNC	ISRT3
	LHLD	NLINE
	SHLD	STLINE
ISRT1:	MVI	D,377Q
	MOV	E,D
	CALL	STPNT
	INX	H
ISRT2:	MOV	A,M
	ADI	5
	LHLD	NLINE
	ADD	L
	MOV	L,A
	MVI	A,0
	ADC	H
	MOV	H,A
	SHLD	NLINE
	RET
ISRT3:	SHLD	KLINE
ISRT4:	LXI	H,KLINE
	CALL	PTVAL
	LXI	H,NL2
	MOV	D,M
	INR	L
	MOV	E,M
	LXI	H,KL2
	MOV	B,M
	INR	L
	MOV	C,M
	CALL	DCOMP
	JZ	ISRT6
	JC	ISR12
	LHLD	KL4
	CALL	CHK1
	JC	ISRT5
	PUSH	H
	LHLD	KLINE
	SHLD	PLINE
	LXI	H,PLINE
	CALL	PTVAL
	POP	H
	SHLD	KLINE
	JMP	ISRT4
ISRT5:	LHLD	NLINE
	CALL	NOLINE
	RZ
	XCHG
	LHLD	KLINE
	CALL	STPNT
	XCHG
	JMP	ISRT1
ISRT6:	LHLD	NLINE
	CALL	NOLINE
	JNZ	ISRT8
	LHLD	STLINE
	XCHG
	LHLD	KLINE
	PUSH	H
	POP	B
	CALL	DCOMP
	LHLD	KL4
	JZ	ISRT7
	XCHG
	LHLD	PLINE
	CALL	STPNT
	RET
ISRT7:	SHLD	STLINE
	RET
ISRT8:	LHLD	KL4
	XCHG
	LHLD	NLINE
	CALL	STPNT
ISRT9:	LHLD	KLINE
	XCHG
	LHLD	STLINE
	PUSH	H
	POP	B
	CALL	DCOMP
	JZ	ISR11
	LHLD	NLINE
	XCHG
	LHLD	PLINE
	CALL	STPNT
ISR10:	LXI	H,NL6
	JMP	ISRT2
ISR11:	LHLD	NLINE
	SHLD	STLINE
	JMP	ISR10
ISR12:	LHLD	KLINE
	XCHG
	LHLD	NLINE
	CALL	NOLINE
	RZ
	CALL	STPNT
	JMP	ISRT9
$EJECT
; ROUTINE TO STORE POINTERS INTO MEM ARRAY
;
STPNT:	INX	H
	INX	H
	MOV	M,E
	INX	H
	MOV	M,D
	RET



;
; ROUTINE TO CHECK NEW LINE FOR SOURCE STMT.
;
NOLINE:	PUSH	H
	INX	H
	INX	H
	INX	H
	INX	H
	MOV	C,M
	INX	H
	CALL	LENGTH
	POP	H
	CMP	C
	RET
;
; ROUTINE TO RESPOND WITH 'WHAT?' FOR UNIDENTIFIED COMMAND
;
WHAT:	LXI	H,MESS7	; <'WHAT?'>
	CALL	PRINT
	JMP	READY


;
;	ROUTINE TO CHECK TO SEE IF IN ICE-80 DEBUG MODE
;
;	NOTE: SET-UP UNDER ICE80 WITH <CH MEM 40H = 76H>
;

ICE80:	LDA	ISIS	; IF <MEMORY LOCATION 40H> = <76H>
	CPI	76H
	RZ		;   THEN (P+3) RETURN

RPLUS:	XTHL
	INX	H
	INX	H
	INX	H
	XTHL
	RET		;   ELSE (P+6) RETURN

$EJECT
;  ROUTINES NUMB AND ALPHA CHECK IF CONTENTS OF MEMORY
;  LOCATION IN HL CONTAIN ASCII NUMERIC OR ALPHBETIC
; CHARACTER. RETURN CY=1 IF YES, CY=0 IF NO.
;
NUMB:	PUSH	B
	MVI	B,260Q
	MVI	C,272Q
C1:	MOV	A,M
	CMP	B
	CMC
	JNC	BAC
	CMP	C
BAC:	 POP	B
	RET
ALPHA:	PUSH	B
	MVI	B,301Q
	MVI	C,333Q
	JMP	C1


;
; ROUTINE TO INSURE SOURCE DOES NOT OVERFLOW MEM SPACE
; COMPARES CURENT MEM ADDRESS TO SP.
;
MEMFUL:	PUSH	B
	PUSH	D
	PUSH	H
	MVI	A,50
	ADD	L
	MOV	B,A
	MVI	A,0
	ADC	H
	MOV	C,A
	LXI	H,0
	DAD	SP
	MOV	D,L
	MOV	E,H
	CALL	DCOMP
	POP	H
	POP	D
	POP	B
	RNC
	LXI	H,MESS8	; <'MEMORY FULL',CR,LF>
	CALL	PRINT
	JMP	READY	; PRINT <'READY'>

$EJECT
;	CONSTANTS, VARIABLES AND MESSAGES


MESS1:	DB	9,CR,LF,'READY',CR,LF
MESS2:	DB	15,'LINE TOO LONG',CR,LF
MESS7:	DB	7,'WHAT?',CR,LF
MESS8:	DB	14,'MEMORY FULL',CR,LF

	END	BASIC