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: NORMA ABEL/HPW/JNG/TFV/EGM/AHM

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

GLOBAL BIND DOXPNV = 6^24 + 0^18 + 88;	! Version Date:	13-Nov-81


%(

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

75	-----	-----	FIX ADJGEN TO CORRSPOND TO NEW DIMENSION ENTRY
76	-----	-----	FIX EDIT 75
77	-----	-----	REMOVE CODE THAT KEEPS ARRAY DIMENSIONS ASSOCIATED
			WITH ADJUSTABLE DIMENSIONS ACROSS ENTRIES
78	-----	-----	IN ADJGEN, SET THE "IDLIBFNFLG" IN THE SYMBOL TABLE
			ENTRIES FOR "ADJG." AND "ADJ1." (SO THAT CAN KNOW
			THAT THEY DONT CLOBBER ALL REGS AS OTHER CALLS DO)
79	-----	-----	DO NOT BUILD A REGCONTENTS NODE IN DOXPN
			(CLEVER BUT A BUMMER)

80	-----	-----	CLEAR THE NOALLOC BIT FOR PHASE 1, WHEN GENERATING TEMPORARIES
81	19130	433	IF ALL DO PARAMS KNOWN AT COMPILE TIME AND
			LOOP WILL BE XCT'D NEG OR ZERO TIMES, DO IT ONCE, (JNG)
82	19130	633	FIX 433 TO NOT WIPE OUT A CONSTANT TABLE ENTRY., (JNG)

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

83	761	TFV	1-Mar-80	-----
	Add indices for folding /GFLOATING and remove KA indices

84	772	EGM	5-Jun-80	29516
	Generate fatal error for adjustable dimension variable dimensioned
	after the fact.

88	1143	AHM	13-Nov-81
	More of edit 1136 to make  "data transfer" statements work as well  as
	"device control" statements.  Delete code in IODOXPN that  incremented
	the reference  count  for  labels  used in  END=  and  ERR=  in  "data
	transfer" statements.  BLDKEY now references those labels correctly.

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

)%

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

%*****
	TAKE A NUMBER AND MAKE 4 SIXBIT DIGITS OUT OF IT
	USED TO GENERATE TEMPORARY NAMES
*****%

MACRO MAKNAME(NUMB)=
	(.NUMB<9,3>+16)^18 + (.NUMB<6,3>+16)^12 + (.NUMB<3,3>+16)^6
	+ (.NUMB<0,3>+16)$;
FORWARD INITLTEMP,SSIZTMP;
GLOBAL ROUTINE DOXPN(CNODE)=
BEGIN


![761] KARIGB and KGFRL for folding /GFLOATING
%[761]%	EXTERNAL CORMAN,KARIGB,KARIIB;
	EXTERNAL C1L,C1H,C2L,C2H,TBLSEARCH,CNVNODE;
	EXTERNAL COPRIX,SPKABA,CNSTCM,EXPRTYPER,MAKPR1;
