Trailing-Edge
-
PDP-10 Archives
-
BB-4157E-BM
-
fortran-compiler/skstmn.bli
There are 12 other files named skstmn.bli in the archive. Click here to see a list.
!THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
! OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
!COPYRIGHT (C) 1972,1981 BY DIGITAL EQUIPMENT CORPORATION
!AUTHOR: S. MURPHY/HPW/MD/TFV
MODULE SKSTMN(SREG=#17,VREG=#15,FREG=#16,DREGS=4,RESERVE(0,1,2,3),GLOROUTINES)=
BEGIN
GLOBAL BIND SKSTMV = 6^24 + 0^18 + 96; ! Version Date: 16-Jul-81
%(
***** 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.
***** End Revision History *****
)%
EXTERNAL
SKOPTIO,SKIOLIST,
CANONICALIZE,CGERR,MAKEPR,C1H,C1L,C2H,C2L,COPRIX,
KBOOLBASE,KTYPCB,SPKABA,CNSTCMB,DNEGCNST,TBLSEARCH,
SKERR;
%[761]% EXTERNAL KTYPCG; !For /GFLOATING type conversions
FORWARD
P2SKSTMNT(0),
SKASMNT(0),SKSFN(0),SKRETURN(0),SKAGO(0),SKCGO(0),DELGOLABS(1),SKLOGIF(0),SKARIF(0),
SKASSI(0),SKDECENC(0),SKCALL(0),
FOLDIOLST(0),FORMIOLST(01),IODEPNDS(2),
DEFONCIOL(1),DOP2SKL(0),DOENSKL(0),P2REGCNTS(0);
EXTERNAL
P2SKBL,P2SKREL,P2SKFN,P2SKARITH,P2SKLTP,P2SKLARR,
P2SKNEGNOT, FOLDAIF, FOLDLIF;
EXTERNAL NEGFLG,NOTFLG,CSTMNT;
EXTERNAL P2SKL1DISP;
EXTERNAL CONTVAR,CONTFN;
EXTERNAL CORMAN;
EXTERNAL UNFLDO; !ROUTINE TO UNDO DECISION TO HAVE A DO LOOP USE AOBJN
! ROUTINE IS IN "UTIL" MODULE
SWITCHES NOLIST;
REQUIRE FIRST.BLI;
REQUIRE TABLES.BLI;
SWITCHES LIST;
MAP BASE CSTMNT;
MACRO SKIOLST =
IF .FLGREG<OPTIMIZE> THEN SKOPTIO()
ELSE SKIOLIST()$;
GLOBAL ROUTINE P2SKSTMNT=
%(***************************************************************************
PERFORM PHASE 2 SKELETON OPTIMIZATIONS ON THE STATEMENT POINTED
TO BY THE GLOBAL "CSTMNT"
***************************************************************************)%
BEGIN
EXTERNAL INNERLOOP; !THIS FLAG IS "TRUE" WHEN STMNTS IN AN INNER LOOP
! ARE BEING PROCESSED
EXTERNAL P2REGCNTS;
EXTERNAL INPFLAG; !SET THIS FLAG FOR INPUT STMNTS
EXTERNAL USERFNFLG; !THIS FLAG WILL GET SET FOR ANY STMNT THAT
! INCLUDES USER FUNCTIONS
EXTERNAL DOWDP; !THIS GLOBAL IS USED IN DETERMINING WHETHER
! A DO INDEX IS TO USE AOBJN/LIVE IN A REG
MAP OBJECTCODE DOWDP;
%(***DEFINE A MACRO TO USE FOR IO STMNTS TO CHECK WHETHER THE UNIT NO OR THE
RECORD NUMBER IS EQUAL TO THE INDEX OF THE EMBRACING DO LOOP, AND
IF SO TO SET FLAG INDICATING NOT TO USE AN AOBJN FOR THE LOOP***)%
MACRO CHKFORDOREF=
BEGIN
IF .CSTMNT[IOUNIT] EQL .DOWDP[DOINDUC] OR .CSTMNT[IORECORD] EQL .DOWDP[DOINDUC]
THEN DOWDP[DONOAOBJN]_1;
END$;
%(**MACRO TO PERFORM P2SKEL OPTIMS ON RECORD NUMBERS**)%
MACRO SKRECNO=
BEGIN
REGISTER PEXPRNODE RECNO;
IF (RECNO_.CSTMNT[IORECORD]) NEQ 0
THEN CSTMNT[IORECORD]_(.P2SKL1DISP[.RECNO[OPRCLS]])(.RECNO);
END$;
%(***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(); !FOR 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
SKRECNO; !OPTIMIZE RECORD NUMBER
CHKFORDOREF; !CHECK FOR RECORD OR UNIT EQL TO DO INDEX
INPFLAG_TRUE;
SKIOLST;
END;
BEGIN ! WRITE
SKRECNO; !OPTIMIZE RECORD NUMBER
CHKFORDOREF; !CHECK FOR RECORD OR UNIT EQL TO DO INDEX
INPFLAG_FALSE;
SKIOLST;
END;
BEGIN ! DECODE
SKDECENC();
INPFLAG_TRUE;
SKIOLST;
END;
BEGIN ! ENCODE
SKDECENC();
INPFLAG_FALSE;
SKIOLST;
END;
BEGIN ! REREAD
INPFLAG_TRUE;
SKIOLST;
END;
BEGIN ! FIND
SKRECNO; !!OPTIMIZE RECORD NUMBER
CHKFORDOREF; !CHECK FOR RECORD OR UNIT EQL TO DO INDEX
END;
BEGIN END; ! CLOSE
BEGIN END; ! INPUT (NOT IMPLEMENTED IN RELEASE 1)
BEGIN END; ! OUTPUT (NOT IMPLEMENTED IN RELEASE 1)
BEGIN END; ! BACKSPACE
BEGIN END; ! BACKFILE
BEGIN END; ! REWIND
BEGIN END; ! SKIP FILE
BEGIN END; ! SKIP RECORD
BEGIN END; ! UNLOAD
BEGIN END; ! RELEASE
BEGIN END; ! ENDFILE
BEGIN END; ! END
BEGIN END; ! PAUSE
BEGIN END; ! OPEN
SKSFN(); !SFN
BEGIN END; ! FORMAT
BEGIN END; ! BLT
BEGIN END; ! "CHANGE SET OF AVAILABLE REGS" (INSERTED
! BY GLOBAL REG ALLOCATOR)
TES;
%(***IF THIS STMNT CONTAINED A USER FN, SET FLAG IN STMNT**)%
IF .USERFNFLG THEN CSTMNT[USRFNREF]_1;
%(***IF ARE IN AN INNER 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 DO LOOP
END;
END;
GLOBAL ROUTINE SKASMNT=
%(***************************************************************************
PERFORM PHASE 2 SKELETON OPTIMIZATIONS ON AN ASSIGNMENT STATEMNT
***************************************************************************)%
BEGIN
EXTERNAL DOWDP;
MAP OBJECTCODE DOWDP;
OWN PEXPRNODE RHNODE:LHNODE: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
%(***IF LEFT HAND SIDE IS NOT A SIMPLE VARIABLE***)%
BEGIN
LHNODE_.CSTMNT[LHEXP];
IF .LHNODE[OPRCLS] NEQ ARRAYREF THEN RETURN CGERR();
%(***IF LEFT HAND SIDE IS AN ARRAYREF - OPTIMIZE THE ADDRESS CALCULATION**)%
IF NOT .LHNODE[A2VALFLG]
THEN
BEGIN
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;
END;
%(***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;
GLOBAL ROUTINE SKSFN=
%(***************************************************************************
PERFORM P2 SKEL OPTIMS ON THE EXPRESSION UNDER A STMNT FN
***************************************************************************)%
BEGIN
LOCAL OCSTMNT;
%(***INIT FLAGS FOR PROPAGATING NEGATES AND NOTS***)%
NEGFLG_FALSE;
NOTFLG_FALSE;
OCSTMNT_.CSTMNT;
CSTMNT_.CSTMNT[SFNEXPR];
SKASMNT();
CSTMNT_.OCSTMNT;
END;
GLOBAL ROUTINE SKRETURN=
%(***************************************************************************
PERFORM P2SKEL OPS ON THE EXPR UNDER A RETURN STMNT
***************************************************************************)%
BEGIN
OWN PEXPRNODE RHNODE;
IF (RHNODE_.CSTMNT[RETEXPR]) NEQ 0 THEN
CSTMNT[RETEXPR]_(.P2SKL1DISP[.RHNODE[OPRCLS]])(.RHNODE);
END;
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
OWN PEXPRNODE AGOVAR;
AGOVAR_.CSTMNT[AGOTOLBL];
IF .AGOVAR[OPRCLS] EQL ARRAYREF
THEN
CSTMNT[AGOTOLBL]_(.P2SKL1DISP[.AGOVAR[OPRCLS]])(.AGOVAR);
END;
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
EXTERNAL DOWDP;
MAP OBJECTCODE DOWDP;
OWN 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;
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;
GLOBAL ROUTINE SKLOGIF=
%(***************************************************************************
PERFORM PHASE 2 SKELETON OPTIMIZATIONS ON A LOGICAL IF STATEMENT
CALLED WITH THE GLOBAL "CSTMNT" POINTING TO THE STATEMENT.
***************************************************************************)%
BEGIN
EXTERNAL DOWDP; !GLOBAL USED IN DETERMINING WHETHER THE DO-LOOP
! EMBRACING THIS STMNT SHOULD USE AOBJN OR
! HAVE ITS INDEX KEPT IN A REG
MAP OBJECTCODE DOWDP;
EXTERNAL P2SKL1DISP; !DISPATCH TABLE INDICATING BY OPRCLS
! WHICH ROUTINE OF P2SKEL IS TO BE
! USED FOR AN EXPRESSION
OWN PEXPRNODE CONDEXPR;
OWN 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;
GLOBAL ROUTINE SKARIF=
%(***************************************************************************
PERFORM PHASE 2 SKELETON OPTIMIZATIONS ON AN ARITHMETIC IF
STATEMENT.
CALLED WITH THE GLOBAL CSTMNT POINTING TO THE STATEMENT.
***************************************************************************)%
BEGIN
EXTERNAL DOWDP; !GLOBAL USED IN DETERMINING WHAT TO DO WITH THE
! INDEX OF THE CURRENT DO LOOP
MAP OBJECTCODE DOWDP;
EXTERNAL P2SKL1DISP; !DISPATCH TABLE INDICATING BY OPRCLS WHICH
! ROUTINE OF P2SKEL TO USE FOR AN EXPRESSION
OWN PEXPRNODE CONDEXPR; !THE CONDITIONAL EXPRESSION UNDER THE STMNT
OWN PEXPRNODE ARG1NODE:ARG2NODE; !THE 2 ARGS UNDER CONDEXPR
OWN PEXPRNODE RPTLBL; !THE LABEL THAT OCCURS TWICE IN THIS STMNT (IF
! ANY 2 OF THE 3 LABELS ARE THE SAME)
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]% EXTERNAL USERFNFLG; !True when function calls
%[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***)%
OWN RELOPERATOR;
REGISTER BASE GONODE1:GONODE2;
OWN SAVSTMN;
CSTMNT[SRCID]_IFLID;
NAME<LEFT>_SRCSIZ+GOSIZ;
GONODE1_CORMAN();
GONODE1[OPRCLS]_STATEMENT;
GONODE1[SRCID]_GOTOID;
NAME<LEFT>_SRCSIZ+GOSIZ;
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;
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
EXTERNAL P2SKLARR;
OWN PEXPRNODE SYMNODE;
SYMNODE_.CSTMNT[ASISYM];
IF .SYMNODE[OPRCLS] EQL ARRAYREF
THEN P2SKLARR(.SYMNODE);
END;
GLOBAL ROUTINE SKDECENC=
%(***************************************************************************
TO PERFORM PHASE 2 SKEL OPTIMS ON ENCODE/DECODE STMNTS
***************************************************************************)%
BEGIN
OWN PEXPRNODE ENCVAR;
EXTERNAL P2SKLARR;
ENCVAR_.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 .ENCVAR[OPRCLS] EQL ARRAYREF
THEN
CSTMNT[IOVAR]_P2SKLARR(.ENCVAR);
END;
GLOBAL ROUTINE SKCALL=
%(***************************************************************************
PERFORM PHASE 2 SKEL OPTIMIZS ON ALL ARGS OF A CALL STMNT
***************************************************************************)%
BEGIN
OWN ARGUMENTLIST ARGLST;
OWN 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
BEGIN
NEGFLG_FALSE;
NOTFLG_FALSE;
ARGNODE_.ARGLST[.CT,ARGNPTR];
ARGLST[.CT,ARGNPTR]_(.P2SKL1DISP[.ARGNODE[OPRCLS]])(.ARGNODE);
END;
END;
END;
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
EXTERNAL CIOCALL; !PTR TO CURRENT IOLISTCALL NODE BEING BUILT
EXTERNAL CIOCLAST; !PTR TO LAST ELEMENT ON THE IOLISTCALL NODE BEING BUILT
MAP BASE CIOCALL:CIOCLAST;
OWN BASE IOLELEM:PREVELEM;
EXTERNAL INPFLAG; !FLAG IS SET IF STMNT IS AN INPUT STMNT
%(***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
****)%
IF .INPFLAG AND DEFONCIOL(.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;
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
EXTERNAL CIOCALL; !PTR TO CURRENT IOLISTCALL NODE BEING BUILT
EXTERNAL CIOCLAST; !PTR TO LAST ELEMENT UNDER CIOCALL
MAP BASE IOLELEM;
OWN BASE IOLNODE;
OWN BASE NXTELEM;
EXTERNAL INPFLAG; !FLAG IS SET IF THIS STMNT IS AN INPUT
! STMNT - THIS FLAG SHOULD BE SET PRIOR TO ENTERING
! THIS ROUTINE
CIOCALL_-1;
%(****IF IOLELEM IS THE LAST ELEM ON THE IOLIST, CANNOT DO ANYTHING***)%
IF .IOLELEM[CLINK] EQL 0 THEN RETURN .IOLELEM;
%(***IF THE 1ST NODE CONTAINS FN-CALLS, CANNOT FORM AN IOLST***)%
IF CONTFN(.IOLELEM) THEN RETURN .IOLELEM;
NXTELEM_.IOLELEM[CLINK];
%(***IF THE 2ND NODE IS A STMNT, CANNOT FORM AN IOLST***)%
IF .NXTELEM[OPRCLS] EQL STATEMENT 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****)%
IOLNODE_GETCORE(IOLCSIZ,IOLCCD);
IOLNODE[OPERATOR]_IOLSTCFL;
IOLNODE[IOLSTPTR]_.IOLELEM;
%(***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;
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:IOELEM2;
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:IOELEM;
ROUTINE FILTER(EXPR,VAR)=
%(******************************************************
ROUTINE TO FILTER CALLS TO CONTVAR
******************************************************)%
BEGIN
MAP BASE EXPR:VAR;
IF .EXPR[OPRCLS] EQL ARRAYREF THEN IF (EXPR_.EXPR[ARG2PTR]) EQL 0 THEN RETURN 0;
IF .VAR[OPRCLS] EQL ARRAYREF THEN VAR_.VAR[ARG1PTR];
RETURN CONTVAR(.EXPR,.VAR)
END;
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
LOCAL BASE IOARRAY;
IOARRAY_.IOELEM[IOLSTPTR];
WHILE .IOARRAY NEQ 0 DO
BEGIN
%[1026]% IF FILTER(.IOARRAY,.VARPTR) THEN RETURN 1;
IOARRAY_.IOARRAY[CLINK];
END
END;
%E1LISTCALL% BEGIN
LOCAL BASE IOARRAY;
IF FILTER(.IOELEM[ECNTPTR],.VARPTR) THEN RETURN 1;
IF FILTER(.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
END;
%E2LISTCALL% BEGIN
LOCAL BASE IOARRAY;
IF FILTER(.IOELEM[ECNTPTR],.VARPTR) THEN RETURN 1;
IOARRAY_.IOELEM[ELSTPTR];
WHILE .IOARRAY NEQ 0 DO
BEGIN
IF FILTER(.IOARRAY[E2ARREFPTR],.VARPTR) THEN
RETURN 1;
IF FILTER(.IOARRAY[E2INCR],.VARPTR) THEN
RETURN 1;
IOARRAY_.IOARRAY[CLINK]
END;
END
TES;
RETURN 0
END;
%(*** 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, INDEPENDED
***)%
CASE .IOELEM1[OPERSP] OF SET
%DATACALL% BEGIN
RETURN LOOKELEM2(.IOELEM1[DCALLELEM],.IOELEM2)
END;
%SLISTCALL% BEGIN
RETURN LOOKELEM2(.IOELEM1[SCALLELEM],.IOELEM2)
END;
%IOLSTCALL% BEGIN
LOCAL BASE IOARRAY;
IOARRAY_.IOELEM1[IOLSTPTR];
WHILE .IOARRAY NEQ 0 DO
BEGIN
IF IODEPNDS(.IOELEM2,.IOARRAY) THEN RETURN 1;
IOARRAY_.IOARRAY[CLINK]
END
END;
%E1LISTCALL% BEGIN
LOCAL BASE IOARRAY;
IOARRAY_.IOELEM1[ELSTPTR];
WHILE .IOARRAY NEQ 0 DO
BEGIN
IF LOOKELEM2(.IOARRAY[E2ARREFPTR],.IOELEM2) THEN RETURN 1;
IOARRAY_.IOARRAY[CLINK]
END
END;
%E2LISTCALL% BEGIN
LOCAL BASE IOARRAY;
IOARRAY_.IOELEM1[ELSTPTR];
WHILE .IOARRAY NEQ 0 DO
BEGIN
IF LOOKELEM2(.IOARRAY[E2ARREFPTR],.IOELEM2) THEN RETURN 1;
IOARRAY_.IOARRAY[CLINK]
END
END
TES;
RETURN 0
END;
GLOBAL ROUTINE DEFONCIOL(IOELEM)=
%(***************************************************************************
TEST WHETHER THE LOC SPECIFIED BY THE IOLIST ELEMENT IOELEM
IS AFFECTED BY CHANGES IN VALUES OF ANY VARIABLES UNDER THE
IOLISTCALL NODE POINTED TO BY THE GLOBAL "CIOCALL"
IOELEM IS KNOWN TO BE AN ELEMENT ON AN IOLIST FOR AN INPUT STMNT
***************************************************************************)%
BEGIN
EXTERNAL CIOCALL;
MAP BASE CIOCALL;
MAP BASE IOELEM;
OWN BASE IOELEM1;
IOELEM1_.CIOCALL[IOLSTPTR];
%(***CHECK FOR IOELEM DEPENDENT ON EACH ELEMENT UNDER CIOCALL***)%
UNTIL .IOELEM1 EQL 0
DO
BEGIN
IF IODEPNDS(.IOELEM,.IOELEM1) THEN RETURN TRUE;
IOELEM1_.IOELEM1[CLINK];
END;
RETURN FALSE;
END;
!AUTHOR: NORMA ABEL
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
EXTERNAL CHOSEN; !USE THE GLOBAL ARRAY "CHOSEN" TO HOLD THIS TABLE
MAP LPLABLST CHOSEN;
OWN TRANSFOUT; !THIS FLAG IS SET TO "TRUE" IF THE INNER DO LOOP
! BEING PROCESSED HAS TRANSFERS OUT
GLOBAL ROUTINE DOP2SKL=
!ROUINE TO HANDLE P2SKELETON FUNCTIONS FOR DO STATEMENTS
BEGIN
EXTERNAL INNERLOOP; !GLOBAL FLAG THAT IS SET WHILE PROCESSING
! STMNTS IN AN INNER LOOP
EXTERNAL CSTMNT,MAKPR1,NEGFLG,NOTFLG,DOWDP,CDONODE,MAKEPR;
!CSTMNT POINTS AT THE ENCODED SOURCE NODE
LOCAL BASE DOEXPR;
EXTERNAL P2SKL1DISP;
MAP OBJECTCODE DOWDP;
MAP BASE CSTMNT:CDONODE;
!INITIALIZE NEGFLG AND NOTFLG TO FALSE
NEGFLG_FALSE;
NOTFLG_FALSE;
DOEXPR_.CSTMNT[DOLPCTL];
!CALL THE DISPATCH
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 (HA-HA) USEAGE OF THE INDUCTION VARIABLE IN
!A REGISTER ON AN INNER DO LOOP THE GLOBAL CDONODE WILL
!POINT BACK TO THE DO STATEMENT SO THAT FLAGS CAN BE SET AND
!UNSET PROPERLY (CHANGE FOR LARGE SORCE SOLUTION********)
!DOWDP WILL ALSO POINT TO A WORD OF THE FORMAT
!
! !-------------------------------!
! !X!Y! ! DOINDUC !
! !-------------------------------!
!WHERE X IS THE INNERDOFLG AND IS USED TO SIGNAL THAT
!REGCONTENTS NODE SUBSTITUTION IS STILL VALID.
!Y IS SET WHILE PROCESSING THE STMNTS IN THE LOOP IF THE LOOP INDEX IS
! USED IN A CONTEXT THAT PREVENTS USE OF AN AOBJN IF THE LOOP INDEX IS TO
! BE LEFT IN A REGISTER (EG IF THE LOOP INDEX IS USED AS AN ARG TO FOROTS OR
! IN A COMPUTED GOTO
!DO INDUC POINTS TO THE INDUCTION VARIABLE
IF .CSTMNT[INNERDOFLG] THEN
BEGIN
INNERLOOP_TRUE; !SET GLOBAL FLAG FOR "PROCESSING STMNTS
! IN AN INNER LOOP"
DOWDP_0;
CDONODE_.CSTMNT;
DOWDP[DOINDUC]_.CSTMNT[DOSYM];
CSTMNT[NEDSMATRLZ]_0;
DOWDP[DOISUBS]_1;
DOWDP[DONOAOBJN]_0; !FLAG THAT INDICATES THAT FOUND THE
! LOOP INDEX USED IN A CONTEXT THAT
! PREVENTS USE OF AOBJN
DOWDP[DOMTRLZIX]_0; !FLAG THAT INDICATES THAT THE LOOP
! INDEX MUST BE MATERIALIZED (BECAUSE
! IT WAS USED AS AN ARG TO A FN OR THE LOOP
! HAD TRANSFERS OUT OR THE INDEX IS
! IN COMMON AND LOOP HAS A FN CALL)
TRANSFOUT_FALSE; !INIT FLAG FOR "LOOP HAS
! TRANSFERS OUT"
!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;
END; !ROUTINE
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;
GLOBAL ROUTINE DOENSKL=
%(***************************************************************************
ROUTINE TO DO P2SKEL PROCESSING FOR THE TERMINATION OF AN INNER
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
EXTERNAL CDONODE; !PTR TO THE PREVIOUS DO STMNT IN
! THIS PROGRAM
MAP BASE CDONODE;
EXTERNAL DOWDP; !GLOBAL VAR IN WHICH THE "DOISUBS" BIT GETS
! SET TO 0 WHENEVER A CONDITION IS DETECTED
! WHCH NECESSITAES MATERIALIZATION OF BOTH
! LP INDEX AND CT; THE "DONOAOBJN" BIT GETS
! SET WHENEVER A CONDITION IS DETECTED WHICH
! PREVENTS USE OF "AOBJN" LOOP ENDING
! THE "DOMTRLZIX" BIT GETS SET WHENEVER A CONDITION
! IS ENCOUNTERED WHICH NECESSITATES MATERIALIZATION
! OF THE LOOP INDEX ONLY
MAP OBJECTCODE DOWDP;
REGISTER BASE DOVAR; !TO CHECK SYMBOL FOR BEING IN COMMON
!AND/OR EQUIVALENCED
EXTERNAL CSTMNT;
MAP BASE CSTMNT;
EXTERNAL INNERLOOP; !GLOBAL WHICH IS "TRUE" WHILE STMNTS
! OF AN INNER LOOP ARE BEING PROCESSED
%(***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] AND NOT .CDONODE[NEDSMATRLZ]
THEN UNFLDO(.CDONODE);
END;
INNERLOOP_FALSE; !AFTER THIS STMNT WILL NO LONGER
! BE IN AN INNERMOST LOOP
END;
END;
FORWARD LOOKOUT,LOKIOUT;
MACRO QUIT=
BEGIN
DOWDP[DOISUBS]_0;
CDONODE[NEDSMATRLZ]_1;
END$;
GLOBAL ROUTINE P2REGCNTS=
%(***************************************************************************
THIS ROUTINE IS CALLED FOR EACH STATEMENT IN AN INNER 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
EXTERNAL DOWDP;
EXTERNAL CDONODE;
MAP BASE CDONODE;
EXTERNAL CSTMNT;
MAP BASE CSTMNT;
MAP OBJECTCODE DOWDP;
EXTERNAL USERFNFLG;
OWN LBLPTR;
OWN BASE ARGNOD;
IF NOT .DOWDP[DOISUBS] THEN RETURN;
!CHECK FOR HARMLESS STATUS QUO FORMAT
IF .CSTMNT[SRCID] EQL FORMID THEN RETURN;
IF .CSTMNT[SRCID] GEQ ENCOID THEN
(QUIT; 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
!ASSIGNMENT
BEGIN
END;
!
!ASSIGN STATEMENT
BEGIN END; !ILLEGAL
!
!CALL
QUIT;
!
!CONTINUE
BEGIN
END;
!
!DOID
BEGIN END; !ILLEGAL
!
!ENTRID !ILLEGAL
BEGIN END;
!
!COMNSUB
BEGIN END;
!
!GOTOID
LOOKOUT(.CSTMNT[GOTOLBL]);
!
!AGOTOT
BEGIN
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;
!
!CGOTO
BEGIN
DECR I FROM .CSTMNT[GOTONUM]-1 TO 0 DO
BEGIN
LBLPTR_@(.CSTMNT[GOTOLIST]+.I);
LOOKOUT(.LBLPTR);
END;
END;
!ARITHMETIC IF
BEGIN
LOOKOUT(.CSTMNT[AIFLESS]);
LOOKOUT(.CSTMNT[AIFEQL]);
LOOKOUT(.CSTMNT[AIFGTR]);
END;
!
!LOGICAL IF
BEGIN
!(P2REGCNTS WILL BE CALLED FROM SKSTMN FOR THE SUBSTATEMENT)
END;
!
!RETURN
QUIT;
!
!STOP
BEGIN END;
!
!READ
BEGIN
IF .CSTMNT[IOEND] EQL 0 AND .CSTMNT[IOERR] EQL 0 THEN
BEGIN
END ELSE
LOKIOUT();
END;
!
!WRITE
BEGIN
IF .CSTMNT[IOEND] EQL 0 AND .CSTMNT[IOERR] EQL 0 THEN
BEGIN
END ELSE
LOKIOUT();
END;
!
!DECODE
BEGIN
END;
!
!ENCODE
BEGIN
END;
TES;
END;
ROUTINE LOOKOUT(LABLE)=
%(***************************************************************************
ROUTINE TO CHECK WHETHER THE LABEL "LABLE" IS IN THE TABLE
OF LABELS THAT OCCUR INSIDE THE INNER 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
EXTERNAL DOWDP,CDONODE;
MAP BASE CDONODE;
MAP OBJECTCODE DOWDP;
!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;
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
EXTERNAL CSTMNT;
MAP BASE CSTMNT;
IF .CSTMNT[IOEND] NEQ 0 THEN LOOKOUT(.CSTMNT[IOEND]);
IF .CSTMNT[IOERR] NEQ 0 THEN LOOKOUT(.CSTMNT[IOERR]);
END;