BIPTRG.ASM

; [ This translation created 10-Feb-83 by Version 4.3 ]

	.RADIX  8		; To be safe

CSEG	SEGMENT PUBLIC 'CODESG' 
	ASSUME  CS:CSEG

INCLUDE	OEM.H

	TITLE   BIPTRG  BASIC Interpreter pointer get routines/WHG/PGA

	.RADIX	10

PC8A=0
TRSHHC=0
NECPPC=0
OLVPPC=0

	SUBTTL  DIMENSION & VARIABLE SEARCHING - PTRGET

DSEG	SEGMENT PUBLIC 'DATASG'		; Data Segment
	ASSUME DS:DSEG
	EXTRN	ARYTA2:WORD,ARYTAB:WORD,DIMFLG:WORD,STREND:WORD
	EXTRN	SUBFLG:WORD,TEMP2:WORD,TEMP3:WORD,VALTYP:WORD,VARTAB:WORD
	EXTRN	DSEGZ:WORD
	EXTRN	NAMBUF:WORD,NAMCNT:WORD,NAMTMP:WORD
	EXTRN	OPTVAL:WORD
	EXTRN	PARM1:WORD,PRMFLG:WORD,PRMLEN:WORD,DEFTBL:WORD,NOFUNS:WORD
	EXTRN	FAC:WORD,FACLO:WORD
DSEG	ENDS			; End of data degment externals

				; Code Segment ( terminated by END at bottom of file )


	EXTRN	BLTU:NEAR,ERRBS:NEAR,ERROR:NEAR,FCERR:NEAR
	EXTRN	GETSTK:NEAR,INTIDX:NEAR,ISLET:NEAR,ISLET2:NEAR,OMERR:NEAR
	EXTRN	REASON:NEAR,SNERR:NEAR
	EXTRN	REDDY:NEAR,POPHRT:NEAR,ERRDD:NEAR,RETVAR:NEAR,UMULT:NEAR

	EXTRN	CHRGTR:NEAR,DCOMPR:NEAR,SYNCHR:NEAR
	EXTRN	GETYPR:NEAR
	EXTRN	LOPFD1:NEAR,LOPFND:NEAR
	PUBLIC	NOTFDD,NOTFNS

	PUBLIC	PTRGET,BSERR,PTRGT2,DIM,NOARYS
	PAGE	
DIMCON:	DEC	BX		;SEE IF COMMA ENDED THIS VARIABLE
	CALL	CHRGTR
	JNZ	SHORT $+3
	RET			;IF TERMINATOR, GOOD BYE
	CALL	SYNCHR
	DB	OFFSET 44	;MUST BE COMMA
;
; THE "DIM" CODE SETS DIMFLG AND THEN FALLS INTO THE VARIABLE
; SEARCH ROUTINE. THE VARIABLE SEARCH ROUTINE LOOKS AT
; DIMFLG AT THREE DIFFERENT POINTS:
;
;       1) IF AN ENTRY IS FOUND, DIMFLG BEING ON INDICATES
;               A "DOUBLY DIMENSIONED" VARIABLE
;       2) WHEN A NEW ENTRY IS BEING BUILT DIMFLG'S BEING ON
;               INDICATES THE INDICES SHOULD BE USED FOR
;               THE SIZE OF EACH INDICE. OTHERWISE THE DEFAULT
;               OF TEN IS USED.
;       3) WHEN THE BUILD ENTRY CODE FINISHES, ONLY IF DIMFLG IS
;               OFF WILL INDEXING BE DONE
;
DIM:	MOV	CX,OFFSET DIMCON	;PLACE TO COME BACK TO
	PUSH	CX
	MOV	AL,LOW 200
	JMP	SHORT PTRGT1
				;MUST TURN THE MSB ON
;
; ROUTINE TO READ THE VARIABLE NAME AT THE CURRENT TEXT POSITION
; AND PUT A POINTER TO ITS VALUE IN [D,E]. [H,L] IS UPDATED
; TO POINT TO THE CHARACTER AFTER THE VARIABLE NAME.
; VALTYP IS SETUP. NOTE THAT EVALUATING SUBSCRIPTS IN
; A VARIABLE NAME CAN CAUSE RECURSIVE CALLS TO PTRGET SO AT
; THAT POINT ALL VALUES MUST BE STORED ON THE STACK.
; ON RETURN, [A] DOES NOT REFLECT THE VALUE OF THE TERMINATING CHARACTER
;
PTRGET:	XOR	AL,AL		;MAKE [A]=0
PTRGT1:
	MOV	BYTE PTR DIMFLG,AL	;FLAG IT AS SUCH
	MOV	CL,BYTE PTR [BX]	;GET FIRST CHARACTER IN [C]
PTRGT2:
	CALL	ISLET		;CHECK FOR LETTER
	JAE	SHORT ??L000
	JMP	SNERR		;MUST HAVE A LETTER
