Trailing-Edge
-
PDP-10 Archives
-
FORTRAN-10_V7wLink_Feb83
-
pha2.bli
There are 12 other files named pha2.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) DIGITAL EQUIPMENT CORPORATION 1972, 1983
!AUTHOR: NORMA ABEL/HPW/SRM/SJW/DCE/TFV/EGM
MODULE PHA2(RESERVE(0,1,2,3),SREG=#17,VREG=#15,FREG=#16,DREGS=4,START)=
BEGIN
! REQUIRES FIRST, TABLES,OPTMAC
GLOBAL BIND PHA2V = 6^24 + 0^18 + #1633; ! Version Date: 1-Sep-82
%(
***** Begin Revision History *****
94 ----- ----- CALL I/O OPTIMIZER TO FOLD OUTERMOST
LEVEL OF I/O LISTS
95 ----- ----- REVISION TO ORIGINAL EDIT 94
96 ----- ----- ADD REREDID TO IOCLEAR
97 ----- ----- ADD SETTING/RESETTING OF GCALLSLFLG AND PARAMETER
TI IOCLEAR
98 ----- ----- DO NOT SAVESPACE ON LOGICAL IF IF SRCOPT IS
ZERO. OCCURS IN ERROR CASE
99 ----- ----- INSERT A CONTINUE AFTER EVERY DO NODE
TO BE ABLE TO SET BITS ON IT
AND STILL DO COMMON SUBS ON THE FIRST
STATEMENT IN THE LOOP
100 ----- ----- ADJUST FOR NEW GRAPH STRUCTURE
101 ----- ----- CALL DOTOPROPAGATE AND DO NOT ADJUST THE STACK
102 ----- ----- FIX UP ERROR MESSAGE CALLS AND TESTREPLACEMENT
ON LOOPS WITH EXITS
103 ----- ----- PUNT!
104 ----- ----- SAVSPACE EXPRESSION HASH ENTRIES
105 ----- ----- FIX ROTTEN TEST FOR SUPPLANTING AND
MAKE SPECIAL CASE IN CONTINUE
GENERATION THAT WILL NOT GENERATE SO MANY
106 ----- ----- FIX SPECIAL CASE MENTIOMED IN 105
107 ----- ----- FIX REFERENCE TO MAIN. AS NAME OF MAIN PROGRAM
108 263 15865 FIX VALUE SAVED FOR STACK RESTORE
***** Begin Version 5 *****
109 VER5 ----- RECALL GLOBELIM WITH STARTING VALUE OF VERYFRST
FOR GLOBDEP
CALL ZTREE TO ZERO DEFPTS & CLEAN UP .O SYMTBL
SET/RESET GLOBELIM2 TO FLAG 2ND GLOBELIM, (SJW)
110 425 QA714 CALL ZTREE TO CLEAR DEFPTS IF OPTIMIZATIONS
DISCONTINUED IN OPTERR, (SJW)
***** Begin Version 5B *****
111 720 27830 GIVE BETTER CODE FOR ASSIGNED GO TO STMNT /OPT, (DCE)
***** Begin Version 6 *****
112 760 TFV 1-Feb-80 -----
Fix edit 720 so it only throws away created lists
113 1047 EGM 22-Jan-81 Q10-05325
Add support for TOPS-10 execute only.
114 1066 EGM 12-May-81 Q10-05202
Do not use ISN in error messages if not pertinent.
115 1105 DCE 26-Jun-81 -----
Correct label count for DO loops ending on same label.
***** Begin Version 7 *****
1633 TFV 1-Sep-82
Count number of executable statements.
***** End Revision History *****
)%
SWITCHES NOLIST;
REQUIRE FIRST.BLI;
REQUIRE TABLES.BLI;
REQUIRE OPTMAC.BLI;
SWITCHES LIST;
SWITCHES NOSPEC;
%1633% EXTERNAL STCNT;
EXTERNAL SAVE17; !TO SAVE STACK REGISTER IN CASE OF
!EMERGENCY EXIT
%(********************************************
OPTIMIZER OVERLAY
*************************************************)%
EXTERNAL DWP,WALKER,GPHBLD,LOOP,TOP,BOTTOM,INDVAR,
LENTRY,LEND,DOPARMS,GREGALC,FLOOD,LOOPNO,GLOBELIM,
DEFDRIV,PROPAGATE,DOCOLLAPSE,RGRAPH,FGRAPH;
EXTERNAL POOL,PROGNAME;
MACHOP POPJ=#263;
MAP BASE LOOP:LENTRY:TOP;
EXTERNAL CSTMNT,P2SKSTMNT,LOCELIM;
MAP BASE CSTMNT;
!**********************
!EXIT MACRO
!************************
MACRO DEAD=
BEGIN
SREG<0,36>_.SAVE17<0,36>;
POPJ (#17,0);
END$;
ROUTINE PASSOUT=
BEGIN
EXTERNAL IOCLEAR,IOPTFLG;
EXTERNAL CSTMNT,BACKST,LOCELIM,MEMCMCHK;
MAP BASE CSTMNT;
EXTERNAL CORMAN,LOCELMIO,LOCLNK;
!THIS ROUTINE CLEANS UP FOR A GRACEFULL EXIT FROM
!THE OPTIMIZER. IT IS USED IN THE NORMAL EXIT CASE
!AFTER THE MAIN CODE AND ALSO FOR ERRORS.
!THE SERVICES PERFORMED ARE:
!1. DO LOCAL COMMON SUBS
!2. CLEAR TARGET WORDS
!3. CATCH COMPUTATIONS TO MEMORY
!FIND LOCAL COMMON-SUB EXPRESSIONS IN ALL I/O STATEMENTS
NAME<LEFT>_4;
BACKST_CORMAN();
!GO THROUGH ALL STATEMENTS AND AMKE SURE THAT THE
!TARGET WORD IS ZERO
!INITIALIZE THE GLOBAL LOCLNK
LOCLNK_0;
CSTMNT_.SORCPTR<LEFT>;
GCALLSLFLG_1;
FLGREG<OPTIMIZE>_0;
WHILE .CSTMNT NEQ 0 DO
BEGIN
%1633% STCNT = .STCNT + 1; ! Count executable statements
!ZERO TARGET FIELD
CSTMNT[TARGADDR]_0;
IF .CSTMNT[SRCISN] NEQ 0 THEN
IF .CSTMNT[SRCID] GEQ READID AND .CSTMNT[SRCID] LEQ REREDID THEN
IOCLEAR(.CSTMNT)
ELSE
![720] WE ARE DONE WITH ANY CREATED LISTS OF ASSIGNED GO TO
![720] LABELS. THROW AWAY THE POINTER TO THEM SO THAT
![720] WE DO NOT THINK THERE IS AN EXPLICIT LIST IN CODE GENERATION!
![720] THIS RESULTS IN MUCH BETTER CODE OPTIMIZED.
![760] Only throw away list if it was created, not if used specified it
%[760]% (LOCELIM(.CSTMNT);
%[760]% IF .CSTMNT[SRCID] EQL AGOID AND .CSTMNT[NOLBLLST]
%[760]% THEN CSTMNT[GOTOLIST]_0);
MEMCMCHK();
CSTMNT_.CSTMNT[SRCLINK];
END;
FLGREG<OPTIMIZE>_1;
GCALLSLFLG_0;
END;
FORWARD UNFUDGDO;
GLOBAL ROUTINE OPTERR(NUMB)=
BEGIN
!ERROR ROUTINE CALLED BY THE OPTIMIZER.
!PRINT ERROR MESSAGE, RESTORE STACK TO VALUE IT
!HAD ON ENTRY TO THIS OVERLAY AND GET OUT******
EXTERNAL CSTMNT,LOOP;
MAP BASE CSTMNT;
EXTERNAL ENTRY,ISN,WARNERR;
EXTERNAL ZTREE;
WARNERR(.ISN,.NUMB);
!CLEANUP GRAPH POINTERS LEFT IN STATEMENT NODES,ELSE
!THE REGISTER ALLOCATOR WILL THINK THEY ARE POINTERS TO
!LOCAL COMMON SUB-EXPRESSIONS.
ZTREE (); ! CLEAR DEFPTS BEFORE LEAVING
!IF THIS IS A MAIN CODE SEGMENT THEN FIX UP
!THE DO LOOP WE INSERTED SO THAT THE GLOBAL REGISTER
!ALLOCATOR WILL NOT DIE
IF .LOOP EQL 0 THEN UNFUDGDO();
PASSOUT();
DEAD;
END;
!********************************************
!TWO LOCAL ROUTINES TO KLUDGE A PSEUDO DO-LOOP FOR THE MAIN PROGRAM
ROUTINE FUDGDO=
BEGIN
LOCAL BASE P:T:DL;
EXTERNAL CORMAN,TOP,LEND,QQ,NAME,GENLAB;
MAP BASE TOP:QQ;
! 1. THE DUMMY CONTINUE IN FRONT AS LENTRY
! 2. THE FUDGED DO LOOP NEXT AS TOP
! 3. BOTTOM WILL POINT TO THE END STATEMENT
! 4. LEND WILL POINT TO THE FUDGED CONTINUE
NAME_0;
NAME<LEFT>_DOSIZ+SRCSIZ;
TOP_
P_CORMAN();
!THIS WILL LOOK LIKE A DO LOOP IN THE SIZE
!FLAGS AND LABEL FIELD. IT WILL HAVE A SRCID
!OF A CONTINUE TO PREVENT PHASE 2 SKELETON
!OPTIMIZATIONS ON IT
P[SRCID]_CONTID;
P[OPRCLS]_STATEMENT;
DL_
P[DOLBL]_GENLAB();
!SET SNREFNO SO LABEL WILL BE CONSIDERED LOCAL
DL[SNREFNO]_2;
T_.SORCPTR<LEFT>;
!FOR A SUBPROGRAM, MAKE THE ENTRY STATEMENT LENTRY
!AND PUT TOP RIGHT AFTER IT, ELSE IF WE MOVE
!ANYTHING TO LENTRY IT WOULD BE INACCESSIBLE CODE.
!OPTIMIZING A BLOCK DATA PROGRAM IS ILLEGAL
IF .FLGREG<PROGTYP> NEQ MAPROG THEN
BEGIN
T_.T[SRCLINK];
WHILE .T[SRCID] EQL ENTRID DO
BEGIN
LENTRY_.T;
IF .T[SRCLINK] EQL 0 THEN
(PASSOUT(); DEAD;);
T_.T[SRCLINK];
END;
END;
P[SRCLINK]_.LENTRY[SRCLINK];
LENTRY[SRCLINK]_.P;
!GO THROUGH THE WHOLE THING LOOKING FOR
!THE STATEMENT BEFORE THE LAST TO LINK INTO
!THE CONTINUE WE WILL MAKE
!A HALF SPECIAL CASE
!SUBROUTINE SUB
!END
IF .T[SRCLINK] EQL 0 THEN
(PASSOUT();DEAD;);
WHILE .T[SRCLINK] NEQ .SORCPTR<RIGHT> DO
T_.T[SRCLINK];
!NOW MAKE THE CONTINUE TO GO WITH IT
NAME<LEFT>_SRCSIZ;
QQ_CORMAN();
T[SRCLINK]_.QQ;
QQ[OPRCLS]_STATEMENT;
QQ[SRCID]_CONTID;
QQ[SRCLBL]_.DL;
QQ[OPTCONFLG]_1;
!USE T AS A TEMP
T_.P[DOLBL];
T[SNHDR]_.QQ;
BOTTOM_QQ[SRCLINK]_.SORCPTR<RIGHT>;
!ALSO SET UP LEND
LEND_.QQ;
END;
ROUTINE UNFUDGDO=
BEGIN
!UNDO THE DO LOOP FUDGE SO NO ATTEMPT WILL BE MADE TO
!GENERATE CODE FOR IT
EXTERNAL SAVSPACE,QQ;
MAP BASE QQ;
LOCAL BASE T;
MAP BASE TOP;
!UNFORTUNATELY, WE HAVE TO LEAVE THE DUMMY CONTINUE
!IN THE PROGRAM TREE. BUT IT WILL NOT DEGRADE THE CODE.
!ALSO GO THROUGH THE REMAINING STATEMENTS AND
!RETURN THE OPTIMIZERS CORE TO THE FREE LIST
!AND ZERO SRCOPT (ELSE THE REGISTER ALLOCATOR
!ETC WILL THINK IT IS A POINTER TO A LOCAL COMNSUB
!WATCH OUT !********
T_.TOP;
WHILE .T NEQ .BOTTOM DO
BEGIN
IF .T[SRCOPT] NEQ 0 THEN
BEGIN
SAVSPACE(4,.T[SRCOPT]);
T[SRCOPT]_0;
IF .T[SRCID] EQL IFLID THEN
BEGIN
!LOGICAL IF STATEMENT
LOCAL BASE T1;
T1_.T[LIFSTATE];
IF .T1[SRCOPT] NEQ 0 THEN
BEGIN
SAVSPACE(4,.T1[SRCOPT]);
T1[SRCOPT]_0;
END;
END;
END;
T_.T[SRCLINK];
END;
!LOOK FOR THE STATMENT IN FRONT OF TOP
!SO TOP CAN BE SWAPPED WITH THE FIRST STATEMENT
!SO THAT THE REGISTER ALLOCATOR CAN FIND THE
!BOUNDS OF THE PROGRAM IF REQUIRED
T_.SORCPTR<LEFT>;
!LOOK FOR TOP (CODE MAY HAVE BEEN MOVED TO LENTRY)
WHILE .T[SRCLINK] NEQ .TOP DO
T_.T[SRCLINK];
!SWITCH THEM AROUND
T[SRCLINK]_.TOP[SRCLINK];
TOP[SRCLINK]_.SORCPTR<LEFT>;
SORCPTR<LEFT>_.TOP;
END;
EXTERNAL MAKASSOC;
FORWARD LABLADJ,DRIVDOALLOC,DOALLOCDECIDE;
%[1047]% PORTAL ROUTINE MRP2 =
BEGIN
EXTERNAL DLOOPTREE,INNERLOOP,TESTREPLACE,SUPPLANT;
EXTERNAL DOTOPROPAGATE;
EXTERNAL LPRDCCT,RDCCT;
EXTERNAL QQ;
MAP BASE QQ;
EXTERNAL CORMAN,BACKST,LOCELMIO;
MAP BASE BACKST;
EXTERNAL MEMCMCHK;
EXTERNAL WARNOPT,WARNERR;
EXTERNAL CDONODE;
EXTERNAL DOCNT;
EXTERNAL ZTREE;
EXTERNAL VERYFRST;
LOCAL CURVERYFRST; ! VERYFRST SIXBIT VALUE BEFORE GLOBELIM
!GET OUT IF THIS IS BLOCK DATA
IF .FLGREG<PROGTYP> EQL BKPROG THEN RETURN;
DWP_-1;
ISN_1;
!IF PHASE 1 ISSUED WARNINGS THAT MAY HURT OPTIMIZATION, GIVE A
!WARNING OF THAT FACT NOW
%[1066]% IF .WARNOPT THEN WARNERR(0,E78);
INNERLOOP_FALSE;
DOCNT_0;
RGRAPH_0;
FGRAPH_0;
!INITAILIZE A VARIBALE TO STOP RANDOM USE. IT IS USED IN
!P2REGCNTS, A PART OF PHASE 2 SKELETON
NAME<LEFT>_DOSIZ+SRCSIZ;
CDONODE_CORMAN();
!MAKE LIST OF ASSOCIATE (RANDOM ACCESS I/O) VARIABLE
MAKASSOC();
!CREATE UNIQUE LABELS FOR ALL DO TERMIATIONS AND QUESTIONABLE
!STATEMENTS.
!ALSO CAUSE LOCAL OPTIMIZATIONS TO HAPPEN ON ALL STATEMENTS IN THE PROGRAM
LABLADJ();
!DECIDE ON GLOBAL ALLOCATION POSSIBILITIES
IF .DLOOPTREE NEQ 0 THEN DRIVDOALLOC(.DLOOPTREE);
!CHECK FOR MAIN PROGRAM WITH NO LOOPS
IF .DLOOPTREE NEQ 0 THEN
BEGIN
LOOPNO_1; !INITIALIZE LOOPNO
LOOP_WALKER(); !GET A DO LOOP
WHILE .LOOP NEQ 0 DO
BEGIN
!INDICATE COUNT OF LOOPS FOUND
DOCNT_.DOCNT+1;
!SAVE REDUCTION VARIABLE COUNTER SO WE KNOW JOW MANY WERE DONE
LPRDCCT_.RDCCT;
DOPARMS(.LOOP);
!PICK UP THE GLOBAL INFO USED
GPHBLD(); !BUILD DIRECTED GRAPH
!SAVE LOTS OF USELESS WORK BY
!LOOKING FOR
!DO 10
!DO 10
!AS A SPECIAL, OFT OCCURRING CASE
QQ_.TOP[SRCLINK];
IF .QQ[SRCID] EQL DOID AND
.QQ[DOLBL] EQL .TOP[DOLBL] THEN
BEGIN
!ADD THE INDEX VARIABLE FOR THE LOOP
!TO THE DOCHNGL LIST OF THE INNER MORE
!LOOP
MAP PHAZ2 QQ:TOP;
LOCAL BASE TMP;
EXTERNAL NAME,CORMAN;
!GET CORE FOR ENTRY
NAME<LEFT>_1;
TMP_CORMAN();
!THE LEFTP FIELD POINTS TO THE INDEX
!VARIABLE FOR THIS LOOP
TMP[LEFTP]_.TOP[DOSYM];
!THE RIGHTP FIELD IS THE LINK TO
!THE PREVIOUS DOCHNGL LIST. NOTE:
!THIS WORKS EVEN IF THE PREVIOUS DOCHNGL IS 0.
TMP[RIGHTP]_.QQ[DOCHNGL];
TOP[DOCHNGL]_.TMP;
END
ELSE
BEGIN
FLOOD(); !MOORE FLOOD
DEFDRIV(); !GET DEFINITION POINTS
CURVERYFRST _ MAKNAME (VERYFRST); ! TO BE PASSED TO GLOBDEP
GLOBELIM(.CURVERYFRST); !COMMON SUBS AND
!CODE MOTION
PROPAGATE(); !CONSTANT PROPAGATION
!AND REDUCTION IN STRENGTH
!DO TESTREPLACEMENT IF POSSIBLE
!REDUCTIONS WERE MADE REPLACING ALL
!OCCURRENCES OF THE INDEX AND THERE
!WERE NO LOOP EXITS (REQUIRING THE
!ACTUAL INDEX TO BE IN CORE).
IF ((TESTREPLACE() NEQ 0) AND NOT .TOP[HASEXIT]) THEN SUPPLANT();
GLOBELIM2 _ 1; ! FLAG 2ND CALL
GLOBELIM(.CURVERYFRST); ! RECALL COMMON SUB ELIM
GLOBELIM2 _ 0;
END;
DOCOLLAPSE(); !REDUCE LOOP TO A
!SINGLE NODE FOR GRAPH
!OF NEXT OUTER LOOP
LOOP_WALKER();
LOOPNO_.LOOPNO+1;
END;
END;
!NOW WE ARE UP TO THE MAIN PROGRAM
LENTRY_.SORCPTR<LEFT>;
!LOOK FOR A DO LOOP AS THE FIRST STATEMENT AND QUIT HERE
TOP_.LENTRY[SRCLINK];
!FOR GLOBAL ALLOCATION NEED TO FUDGE AND UNFUDGE A DO
FUDGDO();
IF .TOP[SRCID] EQL DOID AND .DOCNT EQL 1 THEN
ELSE
BEGIN
!INDVAR IS USED AS A POINTER. WE MUST MAKE IT SOMETHING
!THAT WILL NOT BLOW UP WHEN USED AS A POINTER
!POOL HAS A ZERO IN IT, SO WE WILL USE POOL
INDVAR_POOL<0,0>;
GPHBLD();
FLOOD(); !MOORE FLOOD
DEFDRIV(); !DEFINITION POINT
CURVERYFRST _ MAKNAME (VERYFRST);
GLOBELIM(.CURVERYFRST); !CODE MOTION AND COMMON SUBS
PROPAGATE(); !CONSTANT PROPAGATION AND REDUCTION IN STRENGTH
GLOBELIM2 _ 1; ! FLAG 2ND CALL
GLOBELIM(.CURVERYFRST); ! COMMON SUBS ELIM AGAIN
GLOBELIM2 _ 0;
END;
!UNFUDG THE DO LOOP
UNFUDGDO();
!TRY TO PROPAGATE .O VARS
DOTOPROPAGATE();
ZTREE (); ! ZERO DEFPTS BEFORE LEAVE
!GET OUT SMOOTHLY
PASSOUT();
FLGREG<OPTIMIZE>_1;
!***********************************!*!*!*!*!*!*!**!*!*!*!
!NOTE:
! MAY WANT TO DO THIS INSTEAD OF SETINF EMPTY BIT
!!!*!*!*!*!*!*!*!*!*!*!*!*!*!*!*!*!*!*!*!*!*!*!*!*!*!*!*!*
INCR I FROM 0 TO EHSIZ-1 DO
BEGIN
EXTERNAL EHASH;
REGISTER BASE T:GP;
EXTERNAL SAVSPACE;
T_.EHASH[.I];
WHILE .T NEQ 0 DO
BEGIN
GP_.T[CLINK];
SAVSPACE(5,.T);
T_.GP;
END;
END;
END; !END OF MRP2
ROUTINE LABLADJ=
BEGIN
!GIVE EACH LABEL A UNIQUE CONTINUE STATEMENT AND ADJUST ALL
!DO LOOPS TO END ON THEIR OWN LABELED CONTINUE. AT THE SAME
!TIME ELIMINATE REFERENCES TO UNREFERENCED LABELS BY ZEROING
!THE SRCLBL FIELD OF THE NODE AT WHICH THEY ARE DEFINED.
!THIS PROCESS SAVES MANY SPECIAL CONTEXT CHECKS AND
!ADJUSTMENTS. IT THUS ELIMINATES HIGH SEG CODE AT THE
!EXPENSE OF EXPANDING THE LOW SEGMENT. IT REQUIRES ABOUT
!106 NEW LABELS TO BE AT THE BREAK EVEN POINT IN SIZE.
!SOME OF THE SPECIAL CONTEXTS HELPED BY THIS DEVICE ARE
! 1.DO LOOP ENDINGS WITH REDUCTIONS IN STRENGTH
! 2.COMMON SUB-EXPRESSIONS
! 3.RECOMPUTING LABLE INFORMATION FOR GLOBAL REG. ALLOC
! 4.SPECIAL CASING IN GLOBAL ALLOCATION FOR FUNCTION SAVE/RESTORE
! 5.DO LOOPS ENDING ON A LOGICAL IF
!IT ALSO PERMITS ADDITIONAL INFORMATION TO BE KEPT WITH THE DATA
!STRUCTURE THAT IS PASSED BETWEEN OPTIMIZATION AND GLOBAL ALLOCATION
!AND ADDITIONAL INFORMATION ABOUT DO LOOPS WITHIN THE OPTIMIZER
!ITSELF. THIS HAPPENS BECAUSE OF THE UNIQUENESS OF THE DO LOOP
!ENDING AND ITS LABEL.
!ALSO CALL FOR LOCAL OPTIMIZATIONS ON EACH STATEMENT
EXTERNAL MAKCONTINUE,GENLAB;
EXTERNAL P2SKSTMN,ISN;
OWN BASE PREV:MADLBL:FIRSTCONT;
MAP BASE PREV:CSTMNT;
OWN BASE STMTLBL:NEWCONT:DONODECHAIN:DONODE;
LABEL PROCSLAB,NEWC;
!GO THROUGH THE ENCODED SOURCE TREE
PREV_CSTMNT_.SORCPTR<LEFT>;
WHILE .CSTMNT NEQ 0 DO
BEGIN
ISN_.CSTMNT[SRCISN];
!CALL FOR LOCAL OPTIMIZATIONS
P2SKSTMN();
!INSERT A CONTINUE AFTER EACH DO LOOP NODE
!SO WE CAN SET BITS ON IT IN THE DEFPT
!ALGORITHM
IF .CSTMNT[SRCID] EQL DOID THEN
BEGIN
NEWCONT_MAKCONTINUE();
NEWCONT[SRCLINK]_.CSTMNT[SRCLINK];
CSTMNT[SRCLINK]_.NEWCONT;
END;
!IS THE STATEMENT LABELED WITH A REFERENCED LABEL
PROCSLAB:
IF .CSTMNT[SRCLBL] NEQ 0 THEN
BEGIN
!GET THE LABLE TABLE ENTRY
STMTLBL_.CSTMNT[SRCLBL];
FIRSTCONT_0;
!1. DELETE IT IF UNREFERENCED
IF .STMTLBL[SNREFNO] EQL 1 AND .CSTMNT[SRCID] NEQ FORMID THEN
BEGIN
CSTMNT[SRCLBL]_0;
LEAVE PROCSLAB;
END;
!FOR ALL LABELLED DO LOOPS INSERT
!A CONTINUE IN FRONT OF THE DO AND
!MOVE THE LABEL TO THE CONTINUE
IF .CSTMNT[SRCID] EQL DOID THEN
BEGIN
NEWCONT_PREV[SRCLINK]_MAKCONTINUE();
NEWCONT[SRCLBL]_.STMTLBL;
CSTMNT[SRCLBL]_0;
STMTLBL[SNHDR]_.NEWCONT;
NEWCONT[SRCLINK]_.CSTMNT;
CSTMNT[DOPRED]_.NEWCONT; !POINTER TO PREDECESSOR
LEAVE PROCSLAB
END;
!LINK ANY FORMATS OUT. EVENTUALLY PHASE 1 WILL
!DO THIS AND THERE WILL BE NONE TO LINK OUT
IF .CSTMNT[SRCID] EQL FORMID THEN
BEGIN
PREV[SRCLINK]_.CSTMNT[SRCLINK];
!IF THIS IS DIRECTLY INFRONT OF
!A DO LOOP THEN WE HAVE TO
!ADJUST THE DOPRED FIELD OF THE LOOP
DONODE_.CSTMNT[SRCLINK];
IF .DONODE[SRCID] EQL DOID AND
.CSTMNT EQL .DONODE[DOPRED] THEN
DONODE[DOPRED]_.PREV;
CSTMNT_.PREV;
LEAVE PROCSLAB;
END;
!2. ITS ALREADY A CONTINUE WITH A SINGLE DO ENDING AT IT
IF .CSTMNT[SRCID] EQL CONTID AND (.STMTLBL[SNDOLVL] LEQ 1)
THEN
LEAVE PROCSLAB;
!3. ITS AN ASSIGNMENT STATEMENT WITH:
! A. NO USER FUNCTION REFERENCES
! B. NO DO LOOPS END AT IT
IF .CSTMNT[SRCID] EQL ASGNID AND
NOT .CSTMNT[USRFNREF] AND
.STMTLBL[SNDOLVL] EQL 0 THEN
LEAVE PROCSLAB;
NEWC:
IF .CSTMNT[SRCID] NEQ CONTID THEN
BEGIN
!SPECIAL CASE EXACTLY 1 DO LOOP ENDING
!HERE WHOSE TERMINATION LABEL
!IS NOT THE OBJECT OF A TRANSFER
IF (.STMTLBL[SNREFNO] EQL 2)
AND
(.STMTLBL[SNDOLVL] EQL 1) THEN
BEGIN
FIRSTCONT_1;
LEAVE NEWC;
END;
FIRSTCONT_0;
!HERE WE HAVE AT A MINIMUM TO MOVE THE
!LABEL BACK (BETWEEN PREV AND CSTMNT)
!TO A DUMMY CONTINUE
!MAKE THE DUMMY CONTINUE
NEWCONT_PREV[SRCLINK]_MAKCONTINUE();
!ADJUST ALL THE CROSS POINTERS
!AND FINISH LINKING IT IN
NEWCONT[SRCLBL]_.STMTLBL;
CSTMNT[SRCLBL]_0;
STMTLBL[SNHDR]_.NEWCONT;
NEWCONT[SRCLINK]_.CSTMNT;
!FIX REFERENCE COUNT ON LABEL
IF .STMTLBL[SNDOLVL] NEQ 0 THEN
![1105] Get label count exactly right
%[1105]% STMTLBL[SNREFNO]_.STMTLBL[SNREFNO]
%[1105]% -.STMTLBL[SNDOLVL];
END;
!WE CAN QUIT IF NO DO LOOPS END HERE
IF .STMTLBL[SNDOLVL] EQL 0 THEN
LEAVE PROCSLAB;
!CHECK FOR SPECIAL CASE (FIRSTCONT=1)
IF .FIRSTCONT THEN
BEGIN
!GENERATE A CONTIUE AND MOVE STMTLBL TO
!IT
NEWCONT_MAKCONTINUE();
NEWCONT[SRCLBL]_.STMTLBL;
STMTLBL[SNHDR]_.NEWCONT;
CSTMNT[SRCLBL]_0;
NEWCONT[SRCLINK]_.CSTMNT[SRCLINK];
CSTMNT_CSTMNT[SRCLINK]_.NEWCONT;
LEAVE PROCSLAB;
END;
!NO, SORRY, THERE ARE DO LOOPS
! FOLLOW THE LINKED LIST OF DO LOOPS THAT END
!HERE MAKING A CONTINUE FOR EACH ONE.
DONODECHAIN_.STMTLBL[SNDOLNK];
FIRSTCONT_0;
WHILE .DONODECHAIN NEQ 0 DO
BEGIN
!IF THE STATEMENT IS QUESTION IS A
!CONTINUE WE WILL SPECIAL CASE OUT
!MAKING TWO FOR THE SAME PURPOSE
IF .CSTMNT[SRCID] NEQ CONTID OR .FIRSTCONT THEN
BEGIN
!LOOK AT THE NODE ITSELF
DONODE_.DONODECHAIN[LEFTP];
!MAKE A LABEL
MADLBL_GENLAB();
DONODE[DOLBL]_.MADLBL;
NEWCONT_MADLBL[SNHDR]_MAKCONTINUE();
NEWCONT[SRCLINK]_.CSTMNT[SRCLINK];
MADLBL[SNREFNO]_2;
NEWCONT[SRCLBL]_.MADLBL;
!NO DOES NOW END ON STMTLBL
!SO ZERO THE SNDOLVL FIELD
!IF ITS NOT ON A CONTINUE THAT
!STAYS AROUND
IF .CSTMNT[SRCID] NEQ CONTID THEN
STMTLBL[SNDOLVL]_0;
!NOTE THAT CSTMNT IS UPDATED TO POINT TO
!THE NEW CONTINUE
CSTMNT_CSTMNT[SRCLINK]_.NEWCONT;
FIRSTCONT_1;
END ELSE
BEGIN
MADLBL_.STMTLBL;
MADLBL[SNREFNO]_.MADLBL[SNREFNO]-.STMTLBL[SNDOLVL]+1;
FIRSTCONT_1;
END;
MADLBL[SNDOLVL]_1;
MADLBL[SNDOLNK]_.DONODECHAIN;
!UPDATE TO THE NEXT LOOP IN THE CHAIN.
!ZERO THE LINK FIELD OF THE OLD CHAIN
!SO THAT THE SNDOLNK JUST MADE TERMINATES
!WITH A ZERO.
NEWCONT_.DONODECHAIN;
DONODECHAIN_.NEWCONT[RIGHTP];
NEWCONT[RIGHTP]_0;
END; !WHILE ON DONODECHAIN
END; !THE STATEMENT IS LABELED
PREV_.CSTMNT;
CSTMNT_.CSTMNT[SRCLINK];
END; !WHILE ON CSTMNT
END; !ROUTINE
ROUTINE DOALLOCDECIDE(DODEPTHNODE)=
BEGIN
!ROUTINE CALLED BY DRIVDOALLOC TO TEST ACTUAL DO LOOPS
!FOR THE PROPERTIES THAT ALLOW EXTENDED GLOBAL REGISTER
!ALLOCATION TO OCCUR ON THEM.
!THESE CONDITIONS ARE:
! 1. IT IS A SECOND LEVEL LOOP
! 2. IT CONTAINS ONLY ONE INNER LOOP.
!DODEPTHNODE POINTS AT A NODE OF THE DO DEPTH ANALYSIS TREE
MAP BASE DODEPTHNODE;
LOCAL BASE DONODE:INNERSON;
!LOOP AT THE DO LOOP NODE ITSELF
DONODE_.DODEPTHNODE[DOSRC];
!IF IT IS NOT ITSELF INNERMOST
IF NOT .DONODE[INNERDOFLG] THEN
BEGIN
!LOOK AT THE INNERMORE SON
INNERSON_.DODEPTHNODE[NEXTDO];
!NOTE THAT WE ARE SURE THIS FIELD IS NOT ZERO
!IF, ON THE OTHERHAND, INNERSON IS AN INNERDO
IF .INNERSON[NEXTDO] EQL 0 THEN
BEGIN
!IF THERE ARE NODE PARALLEL TO IT
!DONODE MEETS THE CRITERIA AND GETS THE FLAG SET
IF .INNERSON[PARLVL] EQL 0 THEN
DONODE[EXTALLOC]_1
ELSE
DRIVDOALLOC(.INNERSON);
END ELSE
!THERE ARE MORE FURTHER IN. LOOK AT THEM BY
!RECURSING ON THE DRIVER
DRIVDOALLOC(.INNERSON);
END;
END;
ROUTINE DRIVDOALLOC(DODEPTHNODE)=
BEGIN
!DRIVE A SEPARATE WALK OF THE DO DEPTH ANALYSIS TREE
!TO FIND AND MARK LOOPS THAT POTENTIALLY CAN HAVE
!GLOBAL ALLOCATION EXTENDED TO THEM.
MAP BASE DODEPTHNODE;
!ITERATE ON THE PARALLEL LOOPS. IF THERE ARE NONE
!THE INITIAL CALL TO DRIVDOALLOC IS WITH DLOOPTREE
!SO IT WONT BE ZERO AND WE WILL JUST WALK DOWN
WHILE .DODEPTHNODE NEQ 0 DO
BEGIN
DOALLOCDECIDE(.DODEPTHNODE);
DODEPTHNODE_.DODEPTHNODE[PARLVL];
END;
END;
SAVE17_.SREG<0,36>; ! SAVE STACK VALUE FOR EXITS
MRP2();
POPJ(#17,0)
END ELUDOM