$PAGELENGTH(66) XREF DEBUG PRINT(:LP:)
;
; LLL BASIC INTERPRETER - RUN SUBROUTINES
;
	NAME	BASIC5

;	REVISED CHARLES CHERNACK 12/11/77


	EXTRN	ZROL,CHKLC,WRIT,PAD
	EXTRN	FORM5,FORM6,READY,STPNT,MEMFUL
	EXTRN	DCOMP,CHK1,LENGTH

	PUBLIC	FSYM,ERROR
	PUBLIC	ERLN,ICP2,ICP4,ICP7,ICP8


MEMST	EQU	3200H			; MUST BE ON PAGE BOUNDARY
KLINE	EQU	MEMST+122Q		; POINTER TO CURRENT LINE - LINE INSERT
NXTSP	EQU	MEMST+131Q
STSPAC	EQU	MEMST+113Q		; START OF SYMBOL TABLE


	CSEG


$EJECT TITLE('RUN SUBROUTINES 12/11/77')
; ROUTINE TO OUTPUT ERROR MSG. TO USER.
; REG A CONTAINS BCD ERROR NUMBER, HL
; LOADED WITH VALUE OF KLINE.

ERROR:	LXI	H,READY		;RETURN ADDRESS
	PUSH	H		;PUT ON STACK
	MOV	D,A		;SAVE ERROR NUMB. IN D
	LXI	H,MESS3		; <CR,LF,'ERROR '>
	CALL	FORM5
	MVI	B,1		;INIT FOR PADS
	MOV	C,B		;INIT AS CNTR.
	MOV	A,D		;GET ERROR NUMB.
	RLC			;ROTATE HIGH 4 BITS TO LOW 4
	RLC
	RLC
	RLC
ERRR1:	ANI	17Q		;MASK
	ADI	260Q		;CONVERT TO ASCII
	CALL	PAD		;PAD IT
	MOV	A,D		;GET ERROR NUMB.
	DCR	C		;ANOTHER PASS?
	JP	ERRR1		;YES

ERLN:	LXI	H,MESS4		; <' IN LINE '>
	CALL	FORM5
	LHLD	KLINE
	INX	H
	INX	H
	INX	H
	INX	H
	MOV	C,M
	INX	H
	CALL	LENGTH
	MOV	C,A
	CALL	FORM6
	CALL	WRIT
	RET


;THIS ROUTINE INCREMENTS H AND L AND
;DECR. C(CHARS IN LINE) SHOULD C RESULT
;IN 0 THEN THE ERROR CORRES. TO ENTRY PNT.
;IS GIVEN
ICP7:	MVI	A,7
	JMP	INCPT
ICP8:	MVI	A,8
	JMP	INCPT
ICP4:	MVI	A,4
	JMP	INCPT
ICP2:	MVI	A,2
INCPT:	INX	H
	DCR	C
	RNZ
	JMP	ERROR
$EJECT
;FSYM FINDS SYMBOLS IN TABLE - USED BY <RUN> MODULE
;B,C CONTAIN SYMBOL
;RET WITH B,C,D,E SAME
;H AND L PNT TO VALUE (1ST BYTE)
;CY=1  => FOUND
;CY=0  AND A SCALAR VAR. => INSERTED
;	AND SET TO 0
;CY=0  AND AN ARRAY  => NO ACTION,
;	H AND L PNT TO LAST ENTRY IN SYMBOL TABLE


;	SYMBOL TABLE FORMAT:
;
;		BYTES 1-2	SYMBOL NAME
;		BYTES 3-4	BACK POINTER TO NEXT SYMBOL 
;				  OR 0FFFFH = <END>
;		BYTES 5-8	VALUE OF SYMBOL
;	       (BYTES 9-*)	ADDITIONAL IF ARRAY
FSYM:	PUSH	D
	XRA	A
	ORA	B		;SET CARRY IF NOT
	JZ	AR		 ;AN ARRAY AND SAVE
	CMC
AR:	PUSH	PSW
	LHLD	NXTSP	;GET NEXT AVAILABLE
	PUSH	B		;SPACE PNTR.
	MOV	B,H
	MOV	C,L		;CHECK TO SEE
	LHLD	STSPAC	 ;IF SYMBOL TABLE
	MOV	D,H		;EMPTY
	MOV	E,L
	CALL	DCOMP	;DOUBLE BYTE COMPARE
	POP	B		;GET VAR. BACK
	JZ	NOSYM
LUKON:	CALL	CHK1		;CHECK FOR END
	JC	NOENT
	MOV	D,H		;SAVE OLD PNTR
	MOV	E,L
	MOV	A,B
	CMP	M		;DO VARIABLES MATCH
	JNZ	NOMAT
	INX	H
	MOV	A,C
	CMP	M
	JZ	ENTRY
	DCX	H
NOMAT:	INX	H		;NO MATCH GET NEW PNT.
	INX	H
	MOV	A,M
	INX	H
	MOV	H,M
	MOV	L,A
	JMP	LUKON
$EJECT
;ARRIVE HERE IF SYMBOL TABLE IS EMPTY
NOSYM:	DCX	D		; =STSPAC-2 SO STPNT WORKS RIGHT
	DCX	D
;ARRIVE HERE WHEN NO ENTRY FOUND
NOENT:	LHLD	NXTSP	;ADD. OF FREE MEMORY
	XCHG		 ;TO DE, HL HAVE LAST SYM. TAB. ENTRY
	POP	PSW		;ARRAY?
	JNC	FBAC		;YES, RETURN
	CALL	CHKLC	;CHECK FOR PAGE BOUNDARY CROSSING
	CALL	STPNT	;UPDATE PNTR
	XCHG		 ;NXTSP TO HL
	MOV	M,B		;STORE VAR.
	INX	H
	MOV	M,C
	INX	H
	PUSH	H
	INX	H		;STORE NXTSP+8 IN NXTSP
	INX	H
	INX	H
	INX	H
	INX	H
	INX	H
	SHLD	NXTSP
	CALL	MEMFUL	 ;MEMORY FULL?
	POP	H		;SET FWD PNT. TO -1
	MVI	M,377Q
	INX	H
	MVI	M,377Q
	INX	H		;INIT TO FLT. PNT. 0
	CALL	ZROL
	ORA	A		;CLEAR CY
	JMP	FBAC		;RESET CARRY AND RETURN
ENTRY:	POP	PSW		;VAR FOUND
	INX	H		;MOVE PNT. TO FIRST BYTE
	INX	H		;OF FLT. PNT. NO.
	INX	H
	STC		;SET CY AND RET.
FBAC:	POP	D		;RESTORE D
	RET


CR	EQU	0DH
LF	EQU	0AH

MESS3:	DB	8,CR,LF,'ERROR '
MESS4:	DB	9,' IN LINE '

	END
$EJECT