%[761]%	EXTERNAL KDPRL,KGFRL;
	!CREATE DO LOOP CONTROL EXPRESSION
	!CNODE POINTS TO DO STATEMENT ENCODED SOURCE
	MAP BASE CNODE;
	OWN	DOINITL,					!POINTER TO INITIAL VALUE
	DOULIM,						!POINTER TO UPPER LIMIT
	DOSTEPSIZ,					!POINTER TO STEP SIZE;0 IF STEP SIZE IS 1
	DOSYMBOL,					!POINTER TO INDUCTION VARABLE
	DOCESSOR,					!PREDECESSOR OF DO STATEMENT
	OPEXPR,						!TEMPORARY
	PEXPR;						!TEMPORARY
	OWN SSIZMINUSONEFLG;	!SET THIS FLAG IF STEP SIZE IS MINUS ONE
	OWN BASE T;		!TEMPORARY
	MAP PEXPRNODE DOCESSOR;
	MAP PEXPRNODE DOSYMBOL:DOINITL:DOULIM:DOSTEPSIZ:PEXPR:OPEXPR;

	!MACRO WILL MOVE LABEL ON THE DO STATEMENT ITSELF (IF ANY)
	!BACK TO THE STEP SIZE COMPUTATION OR INITIAL VALUE
	!COMPUTATION IF THESE ARE PRESENT
	MACRO ADJLAB=
		IF .CNODE[SRCLBL] NEQ 0 THEN
		BEGIN
			LOCAL BASE TMP;
			OPEXPR[SRCLBL]_.CNODE[SRCLBL];
			CNODE[SRCLBL]_0;
			TMP_.OPEXPR[SRCLBL];
			TMP[SNHDR]_.OPEXPR;
		END$;

	DOSYMBOL_.CNODE[DOSYM];
	!SET SYMBOL TABLE BIT TO INDICATE THIS VARIABLE IS
	!STORED INTO IN CASE IT IS AN ARGUMENT THAT NEEDS
	!STORING BACK
	DOSYMBOL[IDATTRIBUT(STORD)]_1;
	DOINITL_.CNODE[DOM1];
	DOULIM_.CNODE[DOM2];
	DOSTEPSIZ_.CNODE[DOM3];
	DOCESSOR_.CNODE[DOPRED];
	CNODE[NEDSMATRLZ]_1;		!SET BIT OPTIMIZER WILL RESET


	!IF EITHER OF THE LIMITS OR THE STEP SIZE IS A NEGATIVE OF A CONSTANT,
	! FOLD THAT NEGATION HERE SO THAT THE GENERATED CODE FOR
	!       DO 10 I=10,1,-1
	! WILL NOT TREAT THE -1 AS AN ARBITRARY EXPRESSION(SRM-FEB 9,1973)
	IF .DOINITL[OPR1] EQL NEGFL
	THEN
	BEGIN
		T_.DOINITL[ARG2PTR];	!ARG UNDER THE NEG
		IF .T[OPR1] EQL CONSTFL THEN DOINITL_NEGCNST(T);
	END;
	IF .DOULIM[OPR1] EQL NEGFL
	THEN
	BEGIN
		T_.DOULIM[ARG2PTR];	!ARG UNDER THE NEG
		IF .T[OPR1] EQL CONSTFL THEN DOULIM_NEGCNST(T);
	END;
	IF .DOSTEPSIZ[OPR1] EQL NEGFL
	THEN
	BEGIN
		T_.DOSTEPSIZ[ARG2PTR];	!ARG UNDER THE NEG
		IF .T[OPR1] EQL CONSTFL THEN DOSTEPSIZ_NEGCNST(T);
	END;


	!IF EITHER OF THE LIMITS OR THE STEP SIZE HAS A DIFFERENT VAL-TYPE FROM
	! THE INDUCTION VARIABLE, MUST PERFORM TYPE CONVERSION (SRM-OCT 6,1972)
	IF .DOINITL[VALTP2] NEQ .DOSYMBOL[VALTP2] THEN DOINITL_CNVNODE(.DOINITL,.DOSYMBOL[VALTYPE],0);
	IF .DOULIM[VALTP2] NEQ .DOSYMBOL[VALTP2] THEN DOULIM_CNVNODE(.DOULIM,.DOSYMBOL[VALTYPE],0);
	IF .DOSTEPSIZ[VALTP2] NEQ .DOSYMBOL[VALTP2] THEN DOSTEPSIZ_CNVNODE(.DOSTEPSIZ,.DOSYMBOL[VALTYPE],0);




	IF .DOSYMBOL[VALTP1] NEQ INTEG1
	THEN
		 CNODE[REALARITH]_1;


	!LOOK AT THE STEP SIZE


	SSIZMINUSONEFLG_FALSE;		!FLAG FOR STEP SIZE = -1, INIT TO FALSE

	IF .DOSTEPSIZ[OPR1] EQL CONSTFL THEN
	BEGIN
		!CHECK FOR STEP SIZES ONE AND MINUS ONE
		IF .DOSTEPSIZ[VALTYPE] EQL REAL THEN
		BEGIN
			%(***FOR REALS- MUST ROUND FROM 2 WDS OF PREC TO ONE BEFORE
				EXAMINING THE VALUE (KEEP THEM AS UNROUNDED 2 WD VALS
				INSIDE THE COMPILER) ***)%
			C1H_.DOSTEPSIZ[CONST1];	!SET GLOBALS FOR THE ASSEMBLY LANG
			C1L_.DOSTEPSIZ[CONST2];		! THAT ROUNDS THE CONST