??L000:
	XOR	AL,AL
	MOV	CH,AL		;ASSUME NO SECOND CHARACTER
	MOV	BYTE PTR NAMCNT,AL	;ZERO NAMCNT
	INC	BX		;INCRMENT TEXT POINTER
	MOV	AL,BYTE PTR [BX]	;GET CHAR
	CMP	AL,LOW "."	;IS IT A DOT?
	JB	SHORT NOSEC	;TOO SMALL FOR ANYTHING REASONABLE
	JZ	SHORT ISSEC	;"." IS VALID VAR CHAR
	CMP	AL,LOW OFFSET "9"+1	;TOO BIG FOR NUMERIC?
	JAE	SHORT PTRGT3	;YES
	CMP	AL,LOW "0"	;IN RIGHT RANGE?
	JAE	SHORT ISSEC	;YES, WAS NUMERIC
PTRGT3:	CALL	ISLET2		;SET CARRY IF NOT ALPHABETIC
	JB	SHORT NOSEC	;ALLOW ALPHABETICS
ISSEC:	MOV	CH,AL		;IT IS A NUMBER--SAVE IN B
	PUSH	CX		;SAVE [B,C]
	MOV	CH,LOW 255	;[B] COUNTS THE CHARACTERS PAST #2
	MOV	DX,OFFSET NAMBUF-1	;THE PLACE TO PUT THE CHARACTERS
VMORCH:	OR	AL,LOW 128D	;EXTRA CHARACTERS MUST HAVE THE HIGH BIT ON
				;SO ERASE CAN SCAN BACKWARDS OVER THEM
	INC	CH		;INCREASE THE CHACRACTER COUNT
	MOV	DI,DX
	STOSB			;AND STORE INTO THE BUFFER
	INC	DX		;AND UPDATE THE BUFFER POINTER
	INC	BX		;INCREMENT TEXT POINTER
	MOV	AL,BYTE PTR [BX]	;GET CHAR
	CMP	AL,LOW OFFSET "9"+1	;TOO BIG?
	JAE	SHORT VMORC1	;YES
	CMP	AL,LOW "0"	;IN RANGE FOR DIGIT
	JAE	SHORT VMORCH	;YES, VALID CHAR
VMORC1:	CALL	ISLET2		;AS ARE ALPHABETICS
	JAE	SHORT VMORCH
	CMP	AL,LOW "."	;DOTS ALSO OK
	JZ	SHORT VMORCH	;SO EAT IT
	MOV	AL,CH		;CHECK FOR MAXIMUM COUNT
	CMP	AL,LOW OFFSET NAMLEN-1	;LIMITED TO SIZE OF NAMBUF ONLY
	JNAE	SHORT ??L001
	JMP	SNERR		;MUST BE BAD SYNTAX
??L001:
	POP	CX		;GET BACK THE STORED [B,C]
	MOV	BYTE PTR NAMCNT,AL	;ALWAYS SET UP COUNT OF EXTRAS
	MOV	AL,BYTE PTR [BX]	;RESTORE TERMINATING CHAR
NOSEC:
	CMP	AL,LOW OFFSET "%"+1	;NOT A TYPE INDICATOR
	JAE	SHORT TABTYP	;THEN DONT CHECK THEM
	MOV	DX,OFFSET HAVTYP	;SAVE JUMPS BY USING RETURN ADDRESS
	PUSH	DX
	MOV	DH,LOW 2	;CHECK FOR INTEGER
	CMP	AL,LOW "%"
	JNZ	SHORT $+3
	RET
	INC	DH		;CHECK FOR STRING
	CMP	AL,LOW "$"
	JNZ	SHORT $+3
	RET
	INC	DH		;CHECK FOR SINGLE PRECISION
	CMP	AL,LOW "!"
	JNZ	SHORT $+3
	RET
	MOV	DH,LOW 8	;ASSUME ITS DOUBLE PRECISION
	CMP	AL,LOW "#"	;CHECK THE CHARACTER
	JNZ	SHORT $+3
	RET			;WHEN WE MATCH, SETUP VALTYP
	POP	AX		;POP OFF NON-USED HAVTYP ADDRESS
TABTYP:	MOV	AL,CL		;GET THE STARTING CHARACTER
	AND	AL,LOW 127	;GET RID OF THE USER-DEFINED
				;FUNCTION BIT IN [C]
	MOV	DL,AL		;BUILD A TWO BYTE OFFSET
	MOV	DH,LOW 0
	PUSH	BX		;SAVE THE TEXT POINTER
	MOV	BX,OFFSET DEFTBL-"A"	;SEE WHAT THE DEFAULT IS
	ADD	BX,DX
	MOV	DH,BYTE PTR [BX]	;GET THE TYPE OUT OF THE TABLE
	POP	BX		;GET BACK THE TEXT POINTER
	DEC	BX		;NO MARKING CHARACTER
