Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

!THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
!  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.

!COPYRIGHT (C) 1972,1981 BY DIGITAL EQUIPMENT CORPORATION
!AUTHOR: S. MURPHY/NEA/SJW/TFV

MODULE ARRXPN(SREG=#17,VREG=#15,FREG=#16,DREGS=4,RESERVE(0,1,2,3),GLOROUTINES) =
BEGIN

!	REQUIRES FIRST, TABLES

GLOBAL BIND ARRXPV = 6^24 + 0^18 + 53;	! Version Date: 24-Jul-81


%(

***** Begin Revision History *****

47	-----	-----	FIX BUG IN "PROARRXPN" TO CONVER SUBSCRIPTS OF
			PROTECTED ARRAYS TO INTEGER
48	-----	-----	CHANGE ERROR CALLS TO FATLERR/WARNERR
49	-----	-----	MAKE ONLIST A LOCAL ROUTINE
50	-----	-----	49 IS NOT ENOUGH. CHANGE THE ROUTINE NAME
			SO THAT WE CAN STILL ASSEMBLE WITH MACRO
51	-----	-----	MAKE PROARRXPN RESET BTTMMSTFLG SO THAT SUBPROGRAMS
			THAT ARE BOTTOM-MOST WILL SAVE/RESTORE 16 ANYWAY.
52	VER5	-----	MAKE SUBSCRIPT EXPR TRESS LEFT BALANCED

***** Begin Version 6 *****

53	761	TFV	1-Mar-80	-----
	Add KTYPCG for type conversions under /GFLOATING.

***** End Revision History *****

)%

	EXTERNAL
		MAKEPR,MAKPR1,TBLSEARCH,KTYPCB,CNSTCMB,SAVSPACE,ISN;
![761] KTYPCG for type conversions under /GFLOATING
%[761]%	EXTERNAL KTYPCG;
	EXTERNAL E27,E26;	!ERROR MESSAGE POINTERS
	FORWARD
		ARRXPND(2),
		ONLST(3);

EXTERNAL	CNVNODE;


SWITCHES NOLIST;
REQUIRE FIRST.BLI;
REQUIRE TABLES.BLI;
SWITCHES LIST;
SWITCHES NOSPEC;

GLOBAL ROUTINE ARRXPND(ARRNAMENTRY,SSLSTPTR)=
%(********
	THIS ROUTINE EXPANDS AN ARRAY ADDRESS CALCULATION.
	IT IS CALLED WITH THE ARGUMENTS
		ARRNAMENTRY - PTR TO THE SYMBOL TABLE ENTRY FOR THE ARRAY
				NAME
		SSLSTPTR- LH CONTAINS THE NUMBER OF SUBSCRIPTS MINUS 1
			RH IS A   PTR TO A LIST OF SUBSCRIPTS OF THE FORM
				PTR1
				PTR2
				.
				.
				.
				PTRN
			WHERE CT SPECIFIES THE NUMBER OF SUBSCRIPTS
			PTR1-PTRN ARE POINTERS TO EXPRESSION NODES FOR
			SUBSCRIPTS 1-N.

	THE ROUTINE FIRST CHECKS THAT THE NUMBER OF SUBSCRIPTS(SSLSTPTR<LEFT>
	IS EQUAL TO THE NUMBER OF DIMENSIONS. IF NOT THEN A
	FATAL ERROR MESSAGE IS GENERATED.

	THIS ROUTINE CREATES AN "ARRAYREF" NODE FOR THIS ARRAY REFERENCE
	AND RETURNS A POINTER TO IT.
********)%
BEGIN
	EXTERNAL FATLERR,ENTRY;
	EXTERNAL PROARRXPN;	!ROUTINE TO CREATE AN ARRAYREF NODE IN WHICH
				! THE SS IS A CALL TO THE LIBRARY ROUTINE
				! "PROAR.". USED FOR PROTECTED ARRAYS.
	MAP SYMTABENTRY ARRNAMENTRY;
	REGISTER SSLSTP1;
	OWN PEXPRNODE SSNODE;		!PTR TO EXPRESSION NODE FOR A GIVEN SUBSCRIPT
	OWN DIMENTRY ARRDIMENTRY;	!DIMENSION TABLE ENTRY FOR THIS ARRAY
	REGISTER DIMSUBENTRY DIMLSTPTR;	!SUBENTRY FOR A GIVEN DIMENSION
	OWN PEXPRNODE DIMFNODE;		!EXPRESSION NODE FOR THE "FACTOR" CORRES
					! PONDING TO THAT DIMENSION
	OWN SSVARFLG;			!THIS FLAG IS SET IF SOME PART OF
					! THE ADDRESS MUST BE COMPUTED AT RUN TIME
	OWN SSCNSTVAL;
	OWN PEXPRNODE SSCONSTPTR:SSVARPTR;
	OWN PEXPRNODE ARREFNODE;	!PTR TO ARRAY REF NODE BUILT
	OWN PEXPRNODE ARG1NODE:ARG2NODE;		!WHEN A SS IS ADD OR SUB THESE
							! PT TO THE 2 ARGS OF THAT OPERATOR


	ARRDIMENTRY_.ARRNAMENTRY[IDDIM];

	IF .ARRDIMENTRY[DIMNUM] NEQ (.SSLSTPTR<LEFT>+1)
	THEN  RETURN FATLERR( ARRNAMENTRY[IDSYMBOL],.ISN,E27<0,0>);
	     	!WRONG NUMBER OF SUBSCRIPTS



	%(***IF THE USER SPECIFIED THAT SUBSCRIPT BOUNDS CHECKING WAS TO
		BE PERFORMED ON ALL ARRAYS (BY USING THE "BOUNDS" SWITCH)
		DO NOT EXPAND THE ADDRESS CALCULATION - 
		INSTEAD CALL A FN AT RUN TIME WITH
		ALL THE INDIVIDUAL SUBSCRIPTS**)%
	IF  .FLGREG<BOUNDS> THEN RETURN PROARRXPN(.ARRNAMENTRY,.SSLSTPTR);


	%(***EXPAND ADDRESS CALCULATION. REPLACE THE SUBSCRIPT LIST BY EXPRESSION
		NODE FOR THE SUM OF THE PRODUCTS OF EACH SUBSCRIPT BY A FACTOR
		CORRESPONDING TO THAT DIMENSION OF THE ARRAY. KEEP SUM OF CONSTANT
		TERMS SEPARATE FROM SUM OF VARIABLE TERMS.
	***)%

	%(***INIT SUM OF CONSTANT TERMS TO 0**)%
	SSCNSTVAL_0;

	%(***INIT FLAG FOR "SOME PART OF THE ADDRESS CALC MUST BE DONE AT RUN TIME" TO FALSE***)%
	SSVARFLG_FALSE;


	%(***GET PTR TO DIMENSION SUBENTRY FOR 1ST DIMENSION OF THIS ARRAY**)%
	DIMLSTPTR_ARRDIMENTRY[FIRSTDIM];

	%(**GET PTR TO PTR TO NODE FOR 1ST SUBSCRIPT**)%
	SSLSTP1_.SSLSTPTR<RIGHT>;

	DECR CT FROM .SSLSTPTR<LEFT> TO 0
	DO
	BEGIN
		[email protected];
		DIMFNODE_.DIMLSTPTR[DIMFACTOR];

		%(****IF THIS SS IS NOT OF VALTYPE INTEGER, CONVERT IT***)%
		IF .SSNODE[VALTP1] NEQ INTEG1 THEN SSNODE_CNVNODE(.SSNODE,INTEGER,0);


		%(**MULTIPLY THE SUBSCRIPT BY A  FACTOR DETERMINED
			BY THE PRECEEDING DIMENSIONS****)%

		%(**THIS FACTOR MAY BE A VARIABLE, IF PRECEEDING DIMENSIONS
			WERE VARIABLES****)%

		IF .DIMLSTPTR[VARFACTFLG]
		THEN
		%(**IF FACTOR IS A VARIABLE, GENERATE NODES TO MULTIPLY SS BY THIS VARIABLE
			AND ADD IT INTO THE VARIABLE TERM**)%
		BEGIN
			SSNODE_MAKPR1(0,ARITHMETIC,MULOP,INDEX,.SSNODE,.DIMFNODE);
			IF .SSVARFLG
			THEN
			SSVARPTR_MAKPR1(0,ARITHMETIC,ADDOP,INDEX,.SSVARPTR,.SSNODE)
			ELSE
			BEGIN
				SSVARFLG_TRUE;
				SSVARPTR_.SSNODE;
			END;

		END

		ELSE

		%(*****IF FACTOR FOR THIS DIMENSION IS A CONSTANT (IE ALL PRECEEDING DIMENSIONS
		WERE OF CONSTANT SIZE)*********)%

		BEGIN
	
			%(***CHECK FOR A SUBSCRIPT OF THE FORM  "X+C" , "X-C", "C+X", "C-X"
				WHERE C IS A CONSTANT.  REMOVE THE CONSTANT PART OF THE
				PRODUCT OF "DIMENSION FACTOR" AND SUBSCRIPT AND 
				ADD IT INTO THE CONSTANT PORTION OF THE ADDRESS******)%
			IF ADDORSUB(SSNODE)
			THEN
			BEGIN
				ARG1NODE_.SSNODE[ARG1PTR];
				ARG2NODE_.SSNODE[ARG2PTR];
	
				IF .ARG2NODE[OPR1] EQL CONSTFL
				THEN
				%(***IF HAVE X+K OR X-K****)%
				BEGIN
					SSCNSTVAL_ (IF SUBORDIV(SSNODE)
						THEN (.SSCNSTVAL - .ARG2NODE[CONST2]*.DIMFNODE[CONST2])
						ELSE (.SSCNSTVAL + .ARG2NODE[CONST2]*.DIMFNODE[CONST2]));
					SSNODE_.ARG1NODE;
				END
				ELSE
				IF .ARG1NODE[OPR1] EQL CONSTFL
				THEN
				%(***IF HAVE K+X OR K-X*****)%
				BEGIN
					SSCNSTVAL_.SSCNSTVAL+.ARG1NODE[CONST2]*.DIMFNODE[CONST2];
					SSNODE_ (IF SUBORDIV(SSNODE)
						THEN
						MAKPR1(0,NEGNOT,NEGOP,INDEX,0,.ARG2NODE)
						ELSE .ARG2NODE);
				END
			END;

			IF .SSNODE[OPR1] EQL CONSTFL
			THEN
	
			%(***IF SS AND FACTOR ARE BOTH CONSTANTS, ADD
				THEIR PRODUCT INTO THE CONSTANT TERM FOR
				THIS ADDRESS CALCULATION
			***)%
			SSCNSTVAL_.SSCNSTVAL+.DIMFNODE[CONST2]*.SSNODE[CONST2]
	
	
			ELSE
			%(**IF SS IS A VARIABLE AND FACTOR IS A CONSTANT, GENERATE
				NODES TO MULTIPLY THEM AND ADD THE PRODUCT
				INTO THE VARIABLE TERM***)%
			BEGIN
				IF  .DIMFNODE[CONST2] NEQ 1
				THEN
				%(****IF FACTOR IS NOT 1, MULTIPLY BY IT***)%
				SSNODE_MAKPR1(0,ARITHMETIC,MULOP,INDEX,.SSNODE,.DIMFNODE);
				IF .SSVARFLG
				THEN
				SSVARPTR_MAKPR1(0,ARITHMETIC,ADDOP,INDEX,.SSVARPTR,.SSNODE)
				ELSE
				BEGIN
					SSVARFLG_TRUE;
					SSVARPTR_.SSNODE
				END
			END;
		END;

		SSLSTP1_.SSLSTP1+1;
		DIMLSTPTR_.DIMLSTPTR+DIMSUBSIZE;

	END;


	%(***ADD IN THE ARRAY OFFSET FOR THIS ARRAY -
		IF THE DIMENSIONS ARE CONSTANT THEN THIS WILL BE A CONSTANT
		AND SHOULD BE ADDED INTO THE CONSTANT TERM.
		IF THE DIMENSIONS ARE VARIABLE, THEN THIS VALUE WILL BE
		COMPUTED UPON ENTERING THE SUBROUTINE AND STORED IN A
		TEMPORARY WHICH SHOULD BE ADDED INTO THE VARIABLE TERM.
	*********)%

	IF .ARRDIMENTRY[ADJDIMFLG]
	THEN
	BEGIN
		IF .SSVARFLG
		THEN
		SSVARPTR_MAKPR1(0,ARITHMETIC,ADDOP,INDEX,.SSVARPTR,.ARRDIMENTRY[ARAOFFSET])
		ELSE
		BEGIN
			SSVARPTR_.ARRDIMENTRY[ARAOFFSET];
			SSVARFLG_TRUE
		END
	END
	ELSE
	BEGIN
		OWN PEXPRNODE OFFSETNODE;
		OFFSETNODE_.ARRDIMENTRY[ARAOFFSET];
		SSCNSTVAL_.SSCNSTVAL+.OFFSETNODE[CONST2];
	END;



	%(***IF THE ARRAY IS A FORMAL(AND THE ARRAY IS NOT ADJUSTABLY DIMENSIONED - IN WHICH CASE
		THE "OFFSET" VALUE INCLUDES THE BASE VAL), ADD THE BASE INTO THE VARIABLE TERM***)%
	IF  .ARRNAMENTRY[FORMLFLG] AND NOT .ARRDIMENTRY[ADJDIMFLG] 
	THEN
	BEGIN
		%(***IF ALREADY HAVE A VARIABLE TERM, ADD THE BASE INTO THAT EXPRESSION***)%
		IF .SSVARFLG
		THEN
		SSVARPTR_MAKPR1(0,ARITHMETIC,ADDOP,INDEX,.SSVARPTR,
				.ARRDIMENTRY[ARADDRVAR])	!PTR TO SYMBOL THAT
								! CONTAINS THE BASE ADDRESS
		ELSE
		%(***IF DO NOT YET HAVE A VARIABLE TERM, SET THE VARIABLE TERM
			TO BE THE BASE ADDRESS***)%
		BEGIN
			SSVARPTR_.ARRDIMENTRY[ARADDRVAR];
			SSVARFLG_TRUE
		END;
	END;


	%(****MAKE THE ARRAYREF NODE FOR THIS REFERENCE. ARG1PTR SHOULD PT TO THE
		SYMBOL TABLE ENTRY FOR THE ARRAY NAME; ARG2PTR SHOULD PT TO THE
		ADDRESS CALCULATION (OR BE EQUAL TO 0 IF NO RUNTIME CALCULATION
		IS NEEDED).

	********)%
	ARREFNODE_ MAKEPR(ARRAYREF,0,.ARRNAMENTRY[VALTYPE],.ARRNAMENTRY,
			(IF .SSVARFLG THEN .SSVARPTR ELSE 0) );

	%(***PUT THE CONSTANT TERM INTO THE ARRAYREF NODE (ONLY USE THE LAST 18 BITS.)***)%
	ARREFNODE[TARGET]_.SSCNSTVAL AND #777777;


	%(****RETURN THE SSLST TO FREE STORAGE***)%
	SAVSPACE(.SSLSTPTR<LEFT>,@SSLSTPTR);


	%(***IF SS CALCULATION IS A SINGLE DATA ITEM (OR CONSTANT), SET A2VALFLG ***)%
	SSNODE_.ARREFNODE[ARG2PTR];
	IF .SSNODE[OPRCLS] EQL DATAOPR OR .SSNODE EQL 0
	 THEN ARREFNODE[A2VALFLG]_1
	ELSE SSNODE[PARENT]_.ARREFNODE;

	RETURN .ARREFNODE;

END;	!END OF "ARRXPND"


GLOBAL ROUTINE PROARRXPN(ARRNAMENTRY,SSLSTPTR)=
%(***************************************************************************
	ROUTINE TO CREATE AN "ARRAYREF" NODE FOR A REFERENCE TO
	AN ELEMENT OF AN ARRAY ON WHICH ARRAY BOUNDS CHECKING IS
	TO BE PERFORMED. THE EXPRESSION FOR THE ADDRESS CALCULATION
	UNDER SUCH AN ARRAYREF WILL BE A FUNCTION-CALL NODE FOR
	A CALL TO THE LIBRARY FUNCTION "PROAR." WITH THE
	FOLLOWING PARAMETERS:
			SEQUENCE NUMBER OF STMNT CONTAING THIS REF
			POINTER TO THE DIMENSION-BLOCK FOR THIS ARRAY
			PTR TO 1ST SUBSCRIPT
			PTR TO 2ND SUBSCRIPT
			ETC.

	THE ARGUMENTS TO THIS ROUTINE ARE:
		ARRNAMENTRY - PTR TO THE SYMBOL TABLE ENTRY FOR THE ARRAY
			NAME
		SSLSTPTR -  LEFT HALF CONTAINS THE NUMBER OF SUBSCRIPTS
			MINUS 1
			RIGHT HALF IS A POINTER TO A LIST OF POINTERS TO
			EXPRESSION NODES FOR THE INDIVIDUAL SUBSCRIPTS
***************************************************************************)%
BEGIN
	EXTERNAL CORMAN,NAME,TBLSEARCH,ENTRY;
	EXTERNAL ISN;
	EXTERNAL MAKEPR;	!ROUTINE TO BUILD AN EXPRESSION NODE
	EXTERNAL SAVSPACE;	!RETURNS CORE TO FREE STORAGE
	STRUCTURE PVECTOR[I]=(@.PVECTOR+.I)<0,36>;	!STRUCTURE FOR A PTR TO A VECTOR

	MAP PVECTOR SSLSTPTR;
	MAP BASE ARRNAMENTRY;

	OWN BASE ARRDIMENTRY;	!DIMENSION TABLE ENTRY FOR THIS ARRAY
	REGISTER PEXPRNODE SSNODE;	!EXPRESSION NODE FOR A GIVEN SUBSCRIPT

	REGISTER PEXPRNODE FNCALLNODE;	!FUNCTION CALL NODE FOR THE CALL TO "PROAR."
	REGISTER ARGUMENTLIST ARGLST;	!ARG LIST FOR ARGS TO "PROAR."
	OWN BASE PROARSYM;	!SYMBOL TABLE ENTRY FOR THE FN NAME "PROAR."
	OWN PEXPRNODE ARREFNODE;	!THE ARRAY REF NODE BUILT HERE
 

	%(***RESET FLAG SO THAT 16 WILL ALWAYS BE SAVED/RESTORED***)%
	FLGREG<BTTMSTFL>_0;

	%(**GET CORE FORTHE ARGUMENT LIST**)%
	NAME<LEFT>_ARGLSTSIZE(.SSLSTPTR<LEFT>+1	!NUMBER OF SUBSCRIPTS
				+2);		! PLUS 2 IS THE NUMBER OF ARGS TO "PROAR."
	ARGLST_CORMAN();


	%(**GET THE SYMBOL TABLE ENTRY FOR THE ROUTINE NAME "PROAR."**)%
	NAME_IDTAB;
	ENTRY[0]_SIXBIT'PROAR.';
	PROARSYM_TBLSEARCH();	!MAKE THE SYM TABLE ENTRY IF THERE ISNT ONE
	PROARSYM[VALTYPE]_INTEGER;	!FILL IN TYPE FIELD
	PROARSYM[OPERSP]_FNNAME;


	%(**MAKE THE FUNCTION CALL NODE FOR THE CALL TO "PROAR."**)%
	FNCALLNODE_MAKEPR(FNCALL,LIBARY,INTEGER,.PROARSYM,.ARGLST);

	FNCALLNODE[VALTYPE]_INTEGER;

	ARGLST[ARGCOUNT]_.SSLSTPTR<LEFT>+1+2;		!NUMBER OF SUBSCRIPTS PLUS 2
	ARGLST[1,ARGNPTR]_MAKECNST(INTEGER,0,.ISN);	!1ST ARG IS SEQ NUMBER OF THIS STMNT
	ARGLST[1,AVALFLG]_1;
	ARRDIMENTRY_.ARRNAMENTRY[IDDIM];	!DIMENSION TABLE ENTRY FOR THE ARRAY
	ARGLST[2,ARGNPTR]_.ARRDIMENTRY[ARADLBL];	!2ND ARG IS THE LABEL THAT WILL BE ON
					! THE DIMENSION BLOCK FOR THIS ARRAY
	ARGLST[2,AVALFLG]_1;

	%(**HAVE A PARAMETER FOR EACH OF THE INDIVIDUAL SUBSCRIPTS**)%
	INCR I FROM 0 TO .SSLSTPTR<LEFT>
	DO
	BEGIN
		SSNODE_.SSLSTPTR[.I];	!EXPRESSION NODE FOR THIS SUBSCRIPT

		IF .SSNODE[VALTP1] NEQ INTEG1	!IF SUBSCRIPT IS NOT INTEGER
		THEN
		SSNODE_CNVNODE(.SSNODE,INTEGER,0);	! CONVERT IT

		ARGLST[.I+3,ARGNPTR]_.SSNODE;

		IF .SSNODE[OPRCLS] EQL DATAOPR	!IF SUBSCRIPT IS A LEAF
		THEN ARGLST[.I+3,AVALFLG]_1	! SET VALFLG IN ARG LIST
		ELSE SSNODE[PARENT]_.FNCALLNODE;	! OTHERWISE SET PARENT FOR THE SS EXPR
	END;

	SAVSPACE(.SSLSTPTR<LEFT>,.SSLSTPTR);	!RETURN THE SS LIST TO FREE STORAGE

	ARREFNODE_MAKEPR(ARRAYREF,0,.ARRNAMENTRY[VALTYPE],.ARRNAMENTRY,.FNCALLNODE);	!MAKE THE ARRAY REF NODE

	IF NOT .ARRDIMENTRY[ADJDIMFLG]	!IF THIS ARRAY IS NOT ADJUSTABLY DIMENSIONED,
	THEN				! THEN ADD THE CONSTANT OFFSET IN WITH
	BEGIN				! THE BASE ADDRESS
		OWN BASE OFFSETNODE;
		OFFSETNODE_.ARRDIMENTRY[ARAOFFSET];
		ARREFNODE[TARGET]_.OFFSETNODE[CONST2] AND #777777
	END;

	FNCALLNODE[PARENT]_.ARREFNODE;	!PARENT PTR IN THE FN CALL NODE
					! POINTS TO THE ARRAYREF NODE
	RETURN .ARREFNODE
END;







%(***OWN VARIABLES USED BY THE DATA-STMNT CHECKING ROUTINES BELOW***)%
OWN OINDEXLIST;	!OWN IN WHICH SAVE PTR TO LIST OF LEGAL INDICES AS RECURSE
			! THRU THE EXPRESSION TREES CHECKING FOR LEGAL SUBSCRIPTS
			! (SINCE FOR EACH CALL TO DATASUBCHK THIS THEN STAYS CONSTANT)
OWN OIXCT;		!OWN IN WHICH SAVE IXCT AS RECURSE


GLOBAL ROUTINE DATASUBCHK(DATACALLS,IXCT,INDEXLIST)=
%(***************************************************************************
	THIS ROUTINE CHECKS A LIST OF DATACALLS TO DETERMINE WHETHER THEY
	ARE LEGAL DATA-ITEMS FOR A DATA STATEMENT.
	IT IS CALLED WITH THE ARGS:
		DATACALLS- A LINKED LIST OF DATACALL NODES, DO-STMNT NODES, AND
			CONTINUE STMNT NODES. DATACALL NODES WHICH ARE INSIDE
			OF ANY IMPLIED DO-LOOPS ON THIS LIST WILL BE IGNORED.
		INDEXLIST- A LIST OF PTRS TO THE SYMBOL TABLE ENTRIES FOR ALL
			VARIABLES WHICH ARE DO-INDICES ON IMPLIED DO LOOPS THAT
			CONTAIN THE LIST OF DATACALLS WITHIN THEM
		IXCT- CT OF THE NUMBER OF INDICES ON INDEXLIST
	THIS ROUTINE CHECKS EACH DATACALL NODE ON THE LIST OF DATACALLS WHICH
	IS NOT INSIDE OF ANY DO-LOOPS THAT ARE ON THE LIST. FOR EACH ARRAYREF
	UNDER THESE TOP-LEVEL DATACALLS, IT CHECKS THAT THE ADDRESS CALCULATION
	INCLUDES NO OPERATIONS OTHER THAN ADD,SUB,MUL,AND DIV AND
	NO TERMS OTHER THAN INTEGER CONSTANTS AND VARIBLES WHICH ARE ON
	THE LIST "INDEXLIST" (IE WHICH ARE INDICES ON LOOPS THAT INCLUDE THESE
	DATACALLS)
	RETURNS TRUE IF THE ABOVE CONDITION IS SATISFIED.
***************************************************************************)%
BEGIN
	EXTERNAL FATLERR;
	EXTERNAL LEGLDATASUB;
	OWN BASE CDATAELEM;


	%(***IF SYNTAX DETECTED AN ERROR IN THIS STMNT EARLIER, THEN
		THIS ROUTINE WILL BE CALLED WITH "DATACALLS" EQUAL
		TO  #777777. IF SO, JUST RETURN***)%
	IF .DATACALLS EQL #777777 THEN RETURN FALSE;

	%(***PUT THE 2 ARGS INDEXLIST AND IXCT INTO "OWN" TYPE VARS SO DONT HAVE
		TO PASS THEM AS ARGS OVER AND OVER AS RECURSE (THEY NEVER CHANGE)***)%
	OINDEXLIST_.INDEXLIST;
	OIXCT_.IXCT;
	CDATAELEM_.DATACALLS;		!PTR TO 1ST ELEM ON DATA-ITEM LIST

	%(***GO THRU LIST OF DATA-ITEMS, EXAMINING ALL TOP-LEVEL DATACALLS***)%
	UNTIL .CDATAELEM EQL 0
	DO
	BEGIN
		IF .CDATAELEM[OPRCLS] EQL STATEMENT
		THEN
		BEGIN
			%(***WHEN ENCOUNTER A DO-STMNT, SKIP TO THE CONTINUE THAT
				TERMINATES THE DO***)%
			IF .CDATAELEM[SRCID] EQL DOID
			THEN
			BEGIN
				OWN BASE ENDLAB;
				ENDLAB_.CDATAELEM[DOLBL];
				CDATAELEM_.ENDLAB[SNHDR];
			END;
			%(***IGNORE CONTINUE STMNTS***)%
		END

		ELSE
		IF .CDATAELEM[OPERATOR] EQL DATACLFL
		THEN
		BEGIN
			OWN PEXPRNODE ARGNODE;
			ARGNODE_.CDATAELEM[DCALLELEM];

			%(***WANT TO EXAMINE THE ADDRESS CALC UNDER ANY ARRAYREF***)%
			IF .ARGNODE[OPRCLS] EQL ARRAYREF
			THEN
			BEGIN
				IF NOT LEGLDATASUB(.ARGNODE[ARG2PTR])
				%(***IF SUBSCRIPT CONTAINS VARIABLES NOT
					USED AS LOOP INDICES OR OPERATORS OTHER
					THAN +,-,*,/***)%
				THEN (FATLERR(.ISN,E26<0,0>);RETURN FALSE);
			END;

		END;
	CDATAELEM_.CDATAELEM[CLINK];
	END;

	RETURN TRUE;
END;




GLOBAL ROUTINE LEGLDATASUB(EXPRESSION)=
%(***************************************************************************
	CHECKS WHETHER THE ARG "EXPRESSION" IS A LEGAL SUBSCRIPT EXPRESSION
	FOR A DATACALL UNDER A DATASTATEMENT. THE GLOBAL "OINDEXLIST"
	IS ASSUMED TO HAVE BEEN SET UP TO CONTAIN A PTR TO A LIST OF
	PTRS TO SYMBOL TABLES ENTRIES FOR INDICES OF IMPLIED DO LOOPS THAT INCLUDE THE
	DATACALL NODE IN QUESTION.
	A SUBSCRIPT EXPRESSION IS LEGAL IFF ALL TERMS ARE EITHER INTEGER
	CONSTANTS OR VARIABLES ON "OINDEXLIST", AND ALL OPERATORS ARE
	ADD,SUB,MUL,OR DIV
***************************************************************************)%
BEGIN
	MAP PEXPRNODE EXPRESSION;

	IF .EXPRESSION EQL 0 THEN RETURN TRUE

	ELSE
	IF .EXPRESSION[OPERATOR] EQL INTCONST
	THEN RETURN TRUE			!INTEGER CONSTANT

	ELSE
	%(***FOR AN INTEGER VARIABLE, DETERMINE WHETHER IT IS ON THE LIST OF LEGAL VARIABLES***)%
	IF .EXPRESSION[OPR1] EQL VARFL
	THEN RETURN ONLST(.EXPRESSION,.OIXCT,.OINDEXLIST)	


	ELSE
	%(***FOR A LEGAL ARITHMETIC OP (ADD,SUB,MUL,OR DIV), DETERMINE THAT BOTH ARGS
		ARE LEGAL EXPRESSIONS***)%
	IF .EXPRESSION[OPRCLS] EQL ARITHMETIC AND .EXPRESSION[OPERSP] NEQ EXPONOP
	THEN
	BEGIN
		IF NOT LEGLDATASUB(.EXPRESSION[ARG1PTR])
		THEN RETURN FALSE
		ELSE
		RETURN LEGLDATASUB(.EXPRESSION[ARG2PTR])
	END

	ELSE
	%(***FOR OPERATION NEGATE (UNARY MINUS) - THE ARG MUST BE LEGAL***)%
	IF .EXPRESSION [OPR1] EQL NEGFL
	THEN RETURN LEGLDATASUB(.EXPRESSION[ARG2PTR])

	ELSE
	RETURN FALSE
END;




ROUTINE ONLST(VARTOMATCH,LSTLNTH,LISTTOMATCH)=
%(***************************************************************************
	DETERMINE WHETHER "VARTOMATCH" IS AN ELEMENT IN THE VECTOR POINTED TO
	BY "LISTTOMATCH". LSTLNTH IS THE NUMBER OF ELEMENTS ON LISTTOMATCH.
***************************************************************************)%
BEGIN
	%(***DEFINE A STRUCTURE FOR A PTR TO A VECTOR IN WHICH
		ONLY THE RIGHT HALF OF EACH ENTRY SHOULD BE EXAMINED***)%
	STRUCTURE PVECTOR[CT]=
	(@.PVECTOR+.CT)<0,18>;

	MAP PVECTOR LISTTOMATCH;

	INCR I FROM 0 TO (.LSTLNTH-1)
	DO
	BEGIN
		IF .LISTTOMATCH[.I] EQL .VARTOMATCH
		THEN RETURN TRUE
	END;

	%(***IF NEVER FIND IT***)%
	RETURN FALSE;
END;