![761] Choose index for folding based on /GFLOATING
%[761]%			IF .GFLOAT
%[761]%				THEN COPRIX_KGFRL
%[761]%				ELSE COPRIX_KDPRL;

			CNSTCM();			!ROUND - LEAVE RESULT IN C2H

			IF .C2H EQL #201400000000 THEN
				CNODE[SSIZONE]_1
			ELSE IF .C2H EQL #576400000000
			THEN
				SSIZMINUSONEFLG_TRUE
		END ELSE
		IF .DOSTEPSIZ[VALTP1] EQL INTEG1 THEN
		BEGIN
			IF .DOSTEPSIZ[CONST2] EQL 1 THEN
				CNODE[SSIZONE]_1
			ELSE IF .DOSTEPSIZ[CONST2] EQL -1 THEN
				SSIZMINUSONEFLG_TRUE
		END
		ELSE
		%(***FOR DOUBLE PRECISION AND COMPLEX - DONT BOTHER OPTIMIZING THE -1 CASE***)%
		BEGIN
			IF .DOSTEPSIZ[CONST1] EQL #201400000000 AND .DOSTEPSIZ[CONST2] EQL 0
			THEN CNODE[SSIZONE]_1
		END;

	END;		!STEP SIZE NOT A CONSTANT
	IF .DOSTEPSIZ[OPRCLS] NEQ DATAOPR THEN
	BEGIN
		!STEP SIZE REALLY REQUIRES A COMPUTATION.
		!MAKE AN ASSIGNMENT STATEMENT FOR IT AND PUT
		!IT IN FRONT OF THE DO STATEMENT
		NAME<LEFT>_ASGNSIZ+SRCSIZ;
		OPEXPR_CORMAN();
		!LINK IT IN
		DOCESSOR[SRCLINK]_.OPEXPR;
		OPEXPR[SRCLINK]_.CNODE;
		!SET VAL FLG IN STATEMENT NODE
		OPEXPR[A1VALFLG]_1;
		OPEXPR[OPRCLS]_STATEMENT;
		OPEXPR[SRCID]_ASGNID;
		OPEXPR[LHEXP]_SSIZTMP(.DOSTEPSIZ[VALTYPE]);
		DOSTEPSIZ[PARENT]_.OPEXPR;
		OPEXPR[RHEXP]_.DOSTEPSIZ;
		!FIX FIELDS IN DO STATMENT NODE
		CNODE[DOPRED]_.OPEXPR;
		!FIX LOCALS
		DOCESSOR_.OPEXPR;
		DOSTEPSIZ_.OPEXPR[LHEXP];
		!SET FLAG
		CNODE[SSIZINTMP]_1;
		!MOVE THE LABEL BACK
		ADJLAB;
	END;


		CNODE[DOSSIZE]_.DOSTEPSIZ;
		CNODE[DOCTLVAR]_SSIZTMP(INTEGER);






	PEXPR_0;

	%(***SET "PEXPR" TO POINT TO AN EXPRESSION NODE FOR "M2-M1"
		THIS WILL BE USED IN THE COMPUTATION OF THE LOOP ITERATION CT***)%
	IF .DOULIM[OPR1] EQL CONSTFL AND .DOINITL[OPR1] EQL CONSTFL THEN
	BEGIN
		COPRIX_KKARITHOP(.DOINITL[VALTP1],SUBOP);
		C1H_.DOULIM[CONST1];
		C1L_.DOULIM[CONST2];
		C2H_.DOINITL[CONST1];
		C2L_.DOINITL[CONST2];
		CNSTCM();
		PEXPR_MAKECNST(.DOINITL[VALTYPE],.C2H,.C2L);
	END

	ELSE
	!IF NOT BOTH CONSTANTS, BUILD EXPRESSION
	BEGIN
		!BUILD AN EXPRESSION NODE
		!CHECK THE PROPERTIES OF THE INITIAL VALUE
		!BAD RESULTS (IN CODE) IF IT IS A CONSTANT EXPRESSION
		!AS WE WILL NOT FOLD IT HERE

		!IF INITIAL VAL IS AN EXPRESSION, BUILD AN ASSIGNMENT
		!STMNT TO A TEMPORARY FOR THAT EXPRESSION
		!INSERT THAT ASSIGNMENT STMNT BEFORE THE DO STMNT
		IF .DOINITL[OPRCLS] NEQ DATAOPR THEN
		BEGIN
			CNODE[INITLTMP]_1;	!SET FLAG
			!MAKE AN ASSIGNMENT STATEMENT FOR IT
			!OPEXPR IS USED AS A TEMPORARY
			NAME<LEFT>_ASGNSIZ+SRCSIZ;
			OPEXPR_CORMAN();
			!LINK IT IN FRONT OF THE DO STATEMENT
			DOCESSOR[SRCLINK]_.OPEXPR;
			OPEXPR[SRCLINK]_.CNODE;
			!SET APPROPRIATE FLAGS
			OPEXPR[A1VALFLG]_1;		!THE TEMP
			OPEXPR[OPRCLS]_STATEMENT;
			OPEXPR[SRCID]_ASGNID;
							!GENERATE TEMPORARY
							!FOR INITIAL
							!VALUE
			OPEXPR[LHEXP]_INITLTEMP(.DOINITL[VALTYPE]);
			OPEXPR[RHEXP]_.DOINITL;
			DOINITL[PARENT]_.OPEXPR;
			!RESET DOPRED  IN THE DO STATEMENT
			CNODE[DOPRED]_.OPEXPR;
			!RESET MY LOCALS FOR THE RIGHT THING
			DOINITL_.OPEXPR[LHEXP];
			DOCESSOR_.OPEXPR;
			!MOVE THE LABEL BACK IF THERE IS ONE
			ADJLAB;
		END;


		%(***MAKE EXPRESSION NODE FOR FINAL VALUE(POSSIBLY AN EXPRESSION)
			MINUS INITIAL VALUE (ALWAYS EITHER A DATAOPR OR THE REGCONTENTS
			NODE JUST BUILT) ****)%
		PEXPR_MAKPR1(.CNODE,ARITHMETIC,SUBOP,.DOULIM[VALTYPE],.DOULIM,.DOINITL);

		PEXPR[A2VALFLG]_1;	!ARG2 OF THE SUBTRACT IS EITHER A DATAOPR OR A REGCONTENTS
					! HENCE SHOULD ALWAYS HAVE VALFLG SET ABOVE IT
		OPEXPR_.PEXPR[ARG1PTR];	!IF ARG1 IS A DATAOPR, SET THE VALFLG ABOVE IT

		PEXPR[A1VALFLG]_.OPEXPR[OPRCLS] EQL DATAOPR;
	END;


	!NOW MAKE THE LOOP CONTROL EXPRESSION

	IF NOT .CNODE[SSIZONE] THEN
	BEGIN
		OPEXPR_.PEXPR;
		IF .DOSTEPSIZ[OPR1] EQL CONSTFL AND .PEXPR[OPR1] EQL CONSTFL
			AND .PEXPR[VALTYPE] NEQ COMPLEX   !CANNOT FOLD COMPLEX DIVIDE
		 THEN
		BEGIN
			!CONSTANTS OF SAME TYPE
			COPRIX_KKARITHOP(.PEXPR[VALTP1],DIVOP);
			C1H_.PEXPR[CONST1];
			C1L_.PEXPR[CONST2];
			C2H_.DOSTEPSIZ[CONST1];
			C2L_.DOSTEPSIZ[CONST2];
			CNSTCM();
			PEXPR_MAKECNST(.PEXPR[VALTYPE],.C2H,.C2L);
		END
		ELSE
		IF .SSIZMINUSONEFLG
		THEN
		BEGIN
			!FOR STEP SIZE EQUAL TO MINUS 1, NEGATE THE DIFFERENCE BETWEEN
			! THE BOUNDS RATHER THAN DIVIDING IT BY -1
			PEXPR_MAKPR1(.CNODE,NEGNOT,NEGOP,.PEXPR[VALTYPE],0,.PEXPR);
			IF .OPEXPR[OPR1] EQL DATAOPR 
			THEN PEXPR[A2VALFLG]_1
			ELSE OPEXPR[PARENT]_.PEXPR;
		END
		ELSE
		BEGIN
			PEXPR_MAKPR1(.CNODE,ARITHMETIC,DIVOP,.PEXPR[VALTYPE],.PEXPR,.DOSTEPSIZ);
			IF .OPEXPR[OPRCLS] NEQ DATAOPR	!(IF OPEXPR IS A SCALAR VARIABLE,
			THEN				! DO NOT SET PARENT PTR IN IT - SRM)
			OPEXPR[PARENT]_.PEXPR;
			!CHECK OUT THE VALFLAGS
			OPEXPR_.PEXPR[ARG1PTR];
			PEXPR[A1VALFLG]_.OPEXPR[OPRCLS] EQL DATAOPR;
			OPEXPR_.PEXPR[ARG2PTR];
			PEXPR[A2VALFLG]_.OPEXPR[OPRCLS] EQL DATAOPR;
		END;
	END;

	!CONVERT THE QUOTIENT(WHICH IS TO BE USED AS A LOOP COUNT) TO INTEGER
	! IF IT IS NOT INTEGER
	IF .PEXPR[VALTYPE] NEQ INTEGER THEN
	PEXPR_CNVNODE(.PEXPR,INTEGER,0);

	!ADD ONE TO THE QUOTIENT (WHICH HAS BEEN CONVERTED TO INTEGER)
	IF .PEXPR[OPR1] EQL CONSTFL
	THEN
	BEGIN
		!MAKE DO LOOPS LIKE I=10,1,1 BE EXECUTED ONCE