HAVTYP:	MOV	AL,DH		;SETUP VALTYP
	MOV	BYTE PTR VALTYP,AL
	CALL	CHRGTR		;READ PAST TYPE MARKER
	MOV	AL,BYTE PTR SUBFLG	;GET FLAG WHETHER TO ALLOW ARRAYS
	DEC	AL		;IF SUBFLG=1, "ERASE" HAS CALLED
	JNZ	SHORT ??L002
	JMP	ERSFIN		;PTRGET, AND SPECIAL HANDLING MUST BE DONE
??L002:
	JS	SHORT ??L003
	JMP	NOARYS		;NO ARRAYS ALLOWED
??L003:
	MOV	AL,BYTE PTR [BX]	;GET CHAR BACK
	SUB	AL,LOW "("	;ARRAY PERHAPS (IF SUBFLG SET NEVER WILL MATCH)
	JNZ	SHORT ??L004
	JMP	ISARY		;IT IS!
??L004:
	SUB	AL,LOW OFFSET "["-")"+1	;SEE IF LEFT BRACKET
	JNZ	SHORT ??L005
	JMP	ISARY		;IF SO, OK SUBSCRIPT
??L005:
NOARYS:	XOR	AL,AL		;ALLOW PARENS AGAIN
	MOV	BYTE PTR SUBFLG,AL	;SAVE IN FLAG LOCATION
	PUSH	BX		;SAVE THE TEXT POINTER
	MOV	AL,BYTE PTR NOFUNS	;ARE FUNCTIONS ACTIVE?
	OR	AL,AL
	MOV	BYTE PTR PRMFLG,AL	;INDICATE IF PARM1 NEEDS SEARCHING
	JZ	SHORT SNFUNS	;NO FUNCTIONS SO NO SPECIAL SEARCH
	MOV	BX,PRMLEN	;GET THE SIZE TO SEARCH
	MOV	DX,OFFSET PARM1	;GET THE BASE OF THE SEARCH
	ADD	BX,DX		;[H,L]= PLACE TO STOP SEARCHING
	MOV	ARYTA2,BX	;SET UP STOPPING POINT
	XCHG	BX,DX		;[H,L]=START [D,E]=END
	JMP	LOPFND
NOTFNS:	MOV	AL,BYTE PTR PRMFLG	;HAS PARM1 BEEN SEARCHED
	OR	AL,AL
	JZ	SHORT SMKVAR	;IF SO, CREATE VARIABLE
	XOR	AL,AL		;FLAG PARM1 AS SEARCHED
	MOV	BYTE PTR PRMFLG,AL
SNFUNS:	MOV	BX,ARYTAB	;STOPPING POINT IS [ARYTA2]
	MOV	ARYTA2,BX
	MOV	BX,VARTAB	;SET UP STARTING POINT
	JMP	LOPFND

; THIS ENTRY POINT IS FOR THOSE CALLERS WHO WANT TO RETURN
; FROM PTRGET WITHOUT CREATING A SYMBOL TABLE ENTRY IF THE
; VARIABLE IS NOT FOUND IN THE SYMBOL TABLE. PTRGET THEN RETURNS
; THROUGH VARNOT AND RETURNS WITH [D,E]=0 AND [A]=0
	PUBLIC	PTRGTN,PTRGTR
PTRGTN:	CALL	PTRGET		;CALL PTRGET
PTRGTR:	RET			;DONT CHANGE THIS SEQUENCE AS RETURN
				;ADDRESS IS CHECKED FOR

; THIS IS EXIT FOR VARPTR AND OTHERS
VARNOT:
	XOR	AL,AL		;MAKE SURE [AL]=0
	MOV	DH,AL		;ZERO [D,E]
	MOV	DL,AL
	POP	CX		;GET RID OF PUSHED [D,E]
	POP	SI		;XTHL
	XCHG	SI,BX
	PUSH	SI		;PUT RETURN ADDRESS BACK ON STACK
	RET			;RETURN FROM PTRGET

