Google
 

Trailing-Edge - PDP-10 Archives - BB-D480F-SB_FORTRAN10_V10 - skstmn.bli
There are 12 other files named skstmn.bli in the archive. Click here to see a list.
!COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1972, 1985
!ALL RIGHTS RESERVED.
!
!THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
!ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
!INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
!COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
!OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
!TRANSFERRED.
!
!THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
!AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
!CORPORATION.
!
!DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
!SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

!AUTHOR: S. MURPHY & NORMA ABEL/HPW/MD/TFV/CKS/CDM/TJK/AHM

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

GLOBAL BIND SKSTV = #10^24 + 0^18 + #2463;	! Version Date:	8-Oct-84

%(

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

83	-----	-----	INTERFACE TO SKOPTIO
84	-----	-----	INCLUDE E1LISTCALL AND E2LISTCALL NODES
			IN IODEPNDS
85	-----	-----	PERFORM P2SKEL ON RECORD NUMBERS
			ALSO, REMOVE A=A
86	-----	-----	FIX 85 TO CHECK FOR NEG/NOT FLAGS TOO
87	-----	-----	IF DO LOOP INDEX IS IN COMMON MAKE SURE
			AT LEAST MATRLZIXONLY IS SET
88	-----	-----	FIX FOR NEW SFN HANDLING

89	-----	-----	IF DBGINDX FLAG IS SET, MATERIALIZE LOOP
			INDEX (EDIT TO "DOENSKL")
90	-----	-----	P2REGCNTS SHOULD NOT CALL ITSELF FOR
			THE SUBSTATEMENT OF A LOGICAL IF
91	-----	-----	WHEN AN ARITH IF IS TRANSFORMED INTO LOG
			IF/GOTO, MUST CALL P2SKSTMN FOR THE GOTO INSERTED
			UNDER THE LOGICAL IF (SO THAT "P2REGCNTS"
			WILL GET CALLED FOR IT AND THE LABEL WILL BE EXAMINED
			FOR A TRANSFER OUT OF THE CURRENT LOOP)
92	242	15010	DO NOT DELETE THE CONDITIONAL IN A LOGICAL
			IF WHEN THE SUBSTATEMENT IS A CONTINUE.
93	260	-----	ADD A DOT TO CORRECTLY MATERILIZE DO LOOP INDEXES
			WHICH ARE IN COMMON

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

94	761	TFV	1-Mar-80	-----
	Add KTYPCG for /GFLOATING type conversions

95	1026	DCE	24-Nov-80	-----
	Fix FILTER to call itself rather than LOOKELEM2 for IOLSTCALL

96	1050	EGM	5-Feb-81	--------
	Retain arithmetic if expression if it contains function references,
	otherwise, if all three labels are the same, reduce the label reference
	count by 2 at the same time as replacing the IF by a GO TO.

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

1167	TFV	11-Jan-83	20-18247
	Fix LOOKELEM2 to  check E1/E2LISTCALLs  to see if  the count  or
	increment depend  upon previous  iolist elements.

***** Begin Version 7 *****

97	1207	DCE	3-Apr-81	-----
	Handle all the I/O list dependencies introduced by FORTRAN-77.
	In particular, be wary of final loop values and dependencies
	introduced by them.  Changes to LOOKELEM2, IODEPENDS, and
	addition of new routine - LPVARDEPNDS.

98	1441	SRM	16-Dec-81
	Fix FORMIOL to not fold:
		X, F(X)
	since F(X) might have side effects on X.
	Formerly we were erroneously disallowing:
		F(X), X
	which can be folded with no problem.

99	1455	TFV	5-Jan-82	------
	Modify SKSFN  for character  statement functions.   The  SFNEXPR
	field of a  numeric statement function  points to an  assignment
	node.  The SFNEXPR field for character statement function points
	to a call node.  It is either a call to CHSFN.  (the  subroutine
	form of CHASN.)  or  a call to CHSFC.   (the subroutine form  of
	CONCA.).  CHSFC.   is  used  if  the  character  expression  has
	concatenation at its  top level,  CHSFN. is used  for all  other
	character expressions.

1527	CKS	29-Apr-82
	Add SKOPNCLS to do skeleton walk for expressions under OPEN and
	CLOSE statements.

1530	TFV	4-May-82
	Setup TOPIO  in  P2SKSTMNT.  It  points to  the  top  level  I/O
	statement above  an  IOLSCLS  node.   It  is  used  to  set  the
	IOLSTATEMENT field.  Also  use symbols for  the size of  IOLSCLS
	nodes in FORMIOLST.

1626	CKS	31-Aug-82
	Call P2 optimizations on ENCODE/DECODE string length.

***** End V7 Development *****

1742	TFV	13-Apr-83
	Fix I/O  deficiencies.  Do  skeleton walk  for all  I/O  keyword
	values.  Modify SKIOLST and SKIO  so P2SKSTMNT can use them  for
	FIND, REWIND, etc..  Fix checks  for DONOAOBJN on inner do  loop
	index as keyword value.  Have P2REGCNTS check all I/O statements
	for transfers out of the loop.


***** Begin Version 10 *****

2200	TFV	23-Mar-83
	Do skeleton  optimizations for  the INQUIRE  statement.   Modify
	SKOPNCLS to do the work.

2243	CDM	13-Dec-83
	Detect AOBJN DO loop register indexes into large arrays  (arrays
	in .LARG.).  This is  done in the  skeleton optimizer, and  will
	disable the  DO loop  from using  an AOBJN  instruction for  the
	cases that can be caught  this early in compilation.  This  will
	prevent the negative left half  of the AOBJN register  appearing
	to be an  invalid section  number when indexing  into the  array
	when running in a non-zero section.

2272	TJK	20-Jan-84
	Have SKCALL call P2SKFOLD  if the CALL  statement is really  a
	character assignment or character  statement function so  that
	subconcatenations are  now folded  in these  cases.  Also  fix
	SKCALL to  set AVALFLG  when  an expression  is reduced  to  a
	DATAOPR due to skeleton optimizations.

2302	TJK	2-Feb-84
	Add new flag IDCLOBB to the IDFNATTRIB field of a symbol table
	entry.  This flag is set for certain library routines  (called
	as subroutines).  It indicates that  ACs are not preserved  by
	the call.

	Have CHASGN generate calls to  CASNM.  instead of CHASN.   for
	single-source character  assignments,  and CNCAM.  instead  of
	CONCA. for character concatenation assignments.  Also have  it
	set IDCLOBB for these routines, which don't preserve ACs.

	Replace a check for CONCA. with a check for CNCAM. in  SKCALL.

	Have ALCCALL mark registers 2-15 (octal) as being clobbered if
	IDCLOBB is set.

2304	TJK	8-Feb-84
	Add  P2SKOVRLP  to  do   compile-time  overlap  checking   for
	character assignments.  Have SKCALL  call this routine if  the
	CALL statement is really a character assignment.

2365	TJK	6-Jun-84
	Move checks for inner DO-variable  in SKIO and SKOPNCLS  until
	after SKWALK, in case folding occurs.

2405	TJK	21-Jun-84
	Correct a  problem with  edit 1441.   It missed  the place  in
	FOLDIOLST where  CONTFN  must be  called.   Delete  DEFONCIOL,
	whose references may be replaced by direct calls to  IODEPNDS.
	Improve FILTER (in LOOKELEM2).

2463	AHM	8-Oct-84
	Disabuse ARNOAOBJN of the notion that ARRAYREFs for large numeric
	arrays with large offsets won't use the offset in an EFIW.

***** End V10 Development *****

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

)%

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

! Below is for use in making PLM's with RUNOFF
!++
!.LITERAL
!--

OWN CTR;

%(***KEEP A TABLE OF THE LABELS INSIDE AN INNERMOST LOOP AND KEEP A COUNT OF REFERENCES 
	TO EACH LABEL THAT OCCUR WITHIN THE LOOP****)%
STRUCTURE LPLABLST[CT,POS,SIZE]=	!DEFINE THE STRUCTURE OF THAT TABLE
	( (.LPLABLST+.CT)<.POS,.SIZE> );
MACRO LABL=LEFT$,	!PTR TO THE STMNT NUMBER TABLE ENTRY FOR THE LABEL
	LOCREFCT=RIGHT$;	!CT OF REFS THAT OCCUR INSIDE THIS LOOP

OWN TRANSFOUT;	!THIS FLAG IS SET TO "TRUE" IF THE INNER DO LOOP
			! BEING PROCESSED HAS TRANSFERS OUT

FORWARD
	P2SKSTMNT,
	SKASMNT,
	SKSFN,
	SKRETURN,
	SKAGO,
	SKCGO,
	DELGOLABS(1),
	SKLOGIF,
	SKARIF,
	SKASSI,
	SKIO(1),
	SKDECENC(1),
	SKOPNCLS,
	SKCALL,
	FOLDIOLST,
	FORMIOLST(1),
	LOOKELEM2(2),
	IODEPNDS(2),
	LPVARDEPNDS(2),
	DOP2SKL,
	TRINTOLOOP,
	DOENSKL,
	P2REGCNTS,
	LOOKOUT(1),
	LOKIOUT,
%2243%	ARNOAOBJN(1);	! Routine to decide if array reference's address
%2243%			! calc should make a innermost DO loop not AOBJN.

EXTERNAL
	C1H,
	C1L,
	C2H,
	C2L,
	BASE CDONODE,	! Ptr to the previous DO statement in this program
	CGERR,
	LPLABLST CHOSEN,	! Used to hold table of labels inside a loop
	BASE CIOCALL,	! Ptr to current IOLISTCALL node being built
	BASE CIOCLAST,	! Ptr to last element on IOLISTCALL node being built
	CNSTCMB,
	CONTFN,
	CONTVAR,
	COPRIX,
	CORMAN,
	BASE CSTMNT,	! pointer to current statement
	DNEGCNST,
	OBJECTCODE DOWDP,
	FOLDAIF,
	FOLDLIF,
	INNERLOOP,	! Flag set while processing stmnts in an innermost loop
	INPFLAG,	! Flag set for statements that do input
	KBOOLBASE,
	KTYPCB,
%761%	KTYPCG,		! For /GFLOATING type conversions
	MAKEPR,
	MAKPR1,
	NEGFLG,
	NOTFLG,
	P2SKARITH,
	P2SKBL,
	P2SKFN,
%2272%	P2SKFOLD,	! Folds top-level concatenation nodes
	P2SKL1DISP,
	P2SKLARR,
	P2SKLTP,
	P2SKNEGNOT,
%2304%	P2SKOVRLP,	! Handles compile-time overlap tests
	P2SKREL,
	SKERR,
	SKIOLIST,
	SKOPTIO,
	TBLSEARCH,
%1530%	TOPIO,		! Pointer to the top level I/O statement
%1530%			! above an IOLSCLS node
	UNFLDO,		! Undo decision to have a do loop use AOBJN in UTIL
	USERFNFLG;	! Flag set for statement that includes user functions