%[633]%		IF .PEXPR[CONST2] LSS 0
%[633]%		THEN
%[633]%			PEXPR_MAKECNST(INTEGER,0,1)
%[633]%		ELSE
%[633]%			PEXPR_MAKECNST(INTEGER,0,.PEXPR[CONST2]+1)
	END
	ELSE
	BEGIN
		OPEXPR_MAKECNST(INTEGER,0,1);
		PEXPR_MAKPR1(.CNODE,ARITHMETIC,ADDOP,INTEGER,.PEXPR,.OPEXPR);
	END;



!IF LOOP CAN BE HANDLED WITH AN AOBJN, MAKE LOOP CONTROL CONSTANT
IF .PEXPR[OPR1] EQL CONSTFL		!NUMBER OF ITERATIONS A COMPILE TIME CONSTANT
	 AND NOT .CNODE[REALARITH]	! LOOP INDEX MUST BE INTEGER 
	 AND .CNODE[SSIZONE]		!STEP SIZE MUST BE ONE
	AND .DOINITL[CONST2] LEQ #377777	!LOWER BOUND ON INDEX MUST BE LESS THAN 17 BITS
	AND .DOINITL[CONST2] GEQ 0		! AND MUST BE POSITIVE
	AND .DOULIM[CONST2] LEQ #377777		!UPPER BOUND ON INDEX MUST BE LESS THAN 17 BITS
	AND .DOULIM[CONST2] GEQ 0		! AND MUST BE POSITIVE