SMKVAR:	POP	BX		;[H,L]= TEXT POINTER
	POP	SI		;XTHL
	XCHG	SI,BX
	PUSH	SI		;[H,L]= RETURN ADDRESS
	PUSH	DX		;SAVE CURRENT VARIABLE TABLE POSITION
	MOV	DX,OFFSET PTRGTR	;ARE WE RETURNING TO PTRGTN?
	CMP	BX,DX		;COMPARE
	JZ	SHORT VARNOT	;YES.
	MOV	DX,OFFSET RETVAR	;DID EVAL CALL US?
	CMP	BX,DX		;IF SO, DON'T MAKE A NEW VARIABLE
	POP	DX		;RESTORE THE POSITION
	JZ	SHORT FINZER	;MAKE FAC ZERO (ALL TYPES) AND SKIP RETURN
	POP	SI		;XTHL
	XCHG	SI,BX
	PUSH	SI		;PUT RETURN ADDRESS BACK
	PUSH	BX		;PUT THE TEXT POINTER BACK
	PUSH	CX		;SAVE THE LOOKS
	MOV	AL,BYTE PTR VALTYP	;GET LENGTH OF SYMBOL TABLE ENTRY
	MOV	CH,AL		;[B]=VALTYP
	MOV	AL,BYTE PTR NAMCNT	;INCLUDE EXTRA CHARACTERS IN SIZE
	ADD	AL,CH
	INC	AL		;AS WELL AS THE EXTRA CHARACTER COUNT
	MOV	CL,AL		;[B,C]=LENGTH OF THIS VARIABLE
	PUSH	CX		;SAVE THE VALTYP ON THE STACK
	MOV	CH,LOW 0	;[B]=0
	INC	CX		;MAKE THE LENGTH INCLUDE
				;THE LOOKS TOO
	INC	CX
	INC	CX
	MOV	BX,STREND	;THE CURRENT END OF STORAGE
	PUSH	BX		;SAVE THIS #
	ADD	BX,CX		;ADD ON THE AMOUNT OF SPACE
				;EXTRA NOW BEING USED
	POP	CX		;POP OFF HIGH ADDRESS TO MOVE
	PUSH	BX		;SAVE NEW CANDIDATE FOR STREND
	CALL	BLTU		;BLOCK TRANSFER AND MAKE SURE
				;WE ARE NOT OVERFLOWING THE
				;STACK SPACE
	POP	BX		;[H,L]=NEW STREND
	MOV	STREND,BX	;STORE SINCE WAS OK
				;THERE WAS ROOM, AND BLOCK TRANSFER
				;WAS DONE, SO UPDATE POINTERS
	MOV	BX,CX		;GET BACK [H,L] POINTING AT THE END
				;OF THE NEW VARIABLE
	MOV	ARYTAB,BX	;UPDATE THE ARRAY TABLE POINTER
ZEROER:	DEC	BX		;[H,L] IS RETURNED POINTING TO THE
	MOV	BYTE PTR [BX],LOW 0	;END OF THE VARIABLE SO WE
	CMP	BX,DX		;ZERO BACKWARDS TO [D,E] WHICH
	JNZ	SHORT ZEROER	;POINTS TO THE START OF THE VARIABLE
	POP	DX		;[E]=VALTYP
	MOV	BYTE PTR [BX],DH	;VALTYP IS IN HIGH ORDER
	INC	BX
	POP	DX
	MOV	[BX],DX
	INC	BX		;PUT DESCRIPTION OF THIS VARIABLE
				;INTO MEMORY
	CALL	NPUTSB		;SAVE THE EXTRA CHARACTERS IN THE NAME
	XCHG	BX,DX		;POINTER AT VARIABLE INTO [D,E]
	INC	DX		;POINT AT THE VALUE
	POP	BX		;RESTORE THE TEXT POINTER
	RET	
;
; MAKE ALL TYPES ZERO AND SKIP RETURN
;
FINZER:
	EXTRN	$DZERO:NEAR
	CALL	$DZERO		;Really clear the entire FAC since
				;the 8086 math package doesn't
				;treat a number as zero just because
				;its exponent is zero like to 8080
				;math package does.
	CALL	GETYPR		;SEE IF ITS A STRING
	JNZ	SHORT POPHR2	;IF NOT, DONE
	MOV	BX,OFFSET DSEGZ	;ZERO IN THE DATA SEGMENT
	MOV	FACLO,BX	;POINTING AT A ZERO
POPHR2:	POP	BX		;GET THE TEXT POINTER
	RET			;RETURN FROM EVAL


	PAGE	
	SUBTTL  MULTIPLE DIMENSION CODE

;
; FORMAT OF ARRAYS IN CORE
;
; DESCRIPTOR 
;       LOW BYTE = SECOND CHARCTER (200 BIT IS STRING FLAG)
;       HIGH BYTE = FIRST CHARACTER
; LENGTH OF ARRAY IN CORE IN BYTES (DOES NOT INCLUDE DESCRIPTOR)
; NUMBER OF DIMENSIONS 1 BYTE
; FOR EACH DIMENSION STARTING WITH THE FIRST A LIST
; (2 BYTES EACH) OF THE MAX INDICE+1
; THE VALUES
;
ISARY:	PUSH	BX		;SAVE DIMFLG AND VALTYP FOR RECURSION
	MOV	BX,DIMFLG
	POP	SI		;XTHL
	XCHG	SI,BX
	PUSH	SI		;TEXT POINTER BACK INTO [H,L]
	MOV	DH,AL		;SET # DIMENSIONS =0
DSEG	SEGMENT PUBLIC 'DATASG'
	EXTRN	SARYFL:WORD
DSEG	ENDS
	DEC	AL		;SARYFL=^O377 - tells CALL that array element
	MOV	BYTE PTR SARYFL,AL	;has been scanned.
