/SUBS : FORTRAN SUBSCRIPT ROUTINE
/
/	SUBS^ IS EQUIVALENT TO THE STANDARD 'SUBSC' ROUTINE
/	IN ADDITION IT CHECKS FOR SUBSCRIPTS IN RANGE.
/
/	GEORGE GONZALEZ	2-JUL-78
/
/	27-JUL-81 JVE	ADDED SPACE TO 'SUB' ERR MSG TEXT
/	20-MAR-82 JVE	ALLOW MULTI-DIM ARRAYS TO BE > 2047 WORDS
/			SO ERROR MESSAGE PRINTS CORRECTLY.
/
/	INDIVIDUAL SUBSCRIPTS MUST BE  0 < I < 2048
/	FINAL INDEX MUST BE IN ARRAY.
/	ARRAY SIZE PASSED IN WORD 7 OF CALLER'S FIELD.
/
////
	ENTRY	SUBS^

	OPDEF	TADI	1400
	OPDEF	DCAI	3400
	OPDEF	JMPI	5400

	LAP


/ THE FOLLOWING CAN BE USED FOR DOUBLY OR SINGLY
/ SUBSCRIPTED ARRAYS.  ON ENTRY THE AC SHOULD BE
/ NEGATIVE FOR FLOATING POINT VARIABLES.  THIS MAY
/ BE ANY NEGATIVE NUMBER FOR SINGLY SUBSCRIPTED
/ VARIABLES, AND MUST BE THE FIRST DIMENSION FOR
/ DOUBLY SUBSCRIPTED VARIABLES.  SOME EXAMPLES
/ FOLLOW:	(TO LOAD THE I,JTH ELEMENT OF AN FP ARRAY)

/	TAD	(-M		/DIMENSIONS ARE M BY N
/	CALL 3,SUBS^
/	ARG J
/	ARG I
/	ARG ARRAY
/	LOC		/MUST BE A DUMMY VARIABLE
/	CALL 1,IFAD
/	ARG LOC

/ TO LOAD THE JTH ELEMENT OF AN INTEGER ARRAY:

/	CALL 2,SUBS^
/	ARG J
/	ARG INTARR
/	LOC		/STILL A DUMMY VARIABLE
/	TAD	I LOC


S1,	BLOCK	1		/ADDR OF 1ST SUBS^
S2,	BLOCK	1		/ADDR OF 2ND SUBS^
A,	BLOCK	2		/ADDR OF ARRAY
R,	BLOCK	1		/ADDR FOR RESULT
TM,	0
FL,	0		/DOUBLE SUBS^ FLAG
N,	0		/DIMENSION -- NEGATIVE IF FLOATING
AC,	0
MQ,	0
CTR,	0
DIV,	0
MAX,	0		/MAXIMUM SUBSCRIPT

SUBERR,	TEXT	'SUB '	/ERROR
SUBS^,	BLOCK	2	/ENTRY
	DCA	N		/SAVE THE DIMENSION
	TAD	N
	SPA		/... ALSO ABS VALUE
	CMA
	DCA	MQ

	CLA CLL CMA RAL /HOW MANY ARGS?
	TAD	SUBS^#
	DCA	10
	TAD	SUBS^
	DCA	SUB1

SUB1,	NOP		/REPLACED BY CDF
	TADI	(7	/GET MAX
	DCA	MAX
	TADI	10
	AND	(200
	SNA CLA		/DOUBLE SUBSCRIPTS?
	JMP	SB0

	TADI	10		/YES, GET SECOND ARG
	DCA	SB2
	TADI	10
	DCA	S2

	STA
SB0,	DCA	FL		/SET DBL SUBS^ FLAG
	TADI	10	/GET FIRST SUBS^
	DCA	SB1C
	TADI	10
	DCA	S1

	TADI	10	/GET ARRAY BASE
	DCA	A
	TADI	10
	DCA	A#

	TAD	SUBS^
	DCA	SUB2

	TADI	10	/GET RETURN ADDRESS
	DCA	R
	TAD	10
	IAC
	DCA	SUBS^#

	DCA	TM
	ISZ	FL		/DBL SUBSCRIPTING?
	JMP	SB1

	STL STA		/YES
SB2,	NOP		/CDF TO FIELD OF 2ND SUBSCRIPT
	TADI	S2
	SPA
	JMP	ERR	/BAD SECOND SUBSCRIPT

	SNA
	JMP	NOMULT	/NO MULT IF = 1

	DCA	DIV
	TAD	(-14
	DCA	CTR

BACK,
	SZL SPA		/SZL .AND. SPA (SKIP IF NO OVERFLOW)
	JMP	ERR	/TWO-DIM SUBSCRIPT OVERFLOW
	CLL RAL
	DCA	AC
	TAD	MQ
	CLL RAL
	DCA	MQ
	SZL
	TAD	DIV
	CLL
	TAD	AC
	ISZ	CTR
	JMP	BACK

	SZL		/SKIP IF NO OVERFLOW
	JMP	ERR	/TWO-DIM SUBSCRIPT OVERFLOW

NOMULT,	DCA	TM

SB1,	STL STA
SB1C,	HLT		/CDF FIRST SUBSCRIPT
	TADI	S1
	SPA
	JMP	ERR	/BAD FIRST SUBSCRIPT

	TAD	TM
	SZL
	JMP	ERR	/TWO-DIM SUBSCRIPT OVERFLOW
	DCA	TM

SUB2,	NOP		/REPLACED BY CDF
	TAD	A	/SET CDF OF ARRAY
	DCAI	R
	INC R

	TAD	TM
	STL CMA
	TAD	MAX
	SZL CLA
	JMP	ERR	/SUBSCRIPT LARGER THAN ARRAY SIZE

	TAD	N
	SPA CLA		/FIXED OR FLOATING
	TAD	TM
	CLL RAL
	TAD	TM
	TAD	A#
	DCAI	R	/SET ARRAY ADDRESS

	STL CLA RTL	/FAST 'RETRN SUBS^'
	TAD	SUBS^
	DCA	SUB3
SUB3,	NOP		/REPLACED BY 'CDF CIF'
	JMPI	SUBS^#

ERR,	CLA
	CALL	1,ERROR
	ARG	SUBERR

	END