THEN
BEGIN
	PEXPR_MAKECNST(INTEGER,0,-.PEXPR[CONST2]^18+.DOINITL[CONST2]);
	CNODE[SSIZONE]_0;		!RESET ALL OTHER FLAGS
	CNODE[FLCWD]_1;
END ELSE
	!SET SOME OTHER FLAGS DESCRIBING THE CONTROL WORD (IF ITS CONSTANT)
	IF .PEXPR[OPR1] EQL CONSTFL THEN
	BEGIN
		%(***IF THE NUMBER OF TIMES THAT THE LOOP IS TO BE EXECUTED IS A POS
			NUMBER THAT CAN BE USED IMMEDIATE MODE, DO SO. FOR A NEG
			ITERATION COUNT, DONT BOTHER. (NOTE THAT CAN COUNT ON THE CT BEING 
			AN INTEGER***)%
		IF .PEXPR[CONST2] LEQ #777777
		THEN
			CNODE[CTLIMMED]_1;
		CNODE[CTLNEG]_1;
	END ELSE
		IF .PEXPR[OPRCLS] EQL DATAOPR THEN
			CNODE[CTLNEG]_1
		ELSE
	!INSERT THE NEGATE NODE NEEDED
	PEXPR_MAKPR1(.CNODE,NEGNOT,NEGOP,INTEGER,0,.PEXPR);




CNODE[DOLPCTL]_.PEXPR;
CNODE[DOM1]_.DOINITL;		!INITIAL VALUE FOR LOOP INDEX
END;

EXTERNAL
	SSIZTC,			!COUNTER FOR STEP SIZE TEMPS
				!GENERATED FOR DO LOOPS
	INTLTC;			!COUNTER FOR TEMPS GENERATED
				!FOR DO LOOP INITIAL VALUES
%*****
	NOTE THAT THE NAMES WILL NOT BE UNIQUE OR VALID IF THERE
	ARE MORE THAN 9999 FOR EACH
*****%


!************************************

GLOBAL ROUTINE SSIZTMP(SSIZ)=
BEGIN
EXTERNAL TBLSEARCH;

!CREATE A STEP SIZ TEMPORARY FOR DO LOOPS

LOCAL STPTMP;
MAP BASE STPTMP;

	NAME_IDTAB;
	ENTRY[0]_SIXBIT'.S'+MAKNAME(SSIZTC);
	SSIZTC_.SSIZTC+1;		!ADD A SIXBIT 1
	STPTMP_TBLSEARCH();		!LOOK UP
	STPTMP[VALTYPE]_.SSIZ;
	! CLEAR THE NOALLOC BIT FOR PHASE 1
	STPTMP[IDATTRIBUT(NOALLOC)] _ 0;
	!SET THE VALUE TYPE OF THE VARIABLE
	.STPTMP
END;

!***************************************

GLOBAL ROUTINE INITLTEMP(IVAL)=

BEGIN
EXTERNAL TBLSEARCH;

!MAKE AN INITIAL VALUE TEMPORARY

LOCAL ITLTMP;
MAP BASE ITLTMP;

!IVAL POINTS TO THE DO NODE INITIAL VALUE

	NAME_IDTAB;
	ENTRY[0]_SIXBIT'.I'+MAKNAME(INTLTC);
	INTLTC_.INTLTC+1;		!ADD SIX BIT ONE
	ITLTMP_TBLSEARCH();
	ITLTMP[VALTYPE]_.IVAL;
	!CLEAR THE NOALLOC BIT FOR PHASE 1
	ITLTMP[IDATTRIBUT(NOALLOC)] _ 0;
	.ITLTMP
END;



GLOBAL ROUTINE IODOXPN(IOSTMNT)=
%(***************************************************************************
	ROUTINE TO WALK THRU AN IOLIST AND PERFORM DOXPN ON ALL IMPLICIT
	DO STMNT NODES. SETS THE "DOPRED" FIELD OF EACH DO STMNT NODE
	BEFORE CALLING DOXPN.
	CALLED WITH A PTR TO THE IO STMNT FOR WHICH THE IOLIST IS TO BE
	PROCESSED.
***************************************************************************)%
BEGIN
	EXTERNAL CORMAN;
	MAP BASE IOSTMNT;
	OWN PEXPRNODE IOLPTR;
	OWN PEXPRNODE PRVELEM;	!PTR TO THE ELEMENT IN THE IOLIST PRECEEDING
					! THE ELEMENT POINTED TO BY IOLPTR


![1143]	The following  code used  to  increment the  reference counts  of  the
![1143]	labels used after ERR=  or END= in  "data transfer" statments  because
![1143]	the labels were lexically  parsed as integer  constants and never  had
![1143]	their counts bumped by one.  Edit 760 made the front end routines  for
![1143]	"data transfer" and "device control" statements use the routine LABREF
![1143]	which incremented  the count  correctly.  Unfortunately,  IODOXPN  was
![1143]	still  incrementing  the  counts,  so   code  written  for  edit   760
![1143]	decremented the counts to even things  out.  This made the counts  for
![1143]	labels referenced  by "device  control" statements  incorrect  because
![1143]	they don't  go  through  here,  so edit  1136  removed  the  decrement
![1143]	inserted in edit 760.  At this  point, labels used by "data  transfer"
![1143]	statements were wrong because they were still being incremented  here.
![1143]	So the final solution is to get rid of this code entirely.

![1143]	!PHASE ONE IS NOT COUNTING END=,ERR= LABEL REFERENCES
![1143]	!SO WE WILL COUNT THEM NOW
![1143]
![1143]	IF (IOLPTR_.IOSTMNT[IOEND]) NEQ 0 THEN
![1143]		IOLPTR[SNREFNO]_.IOLPTR[SNREFNO]+1;
![1143]
![1143]	IF (IOLPTR_.IOSTMNT[IOERR]) NEQ 0 THEN
![1143]		IOLPTR[SNREFNO]_.IOLPTR[SNREFNO]+1;

	IF (IOLPTR_.IOSTMNT[IOLIST]) EQL 0
	THEN RETURN;		!IF STMNT HAS NO IOLIST

	%(***IF THE FIRST ELEMENT IN THE IOLIST IS A DO-STMNT, INSERT A 
		CONTINUE STMNT IN FRONT OF IT FOR THE "DOPRED" FIELD
		OF THE DO STMNT TO POINT BACK TO***)%
	IF .IOLPTR[OPERATOR] EQL DOSTATEMENT
	THEN
	BEGIN
		NAME_CONTDATA;
		PRVELEM_CORMAN();
		PRVELEM[OPERATOR]_CONTSTATEMENT;
		PRVELEM[CLINK]_.IOLPTR;
		IOSTMNT[IOLIST]_.PRVELEM;
	END;


	%(***WALK THRU SUCCESSIVE ELEMS OF THE IOLIST. SET THE "DOPRED" FIELD
		OF EACH DO-STMNT NODE TO PT TO THE NODE PRECEEDING IT. CALL
		DOXPN FOR EACH DO STMNT NODE***)%
	%(** IF HAVE AN EXPRESSION NODE UNDER A DATACALL, FILL
		IN THE PARENT POINTER)%
	UNTIL .IOLPTR EQL 0
	DO
	BEGIN
		IF .IOLPTR[OPERATOR] EQL DOSTATEMENT
		THEN
		BEGIN
			IOLPTR[DOPRED]_.PRVELEM;
			DOXPN(.IOLPTR);
		END
		ELSE
		IF .IOLPTR[OPERATOR] EQL DATACLFL
		THEN
		BEGIN
			OWN PEXPRNODE T;
			T _ .IOLPTR[DCALLELEM];

			IF .T NEQ 0		!IF THERE WAS AN ERROR FOUND WHEN
						! PROCESSING THIS DATA ELEMNT (EG
						! AN ILLEGAL ARRAYREF)
			THEN
			BEGIN
				IF .T[OPRCLS] NEQ DATAOPR
				THEN
				T[PARENT] _ .IOLPTR
			END;
		END;

		%(***GO ON TO THE NEXT ELEMENT***)%
		PRVELEM_.IOLPTR;
		IOLPTR_.IOLPTR[CLINK];
	END;
END;
FORWARD ALLONES;


ROUTINE ADJGEN(DTABB,ARY)=
BEGIN
	!GENERATE ACTUAL FN(CALL STATEMENT)
	!NODE FOR CALL TO RUN-TIME
	!ROUTINES FOR ADJUSTABLE DIMENSIONS

	LABEL ARGDO;
	OWN BASE CALNODE;
	EXTERNAL CSTMNT,CORMAN,ONEPLIT;
	MAP BASE CSTMNT;
	EXTERNAL TBLSEARCH;
	MAP BASE DTABB: ARY;
	OWN BASE G:ROUT:DNUM:J;
	OWN DIMSUBENTRY DSUBETRY;
	OWN ARGUMENTLIST CLNODLST;

	BTTMSTFNFLG_FALSE;	!IF INSERT A CALL TO ADJUST, THIS ROUTINE IS NO LONGER "BOTTOMMOST"

	NAME<LEFT>_CALLSIZ+SRCSIZ;
	CALNODE_CORMAN();
	CALNODE[SRCLINK]_.CSTMNT[SRCLINK];
	CSTMNT[SRCLINK]_.CALNODE;
	CALNODE[OPRCLS]_STATEMENT;
	CALNODE[SRCID]_CALLID;
	G_ALLONES(.DTABB);

	!THE SPECIAL PURPOSE ROUTINE FOR ALL LOWER BOUND OF
	!ONE WILL BE CALLED ONLY IF IT IS ALSO TRUE THAT
	!ALL DIMENSIONS ARE ADJUSTABLE. WE NOW DETERMINE THAT FACT
	!BY SEEING IF THE SECOND ONE IS ADJUSTABLE. THE
	!FIRST ONE ALWAYS HAS A FACTOR OF ONE .

	IF .DTABB[DIMNUM] GTR 1 THEN
	BEGIN
		DSUBETRY_DTABB[FIRSTDIM]+DIMSUBSIZE;	!SECOND ONE
		IF NOT .DSUBETRY[VARFACTFLG] THEN G_0;
	END;

	IF .G THEN
	ENTRY_SIXBIT'ADJ1. '
	ELSE
	ENTRY_SIXBIT'ADJG. ';

	NAME_IDTAB;
	ROUT_TBLSEARCH();
	!FILL IN THE POINTER TO THE FUNCTION NAME
	CALNODE[CALSYM]_.ROUT;
	IF .FLAG THEN
	ELSE	!IF HAVE JUST CREATED A NEW SYMBOL TABLE ENTRY
	(ROUT[OPERSP]_FNNAME; ROUT[IDLIBFNFLG]_1);
	DNUM_.DTABB[DIMNUM];

	!COMPOSE THE ARGUMENT LIST FOR A CALL TO
	!ADJ1.OR ADJG.


	!FIRST GET THE CORE FOR THE LIST
	NAME<LEFT>_(3-.G)*(.DNUM)+6;
	!FOR EACH DIMENSION
	!ONE WORD FOR U(I)			!MAYBE ONE FDR L(I)
	!ONE WORD FOR MULT(I)
	!=(2 OR 3)*DNUM
	!+
	!ONE WORD FOR OFFSET
	!+
	!ONE WORD FOR NUMBER OF DIMENSIONS
	!+
	!WORD THAT CONTAINS NUMBER OF PARAMETERS
	!+
	!ZERO HEADER WORD (FILLED IN IN CODE
	!+
	!WORD FOR ARRAY SIZE
	!+
	!WORD FOR BASE ADDRESS OF ARRAY
	!GENERATION WITH LABEL FOR GENERATED
	!ARG LIST

	CLNODLST_CALNODE[CALLIST]_CORMAN();
	!FILL IN ARG LIST
	!FIRST THE NUMBER OF ARGUMENTS

	CLNODLST[ARGCOUNT]_.NAME<LEFT>-2;

	!NOW FILL IN THE ARGUMENT LIST.
	!J POINTS TO ARG ENTRY WHILE THE INCR LOOP
	!GOES THROUGH ALL DIMENSIONS
	!THE FIRST ARGUMENT WE WILL FIRST FILL IN IS UB(1)
	!WHUCH IS THE FOURTH ARGUMENT,THUS J=4.
	!THEN MULT(2) WHICH IS THE DIMFACTOR FROM THE
	!DIMENSION SUBENTRY AFTER THE ONE CONTAINING UB(1).
	J_6;
	DSUBETRY_DTABB[FIRSTDIM];
	!IN ORDER FOR THE LOOP TO OPERATE CORRECTLY, WE ARE
	!NOT DOING WHAT IT APPEARS WE ARE DOING. WE WILL
	!FILL IN MULT(1), UB(1),.....MULT(N),UB(N) AND
	!THEN SINCE MULT(1) IS SPECIAL REALLY FILL IT IT LATER
	!ROUT WILL BE USED AS A TEMP TO
	!HELP US SAVE THE RIGHT THING TO PUT INTO MULT(1)
	!LATER.
	!A DOUBLE PRECISION OR COMPLEX ARRAY STARTS OUT AT TWO
	IF .ARY[DBLFLG] THEN ROUT_MAKECNST(INTEGER,0,2)
	ELSE
	ROUT_.ONEPLIT;

	ARGDO:
	INCR I FROM 1 TO .DNUM DO
	BEGIN
			!HOLE FOR PARTIALLY CONSTANT ONES
			CLNODLST[.J,ARGNPTR]_.DSUBETRY[DIMUB];
			CLNODLST[.J,AVALFLG]_1;
			IF NOT .G THEN
			BEGIN
			!ALL LOWER BOUNDS ARE NOT 1
				J_.J+1;
				CLNODLST[.J,ARGNPTR]_.DSUBETRY[DIMLB];
				CLNODLST[.J,AVALFLG]_1;
			END;
			!DONT PUT OUT FACTOR FOR LAST ONE
			IF .I EQL .DNUM THEN LEAVE ARGDO;
			DSUBETRY_.DSUBETRY+DIMSUBSIZE;
			J_.J+1;
			CLNODLST[.J,ARGNPTR]_.DSUBETRY[DIMFACTOR];
			CLNODLST[.J,AVALFLG]_1;
			J_.J+1;
	END;							!INCR LOOP

	!FILL IN ARGUMENT 1, THE NUMBER
	!OF DIMENSIONS
	
	CLNODLST[1,ARGNPTR]_MAKECNST(INTEGER,0,.DNUM);
	CLNODLST[1,AVALFLG]_1;
	!FILL IN ARRAY SIZE
	CLNODLST[2,ARGNPTR]_.DTABB[ARASIZ];
	CLNODLST[2,AVALFLG]_1;
	!FILL IN ARGUMENT 2, BASE ADDRESS OF ARRAY
	CLNODLST[3,ARGNPTR]_.ARY;
	CLNODLST[3,AVALFLG]_1;
	!FILL IN ARGUMENT 4, THE ARRAY OFFSET
	CLNODLST[4,ARGNPTR]_.DTABB[ARAOFFSET];
	CLNODLST[4,AVALFLG]_1;
	!FILL IN MULT(1)
	CLNODLST[5,ARGNPTR]_.ROUT;
	CLNODLST[5,AVALFLG]_1;
	
END;

ROUTINE ALLONES(DTABB)=

BEGIN
	!LOOK THROUGH DIMENSION TABLE ENTRY
	!TO SEE IF ALL LOWER BOUNDS ARE 1.
	!RETURN 1 (TRUE) IF THEY ARE AND
	!0 (FALSE) IF NOT
	EXTERNAL ONEPLIT;
	OWN DNUM,DSUBETRY;
	MAP PEXPRNODE DTABB;
	MAP DIMSUBENTRY DSUBETRY;
	DNUM_.DTABB[DIMNUM];
	DSUBETRY_DTABB[FIRSTDIM];			!POINT TO FIRST SUBENTRY
	INCR I FROM 1 TO .DNUM DO
	BEGIN
		IF .DSUBETRY[DIMLB] NEQ .ONEPLIT
		THEN
		RETURN(0)
		ELSE
		DSUBETRY_.DSUBETRY+DIMSUBSIZE;
	END;
	RETURN 1
END;


GLOBAL ROUTINE ADJCALL=
BEGIN
	!INSERT CALL STATEMENT NODES FOR ADJUSTABLY DIMENSIONED
	!ARRAYS TO CALL THE OBJECT TIME ROUTINES
	!ADJ1. OR ADJG. TO COMPUTE FACTORS AND OFFSET
	EXTERNAL CSTMNT,CHOSEN,ENTRY,NAME,CORMAN;
	EXTERNAL VERYFRST,QQ;
	OWN DTABB,CLST,CALNODE,CLNODLST,G,CLSTARG;
	MAP ARGUMENTLIST CLNODLST:CLST;
	MAP BASE CSTMNT:DTABB:CLSTARG;
%[772]%	EXTERNAL FATLERR,E126;
%[772]%	OWN DIMSUBENTRY DSUBETRY;
%[772]%	MAP BASE G;	! SYMBOL TEMP FOR ADJCAL

	VERYFRST_0;
	CSTMNT_.SORCPTR<LEFT>;
	WHILE .CSTMNT NEQ 0 DO
	BEGIN
		!IF ITS AN ENTRY
		IF .CSTMNT[SRCID] EQL ENTRID THEN
		!IF THERE ARE PARAMETERS
		IF .CSTMNT[CALLIST] NEQ 0 THEN
		BEGIN
			CLST_.CSTMNT[CALLIST];
			INCR I FROM 1 TO .CLST[ARGCOUNT] DO
			BEGIN
				CLSTARG_.CLST[.I,ARGNPTR];
				!IF AN ARRAY LOOK TO SEE
				!IF IT IS ADJUSTABLE

				IF .CLSTARG[OPR1] EQL
				OPR1C(DATAOPR,FORMLARRAY)
				THEN
				BEGIN
					DTABB_.CLSTARG[IDDIM];
					!LOOK TO SEE IF IT IS
					!ADJUSTABLY DIMENSIONED
![772] If this is indeed a variable DIMENSIONed array, generate the
![772] run-time call, and check the dimension information one last
![772] time to catch the case where a variable dimension subscript
![772] variable has later been DIMENSIONed itself.
%[772]%					IF .DTABB[ADJDIMFLG]
%[772]%					THEN
%[772]%					BEGIN
						ADJGEN(.DTABB,.CLSTARG);
%[772]%						DSUBETRY_DTABB[FIRSTDIM]<0,0>;
%[772]%						INCR J FROM 1 TO .DTABB[DIMNUM] DO
%[772]%						BEGIN
%[772]%							G_.DSUBETRY[DIMLB];
%[772]%							IF .DSUBETRY[VARLBFLG] AND
%[772]%							   .G[IDDIM] NEQ 0
%[772]%							THEN
%[772]%								FATLERR(.G[IDSYMBOL],0,E126<0,0>);
%[772]%							G_.DSUBETRY[DIMUB];
%[772]%							IF .DSUBETRY[VARUBFLG] AND
%[772]%							   .G[IDDIM] NEQ 0
%[772]%							THEN
%[772]%								FATLERR(.G[IDSYMBOL],0,E126<0,0>);
%[772]%							DSUBETRY_.DSUBETRY+DIMSUBSIZE;
%[772]%						END;
%[772]%					END;
				END;
			END;
		END;
		CSTMNT_.CSTMNT[SRCLINK];
	END;
END;