INDLOP:	PUSH	DX		;SAVE NUMBER OF DIMENSIONS
	PUSH	CX		;SAVE LOOKS
	MOV	DX,OFFSET NAMCNT	;POINT AT THE AREA TO SAVE
	MOV	SI,DX
	MOV	AL,[SI]		;GET LENGTH
	OR	AL,AL		;IS IT ZERO?
	JZ	SHORT SHTNAM	;YES, SHORT NAME
	XCHG	BX,DX		;SAVE THE TEXT POINTER IN [D,E]
	ADD	AL,LOW 2	;WE WANT SMALLEST INT .GE.(NAMCNT+1)/2
	RCR	AL,1
	MOV	CL,AL		;SEE IF THERE IS ROOM TO SAVE THIS STUFF
	CALL	GETSTK
	MOV	AL,CL		;RESTORE COUNT OF PUSHES
LPPSNM:	MOV	CL,BYTE PTR [BX]	;GET VALUES TO PUSH
	INC	BX
	MOV	CH,BYTE PTR [BX]
	INC	BX
	PUSH	CX		;AND DO THE SAVE
	DEC	AL		;[A] TIMES
	JNZ	SHORT LPPSNM
	PUSH	BX		;SAVE THE ADDRESS TO STORE TO
	MOV	AL,BYTE PTR NAMCNT	;SAVE THE NUMBER OF BYTES FOR A COUNT
	PUSH	AX
	XCHG	BX,DX		;RESTORE THE TEXT POINTER
	CALL	INTIDX		;EVALUATE INDICE INTO [D,E]
	POP	AX		;COUNT TELLING HOW MUCH TO RESTORE
	MOV	NAMTMP,BX	;SAVE THE TEXT POINTER
	POP	BX		;THE PLACE TO RESTORE TO
	ADD	AL,LOW 2	;CALCULATE BYTE POPS AGAIN
	RCR	AL,1
LPLNAM:	POP	CX
	DEC	BX
	MOV	BYTE PTR [BX],CH
	DEC	BX
	MOV	BYTE PTR [BX],CL
	DEC	AL		;LOOP [A] TIMES POPING NAME BACK INTO NAMBUF
	JNZ	SHORT LPLNAM
	MOV	BX,NAMTMP
	JMP	SHORT LNGNAM	;WAS LONG ONE
SHTNAM:	CALL	INTIDX		;EVALUATE IT
	XOR	AL,AL		;MAKE SURE NAMCNT=0
	MOV	BYTE PTR NAMCNT,AL
LNGNAM:
	MOV	AL,BYTE PTR OPTVAL	;SEE WHAT THE OPTION BASE IS
	OR	AL,AL
	JZ	SHORT OPTB0	;IF BASE 0 DO NOTHING
	OR	DX,DX		;CHECK FOR 0 SUBSCRIPT
				;WHICH IS ILLEGAL IN BASE 1
	JNZ	SHORT ??L006
	JMP	BSERR
??L006:
	DEC	DX		;ADJUST SUBSCRIPT
OPTB0:
	POP	CX		;POP OFF THE LOOKS
	POP	AX		; POP PSW
	XCHG	AL,AH
	SAHF			;[A] = NUMBER OF DIMENSIONS SO FAR
	XCHG	BX,DX		;[D,E]=TEXT POINTER
				;[H,L]=INDICE
	POP	SI		;XTHL
	XCHG	SI,BX
	PUSH	SI		;PUT THE INDICE ON THE STACK
				;[H,L]=VALTYP & DIMFLG
	PUSH	BX		;RESAVE VALTYP AND DIMFLG
	XCHG	BX,DX		;[H,L]=TEXT POINTER
	INC	AL		;INCREMENT # OF DIMENSIONS
	MOV	DH,AL		;[D]=NUMBER OF DIMENSIONS
	MOV	AL,BYTE PTR [BX]	;GET TERMINATING CHARACTER
	CMP	AL,LOW 44	;A COMMA SO MORE INDICES FOLLOW?
	JNZ	SHORT ??L007
	JMP	INDLOP		;IF SO, READ MORE
??L007:
	CMP	AL,LOW ")"	;EXPECTED TERMINATOR?
	JZ	SHORT DOCHRT	;DO CHRGET FOR NEXT ONE
	CMP	AL,LOW "]"	;BRACKET?
	JZ	SHORT ??L008
	JMP	SNERR		;NO, GIVE ERROR
??L008:
DOCHRT:	CALL	CHRGTR
SUBSOK:	MOV	TEMP2,BX	;SAVE THE TEXT POINTER
	POP	BX		;[H,L]= VALTYP & DIMFLG
	MOV	DIMFLG,BX	;SAVE VALTYP AND DIMFLG
	MOV	DL,LOW 0	;WHEN [D,E] IS POPED INTO PSW, WE
				;DON'T WANT THE ZERO FLAG TO BE SET, SO
				;"ERASE" WILL HAVE A UNIQUE CONDITION
	PUSH	DX		;SAVE NUMBER OF DIMENSIONS
	PUBLIC	ERSFIN
	JMP	SHORT LOPFD0
