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