MACRO SKIOLST=
%1742%	! Do skeleton optimizations for IOLIST if specified

	IF .CSTMNT[IOLIST] NEQ 0
	THEN IF .FLGREG<OPTIMIZE>
	THEN SKOPTIO()		! Optimized skeleton for IOLIST
	ELSE SKIOLIST()$;	! non-optimized skeleton for IOLIST

MACRO SKWALK(X)=
%1742%	! Do skeleton optimization for an expression

%1742%	BEGIN
%1742%		CNODE = .X;	! Get expression

%1742%		! If non-zero, call the appropriate skeleton routine

%1742%		IF .CNODE NEQ 0
%1742%		THEN X = (.P2SKL1DISP[.CNODE[OPRCLS]])(.CNODE)
%1742%	END$;

GLOBAL ROUTINE P2SKSTMNT=
BEGIN
	!***************************************************************
	! Perform  phase  2  skeleton  optimizations  on  the  statement
	! pointed to by the global CSTMNT.
	!***************************************************************

	%(***AT START OF A STMNT, CAN INIT NEGFLG AND NOTFLG TO FALSE***)%
	NEGFLG_FALSE;
	NOTFLG_FALSE;

	USERFNFLG_FALSE;	!FLAG FOR "STMNT INCLUDES USER FNS" - INIT TO FALSE
	%(***PROCESS THIS STMNT IN A MANNER DETERMINED BY ITS SRCID***)%
	CASE .CSTMNT[SRCID] OF SET

	SKASMNT();		! ASSIGNMENT
	SKASSI();		! ASSIGN
	SKCALL();		! CALL
	BEGIN END;		! CONTINUE (DO NOTHING)
	DOP2SKL();		! DO
	BEGIN END;		! ENTRY (DO NOTHING)
	SKASMNT();		! COMNSUB (SAME AS ASSIGNMENT IN FORMAT)

	BEGIN END;		! GOTO
	SKAGO();		! ASSIGNED GOTO
	SKCGO();		! COMPUTED GOTO
	SKARIF();		! ARITHMETIC IF
	SKLOGIF();		! LOGICAL IF
	SKRETURN();		! RETURN
	BEGIN END;		! STOP

	BEGIN			! READ
%1530%		TOPIO = .CSTMNT;	! Pointer to top level I/O statement
%1516%		SKIO(TRUE);
	END;			! READ

	BEGIN			! WRITE
%1530%		TOPIO = .CSTMNT;	! Pointer to top level I/O statement
%1516%		SKIO(FALSE);
	END;			! WRITE

	BEGIN			! DECODE
%1530%		TOPIO = .CSTMNT;	! Pointer to top level I/O statement
%1742%		SKDECENC(TRUE);
	END;			! DECODE

	BEGIN			! ENCODE
%1530%		TOPIO = .CSTMNT;	! Pointer to top level I/O statement
%1742%		SKDECENC(FALSE);
	END;			! ENCODE

	BEGIN			! REREAD
%1530%		TOPIO = .CSTMNT;	! Pointer to top level I/O statement
%1742%		SKIO(TRUE)
	END;			! REREAD

	BEGIN			! FIND
%1742%		SKIO(FALSE);
	END;			! FIND

	BEGIN			! CLOSE
%1530%		TOPIO = .CSTMNT;	! Pointer to top level I/O statement
%1527%		SKOPNCLS();
	END;			! CLOSE

	BEGIN END;		! INPUT (not implemented)
	BEGIN END;		! OUTPUT (not implemented)

%1742%	SKIO(FALSE);		! BACKSPACE
%1742%	SKIO(FALSE);		! BACKFILE
%1742%	SKIO(FALSE);		! REWIND
%1742%	SKIO(FALSE);		! SKIP FILE
%1742%	SKIO(FALSE);		! SKIP RECORD
%1742%	SKIO(FALSE);		! UNLOAD
	BEGIN END;		! RELEASE
%1742%	SKIO(FALSE);		! ENDFILE

	BEGIN END;		! END
	BEGIN END;		! PAUSE

	BEGIN			! OPEN
%1530%		TOPIO = .CSTMNT;	! Pointer to top level I/O statement
%1527%		SKOPNCLS();
	END;			! OPEN

	SKSFN();		! SFN
	BEGIN END;		! FORMAT
	BEGIN END;		! BLT
	BEGIN END;		! REGMASK - change set of available registers -
				!  inserted by global register allocator
%2200%	BEGIN			! INQUIRE
%2200%		TOPIO = .CSTMNT;	! Pointer to top level I/O statement
%2200%		SKOPNCLS();
%2200%	END;			! INQUIRE

	TES;

	%(***IF THIS STMNT CONTAINED A USER FN, SET FLAG IN STMNT**)%
	IF .USERFNFLG THEN CSTMNT[USRFNREF]_1;


	%(***IF ARE IN AN INNERMOST DO LOOP, CHECK FOR CONDITIONS THAT PREVENT
		THE LOOP INDEX FROM BEING MAINTAINED IN A REGISTER, OR FROM BEING
		HANDLED WITH AN AOBJN***)%
	IF .INNERLOOP
	THEN
	BEGIN
		P2REGCNTS();
		IF .CSTMNT[SRCLBL] NEQ 0	! IF THIS STMNT HAD A LABEL
		THEN DOENSKL();			! CHECK FOR THE END OF THE LOOP
	END;
END;	! of P2SKSTMNT

GLOBAL ROUTINE SKASMNT=
!++
!***********************************************************************
! Perform phase 2 skeleton optimizations on an assignment statement.
!
! The global CSTMNT contains the assignment statement to optimize.
!***********************************************************************
!--
BEGIN
	REGISTER
		PEXPRNODE RHNODE,
		PEXPRNODE LHNODE,
		PEXPRNODE SSNODE;


	%(***PROCESS RIGHT HAND SIDE***)%
	IF NOT .CSTMNT[A2VALFLG]
	THEN
	BEGIN
		RHNODE_.CSTMNT[RHEXP];
		NEGFLG_FALSE;
		NOTFLG_FALSE;
		CSTMNT[RHEXP]_(.P2SKL1DISP[.RHNODE[OPRCLS]])(.RHNODE);
		IF .NEGFLG THEN
		 CSTMNT[A2NEGFLG]_NOT .CSTMNT[A2NEGFLG];	!IF A NEG IS PROPAGATED FROM BELOW,
								! COMPLEMENT THE NEGFLG IN THE STMNT NODE

		IF .NOTFLG THEN			!IF A NOT IS PROPAGATED UP FROM BELOW
		 CSTMNT[A2NOTFLG]_NOT .CSTMNT[A2NOTFLG];	! COMPLEMENT THE NOT FLAG IN THE STMNT
	END;

	! Process left hand side - it must be either a simple variable,
	! or an array reference

	IF NOT .CSTMNT[A1VALFLG]
	THEN
	BEGIN	! Left had side not a leaf, must be an array reference

		LHNODE_.CSTMNT[LHEXP];
		IF .LHNODE[OPRCLS] NEQ ARRAYREF THEN RETURN CGERR();

		! Optimize address calculation.

		IF NOT .LHNODE[A2VALFLG]
		THEN
		BEGIN	! Address calculation not leaf
			SSNODE_.LHNODE[ARG2PTR];
			NEGFLG_FALSE;
			NOTFLG_FALSE;
			LHNODE[ARG2PTR]_(.P2SKL1DISP[.SSNODE[OPRCLS]])(.SSNODE);
			IF .NEGFLG THEN LHNODE[A2NEGFLG]_1;
			IF .NOTFLG THEN LHNODE[A2NOTFLG]_1;

		END;	! Address calculation not leaf

%2243%		! If a numeric array reference is:
%2243%		!
%2243%		!	o in an innermost DO loop,
%2243%		!	o and the array is in PSLARGE,
%2243%		!	o and the index variable for the DO is in  the
%2243%		!	  address calculation for the array,
%2243%		!
%2243%		! then mark that this  should not be an AOBJN loop.
%2243%
%2243%		IF .INNERLOOP
%2243%		THEN ARNOAOBJN(.LHNODE);

	END;	! Left had side not a leaf

	%(***IF THE VAR ON THE LEFT HAND SIDE OF THIS ASSIGNMENT STMNT IS EQUAL
		TO THE DO INDEX OF THE CURRENT DO LOOP, DONT WANT TO USE AOBJN
		IF THE INDEX IS NOT MATERIALIZED***)%
	IF .DOWDP[DOINDUC] EQL .CSTMNT[LHEXP] THEN DOWDP[DONOAOBJN]_1;

	%(**IF LHS=RHS, CHANGE THIS TO A CONTINUE**)%
	IF .CSTMNT[LHEXP] EQL .CSTMNT[RHEXP]
	 	AND (.CSTMNT[A1NGNTFLGS] EQL 0)
	AND (.CSTMNT[A2NGNTFLGS] EQL 0)
	THEN CSTMNT[SRCID]_CONTID;

END;	! of SKASMNT

GLOBAL ROUTINE SKSFN=
BEGIN

%1455%	! Rewritten by TFV on 5-Jan-81

	! Perform phase 2 skeleton optimizations on the expression under
	! a statement function.  The expression is either an  assignment
	! node for  numeric  statement  functions or  a  call  node  for
	! character statement functions.

	REGISTER OCSTMNT;
	REGISTER BASE FNID;

	NEGFLG = FALSE;		! Init flags for propagating negates and nots
	NOTFLG = FALSE;

	OCSTMNT = .CSTMNT;	! Save away a pointer to the current statement

	FNID = .CSTMNT[SFNNAME];	! Get the symbol table entry for the
					! function name

	CSTMNT = .CSTMNT[SFNEXPR];	! Get the expression

	IF .FNID[VALTYPE] EQL CHARACTER
	THEN	SKCALL()
	ELSE	SKASMNT();

	CSTMNT = .OCSTMNT;	! Restore the pointer to the current statement

END;	! of SKSFN

GLOBAL ROUTINE SKRETURN=
%(***************************************************************************
	PERFORM P2SKEL OPS ON THE EXPR UNDER A RETURN STMNT
***************************************************************************)%
BEGIN
	REGISTER PEXPRNODE RHNODE;
	IF (RHNODE_.CSTMNT[RETEXPR]) NEQ 0 THEN
	CSTMNT[RETEXPR]_(.P2SKL1DISP[.RHNODE[OPRCLS]])(.RHNODE);
END;	! of SKRETURN

GLOBAL ROUTINE SKAGO=
%(***************************************************************************
	ROUTINE TO PERFORM PHASE 2 SKEL OPTIMS ON AN ASSIGNED GOTO.
	OPTIMS MAY BE PERFORMED ON THE ADDRESS CALC FOR THE ASSIGNED VAR
	(WHICH MAY BE AN ARRAY REF)
***************************************************************************)%
BEGIN
	REGISTER PEXPRNODE AGOVAR;

	AGOVAR_.CSTMNT[AGOTOLBL];

	IF .AGOVAR[OPRCLS] EQL ARRAYREF
	THEN
	CSTMNT[AGOTOLBL]_(.P2SKL1DISP[.AGOVAR[OPRCLS]])(.AGOVAR);