ERSFIN:	PUSH	BX		;SAVE THE TEXT POINTER
	LAHF			; PUSH PSW
	XCHG	AL,AH
	PUSH	AX
	XCHG	AL,AH		;SAVE A DUMMY NUMBER OF DIMENSIONS
				;WITH THE ZERO FLAG SET
LOPFD0:
;
; AT THIS POINT [B,C]=LOOKS. THE TEXT POINTER IS IN TEMP2.
; THE INDICES ARE ALL ON THE STACK, FOLLOWED BY THE NUMBER OF DIMENSIONS.
;
	MOV	BX,ARYTAB	;[H,L]=PLACE TO START THE SEARCH
	JMP	LOPFD1
	PUBLIC	ARYEXT
ARYEXT:
				;AND TRY AGAIN
	MOV	AL,BYTE PTR DIMFLG	;SEE IF CALLED BY "DIM"
	OR	AL,AL		;ZERO MEANS NO
	EXTRN	DDERR:NEAR
	JZ	SHORT ??L009
	JMP	DDERR		;PRESERVE [D,E], AND DISPATCH TO
??L009:
				;"REDIMENSIONED VARIABLE" ERROR
				;IF ITS "DIM" CALLING PTRGET
;
; TEMP2=THE TEXT POINTER
; WE HAVE LOCATED THE VARIABLE WE WERE LOOKING FOR
; AT THIS POINT [H,L] POINTS BEYOND THE SIZE TO THE NUMBER OF DIMENSIONS
; THE INDICES ARE ON THE STACK FOLLOWED BY THE NUMBER OF DIMENSIONS
;
	POP	AX		; POP PSW
	XCHG	AL,AH
	SAHF			;[A]=NUMBER OF DIMENSIONS
	MOV	CX,BX		;SET [B,C] TO POINT AT NUMBER OF DIMENSIONS
	JNZ	SHORT ??L010
	JMP	POPHRT		;"ERASE" IS DONE AT THIS POINT, SO RETURN
??L010:
				;TO DO THE ACTUAL ERASURE
	SUB	AL,BYTE PTR [BX]	;MAKE SURE THE NUMBER GIVEN NOW AND
				;AND WHEN THE ARRAY WAS SET UP ARE THE
				;SAME
	JNZ	SHORT ??L011
	JMP	GETDEF		;JUMP OFF AND READ
??L011:
				;THE INDICES....

BSERR:	MOV	DX,OFFSET ERRBS	;"SUBSCRIPT OUT OF RANGE"
	JMP	ERROR
;
; HERE WHEN VARIABLE IS NOT FOUND IN THE ARRAY TABLE
;
; BUILDING AN ENTRY:
; 
;       PUT DOWN THE DESCRIPTOR 
;       SETUP NUMER OF DIMENSIONS
;       MAKE SURE THERE IS ROOM FOR THE NEW ENTRY
;       REMEMBER VARPTR
;       TALLY=4 (VALTYP FOR THE EXTENDED)
;       SKIP 2 LOCS FOR LATER FILL IN -- THE SIZE
; LOOP: GET AN INDICE
;       PUT NUMBER +1 DOWN AT VARPTR AND INCREMENT VARPTR
;       TALLY= TALLY * NUMBER+1
;       DECREMENT NUMBER-DIMS
;       JNZ     LOOP
;       CALL REASON WITH [H,L] REFLECTING LAST LOC OF VARIABLE
;       UPDATE STREND
;       ZERO BACKWARDS
;       MAKE TALLY INCLUDE MAXDIMS
;       PUT DOWN TALLY
;       IF CALLED BY DIMENSION, RETURN
;       OTHERWISE INDEX INTO THE VARIABLE AS IF IT
;       WERE FOUND ON THE INITIAL SEARCH
;
NOTFDD:
	MOV	AL,BYTE PTR VALTYP	;GET VALTYP OF NEW VAR
	MOV	BYTE PTR [BX],AL	;PUT DOWN THE VARIABLE TYPE
	INC	BX
	MOV	DL,AL
	MOV	DH,LOW 0	;[D,E]=SIZE OF ONE VALUE (VALTYP)
	POP	AX		; POP PSW
	XCHG	AL,AH
	SAHF			;[A]=NUMBER OF DIMENSIONS
	JNZ	SHORT ??L012
	JMP	PTRRNZ		;CALLED BY CHAIN, JUST RETURN NON-ZERO
??L012:
	MOV	BYTE PTR [BX],CL	;PUT DOWN THE DESCRIPTOR
	INC	BX
	MOV	BYTE PTR [BX],CH
	CALL	NPUTSB		;STORE THE EXTRA CHARACTERS IN THE TABLE
	INC	BX
	MOV	CL,AL		;[C]=NUMBER OF TWO BYTE ENTRIES NEEDED
				;TO STORE THE SIZE OF EACH DIMENSION
	CALL	GETSTK		;GET SPACE FOR DIMENSION ENTRIES
	INC	BX		;SKIP OVER THE SIZE LOCATIONS
	INC	BX
	MOV	TEMP3,BX	;SAVE THE LOCATION TO PUT THE SIZE
				;IN -- POINTS AT THE NUMBER OF DIMENSIONS
	MOV	BYTE PTR [BX],CL	;STORE THE NUMBER OF DIMENSIONS
	INC	BX
	MOV	AL,BYTE PTR DIMFLG	;CALLED BY DIMENSION?
	RCL	AL,1		;SET CARRY IF SO
	MOV	AL,CL		;[A]=NUMBER OF DIMENSIONS
LOPPTA:
	JB	SHORT POPDIM
	LAHF
	PUSH	AX
	MOV	AL,BYTE PTR OPTVAL	;GET THE OPTION BASE
	XOR	AL,LOW 11	;MAP 0 TO 11 AND 1 TO 10
	MOV	CL,AL		;[B,C]=DEFAULT DIMENSION
	MOV	CH,LOW 0
	POP	AX
	SAHF
	JAE	SHORT NOTDIM	;DEFAULT DIMENSIONS TO TEN
POPDIM:	POP	CX		;POP OFF AN INDICE INTO [B,C]
	LAHF
	INC	CX		;ADD ONE TO IT FOR THE ZERO ENTRY
	SAHF
NOTDIM:	MOV	BYTE PTR [BX],CL	;PUT THE MAXIMUM DOWN
	LAHF
	PUSH	AX		;SAVE THE NUMBER OF DIMENSIONS AND
				;DIMFLG (CARRY)
	INC	BX
	MOV	BYTE PTR [BX],CH
	INC	BX
	CALL	UMULT		;MULTIPLY [B,C]=NEWMAX BY CURTOL=[D,E]
	POP	AX
	SAHF			;GET THE NUMBER OF DIMENSIONS AND
				;DIMFLG (CARRY) BACK
	DEC	AL		;DECREMENT THE NUMBER OF DIMENSIONS LEFT
	JNZ	SHORT LOPPTA	;HANDLE THE OTHER INDICES
	LAHF
	PUSH	AX		;SAVE DIMFLG (CARRY)
	MOV	CH,DH		;[B,C]=SIZE
	MOV	CL,DL
	XCHG	BX,DX		;[D,E]=START OF VALUES
	ADD	BX,DX		;[H,L]=END OF VALUES
	JAE	SHORT ??L013
	JMP	OMERR		;OUT OF MEMORY POINTER BEING GENERATED?
??L013:
	CALL	REASON		;SEE IF THERE IS ROOM FOR THE VALUES
	MOV	STREND,BX	;UPDATE THE END OF STORAGE
ZERITA:	DEC	BX		;ZERO THE NEW ARRAY
	MOV	BYTE PTR [BX],LOW 0
	CMP	BX,DX		;BACK AT THE BEGINNING?
	JNZ	SHORT ZERITA	;NO, ZERO MORE
	XOR	AL,AL		;MAKE SURE [AL]=0
	INC	CX		;ADD ONE TO THE SIZE TO INCLUDE
				;THE BYTE FOR THE NUMBER OF DIMENSIONS
	MOV	DH,AL		;[D]=ZERO
	MOV	BX,TEMP3	;GET A POINTER AT THE NUMBER OF DIMENSIONS
	MOV	DL,BYTE PTR [BX]	;[E]=NUMBER OF DIMENSIONS
	XCHG	BX,DX		;[H,L]=NUMBER OF DIMENSIONS
	ADD	BX,BX		;[H,L]=NUMBER OF DIMENSIONS TIMES TWO
	ADD	BX,CX		;ADD ON THE SIZE
				;TO GET THE TOTAL NUMBER OF BYTES USED
	XCHG	BX,DX		;[D,E]=TOTAL SIZE
	DEC	BX		;BACK UP TO POINT TO LOCATION TO PUT
	DEC	BX		;THE SIZE OF THE ARRAY IN BYTES IN.
	MOV	[BX],DX
	INC	BX
	INC	BX		;PUT DOWN THE SIZE
	POP	AX
	SAHF			;GET BACK DIMFLG (CARRY) AND SET [A]=0
	JB	SHORT FINNOW
;
; AT THIS POINT [H,L] POINTS BEYOND THE SIZE TO THE NUMBER OF DIMENSIONS
; STRATEGY:
;       NUMDIM=NUMBER OF DIMENSIONS
;       CURTOL=0
; INLPNM:GET A NEW INDICE
;       POP NEW MAX INTO CURMAX
;       MAKE SURE INDICE IS NOT TOO BIG
;       MUTLIPLY CURTOL BY CURMAX
;       ADD INDICE TO CURTOL
;       NUMDIM=NUMDIM-1
;       JNZ     INLPNM
;       USE CURTOL*4 (VALTYP FOR EXTENDED) AS OFFSET
;
GETDEF:	MOV	CH,AL		;[B,C]=CURTOL=ZERO
	MOV	CL,AL
	MOV	AL,BYTE PTR [BX]	;[A]=NUMBER OF DIMENSIONS
	INC	BX		;POINT PAST THE NUMBER OF DIMENSIONS
	DB	266O	; SKIP	;"MVI D," AROUND THE NEXT BYTE