END;	! of SKAGO

GLOBAL ROUTINE SKCGO=
%(***************************************************************************
	ROUTINE TO PERFORM PHASE 2 SKELETON OPTIMIZATIONS ON A
	COMPUTED GOTO STATEMENT.
	PERFORM OPTIMIZATIONS ON THE COMPUTED EXPRESSION, AND THEN IF
	THE EXPRESSION COLLAPSES TO A CONSTANT, TRANSFORM THE STMNT
	TO A GOTO.
***************************************************************************)%
BEGIN
	REGISTER PEXPRNODE CGOEXP;

	CGOEXP_.CSTMNT[CGOTOLBL];

	%(***PERFORM PHASE 2 SKEL OPTIMS ON THE COMPUTED EXPRESSION***)%
	IF .CGOEXP[OPRCLS] NEQ DATAOPR
	THEN
	CGOEXP_(.P2SKL1DISP[.CGOEXP[OPRCLS]])(.CGOEXP);

	%(***IF EXPRESSION HAS REDUCED TO A CONSTANT, CHANGE STMNT TO A GOTO**)%
	IF .CGOEXP[OPR1] EQL CONSTFL
	THEN
	BEGIN
		DELGOLABS(.CSTMNT);	!DECR THE REF CTS FOR ALL LABELS ON THE LIST 
		CSTMNT[SRCID]_GOTOID;
		%(***GET PTR TO THE LABEL TO BE USED (THE CONSTANT MUST ALWAYS BE
			INTEGER)****)%

		IF .CGOEXP[CONST2] GEQ .CSTMNT[GOTONUM] OR .CGOEXP[CONST2] LEQ 0
		THEN
		%(***IF CONSTANT IS LARGER THAN NUMBER OF LABELS IN LIST, OR LESS THAN 0***)%
		CSTMNT[SRCID]_CONTID	!CHANGE IT TO A CONTINUE
		ELSE
		BEGIN
			REGISTER PEXPRNODE LABENTRY;	!PTR TO  STMNT NUMBER TABLE ENTRY
							! FOR THE LABEL TO BE USED ON THE "GOTO"
			LABENTRY_@(.CSTMNT[GOTOLIST]+.CGOEXP[CONST2]-1);
			CSTMNT[GOTOLBL]_.LABENTRY;

			LABENTRY[SNREFNO]_.LABENTRY[SNREFNO]+1;	!INCR REF CT FOR THE LABEL USED
							! (HAD PREVIOUSLY DECR'D IT WITH ALL THE OTHERS)
		END;

	END

	ELSE
	BEGIN
		CSTMNT[CGOTOLBL]_.CGOEXP;

		%(***CHECK FOR THE "COMPUTED" VAR EQUAL TO THE DO-LOOP INDEX.
			IF IT IS, THEN THIS DO LOOP SHOULD NOT USE AOBJN***)%
		IF .CGOEXP EQL .DOWDP[DOINDUC]
		THEN DOWDP[DONOAOBJN]_1;
	END;
END;	! of SKCGO

GLOBAL ROUTINE DELGOLABS(GOSTMNT)=
%(***************************************************************************
	ROUTINE TO DECREMENT THE REFERENCE CT FOR EACH LABEL ON A COMPUTED
	GOTO LIST. THIS ROUTINE MUST BE CALLED WHENEVER A COMPUTED GOTO
	IS OPTIMIZED OUT OF A PROGRAM.
	CALLED WITH THE ARG "GOSTMNT" POINTING TO THE COMPUTED GOTO STMNT.
***************************************************************************)%
BEGIN
	MAP BASE GOSTMNT;
	REGISTER CGOLISTPTR;	!PTR TO ELEMS ON CGOTO LIST
	REGISTER PEXPRNODE LABENTRY;	!PTR TO STMNT NUMBER TABLE ENTRY
					! FOR A LABEL ON THE CGOTO LIST

	CGOLISTPTR_.GOSTMNT[GOTOLIST];
	DECR CT FROM (.GOSTMNT[GOTONUM]-1) TO 0	!LOOK AT EACH LABEL ON LIST
	DO
	BEGIN
		[email protected];	!STMNT NUMBER TABLE ENTRY FOR THIS LABEL
		LABENTRY[SNREFNO]_.LABENTRY[SNREFNO]-1;	!DECR REF CT FOR THIS LABEL
		CGOLISTPTR_.CGOLISTPTR+1;	!GO ON TO NEXT ELEM ON LIST
	END;
END;	! of DELGOLABS

GLOBAL ROUTINE SKLOGIF=
%(***************************************************************************
	PERFORM PHASE 2 SKELETON OPTIMIZATIONS ON A LOGICAL IF STATEMENT
	CALLED WITH THE GLOBAL "CSTMNT" POINTING TO THE STATEMENT.
***************************************************************************)%
BEGIN
	REGISTER
		PEXPRNODE CONDEXPR,
		BASE SAVSTMNT;		! SAVE PTR TO THIS STMNT WHILE PROCESS
					! THE SUB-STATEMNET

	%(***PERFORM PHASE 2 SKELETON ON THE CONDITIONAL EXPRESSION***)%
	CONDEXPR_.CSTMNT[LIFEXPR];
	CONDEXPR_(.P2SKL1DISP[.CONDEXPR[OPRCLS]])(.CONDEXPR);
	CSTMNT[LIFEXPR]_.CONDEXPR;
	%(***IF PROPAGATED A NOT BACK UP FROM THE CONDITIONAL EXPR***)%
	IF .NOTFLG
	THEN CSTMNT[A1NOTFLG]_1;

	%(***IF CONDEXPR IS A CONSTANT, CHANGE THE LOGIF TO A CONTINUE FOLLOWED BY 
		THE SUBSTATEMENT****)%
	IF .CONDEXPR[OPR1] EQL CONSTFL
	THEN
	BEGIN
		FOLDLIF();
		RETURN;
	END

	%(***IF THE "CONDITIONAL EXPRESSION" IS SIMPLY THE LOOP INDEX OF THE INNERMOST
		EMBRACING DO LOOP, DO NOT WANT TO USE AOBJN FOR THAT DO LOOP***)%
	ELSE
	IF .CONDEXPR EQL .DOWDP[DOINDUC] THEN DOWDP[DONOAOBJN]_1;



	%(***PERFORM PHASE 2 SKELETON OPTIMIZATIONS ON THE SUBSTATEMENT ***)%
	SAVSTMNT_.CSTMNT;
	CSTMNT_.CSTMNT[LIFSTATE];

	%(***IF THE SUBSTATEMENT IS 'CONTINUE' CAN ELIMINATE THE CONDITIONAL ALTOGETHER***)%
	P2SKSTMNT();

	CSTMNT_.SAVSTMNT;
END;	! of SKLOGIF

GLOBAL ROUTINE SKARIF=
%(***************************************************************************
	PERFORM PHASE 2 SKELETON OPTIMIZATIONS ON AN ARITHMETIC IF
	STATEMENT.
	CALLED WITH THE GLOBAL CSTMNT POINTING TO THE STATEMENT.
***************************************************************************)%
BEGIN
	REGISTER
		PEXPRNODE CONDEXPR,	! THE CONDITIONAL EXPR UNDER THE STMNT
		BASE GONODE1,
		BASE GONODE2,
		RELOPERATOR;

	LOCAL
		PEXPRNODE ARG1NODE,	! THE 2 ARGS UNDER CONDEXPR
		PEXPRNODE ARG2NODE,
		PEXPRNODE RPTLBL,	! THE LABEL THAT OCCURS TWICE IN THIS
				! STMNT (IF ANY 2 OF THE 3 LABELS ARE THE SAME)
		SAVSTMN;	! Save CSTMNT

	CONDEXPR_.CSTMNT[AIFEXPR];

	%(***PERFORM PHASE 2 SKEL OPTIMIZ'S ON THE ARITH EXPRESSION UNDER THIS IF STMNT***)%

	CONDEXPR_(.P2SKL1DISP[.CONDEXPR[OPRCLS]])(.CONDEXPR);

	CSTMNT[AIFEXPR]_.CONDEXPR;
	CSTMNT[A1NEGFLG]_.NEGFLG<0,1>;

	%(***IF THE CONDITIONAL EXPRESSION IS A CONSTANT, CHANGE THE ARIF INTO A GOTO***)%
	IF .CONDEXPR[OPR1] EQL CONSTFL
	THEN
	BEGIN
		FOLDAIF();
		RETURN;
	END

	%(***IF THE "CONDITIONAL EXPRESSION" IS SIMPLY THE DO LOOP INDEX,
		DO NOT KEEP THAT INDEX IN THE RIGHT HALF OF AN AOBJN WD***)%
	ELSE
	IF .CONDEXPR EQL .DOWDP[DOINDUC] THEN DOWDP[DONOAOBJN]_1;




	%(***DETERMINE WHICH (IF ANY) OF THE 3 LABELS ON THE IF ARE IDENTICAL TO EACHOTHER***)%
	IF .CSTMNT[AIFLESS] EQL .CSTMNT[AIFEQL]
	THEN
	BEGIN
		%(***IF ALL 3 LABELS ARE IDENTICAL - MAKE THIS NODE BE A GOTO***)%
		IF .CSTMNT[AIFLESS] EQL .CSTMNT[AIFGTR]
		THEN
		BEGIN
%1050%			IF NOT .USERFNFLG THEN
%1050%			BEGIN	! Expression must not contain function calls
%1050%				CSTMNT[SRCID]_GOTOID;
%1050%				CSTMNT[GOTOLBL]_.CSTMNT[AIFLESS];
%1050%				RPTLBL_.CSTMNT[AIFLESS];
%1050%				RPTLBL[SNREFNO]_.RPTLBL[SNREFNO]-2
%1050%			END
		END

		ELSE
		CSTMNT[AIFLBEQV]_LELBEQV
	END

	ELSE
	IF .CSTMNT[AIFGTR] EQL .CSTMNT[AIFEQL]
	THEN
	CSTMNT[AIFLBEQV]_GELBEQV

	ELSE
	IF .CSTMNT[AIFLESS] EQL .CSTMNT[AIFGTR]
	THEN
	CSTMNT[AIFLBEQV]_LGLBEQV

	ELSE
	CSTMNT[AIFLBEQV]_NOLBEQV;


	%(***CHECK FOR THE ARITH EXPR A SUM OR DIFFERENCE - THEN
		IF OPERATION IS NOT DOUBLE-PREC WE WILL WANT TO GENERATE
		CODE TO TEST THE RELATION OF THE 2 TERMS UNDER THE SUM/DIFFERENCE
		RATHER THAN COMPUTING THE VALUE OF IT (WHEN
		ANY 2 OF THE 3 LABELS ARE IDENTICAL)****)%
	IF ADDORSUB(CONDEXPR) AND (NOT .CONDEXPR[DBLFLG]) AND (.CSTMNT[AIFLBEQV] NEQ NOLBEQV)
		AND (.CSTMNT[SRCLINK] NEQ 0)	!IF THIS ARITH IF IS THE TRUE BRANCH
						! UNDER A LOGICAL IF, CANNOT TRANSFORM
						! THIS ARITH IF TO A LOG IF
	THEN
	BEGIN
		%(***WANT TO TRANSFORM THE ARITHMETIC TO A LOGICAL IF-GOTO, FOLLOWED BY A GOTO***)%

		CSTMNT[SRCID] = IFLID;

%1530%		NAME<LEFT> = SRCSIZ + GOTOSIZ;
		GONODE1 = CORMAN();
		GONODE1[OPRCLS] = STATEMENT;
		GONODE1[SRCID] = GOTOID;
%1530%		NAME<LEFT> = SRCSIZ + GOTOSIZ;
		GONODE2 = CORMAN();
		GONODE2[OPRCLS] = STATEMENT;
		GONODE2[SRCID] = GOTOID;

		%(***DETERMINE WHAT RELATIONAL TO SUBSTITUTE FOR THE ARITHMETIC OPERATOR
			AND WHICH LABELS TO PUT ON EACH OF THE "GOTO"S***)%
		CASE .CSTMNT[AIFLBEQV] OF SET
		%(***IF NONE OF THE 3 LABELS ARE IDENTICAL, HAVE AN ERROR***)%
		CGERR();

		%(***IF LESS LABEL SAME AS EQL LABEL***)%
		BEGIN
			RELOPERATOR_LE;		!RELATIONAL BECOMES LE
			GONODE1[GOTOLBL]_.CSTMNT[AIFLESS];	!WHEN REL IS TRUE, GO
						! LABEL FOR LESS OR EQ
			GONODE2[GOTOLBL]_.CSTMNT[AIFGTR];
		END;

		%(***FOR LESS LABEL SAME AS GTR LABEL***)%
		BEGIN
			RELOPERATOR_N;		!RELATIONAL BECOMES NE
			GONODE1[GOTOLBL]_.CSTMNT[AIFLESS];	!WHEN REL IS TRUE, GOTO
						! LABEL FOR GTR OR LESS
			GONODE2[GOTOLBL]_.CSTMNT[AIFEQL];
		END;

		%(***FOR GTR LABEL SAME AS EQL LABEL***)%
		BEGIN
			RELOPERATOR_GE;		!RELATIONAL BECOMES GE
			GONODE1[GOTOLBL]_.CSTMNT[AIFGTR];	!WHEN REL IS TRUE, GOTO
						! LABEL FOR GTR  OR EQL
			GONODE2[GOTOLBL]_.CSTMNT[AIFLESS];
		END;
		TES;

		%(***FOR THE LABEL THAT OCCURED TWICE IN THE ORIGINAL STMNT,
			MUST DECREMENT THE REFERENCE COUNT SINCE IT IS NOW REFERENCED
			ONLY ONCE IN THE LOGICAL IF***)%
		RPTLBL_.GONODE1[GOTOLBL];
		RPTLBL[SNREFNO]_.RPTLBL[SNREFNO]-1;

		%(***IF ARITHMETIC EXPR WAS (A-B),  WILL WANT THE REALATIONAL
			A.RELAOPERATOR.B 
			TURN OFF THE NEGATE-FLAG ON ARG2
		*****)%
		IF .CONDEXPR[A2NEGFLG]
		THEN CONDEXPR[A2NEGFLG]_0

		ELSE
		%(***IF ARITHMETIC EXPRESSION WAS (A+B), THEN THE
			RELATIONAL IS OF THE FORM:
			A.RELAOPERATOR.(-B)
			SINCE WE CANNOT HANDLE AN A2NEGFLG ON A RELATIONAL WE 
			WILL EITHER:
				1. IF B IS A CONSTANT, NEGATE IT
			   OR	2. MULTIPLY THE RELATIONAL BY -1
		*******)%
		BEGIN
			ARG2NODE_.CONDEXPR[ARG2PTR];
			IF .ARG2NODE[OPR1] EQL CONSTFL
			THEN CONDEXPR[ARG2PTR]_NEGCNST(ARG2NODE)
			ELSE
			BEGIN
				%(**NEGATE THE 1ST ARG***)%
				ARG1NODE_.CONDEXPR[ARG1PTR];
				IF .ARG1NODE[OPR1] EQL CONSTFL
				THEN CONDEXPR[ARG1PTR]_NEGCNST(ARG1NODE)
				ELSE CONDEXPR[A1NEGFLG]_NOT .CONDEXPR[A1NEGFLG];

				%(***REVERSE THE SENSE OF THE RELATIONAL IF IT IS GE OR LE***)%
				IF .RELOPERATOR EQL LE THEN RELOPERATOR_GE
				ELSE
				IF .RELOPERATOR EQL GE THEN RELOPERATOR_LE;
			END;
		END;
		%(***TRANSFORM THE CONDEXPR INTO A RELATIONAL***)%
		CONDEXPR[OPERATOR]_OPERC(CONTROL,RELATIONAL,.RELOPERATOR);

		%(***TRANSFORM THE ARITH-IF STMNT INTO A LOGICAL IF***)%
		CSTMNT[SRCID]_IFLID;
		CSTMNT[AIFLBEQV]_0;
		CSTMNT[LIFSTATE]_.GONODE1;

		SAVSTMN_.CSTMNT;
		CSTMNT_.GONODE1;	!CALL P2SKSTMN FOR THE GOTO NODE THAT
		P2SKSTMNT();		! IS UNDER THE LOGICAL IF, SO THAT P2REGCNTS
					! WILL BE CALLED FOR IT AND ITS LABEL
					! CHECKED FOR A TRANSFER OUT THE CURRENT LOOP
		CSTMNT_.SAVSTMN;


		%(**INSERT THE EXTRA GOTO INTO THE PROGRAM***)%
		GONODE2[CLINK]_.CSTMNT[CLINK];
		CSTMNT[CLINK]_.GONODE2;

	END;

END;	! of SKARIF

GLOBAL ROUTINE SKASSI=
%(***************************************************************************
	TO PERFORM PHASE 2 SKEL OPTIMS ON AN ASSIGN STMNT.
	IF THE VAR ASSIGNED TO IS AN ARRAYREF, THERE MAY BE SOME OPTIMS THAT
	CAN BE PERFORMED ON THE ADDRESS ARITH.
***************************************************************************)%
BEGIN
	REGISTER PEXPRNODE SYMNODE;
	SYMNODE_.CSTMNT[ASISYM];
	IF .SYMNODE[OPRCLS] EQL ARRAYREF
	THEN P2SKLARR(.SYMNODE);
END;	! of SKASSI

ROUTINE SKIO(INPFLG)=
BEGIN
! [1516] New
! Phase 2 skeleton optimizations on READ/WRITE (etc.) statements

	REGISTER PEXPRNODE CNODE;

%1742%	SKWALK(CSTMNT[IOUNIT]);
%1742%	SKWALK(CSTMNT[IORECORD]);
%1742%	SKWALK(CSTMNT[IOIOSTAT]);

%2365%	! Check for inner DO-variable as keyword value
%2365%
%2365%	IF .CSTMNT[IOUNIT] EQL .DOWDP[DOINDUC]
%2365%		OR .CSTMNT[IORECORD] EQL .DOWDP[DOINDUC]
%2365%		OR .CSTMNT[IOIOSTAT] EQL .DOWDP[DOINDUC]
%2365%	THEN DOWDP[DONOAOBJN] = 1;	! don't use AOBJN

%1742%	IF .CSTMNT[IOFORM] NEQ #777777
%1742%	THEN SKWALK(CSTMNT[IOFORM]);	! Not list-directed I/O

	INPFLAG = .INPFLG;
	SKIOLST;		! Do skeleton opts on IOLIST
END;	! of SKIO

GLOBAL ROUTINE SKDECENC(INPFLG)=
BEGIN
	!***************************************************************
	! Perform  phase  2  skeleton  optimizations  on   ENCODE/DECODE
	! statements.
	!***************************************************************

	REGISTER PEXPRNODE CNODE;

%1742%	! Check for do index variables as keyword values

	IF .CSTMNT[IOVAR] EQL .DOWDP[DOINDUC]
	   OR .CSTMNT[IOCNT] EQL .DOWDP[DOINDUC]
%1742%	   OR .CSTMNT[IOIOSTAT] EQL .DOWDP[DOINDUC]
	THEN DOWDP[DONOAOBJN] = 1;	! don't use AOBJN

	CNODE = .CSTMNT[IOVAR];

	%(***OF THE ENCODE/DECODE ARRAY IS ACTUALLY AN ARRAYREF NODE (IE
		IT INCLUDES AN OFFSET) PERFORM P2SKEL OPTIMS  ON THE ADDR
		CALC****)%
	IF .CNODE[OPRCLS] EQL ARRAYREF
	THEN CSTMNT[IOVAR]_P2SKLARR(.CNODE);

%1742%	SKWALK(CSTMNT[IOCNT]);		! Do skeleton opts on count
%1742%	SKWALK(CSTMNT[IOIOSTAT]);	! Do skeleton opts on IOSTAT

%1742%	IF .CSTMNT[IOFORM] NEQ #777777
%1742%	THEN SKWALK(CSTMNT[IOFORM]);	! Not list-directed I/O

%1742%	INPFLAG = .INPFLG;
%1742%	SKIOLST;		! Do skeleton opts on IOLIST

END;	! of SKDECENC

ROUTINE SKOPNCLS=
BEGIN
%1527%	! New
%2200%	! Do  phase   2   skeleton   optimizations   on   arguments   of
%2200%	! OPEN/CLOSE/INQUIRE statement.

	REGISTER
		PEXPRNODE CNODE,
%1742%		OPENLIST OPENL;

%1742%	SKWALK(CSTMNT[IOUNIT]);		! walk unit expression if specified
%1742%	SKWALK(CSTMNT[IOIOSTAT]);	! walk iostat expression if specified
%2200%	SKWALK(CSTMNT[IOFILE]);		! walk file expression if specified

%2365%	! Check for inner DO-variable as keyword value
%2365%
%2365%	IF .CSTMNT[IOUNIT] EQL .DOWDP[DOINDUC]
%2365%		OR .CSTMNT[IOIOSTAT] EQL .DOWDP[DOINDUC]
%2365%	THEN DOWDP[DONOAOBJN] = 1;	! don't use AOBJN

%1742%	OPENL = .CSTMNT[OPLST];		! walk other args in the keyword list
%1742%	DECR I FROM .CSTMNT[OPSIZ] - 1 TO 0 DO
%1742%	BEGIN
%1742%		SKWALK(OPENL[.I,OPENLPTR]);	! Walk expression if not 0
%1742%					! i.e. DIALOG, READONLY
%1742%
%1742%		! Check for do index variable as argument
%1742%		IF .OPENL[.I,OPENLPTR] EQL .DOWDP[DOINDUC]
%1742%		THEN DOWDP[DONOAOBJN] = 1;	! don't use AOBJN
%1742%	END;
END;	! of SKOPNCLS

GLOBAL ROUTINE SKCALL=
%(***************************************************************************
	PERFORM PHASE 2 SKEL OPTIMIZS ON ALL ARGS OF A CALL STMNT
***************************************************************************)%
BEGIN
	REGISTER
		ARGUMENTLIST ARGLST,
		PEXPRNODE ARGNODE;

	ARGLST_.CSTMNT[CALLIST];		!PTR TO ARG LIST

	%(***IF THERE ARE NO ARGS, RETURN***)%
	IF .ARGLST EQL 0 THEN RETURN;

	%(***WALK THRU THE ARGS***)%
	INCR CT FROM 1 TO .ARGLST[ARGCOUNT]
	DO
	BEGIN
		IF NOT .ARGLST[.CT,AVALFLG]
		THEN
%2272%		BEGIN	! Arg is an expression
%2272%
%2272%			ARGNODE = .ARGLST[.CT,ARGNPTR];	! Get ptr to this arg
%2272%
%2272%			! Perform skeleton optimizations on this argument.
%2272%
%2272%			NEGFLG = FALSE;
%2272%			NOTFLG = FALSE;
%2272%			ARGLST[.CT,ARGNPTR] = ARGNODE =
%2272%				(.P2SKL1DISP[.ARGNODE[OPRCLS]])(.ARGNODE);
%2272%
%2272%			IF .ARGNODE[OPRCLS] EQL DATAOPR
%2272%			THEN ARGLST[.CT,AVALFLG] = 1;
%2272%
%2272%		END;	! Arg is an expression
	END;

%2272%	ARGNODE = .CSTMNT[CALSYM];	! Get sym table entry for routine name
%2304%	ARGNODE = .ARGNODE[IDSYMBOL];	! Get sixbit routine name
%2272%
%2304%	! If the CALL is  really a character concatenation  assignment
%2304%	! (normal  or  statement  function),  call  P2SKFOLD  to  fold
%2304%	! top-level concatenations in the argument list.
%2272%
%2304%	IF .ARGNODE EQL SIXBIT 'CNCAM.' OR .ARGNODE EQL SIXBIT 'CHSFC.'
%2272%	THEN CSTMNT[CALLIST] = P2SKFOLD(.CSTMNT[CALLIST],.CSTMNT);

%2304%	! If the CALL is  really a character  assignment (but not  for
%2304%	! statement functions), call P2SKOVRLP to handle  compile-time
%2304%	! overlap tests.
%2304%
%2304%	IF .ARGNODE EQL SIXBIT 'CASNM.' OR .ARGNODE EQL SIXBIT 'CNCAM.'
%2304%	THEN P2SKOVRLP();

END;	! of SKCALL

GLOBAL ROUTINE FOLDIOLST=
%(***************************************************************************
	ROUTINE TO WALK THRU AN IOLIST FOLDING TOGETHER GROUPS OF ELEMENTS THAT CAN
	BE HANDLED BY A SINGLE CALL TO THE OPERATING SYSTEM ROUTINE IOLST.
	FOLDS TOGETHER BLOCKS OF DATACALL, SLISTCALL, AND ELISTCALL NODES
	SUCH THST:
		1.NO DO-STATEMENT NODES OR CONTINUE-STATEMENT NODES WITH
			DO TERMINATION LABELS OCCUR BETWEEN NODES
		2. FOR AN INPUT STATEMENT, NO ELEMENT IN A BLOCK HAS A VALUE WHICH
			IS DEPENDENT ON AN EARLIER ELEMENT IN THE BLOCK.
	CALLED WITH THE GLOBAL CSTMNT POINTING TO THE STATEMENT WHOSE IOLIST IS TO
	BE FOLDED.
***************************************************************************)%
BEGIN
	REGISTER
		BASE IOLELEM,
		BASE PREVELEM;

	%(***GET PTR TO 1ST ELEM ON IOLIST*****)%
	IOLELEM_.CSTMNT[IOLIST];

	%(***IF THERE IS ONLY ONE ELEMENT ON THE LIST, RETURN***)%
	IF .IOLELEM[CLINK] EQL 0 THEN RETURN;

	%(***TRY TO FORM AN IOLISTCALL NODE FROM THIS ELEMENT TOGETHER WITH THE
		ELEMENT FOLLOWING IT, AND PUT THAT NODE UNDER THE IOLIST FIELD OF
		THE IO STMNT*****)%
	IF .IOLELEM[OPRCLS] EQL IOLSCLS
	THEN
	BEGIN
		IOLELEM_FORMIOLST(.IOLELEM);		!FORMIOLIST RETURNS A PTR TO
							! THE IOLIST FORMED OR (IF
							! UNSUCCESSFUL) A PTR TO IOLELEM
		CSTMNT[IOLIST]_.IOLELEM;
	END
	ELSE
	CIOCALL_-1;


	UNTIL .IOLELEM[CLINK] EQL 0
	DO
	BEGIN
		PREVELEM_.IOLELEM;
		IOLELEM_.IOLELEM[CLINK];
		%(***A STATEMENT NODE ALWAYS CAUSES TERMINATION OF AN IOLIST***)%
		IF .IOLELEM[OPRCLS] EQL STATEMENT
		THEN
		CIOCALL_-1

		ELSE
		IF .IOLELEM[OPRCLS] EQL IOLSCLS
		THEN
		BEGIN
			%(***IF THERE IS NO IOLST CURRENTLY BEING BUILT, SEE 
				WHETHER CAN MEKE ONE OF THIS ELEM AND THE
				ONE FOLLOWING IT
			*******)%
			IF .CIOCALL EQL -1
			THEN
			BEGIN
				IOLELEM_FORMIOLST(.IOLELEM);
				PREVELEM[CLINK]_.IOLELEM;
			END

			ELSE
			%(***ON INPUT, IF THE VALUE OF THIS EXPRESSION IS DEPENDENT
				ON THE CONTENTS OF THE IOLIST BEING FORMED,
				THEN TRY TO START A NEW IOLIST WITH THIS ELEM AND
				THE ONE FOLLOWING IT
			****)%
%2405%			IF (.INPFLAG AND IODEPNDS(.IOLELEM,.CIOCALL))
%2405%				OR CONTFN(.IOLELEM)
			THEN
			BEGIN
				%(***TERMINATE CURRENT IOLIST***)%
				CIOCALL_-1;

				IOLELEM_FORMIOLST(.IOLELEM);
				PREVELEM[CLINK]_.IOLELEM;
			END

			ELSE
			%(***IF THIS ELEMENT CAN BE ADDED TO THE IOLIST BEING
				FORMED, ADD IT***)%
			BEGIN
				%(***REMOVE THIS ELEM FROM THE IOLIST BY LINKING THE
					IOLISTCALL NODE (WHICH DIRECTLY PRECEEDED IT)
					TO THE ELEMENT AFTER IT***)%
				CIOCALL[CLINK]_.IOLELEM[CLINK];

				%(***PUT THIS ELEMENT UNDER THE IOLISTCALL NODE***)%
				CIOCLAST[CLINK]_.IOLELEM;
				IOLELEM[CLINK]_0;
				CIOCLAST_.IOLELEM;

				%(***SET "CURRENT IOLIST ELEMENT" TO BE THE IOLISTCALL NODE***)%
				IOLELEM_.CIOCALL;
			END;

		END;
	END;
END;	! of FOLDIOLST

GLOBAL ROUTINE FORMIOLST(IOLELEM)=
%(***************************************************************************
	ROUTINE TO TRY TO FORM A SINGLE IOLSTCALL NODE
	FROM THE IOLIST ELEMENT "IOLELEM" AND THE IOLIST ELEMENT THAT FOLLOWS
	IT.
	IF THIS ROUTINE IS SUCCESSFUL IN FORMING AN IOLIST, IT
	SETS THE GLOBAL CIOCALL TO POINT TO THE IOLISTCALL NODE CREATED, AND THE
	GLOBAL CIOCLAST TO POINT TO THE "LAST" ELEMENT UNDER THAT LIST (IE THE 2ND
	ELEMENT).
	IF IT WAS UNSUCCESSFUL, IT SETS CIOCALL TO -1
	RETURNS A PTR TO THE NODE FORMED IF SUCCESSFUL, A PTR TO IOLELEM IF NOT.
	IS CALLED WITH THE GLOBAL INPFLAG=TRUE IF THE STMNT INVOLVED IS AN INPUT STMNT.
***************************************************************************)%
BEGIN
	MAP BASE IOLELEM;
	REGISTER
		BASE IOLNODE,
		BASE NXTELEM;

	CIOCALL_-1;
	%(****IF IOLELEM IS THE LAST ELEM ON THE IOLIST, CANNOT DO ANYTHING***)%
	IF .IOLELEM[CLINK] EQL 0 THEN RETURN .IOLELEM;

%1441%

	NXTELEM_.IOLELEM[CLINK];

	%(***IF THE 2ND NODE IS A STMNT, CANNOT FORM AN IOLST***)%
	IF .NXTELEM[OPRCLS] EQL STATEMENT THEN RETURN .IOLELEM;

%1441%	! If the 2nd node contains a function call, cannot form an IOLST
%1441%	IF CONTFN(.NXTELEM) THEN RETURN .IOLELEM;

	%(***FOR INPUT STMNTS, THE VAL OF THE 2ND ARG CANNOT BE
		DEPENDENT ON THE VAL OF THE 1ST ***)%
	IF .INPFLAG
	THEN
	BEGIN
		IF IODEPNDS(.NXTELEM,.IOLELEM) THEN RETURN .IOLELEM;

	END;

	%(***MAKE A NEW NODE - OPRCLS=IOLSCLS, OPERSP=IOLSTCALL****)%

%1530%	NAME<LEFT> = IOLCSIZ;
%1530%	IOLNODE = CORMAN();
%1530%	IOLNODE[OPERATOR] = IOLSTCFL;
%1530%	IOLNODE[IOLSTPTR] = .IOLELEM;
%1530%	IOLNODE[IOLSTATEMENT] = .CSTMNT;	! Pointer to the I/O statement

	%(***SET THE LINK FIELD OF THE NODE CREATED TO PT TO THE ELEM AFTER THE LAST
		ELEM REMOVED FROM TH IOLIST AND PUT UNDER THIS IOLISTCALL***)%
	IOLNODE[CLINK]_.NXTELEM[CLINK];

	%(***SET THE LINK OF THE LAST ELEM UNDER THE IOLSTCALL TO 0***)%
	NXTELEM[CLINK]_0;

	%(***SET UP THE GLOBALS CIOCALL (PTR TO IOLSTCALL NODE BEING FORMED) AND CIOCLAST (PTR
		TO LAST ELEM UNDER CIOCALL) ****)%
	CIOCALL_.IOLNODE;
	CIOCLAST_.NXTELEM;
	RETURN .IOLNODE;
END;	! of FORMIOLST

GLOBAL ROUTINE LOOKELEM2(VARPTR,IOELEM)=
	%(**************************************************************
		ROUTINE TO DETERMINE IF THE VARIABLE VARPTR
		IS USED UNDER ANY EXPRESSION IN THE IOLSCLS
		NODE IOELEM
	**************************************************************)%

BEGIN
	MAP
		BASE VARPTR,
		BASE IOELEM;

	REGISTER BASE IOARRAY;

	ROUTINE FILTER(EXPR,VAR)=
	%(******************************************************

		Routine to FILTER calls to CONTVAR

	******************************************************)%
	BEGIN
		MAP
			BASE EXPR,
			BASE VAR;

%2405%		! The following checks are very dependent on the order
%2405%		! in which they're made.
%2405%
%2405%		! Be less pessimal for SUBSTRINGs
%2405%
%2405%		IF .EXPR[OPRCLS] EQL SUBSTRING
%2405%		THEN
%2405%		BEGIN	! EXPR is a SUBSTRING
%2405%
%2405%			IF CONTVAR(.EXPR[ARG1PTR],.VAR)	! Check upper bound
%2405%			THEN RETURN TRUE;		! Found a dependency
%2405%
%2405%			IF CONTVAR(.EXPR[ARG2PTR],.VAR)	! Check lower bound
%2405%			THEN RETURN TRUE;		! Found a dependency
%2405%
%2405%			! There is no dependency due to the  substring
%2405%			! bounds, so just  use what  we're taking  the
%2405%			! substring from.
%2405%
%2405%			EXPR = .EXPR[ARG4PTR];		! Safe to use name
%2405%
%2405%		END;	! EXPR is a SUBSTRING
%2405%
%2405%		! Ideally we  would return  FALSE  here if  EXPR  were
%2405%		! DATAOPR.  However, other routines  rely on this  not
%2405%		! happening.  For example, LPVARDEPNDS.
%2405%
%2405%		! Be less  pessimal  for  ARRAYREFs,  only  the  index
%2405%		! expression matters.

		IF .EXPR[OPRCLS] EQL ARRAYREF
		THEN IF (EXPR = .EXPR[ARG2PTR]) EQL 0
		THEN RETURN FALSE;

		RETURN CONTVAR(.EXPR,.VAR)

	END;	! of FILTER (local)

	CASE .IOELEM[OPERSP] OF SET

%DATACALL%	RETURN FILTER(.IOELEM[DCALLELEM],.VARPTR);

%SLISTCALL%	RETURN IF FILTER(.IOELEM[SCALLELEM],.VARPTR) THEN 1
			ELSE FILTER(.IOELEM[SCALLCT],.VARPTR);

%IOLSTCALL%	BEGIN
			IOARRAY_.IOELEM[IOLSTPTR];
			WHILE .IOARRAY NEQ 0 DO
			BEGIN
%2405%				IF LOOKELEM2(.VARPTR,.IOARRAY) THEN RETURN 1;
				IOARRAY_.IOARRAY[CLINK]
			END
		END;

%E1LISTCALL%	BEGIN

%1167%			! See if count or incr depends on a previous element

%1167%			IF CONTVAR(.IOELEM[ECNTPTR],.VARPTR) THEN RETURN 1;
%1167%			IF CONTVAR(.IOELEM[E1INCR],.VARPTR) THEN RETURN 1;

			IOARRAY_.IOELEM[ELSTPTR];
			WHILE .IOARRAY NEQ 0 DO
			BEGIN
				IF FILTER(.IOARRAY[E2ARREFPTR],.VARPTR)
				 THEN RETURN 1;
				IOARRAY_.IOARRAY[CLINK]
			END;
!**;[1207], LOOKELEM2, DCE, 3-APR-81
%1207%			IF F77 THEN
%1207%			BEGIN
%1207%				IOARRAY_.IOELEM[ELPFVLCHAIN];
%1207%				WHILE .IOARRAY NEQ 0 DO
%1207%				BEGIN
%1207%					IF FILTER(.IOARRAY[LHEXP],.VARPTR)
%1207%					 THEN RETURN 1;
%1207%					IOARRAY_.IOARRAY[CLINK]
%1207%				END
%1207%			END
		END; ! Of E1LISTCALL

%E2LISTCALL%	BEGIN

%1167%			! See if count depends on a previous element

%1167%			IF CONTVAR(.IOELEM[ECNTPTR],.VARPTR) THEN RETURN 1;

			IOARRAY_.IOELEM[ELSTPTR];
			WHILE .IOARRAY NEQ 0 DO
			BEGIN
				IF FILTER(.IOARRAY[E2ARREFPTR],.VARPTR)
				THEN RETURN 1;

%1167%				! See if incr depends on a previous element

%1167%				IF CONTVAR(.IOARRAY[E2INCR],.VARPTR)
				THEN RETURN 1;

				IOARRAY_.IOARRAY[CLINK]
			END;
!**;[1207], LOOKELEM2, DCE, 3-APR-81
%1207%			IF F77 THEN
%1207%			BEGIN
%1207%				IOARRAY_.IOELEM[ELPFVLCHAIN];
%1207%				WHILE .IOARRAY NEQ 0 DO
%1207%				BEGIN
%1207%					IF FILTER(.IOARRAY[LHEXP],.VARPTR)
%1207%					 THEN RETURN 1;
%1207%					IOARRAY_.IOARRAY[CLINK]
%1207%				END
%1207%			END
		END; ! Of E2LISTCALL
	TES;
	RETURN 0
END; ! of LOOKELEM2

GLOBAL ROUTINE IODEPNDS(IOELEM2,IOELEM1)=
%(***************************************************************************
	ROUTINE TO DETERMINE WHETHER THE IOLIST ELEMENT IOELEM2 HAS A VALUE
	WHICH IS DEPENDENT ON THE EVALUATION OF IOLELEM1.
	THIS ROUTINE IS ONLY CALLED FOR INPUT IOLISTS - HENCE IT CAN
	BE ASSUMED THAT THE ELEMENT UNDER A DATACALL CAN ONLY BE A
	VARIABLE OR ARRAYREF.
	THIS ROUTINE IS ONLY CALLED FOR BOTH IOLELEM1 AND IOLELEM2 WITH
	OPRCLS=IOLSCLS
***************************************************************************)%
BEGIN
	MAP
		BASE IOELEM1,
		BASE IOELEM2;

	REGISTER BASE IOARRAY;

%(***	THIS ROUTINE IS DRIVEN BY LOOKING AT THE ELEMENT TO
	BE APPENDED TO.

	FOR EACH VARIABLE "READ" BY THAT ELEMENT A CALL
	IS MADE TO LOOKELEM2 TO SEE IF THE
	SECOND ELEMENT USES THAT VARIABLE IN ANY
	COMPUTATION.

	IF SO, THE IONODES ARE DEPENDENT, IF NOT, INDEPENDENT.

***)%

	CASE .IOELEM1[OPERSP] OF SET

%DATACALL%	RETURN LOOKELEM2(.IOELEM1[DCALLELEM],.IOELEM2);

%SLISTCALL%	RETURN LOOKELEM2(.IOELEM1[SCALLELEM],.IOELEM2);

%IOLSTCALL%	BEGIN
			IOARRAY_.IOELEM1[IOLSTPTR];
			WHILE .IOARRAY NEQ 0 DO
			BEGIN
				IF IODEPNDS(.IOELEM2,.IOARRAY) THEN RETURN 1;
				IOARRAY_.IOARRAY[CLINK]
			END
		END;

%E1LISTCALL%	BEGIN
			IOARRAY_.IOELEM1[ELSTPTR];
			WHILE .IOARRAY NEQ 0 DO
			BEGIN
				IF LOOKELEM2(.IOARRAY[E2ARREFPTR],.IOELEM2)
				 THEN RETURN 1;
				IOARRAY_.IOARRAY[CLINK]
			END;
!**;[1207], IODEPNDS, DCE, 3-APR-81
%1207%			IOARRAY_.IOELEM1[ELPFVLCHAIN];
%1207%			WHILE .IOARRAY NEQ 0 DO
%1207%			BEGIN
%1207%				IF LOOKELEM2(.IOARRAY[LHEXP],.IOELEM2)
%1207%				 THEN RETURN 1;
%1207%				IOARRAY_.IOARRAY[CLINK]
%1207%			END
		END;

%E2LISTCALL%	BEGIN
			IOARRAY_.IOELEM1[ELSTPTR];
			WHILE .IOARRAY NEQ 0 DO
			BEGIN
				IF LOOKELEM2(.IOARRAY[E2ARREFPTR],.IOELEM2)
				 THEN RETURN 1;
				IOARRAY_.IOARRAY[CLINK]
			END;
!**;[1207], IODEPNDS, DCE, 3-APR-81
%1207%			IOARRAY_.IOELEM1[ELPFVLCHAIN];
%1207%			WHILE .IOARRAY NEQ 0 DO
%1207%			BEGIN
%1207%				IF LOOKELEM2(.IOARRAY[LHEXP],.IOELEM2)
%1207%				 THEN RETURN 1;
%1207%				IOARRAY_.IOARRAY[CLINK]
%1207%			END
		END;
	TES;
RETURN 0
END;	! of IODEPNDS

GLOBAL ROUTINE LPVARDEPNDS(IOELEM2,IOELEM1)=
%(***************************************************************************
	This routine determines whether there is any dependency between
	a loop variable which might occur in IOELEM1 and any variable
	occurring in IOLIST IOELEM2.  This is used only for output
	statements where loop variables may take on new (final) values.
	In an output list, new values can be generated only by loop
	variables and during function calls (which are handled in COLLAPSE).
	For example, WRITE() (A(I),I=1,10),I represents a dependency which
	should cause separate .IOLST calls - the dependency is caught here.
	This entire routine was added by edit 1207.
***************************************************************************)%
BEGIN
	MAP
		BASE IOELEM1,
		BASE IOELEM2;
	REGISTER BASE IOARRAY;

	CASE .IOELEM1[OPERSP] OF SET

%DATACALL%	RETURN 0;	! No loop variables in a DATACALL node

%SLISTCALL%	RETURN 0;	! No loop variables in an SLISTCALL node

%IOLSTCALL%	BEGIN
			IOARRAY_.IOELEM1[IOLSTPTR];
			WHILE .IOARRAY NEQ 0 DO
			BEGIN
				IF LPVARDEPNDS(.IOELEM2,.IOARRAY)
				 THEN RETURN 1;
				IOARRAY_.IOARRAY[CLINK]
			END
		END;

%E1LISTCALL%	BEGIN
			IOARRAY_.IOELEM1[ELPFVLCHAIN];
			WHILE .IOARRAY NEQ 0 DO
			BEGIN
				IF LOOKELEM2(.IOARRAY[LHEXP],.IOELEM2)
				 THEN RETURN 1;
				IOARRAY_.IOARRAY[CLINK]
			END
		END;
				
%E2LISTCALL%	BEGIN
			IOARRAY_.IOELEM1[ELPFVLCHAIN];
			WHILE .IOARRAY NEQ 0 DO
			BEGIN
				IF LOOKELEM2(.IOARRAY[LHEXP],.IOELEM2)
				 THEN RETURN 1;
				IOARRAY_.IOARRAY[CLINK]
			END
		END;
	TES;

	RETURN 0 ! => No dependency.

END; ! of LPVARDEPNDS

GLOBAL ROUTINE DOP2SKL=
BEGIN
	! Routine to handle p2skeleton functions for do statements

	REGISTER BASE DOEXPR;

	!INITIALIZE NEGFLG AND NOTFLG TO FALSE
	NEGFLG_FALSE;
	NOTFLG_FALSE;

	DOEXPR_.CSTMNT[DOLPCTL];

	! Call the dispatch for the DO loop control

	IF .DOEXPR[OPRCLS] NEQ DATAOPR THEN
		CSTMNT[DOLPCTL] = (.P2SKL1DISP[.DOEXPR[OPRCLS]])(.DOEXPR);

	! Set  up   (if  necessary)   for  the   leaf  substitution   of
	! reg-contents nodes for the do induction variable.

	! To insure  optimal  usage  of  the  induction  variable  in  a
	! register on an  innermost do  loop the global  CDONODE will  point
	! back to the DO  statement so that flags  can be set and  unset
	! properly.   (???change  for  large  source  solution???)   The
	! global DOWDP will have the "DOISUBS"  bit set to 0 whenever  a
	! condition is  detected which  necessitates materialization  of
	! both loop index and count; the "DONOAOBJN" bit set whenever  a
	! condition is detected which prevents use of "AOBJN" loop;  the
	! "DOMTRLZIX" bit set whenever a condition is encountered  which
	! necessitates materialization of the loop index only.

	IF .CSTMNT[INNERDOFLG] THEN
	BEGIN	! This DO loop is an innermost DO

		INNERLOOP_TRUE;	!SET GLOBAL FLAG FOR "PROCESSING STMNTS
				! IN AN INNERMOST LOOP"
		DOWDP_0;
		CDONODE_.CSTMNT;
		DOWDP[DOINDUC]_.CSTMNT[DOSYM];
		CSTMNT[NEDSMATRLZ]_0;
		DOWDP[DOISUBS]_1;
		DOWDP[DONOAOBJN]_0;
		DOWDP[DOMTRLZIX]_0;
		TRANSFOUT_FALSE;

		!KEEP A TABLE OF LABELS THAT OCCUR WITHIN THIS
		! LOOP. ALSO KEEP A COUNT OF THE NUMBER OF REFERENCES
		! TO EACH SUCH LABEL THAT OCCUR FROM WITHIN THE
		! LOOP.
		!IF A TRANSFER OUT OF THE LOOP (IE A TRANSFER TO A LABEL
		! NOT IN THE TABLE) IS DETECTED, THE LOOP INDEX MUST BE
		! MATERIALIZED. IF A TRANSFER INTO THE LOOP IS DETECTED
		! (IE THE REF CT FOR A LABEL IS GTR THAN THE NUMBER OF
		! REFS FROM WITHIN THE LOOP), THEN IF THERE ARE ANY TRANSFERS
		! OUT, AN EXTENDED RANGE IS ASSUMED AND THE
		! COUNT-CTL VAR MUST BE MATERIALIZED AS WELL AS THE INDEX.
		! IF THERE IS TRANSFER IN BUT NO TRANSFER OUT, HAVE AN ERROR

		CTR_1;
		CHOSEN[0,LABL]_.CDONODE[DOLBL];	!PUT THE LOOP TERMINATING LABEL
						! INTO THE TABLE

		CHOSEN[0,LOCREFCT]_0;	!IN COUNTING REFS WE WILL NOT CT REFS
					! AS LOOP ENDINGS

		DOEXPR_.CDONODE[SRCLINK];
		WHILE .DOEXPR[SRCLBL] NEQ .CDONODE[DOLBL] DO	!LOOK AT ALL STMNTS IN THE LOOP
		BEGIN
			IF .DOEXPR[SRCLBL] NEQ 0 THEN
			BEGIN
				CHOSEN[.CTR,LABL]_.DOEXPR[SRCLBL];
				CHOSEN[.CTR,LOCREFCT]_0;	!INIT REF CT
				CTR_.CTR+1;
				IF .CTR GEQ 32 THEN
				BEGIN
					!CHOSEN IS FULL. FORGET IT.
					DOWDP[DOISUBS]_0;
					CDONODE[NEDSMATRLZ]_1;
					RETURN;
				END;
			END;
			DOEXPR_.DOEXPR[SRCLINK];
		END;
	END;	! This DO loop is an innermost DO

END;	! of DOP2SKL

ROUTINE TRINTOLOOP=
%(***************************************************************************
	ROUTINE TO EXAMINE THE CONTENTS OF THE TABLE "CHOSEN" TO DETERMINE
	WHETHER THERE ARE ANY TRANSFERS INTO THE DO LOOP
	WHICH HAS JUST BEEN PROCESSED.
	THE "LOCREFCT" FIELD OF THE ENTRY FOR EACH LABEL CONTAINS A CT
	OF THE NUMBER OF TRANSFERS TO THIS LABEL THAT OCCUR
	WITHIN THE LOOP.
***************************************************************************)%
BEGIN
	REGISTER PEXPRNODE LABENTRY;

	INCR I FROM 0 TO (.CTR-1)	!LOOK AT EACH ENTRY IN THE TABLE
	DO
	BEGIN
		LABENTRY_.CHOSEN[.I,LABL];
		IF (.LABENTRY[SNREFNO]	!NUMBER OF REFS TO THIS LABEL
					! OTHER THAN AS A FORMAT
		    -1			! DONT COUNT THE DEFINITION OF THE LABEL
		    -.LABENTRY[SNDOLVL]) ! DONT COUNT REFERENCES TO THE LABEL
					! THAT WERE REFERENCES AS DO LOOP TERMINATIONS
		   GTR .CHOSEN[.I,LOCREFCT]	!IF THE NUMBER OF REFS FROM INSIDE
					! THE LOOP WAS LESS THAN THE TOTAL REFERENCES
		THEN RETURN TRUE;	!THEN THERE MUST BE A TRANSFER INTO
					! THE RANGE OF THE LOOP
	END;

	RETURN FALSE;	!IF NO LABELS HAVE LOCAL CTS THAT ARE LESS THAN
			! THEIR TOTAL CTS - THEN NO TRANSFERS INTO THE LOOP
END;	! of TRINTOLOOP

GLOBAL ROUTINE DOENSKL=
%(***************************************************************************
	ROUTINE TO DO P2SKEL PROCESSING FOR THE TERMINATION OF AN INNERMOST
	DO LOOP.
	THIS ROUTINE IS CALLED WITH THE GLOBAL "CSTMNT" POINTING TO A STATEMENT
	THAT HAS A LABEL. IT IS ONLY CALLED IF THE GLOBAL "INNERLOOP"
	IS "TRUE" (INDICWTING THAT WE ARE PROCESSING AN INNER DO LOOP).
	IT CHECKS WHETHER THE LABEL ON THIS STMNT ENDS THE
	CURRENT DO LOOP.
	AT THE END OF AN INNER DO LOOP, IT DETERMINES WHETHER 
		1. THE LOOP INDUCTION VARIABLE AND THE LOOP CT MUST
			BOTH BE MATERIALIZED (IN WHICH CASE "NEDSMATRLZ"
			GETS SET IN THE DO STMNT)
			
		2. THE LOOP CT CAN STAY IN A REG, BUT THE INDUCTION
			VARIABLE MUST BE MATERIALIZED (IN WHICH CASE "MATRLZIXONLY"
			IS SET IN THE DO STMNT)
		3. "AOBJN" SHOULD NEVER BE USED FOR THIS LOOP
			("NOFLCWDREG" SET IN THE DO STMNT)
***************************************************************************)%
BEGIN
	REGISTER BASE DOVAR;	!TO CHECK SYMBOL FOR BEING IN COMMON
				!AND/OR EQUIVALENCED

	%(***IF ARE AT THE TERMINATION LABEL OF THE DO LOOP WHOSE STMNT
		NODE WAS THE LAST DO STMNT SEEN (HENCE ARE AT THE TERMINATION
		OF AN INNERMOST-LOOP)****)%
	IF .CSTMNT[SRCLBL] EQL .CDONODE[DOLBL]

	THEN
	BEGIN
		%(***CHECK WHETHER THERE ARE ANY TRANSFERS IN TO THIS
			LOOP***)%
		IF TRINTOLOOP()
		THEN
		BEGIN
			%(***IF THERE ARE BOTH TRANSFERS IN AND TRANSFERS OUT,
				ASSUME AN EXTENDED RANGE AND MATERIALIZE BOTH
				THE LOOP CT AND THE INDUCTION VARIABLE**)%
			IF .TRANSFOUT
			THEN
			CDONODE[NEDSMATRLZ]_1

			ELSE
			%(***IF THERE ARE TRANSFERS OUT BUT NO TRANSFERS IN,
				GIVE AN ERROR MESSAGE***)%
			BEGIN
				CDONODE[NEDSMATRLZ]_1;
			END;
		END

		ELSE
		%(***IF THE FLAG "DOISUBS" HAS BEEN TURNED OFF WHILE PROCESSING
			THE STATEMENTS IN THIS LOOP, MUST SET "NEDSMATRLZ" FLAG
			ON THE DO-LOOP NODE.***)%
		IF NOT .DOWDP[DOISUBS]
		THEN CDONODE[NEDSMATRLZ]_1

		ELSE
		%(***IF THE FLAG "DOMTRLZIX" HAS BEEN SET, MUST SET
			THE "MATRLZIXONLY" FLAG IN THE DO STMNT.
			ALSO, IF THE DO LOOP INDEX IS IN COMMON
			OR EQUIVALENCED IN MUST BE MATERIALIZED***)%
		BEGIN
			DOVAR_.CDONODE[DOSYM];
			IF .DOWDP[DOMTRLZIX]
			OR .DOVAR[IDATTRIBUT(INCOM)]
			OR .DOVAR[IDATTRIBUT(INEQV)]
			OR (.FLGREG<DBGINDX>	!IF /DEB:INDEX WAS SPECIFIED BY THE USER
				AND NOT .FLGREG<OPTIMIZE>)
			THEN
				CDONODE[MATRLZIXONLY]_1;
		END;


		%(***IF THE FLAG "DONOAOBJN" HAS BEEN SET WHILE PROCESSING
			THE STATEMENTS IN THIS LOOP, MUST UNDO THE DETERMINATION
			THAT THIS LOOP BE HANDLED WITH AN AOBJN***)%
		IF .DOWDP[DONOAOBJN]
		THEN
		BEGIN
			CDONODE[NOFLCWDREG]_1;	!SET FLAG SO THAT THE OPTIMIZER WONT LATER
						! DECIDE TO HAVE THE LOOP BE HANDLED
						! BY AN AOBJN THAT LIVES IN A REG

			IF .CDONODE[FLCWD]
			THEN UNFLDO(.CDONODE);
		END;

		INNERLOOP_FALSE;	!AFTER THIS STMNT WILL NO LONGER
					! BE IN AN INNERMOST LOOP

	END;
END;	! of DOENSKL

GLOBAL ROUTINE P2REGCNTS=
%(***************************************************************************
	THIS ROUTINE IS CALLED FOR EACH STATEMENT IN AN INNERMOST DO LOOP TO
	DETERMINE WHETHER ANY CONDITIONS EXIST WHICH PREVENT THE LOOP INDEX
	FROM BEING KEPT IN A REGISTER.
	THE THINGS THAT PREVENT THIS ARE:
		1.TRANSFER OUT OF LOOP
		2.A NON-LIBRARY FUNCTION REFERENCE WITH
		  LOOP INDEX IN COMMON
		3. A FN REFERENCE WITH LP INDEX AS A PARAMETER
		4. A CALL STMNT (THIS ALSO PREVENTS THE CTL-COUNT
			VAR FROM BEING KEPT IN A REG)
	IF CONDITION 1,2, OR 3 IS DETECTED, THE FLAG "DOMTRLZIX" IS
	SET IN THE GLOBAL VARIABLE "DOWDP".
	IF CONDITION 4 IS DETECTED, THE BIT "DOISUBS" IS SET TO 0.

***************************************************************************)%
BEGIN
	MACRO QUIT=
	BEGIN
		DOWDP[DOISUBS]_0;
		CDONODE[NEDSMATRLZ]_1;
	END$;

	REGISTER
		LBLPTR,
		BASE ARGNOD;

	IF NOT .DOWDP[DOISUBS] THEN RETURN;

	IF .CSTMNT[USRFNREF] 	!IF THIS STMNT REFERENCES A USER FN
	THEN			! THEN IF THE LP INDUCTION VAR IS IN COMMON
				! IT MUST BE MATERIALIZED
	BEGIN
		ARGNOD_.CDONODE[DOSYM];
		IF .ARGNOD[IDATTRIBUT(INCOM)] THEN
		DOWDP[DOMTRLZIX]_1
	END;


	%(***ACTION TO BE TAKEN DEPENDS ON SRCID OF STMNT**)%
	CASE .CSTMNT[SRCID] OF SET

	BEGIN END;	! ASSIGNMENT
	BEGIN END;	! ASSIGN STATEMENT
	QUIT;		! CALL
	BEGIN END;	! CONTINUE
	BEGIN END;	! DOID
	BEGIN END;	! ENTRID
	BEGIN END;	! COMMONSUB
	LOOKOUT(.CSTMNT[GOTOLBL]);	! GOTO

	BEGIN		! AGOTO
		IF .CSTMNT[GOTOLIST] EQL 0
		THEN QUIT
		ELSE DECR I FROM .CSTMNT[GOTONUM]-1 TO 0 DO
		BEGIN
			LBLPTR_@(.CSTMNT[GOTOLIST]+.I);
			LOOKOUT(.LBLPTR);
		END;
	END;		! AGOTO

	BEGIN		! CGOTO
		DECR I FROM .CSTMNT[GOTONUM]-1 TO 0 DO
		BEGIN
			LBLPTR_@(.CSTMNT[GOTOLIST]+.I);
			LOOKOUT(.LBLPTR);
		END;
	END;		! CGOTO

	BEGIN		! ARITHMETIC IF
		LOOKOUT(.CSTMNT[AIFLESS]);
		LOOKOUT(.CSTMNT[AIFEQL]);
		LOOKOUT(.CSTMNT[AIFGTR]);
	END;		! ARITHMETIC IF

	BEGIN END;	! LOGICAL IF (P2REGCNTS WILL BE CALLED FROM SKSTMN
			! FOR THE SUBSTATEMENT)
	QUIT;		! RETURN
	BEGIN END;	! STOP
%1742%	LOKIOUT();	! READ
%1742%	LOKIOUT();	! WRITE
%1742%	LOKIOUT();	! DECODE
%1742%	LOKIOUT();	! ENCODE
%1742%	LOKIOUT();	! REREAD
%1742%	LOKIOUT();	! FIND
%1742%	LOKIOUT();	! CLOSE
%1742%	BEGIN END;	! INPUT (not implemented)
%1742%	BEGIN END;	! OUTPUT (not implemented)
%1742%	LOKIOUT();	! BACKSPACE
%1742%	LOKIOUT();	! BACKFILE
%1742%	LOKIOUT();	! REWIND
%1742%	LOKIOUT();	! SKIPFILE
%1742%	LOKIOUT();	! SKIPRECORD
%1742%	LOKIOUT();	! UNLOAD
%1742%	BEGIN END;	! RELEASE (not implemented)
%1742%	LOKIOUT();	! ENDFILE
%1742%	BEGIN END;	! END
%1742%	BEGIN END;	! PAUSE
%1742%	LOKIOUT();	! OPEN
%1742%	BEGIN END;	! SFN
%1742%	BEGIN END;	! FORMAT
%1742%	BEGIN END;	! BLT (not implemented)
%1742%	BEGIN END;	! REGMASK (not implemented)
%2200%	LOKIOUT();	! INQUIRE

	TES;
END;	! of P2REGCNTS

ROUTINE LOOKOUT(LABLE)=
%(***************************************************************************
	ROUTINE TO CHECK WHETHER THE LABEL "LABLE" IS IN THE TABLE
	OF LABELS THAT OCCUR INSIDE THE INNERMOST DO LOOP CURRENTLY BEING
	PROCESSED. IF THE COUNT OF LOCAL REFERENCES TO
	THAT LABEL IS INCREMENTED. IF IT IS NOT, THEN
	THE FLAG "DOMTRLZIX" GETS SET INDICATING THAT THIS
	LOOP MUST HAVE ITS INDEX MATERIALIZED SINCE IT CONTAINS
	A TRANSFER OUT
***************************************************************************)%
BEGIN
	!SEARCH THE VECTOR CHOSEN FOR THE LABEL
	!LABLE.
	INCR I FROM 0 TO (.CTR-1) DO
	BEGIN
		IF .CHOSEN[.I,LABL] EQL .LABLE THEN
		BEGIN
			CHOSEN[.I,LOCREFCT]_.CHOSEN[.I,LOCREFCT]+1;
			RETURN
		END;
	END;

	%(***IF COULDNT FIND THE LABEL**)%
	TRANSFOUT_TRUE;
	DOWDP[DOMTRLZIX]_1;
END;	! of LOOKOUT

ROUTINE LOKIOUT=
!CSTMNT PTS TO AN I/O STMNT. LOOK AT IOEND AND IOERR TO SEE IF THEY ARE
! OUTSIDE THE CURRENT DO LOOP
BEGIN
	IF .CSTMNT[IOEND] NEQ 0 THEN LOOKOUT(.CSTMNT[IOEND]);
	IF .CSTMNT[IOERR] NEQ 0 THEN LOOKOUT(.CSTMNT[IOERR]);
END;	! of LOKIOUT

GLOBAL ROUTINE ARNOAOBJN(ARRREF)=	![2243] New

!++
! FUNCTIONAL DESCRIPTION:
!
!	Determines for a numeric array reference if:
!
! 		o the array is in PSLARGE,
!	 	o and in an innermost DO loop,
!	 	o and the index variable for an innermost AOBJN DO  loop
!		  is in the address calculation for the array.
!
!	If all are true, then it marks that the innermost DO should  not
!	be an AOBJN loop by setting the field DONOAOBJN in DOWDP.
!
! FORMAL PARAMETERS:
!
!	ARRREF		Is the array reference to check.
!
! IMPLICIT INPUTS:
!
!	DOWDP		Keeps information on innermost DO loop
!
!	INNERLOOP	Flag  is  TRUE  when  processing  stmts  in   an
!			innermost DO
!
! IMPLICIT OUTPUTS:
!
!	DOWDP		Keeps information on innermost DO loop
!
! ROUTINE VALUE:
!
!	None
!
! SIDE EFFECTS:
!
!	None
!
!--


BEGIN
	MAP BASE ARRREF;

	REGISTER
		BASE ADDRCALC,	! Address calculation for the array
		BASE SYMTAB;	! Symbol table reference for the array


	! If for some  reason this routine  does not catch  a case  (for
	! instance,  EQUIVALENCE  processing  is  done  much  later   in
	! compilation), the back  end will  copy the right  half of  the
	! index register into another register,  unless this DO loop  is
	! made no-AOBJN by someplace else.  Making the loop no-AOBJN  is
	! more optimal, in  terms of  code generated,  than copying  the
	! right hand half of the register.


	IF .INNERLOOP				! In innermost DO
	THEN IF NOT .DOWDP[DONOAOBJN]		! Has someone already done?
	THEN IF .ARRREF[VALTYPE] NEQ CHARACTER	! Numeric array only
	THEN
	BEGIN	! In innermost DO loop

		SYMTAB = .ARRREF[ARG1PTR];		! Array STE

		IF .SYMTAB[IDPSECT] EQL PSLARGE	! In PSLARGE?
		THEN
		BEGIN	! In .LARG.

			! Check if DO index is in address calc.  We will look
			! for the address calculation expression being either
			! "I" or "constant+I" (where "I" is the loop index).
			! DOWDP[DOINDUC] points to the innermost DO loop's
			! index variable.

			ADDRCALC = .ARRREF[ARG2PTR];	! Array's addr calc

			IF .ADDRCALC EQL .DOWDP[DOINDUC]	! "I"?
			THEN DOWDP[DONOAOBJN] = 1		! Yes, no AOBJN
			ELSE
			BEGIN	! Not "I"

				! Check for the form "constant+I".  This is all
				! we need to check, since the expression in
				! canonical.

				IF .ADDRCALC[OPR1] EQL ADDOPF	  ! "+"
				THEN IF .ADDRCALC[ARG2PTR] EQL .DOWDP[DOINDUC]
				THEN
				BEGIN	! "something+I".

					! If the something is a constant then
					! this is "constant+I".  The constant
					! will eventually be hidden in the Y
					! field of the EFIW used to reference
					! the array, and the index register
					! containing the loop induction
					! variable will be part of the EFIW.
					! Since we will have to worry about the
					! negative left half of the AOBJN
					! counter sometime, we might as well
					! worry about it now.

					ADDRCALC = .ADDRCALC[ARG1PTR];

					IF .ADDRCALC[OPR1] EQL CONSTFL
					THEN DOWDP[DONOAOBJN] = 1; ! No AOBJN

				END;	! "something+I".

			END;	! Not "I"

		END;	! In .LARG.

	END;	! In innermost DO loop

END;	! of ARNOAOBJN

! Below is for use in making PLM's with RUNOFF
!++
!.END LITERAL
!--

END
ELUDOM