INLPNM:	POP	BX		;[H,L]= POINTER INTO VARIABLE ENTRY
	MOV	DX,[BX]		;[D,E]=MAXIMUM FOR THE CURRENT INDICE
	INC	BX
	INC	BX
	POP	SI		;XTHL
	XCHG	SI,BX
	PUSH	SI		;[H,L]=CURRENT INDICE
				;POINTER INTO THE VARIABLE GOES ON THE STACK
	PUSH	AX		;SAVE THE NUMBER OF DIMENSIONS
	CMP	BX,DX		;SEE IF THE CURRENT INDICE IS TOO BIG
	JNAE	SHORT ??L014
	JMP	BSERR		;IF SO "BAD SUBSCRIPT" ERROR
??L014:
	CALL	UMULT		;CURTOL=CURTOL*CURRENT MAXIMUM
	ADD	BX,DX		;ADD THE INDICE TO CURTOL
	POP	AX		;GET THE NUMBER OF DIMENSIONS IN [A]
	DEC	AL		;SEE IF ALL THE INDICES HAVE BEEN PROCESSED
	MOV	CX,BX		;[B,C]=CURTOL IN CASE WE LOOP BACK
	JNZ	SHORT INLPNM	;PROCESS THE REST OF THE INDICES
	MOV	AL,BYTE PTR VALTYP	;SEE HOW BIG THE VALUES ARE
				;AND MULTIPLY BY THAT SIZE
	MOV	CX,BX		;SAVE THE ORIGINAL VALUE FOR MULTIPLYING
				;BY THREE
	ADD	BX,BX		;MULTIPLY BY TWO AT LEAST
	SUB	AL,LOW 4	;FOR INTEGERS AND STRINGS
				;NO MORE MULTIPLYING BY TWO
	JB	SHORT SMLVAL
	ADD	BX,BX		;NOW MULTIPLIED BY FOUR
	OR	AL,AL		;RE-GEN CONDITION CODES
	JZ	SHORT DONMUL	;IF SINGLE ALL DONE
	ADD	BX,BX		;BY EIGHT FOR DOUBLES
SMLVAL:
	OR	AL,AL		;FIX CC'S FOR Z-80
	JP	SHORT ??L015
	JMP	DONMUL		;FOR STRINGS
??L015:
	ADD	BX,CX		;ADD IN THE ORIGINAL
DONMUL:
	POP	CX		;POP OFF THE ADDRESS OF WHERE THE VALUES
				;BEGIN
	ADD	BX,CX		;ADD IT ONTO CURTOL TO GET THE
				;PLACE THE VALUE IS STORED
	XCHG	BX,DX		;RETURN THE POINTER IN [D,E]
FINNOW:	MOV	BX,TEMP2	;REGET THE TEXT POINTER
	RET	
PTRRNZ:	STC			;RETURN WITH NON-ZERO IN [A]
	SBB	AL,AL		;AND CONDITION CODES SET
	POP	BX		;RESTORE TEST POINTER
	RET	

;
; LONG VARIABLE NAME SUBROUTINES. AFTER THE NORMAL 2 CHARACTER NAME
; THE COUNT OF ADDITIONAL CHARACTERS IS STORED. FOLLOWING THIS
; COMES THE CHARACTFRS IN ORDER WITH THE HIGH BIT TURNED ON SO A BACKWARD
; SCAN IS POSSIBLE
;
	PUBLIC	IADAHL
IADAHL:	MOV	AL,BYTE PTR [BX]	;GET THE CHARACTER COUNT
	INC	BX
ADDAHL:	PUSH	CX		;ADD [A] TO [H,L]
	MOV	CH,LOW 0
	MOV	CL,AL
	ADD	BX,CX
	POP	CX		;RESTORE THE SAVED [B,C]
	RET	
NPUTSB:	PUSH	CX		;THIS ROUTINE STORE THE "LONG" NAME AT [H,L]
	PUSH	DX
	LAHF
	PUSH	AX
	MOV	DX,OFFSET NAMCNT	;POINT AT DATA TO SAVE
	MOV	SI,DX
	MOV	AL,[SI]		;GET THE COUNT
	MOV	CH,AL
	INC	CH		;[B]= NUMBER OF BYTES TO SAVE
SLPLNG:	MOV	SI,DX
	MOV	AL,[SI]		;FETCH STORE VALUE
	INC	DX
	INC	BX		;MOVE UP TO STORE NAME INTO TABLE
	MOV	BYTE PTR [BX],AL	;DO THE STORE
	DEC	CH		;AND REPEAT [B] TIMES
	JNZ	SHORT SLPLNG	;FOR THE COUNT AND DATA
	POP	AX
	SAHF
	POP	DX
	POP	CX
	RET	

	PAGE	
CSEG	ENDS
	END