Trailing-Edge
-
PDP-10 Archives
-
FORTRAN-10_V7wLink_Feb83
-
tstr.bli
There are 12 other files named tstr.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 1974, 1983
!AUTHOR: NORMA ABEL/HPWD/DCE/SJW/JNG/EGM/EDS/AHM
MODULE TSTR(RESERVE(0,1,2,3),SREG=#17,VREG=#15,FREG=#16,DREGS=4)=
BEGIN
! REQUIRES FIRST, TABLES, OPTMAC
GLOBAL BIND TSTRV = 7^24 + 0^18 + #1505; ! Version Date: 9-Dec-82
%(
***** Begin Revision History *****
25 ----- ----- REFER TO GLOBAL RDCLNK
26 ----- ----- SET A2VALFLG IN REDUCTION INITIALIZATION IF
REQUIRED
27 ----- ----- RESET INDVAR IN SUPPLANT
28 ----- ----- FIX REDUCE TO LOOK FOR TRANSMOGRIFIED VARIABLES
ON I/O LISTS IN THE LOOP
29 ----- ----- FIX SUPPLANT SO THAT IF RINCR IS LABELED
WE DO NOT THROW THE LABEL AWAY
30 ----- ----- FIX REDUCE TO MOVE A LABEL ON A REDUCTION
ASSIGNMENT BACK TO OTHER REDUCTIONS
31 ----- ----- ADD TEST ON DOTOHFLG TO REDUCE
32 ----- ----- REDUCE P2 ADN P2+1 OPS
33 ----- ----- FIX SUPPLANT TO CORRECTLY INITIALIZE AN
INCREMENT TEMPORARY FOR A REPLACED INDEX
34 ----- ----- FIX REDUCE NOT TO REDUCE .O TEMPS WITHIN THE
CURRENT LOOP AND TO SAVSPACE THE REDUCED EXPRS.
35 ----- ----- MAKE LOKINDVAR A GLOBAL ROUITNE TO BE CALLED FROM
HAULASS
36 ----- ----- MAKE REDUCE DEAL WITH THE NEG/NOT FLAGS
WHEN MAKING THE INITIALIZATIONS.
37 ----- ----- MAKE SUPPLANT AWARE OF THE NEG/NOT FLAGS
SET BY PATCH 36
38 ----- ----- CAUSE REDUCE TO INSERT THE .R INITILAIZATION
AFTER OTHER OPTIMIZER STATEMENTS IF THE
REDUCTION CONSTANT IS NOT A NUMERIC CONSTANT
39 ----- ----- [EXPLITIVE DELETED] TBLSEARCH TAKES THE VARIABLE TYPE
OUT OF THE GLOBAL SYMTYPE. MAKE SURE THAT
RDCTMP SETS THE GLOBAL.
40 ----- ----- REDUCTION ANDTESTREPLACEMENT ARE
LOSING ON NEGATIVE STEP SIZES.
41 ----- ----- LOOKING AT ARGUMENT LISTS IS LOSING
CUZ IT DOES NOT LOOK AT ANY BUT THE FIRST
ARG.
42 ----- ----- LOKINDVAR SHOULD BE ORING RESULTS
NOT ADDING THEM CUZ SOME TRUES ARE 1 AND SOME
ARE -1.
43 ----- ----- DO NOT TESTREPLACE A FORMAL VARIABLE DO LOOP INDEX
IF THE LOOP CONTAINS A RETURN
44 ----- ----- TRANSMOGRIFIED .O VARIBALES ON I/O LISTS
THAT ARE BRANCHES OF A LOGICAL IF ARE LOSING
45 276 ----- MAKE SURE THE NEGFLG ON A REPLACEMENT GETS SET ON
AN EXPRESSION NODE AND NOT A DATAOPR
46 321 17005 SCAN FOR THE INDUCTION VARIABLE IN OPEN/CLOSE, (JNT)
47 346 17928 PASS RETURN INFORMATION TO OUTER DO LOOPS ,(DCE)
48 354 18015 DECREMENT LABEL COUNT CORRECTLY (BY 1), (DCE)
49 370 17938 FIX MOTION PLACE FOR .R VARIABLES, (DCE)
50 VER5 ----- KEEP .R USE CNT IN 2ND WORD OF RDCLST ,(SJW)
GLOBAL ROUTINE DOTRCNTOK
.R DEFPT <- 0 IF IN + EXPR
.TOP ELSE
51 456 QA784 GIVE FINDTHESPOT 2ND PARAM = TOP IN REDUCE ,(SJW)
52 500 20818 ONLY COMPARE SRCID TO READID IN REDUCE IF
OPRCLS EQL STATEMENT (COULD BE IOLSCLS). ,(JNG)
53 501 21113 DON'T REDUCE .O'S IF NOT IN AN INNER DO LOOP. ,(JNG)
***** Begin Version 5A *****
54 577 22352 IF DO LOOP MATERIALIZATION NEEDED, NO TEST
REPLACEMENT IS POSSIBLE FOR LOOP INDEX ,(DCE)
55 605 23478 REDUCE MUST BE MORE CAREFUL WITH SPECOPS, (DCE)
***** Begin Version 6 *****
56 773 EGM 12-Jun-80 14234
Always set def point for reduced expression to TOP, and add reduction
variable to DOCHNGL list to prevent assignment motion out of the loop.
57 1011 DCE 7-Sep-80 -----
Allow TESTREPLACEMENT in implied loops (fix edit 577)
58 1012 DCE 7-Sep-80 -----
If SPECOP, attempt reduction in strength only if type is integer.
59 1023 DCE 6-Nov-80 -----
Fix edit 1012 - allow type index (of arrays) as well as integer.
This makes edit 1011 work again!
60 1057 EDS 10-Mar-80 Q20-01410
Fix LOKINDVAR to check initial value, upper limit, step size
and loop control for DO loops.
61 1110 EGM 15-Jul-81 --------
Do not attempt to update the DOCHNGL list for implied DO lists.
Refer to edit 773.
***** Begin Version 6 *****
62 1462 DCE 20-Jan-82 -----
Prevent Testreplacement of DO loop variables if F77 specified. This
is because the loop variable ALWAYS needs to retain its value after
the loop is executed. We simply cannot do a full reduction in
strength replacement.
***** Begin Version 6A *****
1166 CDM 9-Dec-82
Enlarge RCDLST by 1.
1505 AHM 13-Mar-82
Make RDCTMP set the psect index for temps it creates to PSDATA
so that the variables go into .DATA.
ENDV7
)%
SWITCHES NOLIST;
REQUIRE FIRST.BLI;
REQUIRE TABLES.BLI;
SWITCHES LIST;
REQUIRE OPTMAC.BLI;
FORWARD LOKINDVAR;
OWN
RDCCNT,
%1166% RDCLST [19];
EXTERNAL
CORMAN,
MAKPR1,
BASE RDCLNK,
TBLSEARCH,
UNFLDO;
GLOBAL ROUTINE TESTREPLACE=
BEGIN
!DRIVE ROUTINE LOKINDVAR TO EXAMINE
!ALL SATEMENTS BETWEEN TOP AND BOTTOM FOR
!REMAINING REFERENCES TO INDVAR
!ONE OF THREE VALUES IS RETURNED
!0 NO TEST REPLACEMENT IS POSSIBLE. THAT IS, REFERENCES
! TO THE DO LOOP INDEX REMAIN
!1 A UNIQUE TEST REPLACEMENT IS POSSIBLE
!2 A NON-UNIQUE TEST REPLACEMENT IS POSSIBLE
EXTERNAL RDCCT,LPRDCCT,TOP,CSTMNT,BOTTOM,INDVAR;
MAP BASE TOP:CSTMNT:INDVAR;
!**;[1462], TESTREPLACE @3902, DCE, 20-Jan-82
![1462] No test replacement is possible if F77 specified. The
![1462] loop variable ALWAYS needs to be made available.
%1462% IF F77 THEN RETURN 0; ! No test replacement possible
!IF THE DO LOOP INDEX IS A FORMAL AND THE LOOP
!CONTIANS A RETURN THAN DO NOT TESTREPLACE IT.
IF .INDVAR[FORMLFLG] AND .TOP[HASRTRN] THEN RETURN;
!IF LOOP INDEX IS MARKED FOR MATERIALIZATION (DUE TO A CALL
! STATEMENT IN THE LOOP FOR INSTANCE), THEN NO TEST REPLACEMENT
! IS POSSIBLE, SO WE SHOULD JUST GET OUT HERE.
![1011] IF IN AN IMPLIED LOOP, IGNORE NEDSMATRLZ AND MATRLZIXONLY
%[1011]% IF NOT .IMPLDO THEN
IF .TOP[NEDSMATRLZ] OR .TOP[MATRLZIXONLY] THEN RETURN;
IF .INDVAR NEQ 0 THEN
BEGIN
CSTMNT_.TOP;
DO
BEGIN
IF LOKINDVAR(.CSTMNT) NEQ 0 THEN RETURN 0;
IF .CSTMNT[SRCID] EQL IFLID THEN
IF LOKINDVAR(.CSTMNT[LIFSTATE]) THEN RETURN 0;
!WHILE WALKING THE DO LOOPS, PASS OUT INFORMATION
! ABOUT ANY INNER RETURN STATEMENTS TO OUTER DO LOOPS
IF .CSTMNT[SRCID] EQL DOID
THEN IF .CSTMNT[HASRTRN]
THEN BEGIN
TOP[HASRTRN]_1; !SET OUTER FLAG
IF .INDVAR[FORMLFLG] THEN RETURN 0;
!FORCE MATERIALIZATION OF INDEX
END;
CSTMNT_.CSTMNT[SRCLINK];
END UNTIL .CSTMNT EQL .BOTTOM;
END;
!THERE ARE NO REFERENCES TO THE DO LOOP INDEX
!SEE IF THE REDUCTION VARIABLE IS UNITQE TO THIS LOOP
!IF THERE WAS ONLY ONE REDUCTION THE TEST REPLACEMENT IS UNIQUE
!SO RETURN 1 ELSE RETURN 2
IF .LPRDCCT EQL .RDCCT-1 THEN RETURN 1 ELSE RETURN 2;
END;
GLOBAL ROUTINE LOKINDVAR(STMNT)=
BEGIN
!ROUTINE WILL DETERMINE IF STMNT CONTAINS A REFERENCE TO
!THE DO LOOP INDEX. IT RETURNS 0 IF NOT 1 IF IT DOES
EXTERNAL CONTVAR,INDVAR;
MAP BASE STMNT;
!UTILITY MACROS AND ROUTINES
MACRO CONTUNIT=
(CONTVAR(.STMNT[IOUNIT],.INDVAR))$;
ROUTINE IOLOK(STMNT)=
BEGIN
MAP BASE STMNT;
LOCAL SUM,TMP;
MAP BASE TMP;
SUM_0;
TMP_.STMNT[IOLIST];
WHILE .TMP NEQ 0 DO
BEGIN
IF .TMP[OPRCLS] EQL STATEMENT THEN
SUM_.SUM OR LOKINDVAR(.TMP)
ELSE
SUM_.SUM OR CONTVAR(.TMP,.INDVAR);
TMP_.TMP[CLINK];
END;
SUM_.SUM OR CONTUNIT;
IF .STMNT[IORECORD] NEQ 0 THEN
SUM_.SUM OR CONTVAR(.STMNT[IORECORD],.INDVAR);
.SUM
END;
ROUTINE OPCLOLOK(STMNT)= ! ROUTINE ADDED FOR OPEN/CLOSE
BEGIN
MAP BASE STMNT;
LOCAL SUM; ! NON-ZERO IF INDVAR IS USED
SUM_CONTUNIT; ! SEE IF USED AS UNIT
IF .STMNT[OPSIZ] NEQ 0 THEN ! IF ANY OTHER ARGS
BEGIN ! THEN SCAN THEM TOO
LOCAL OPENLIST ARVALLST;
ARVALLST_.STMNT[OPLST]; ! GET ADDRESS OF LIST
INCR I FROM 0 TO (.STMNT[OPSIZ]-1) DO ! LOOK AT ALL ARGUMENTS
SUM_.SUM OR CONTVAR(.ARVALLST[.I,OPENLPTR],.INDVAR);
END;
.SUM ! RETURN NET RESULT
END; ! OF OPCLOLOK
MACRO CONTIOVAR=
RETURN(IOLOK(.STMNT))$;
!START OF ROUTINE LOKINDVAR***********************
!IF WE ARE IN THE I/O OPTIMIZATIONS WE WILL WALK DOWN
!TO AN IOLSCLS NODE SO WE MUST MAKE A SPECIAL CHECK AND
!DO THE CORRECT THING.
IF .STMNT[OPRCLS] EQL IOLSCLS THEN
RETURN(CONTVAR(.STMNT,.INDVAR));
CASE .STMNT[SRCID] OF SET
!ASSIGNMENT STATEMENT
RETURN(CONTVAR(.STMNT[LHEXP],.INDVAR) OR CONTVAR(.STMNT[RHEXP],.INDVAR));
!ASSIGN
RETURN(CONTVAR(.STMNT[ASISYM],.INDVAR));
!CALL STATEMENT
BEGIN
LOCAL ARGUMENTLIST AG;
AG_.STMNT[CALLIST];
IF .AG NEQ 0 THEN
INCR I FROM 1 TO .AG[ARGCOUNT] DO
IF CONTVAR(.AG[.I,ARGNPTR],.INDVAR) THEN
RETURN 1;
END;
!CONTINUE
BEGIN END;
!DO
BEGIN
!!LOOK AT THE STEPSIZE, INITIAL VALUE, UPPER LIMIT
!AND THE LOOP CONTROL
%[1057]% RETURN(CONTVAR(.STMNT[DOM1],.INDVAR)
%[1057]% OR CONTVAR(.STMNT[DOM2],.INDVAR)
%[1057]% OR CONTVAR(.STMNT[DOM3],.INDVAR)
%[1057]% OR CONTVAR(.STMNT[DOLPCTL],.INDVAR));
END;
!ENTRY
BEGIN END;
!COMNSUB
BEGIN END;
!GO TO
BEGIN END;
!ASSIGNED GO TO
RETURN( CONTVAR(.STMNT[AGOTOLBL],.INDVAR));
!COMPUTED GO TO
RETURN( CONTVAR(.STMNT[CGOTOLBL], .INDVAR));
!ARITHMETIC IF
RETURN( CONTVAR(.STMNT[AIFEXPR],.INDVAR));
!LOGICAL IF
RETURN( CONTVAR(.STMNT[LIFEXPR],.INDVAR));
!RETURN
BEGIN
IF .STMNT[RETEXPR] NEQ 0 THEN
RETURN( CONTVAR(.STMNT[RETEXPR],.INDVAR))
ELSE RETURN 0;
END;
!STOP
BEGIN END;
!READ
CONTIOVAR;
!WRITE
CONTIOVAR;
!DECODE
CONTIOVAR;
!ENCODE
CONTIOVAR;
!REREAD
CONTIOVAR;
!FIND
CONTIOVAR;
!CLOSE
RETURN OPCLOLOK(.STMNT);
!INPUT
BEGIN END;
!OUTPUT
BEGIN END;
!BACK SPACE
RETURN CONTUNIT;
!BACK FILE
RETURN CONTUNIT;
!REWIND
RETURN CONTUNIT;
!SKIP FILE
RETURN CONTUNIT;
!SKIP RECORD
RETURN CONTUNIT;
!UNLOAD
RETURN CONTUNIT;
!RELEASE
RETURN CONTUNIT;
!END FILE
RETURN CONTUNIT;
!END
BEGIN END;
!PAUSE
BEGIN END;
!OPEN
RETURN OPCLOLOK(.STMNT);
TES;
END;
GLOBAL ROUTINE SUPPLANT=
BEGIN
!PERFORM A TEST REPLACEMENT ON THE FIRST ELEMENT IN
!RDCLST.
LOCAL BASE RINIT:RINCR:PA:PB;
EXTERNAL TOP,LEND,LENTRY,PREV,GETOPTEMP,INDVAR;
EXTERNAL MAKCONTINUE;
MAP BASE TOP:PREV;
!FIRST PICK UP A POINTER TO THE REDUCTION SYMBOL
PA_.RDCLST[1]<LEFT>;
!EXAMINE STATEMENTS LINKED AT LENTRY UTIL WE FIND
!THE INITIALIZATION OF THIS REDUCTION VARIABLE
PB_RINIT_.LENTRY;
WHILE .RINIT NEQ .TOP DO
BEGIN
!CHECK FOR AN ASSIGNMENT TO THIS REDUCTION VARIABLE
IF .RINIT[OPRS] EQL ASGNOS THEN
IF .RINIT[LHEXP] EQL .PA THEN
BEGIN
!IF WE ARE NOT ABOUT TO MAKE AN
!EXPRESSION THE INITIAL VALUE IN THE
!LOOP
!LINK OUT THIS INIITIALIZATION
!ASSIGNMENT STATEMENT
IF .RINIT[A2VALFLG] THEN
BEGIN
PB[SRCLINK]_.RINIT[SRCLINK];
TOP[DOM1]_.RINIT[RHEXP];
!IF THE NEGFLG IS INVOLVED SET
!INITLNEG FOR CODE GENERATION
IF .RINIT[A2NEGFLG] THEN
TOP[INITLNEG]_1;
END ELSE
!MAKE THE INITIAL VALUT BE THE .R
!VARIABLE AND LEAVE THE ASSIGNMENT IN.
!THE BB REG ALLOC WILL MAKE HE CODE
!PRETTY
BEGIN
TOP[DOM1]_.PA;
TOP[INITLTMP]_1;
END;
!SET THE DO SYMBOL
TOP[DOSYM]_INDVAR_.PA;
!NOW LOOK AT THE END OF THE LOOP.
!UNFORTUNATELY, WE HAVE TO START AT
!TOP. RDCLNK POINTS TO WHERE THE REDUCTIONS
!ARE LINKED. WE NEED TO KNOW THE STATEMENT
!INFRONT OF THE REDUCTION IN WHICCH WE ARE
!INTERESTED. IF IT IS THE FIRST REDUCTION
!STARTING AT RDCLNK LOSES. SO,-------
!WE TAKE IT FROM THE TOP.
PREV_.TOP;
!WE WILL SEARCH UNTIL RDCLNK
WHILE .PREV[SRCLINK] NEQ .RDCLNK DO
PREV_.PREV[SRCLINK];
!PREV IS NOW THE STATEMENT IN FRONT OF
!RDCLNK (THE FIRST REDUCTION).
RINCR_.PREV[SRCLINK];
WHILE .RINCR NEQ .LEND DO
BEGIN
REGISTER BASE EXPR;
IF .RINCR[OPRS] EQL ASGNOS THEN
IF .RINCR[LHEXP] EQL .PA THEN
BEGIN
!IF RINCR IS LABELED MAKE
!A CONTINUE TO HOLD THE
!PLACE OF THE LABEL
IF .RINCR[SRCLBL] NEQ 0 THEN
BEGIN
REGISTER BASE T;
!GET THE CONTINUE
EXPR_MAKCONTINUE();
!MOVE THE LABEL
T_EXPR[SRCLBL]_.RINCR[SRCLBL];
T[SNHDR]_.EXPR;
RINCR[SRCLBL]_0;
!LINK CONTINUE INTO
!TREE
PREV[SRCLINK]_.EXPR;
EXPR[SRCLINK]_.RINCR;
!UPDATE PREV
PREV_.EXPR;
END;
!SET STEPSIZE
EXPR_.RINCR[RHEXP];
IF .EXPR[OPRCLS] EQL DATAOPR THEN
BEGIN
TOP[DOM3]_.EXPR;
!KILL THE ASSIGNMENT STATEMENT
PREV[SRCLINK]_.RINCR[SRCLINK];
END
ELSE
BEGIN
EXPR_(IF .EXPR[ARG1PTR]
EQL .PA THEN .EXPR[ARG2PTR] ELSE
.EXPR[ARG1PTR]);
!IF EXPR IS STILL
!AN EXPRESSION MUST DO
!ELABORATE HACK
!TO COMPUTE STEP SIZ
IF .EXPR[OPRCLS] EQL DATAOPR THEN
BEGIN
TOP[DOM3]_.EXPR;
!TURN OFF SSIZNEG FLAG
!REDUCE HAS ALREADY TAKEN CARE
!OF THIS
TOP[SSIZNEGFLG]_0;
PREV[SRCLINK]_.RINCR[SRCLINK];
END
ELSE
BEGIN
!GET AN OPTIMIZER VARIABLE TO USE AS
!STEPSIZE
TOP[DOM3]_
RINCR[LHEXP]_
GETOPTEMP(IF .EXPR[VALTYPE] EQL
CONTROL THEN LOGICAL ELSE
.EXPR[VALTYPE]);
!TRANSFORM RINCR
!INTO THE STEPSIZE
!ASSIGNMENT
RINCR[RHEXP]_.EXPR;
!DELINK ASSIGNMENT
PREV[SRCLINK]_.RINCR[SRCLINK];
!PUT IT AT PB
!INFRONT OF THE LOOP
RINCR[SRCLINK]_.PB[SRCLINK];
PB[SRCLINK]_.RINCR;
!RESET FLAGS
RINCR[EXPFLAGS]_0;
RINCR[A1VALFLG]_1;
TOP[SSIZINTMP]_1;
END;
END;
!RESET LOOP FLAGS
IF .TOP[FLCWD] THEN
UNFLDO(.TOP);
TOP[SSIZONE]_0;
!GET OUT
RETURN;
END; !IF THIS IS THE REDUCTION WE WANT
PREV_.RINCR;
RINCR_.RINCR[SRCLINK];
END; !WHILE TO FIND INCR AT LOOP END
END; !IF STATEMENT ON RINIT
PB_.RINIT;
RINIT_.RINIT[SRCLINK];
END; !WHILE ON RINIT
END; !ROUTINE
FORWARD RDCTMP,REDUCE;
EXTERNAL INDVAR,LENTRY,LEND,RDCCT;
MAP PEXPRNODE INDVAR:LENTRY:LEND;
ROUTINE ONIOLST(LSTNOD,WHO)=
BEGIN
!IF WHO IS ON THE I/O LST POINTED TO BY
!LSTNOD THEN RETURN THE NODE THAT POINTS TO WHO.
!RETURN 0 AS A FLAG FOR NOT FOUND
MAP BASE LSTNOD;
WHILE .LSTNOD NEQ 0 DO
BEGIN
IF .LSTNOD[SRCLINK] EQL .WHO THEN
RETURN(.LSTNOD);
LSTNOD_.LSTNOD[SRCLINK];
END;
0
END;
GLOBAL ROUTINE REDUCE(CNODE)=
BEGIN
EXTERNAL GENLAB,ARSKOPT,DOWDP,TOP,TRANSMOGRIFY;
EXTERNAL SAVSPACE,NEGFLG,NOTFLG;
EXTERNAL FINDTHESPOT;
LABEL CHKREC,LNKOUT;
OWN TEMP;
LOCAL A1NODE,A2NODE,PA,PB,T;
MAP OBJECTCODE DOWDP;
MAP PEXPRNODE CNODE:A1NODE:A2NODE:PA:PB:T;
MAP PHAZ2 TOP;
!INDVAR IS THE INDEX VARIABLE
!CHECK THAT TWO LEAVES AND INTEGER MULTIPLY
IF .DOTOHFLG THEN RETURN(.CNODE);
!IF IT IS A SPECIAL OPERATOR ITS REDUCIBILITY
!PROPERTIES ARE ALREADY KNOWN TO BE PRESENT. WE
!WILL SIMPLY RECONVERT TO A MULTIPLY
IF .CNODE[OPRCLS] EQL SPECOP THEN
BEGIN
!THE COMMENT ABOVE IS NOT CORRECT, FOR WE DO NOT
! KNOW HERE WHETHER WE HAVE SPECOPS WHICH ARE COMING
! FROM MULTIPLICATIONS OR DIVISIONS, ETC.
! WE ONLY WANT TO PROCEED IF WE HAVE POTENTIAL MULTIPLIES.
IF .CNODE[OPERSP] EQL P2DIVOP OR .CNODE[OPERSP] EQL EXPCIOP
![1023] FOR SPECOP, MAKE SURE TYPE IS INTEGER OR INDEX
%[1023]% OR ( .CNODE[VALTYPE] NEQ INTEGER
%[1023]% AND .CNODE[VALTYPE] NEQ INDEX)
THEN RETURN(.CNODE); !NO REDUCTION POSSIBLE
!PICK UP POWER OF 2
A2NODE_.CNODE[ARG2PTR];
!REGENERATE THE CONSTANT
CNODE[ARG2PTR]_
MAKECNST(INTEGER,0,(1^(.A2NODE)+(.CNODE[OPERSP] EQL P2PL1OP)));
CNODE[OPRCLS]_ARITHMETIC;
CNODE[OPERSP]_MULOP;
END ELSE
IF NOT (REDUCOP(CNODE)) THEN RETURN(.CNODE);
!NOW WE KNOW THAT THERE IS A POTENTIAL REDUCTION
!LOOK AT THE VARIABLES INVOLVED
IF .CNODE[ARG2PTR] EQL .INDVAR OR
.CNODE[ARG1PTR] EQL .INDVAR THEN
ELSE
RETURN(.CNODE);
!CHECK FOR NOT FLAGS
IF .CNODE[A1NOTFLG] OR .CNODE[A2NOTFLG] THEN RETURN(.CNODE);
!FIND THE NODES
A1NODE_.CNODE[ARG1PTR]; A2NODE_.CNODE[ARG2PTR];
!PUT THE NODES IN THE RIGHT ORDER
IF .A1NODE EQL .INDVAR THEN
BEGIN
SWAPARGS(CNODE);
A1NODE_.CNODE[ARG1PTR];
A2NODE_.CNODE[ARG2PTR];
END;
!IN THE EVENT THAT THE OTHER LEAF IS
!NOT A CONSTANT IT MUST BE A LOOP CONSTANT OR WE ARE NOT
!INTERESTED IN IT.
CHKREC:
IF .A1NODE[OPR1] NEQ CONSTFL THEN
BEGIN
!MAKE SURE THE RESULT OF THE MULTIPLICATION IS
!POSITIVE
IF .CNODE[A1NEGFLG] AND .CNODE[A2NEGFLG]
THEN
ELSE
IF .CNODE[A1NEGFLG] OR .CNODE[A2NEGFLG] THEN
RETURN(.CNODE);
%(***IF WE'RE IN AN INNER DO LOOP AND TOLENTRY (INDICATING
THAT THE VARIABLE IS ASSIGNED OUTSIDE THE LOOP OF
ITS FIRST USE), THEN CAN REDUCE EXPRESSIONS INVOLVING
.O VARIABLES. OTHERWISE DON'T TOUCH THEM***)%
IF .A1NODE[IDDOTO] EQL SIXBIT".O" THEN
BEGIN
IF .TOP[INNERDOFLG]
AND .A1NODE[IDATTRIBUT(TOLENTRY)]
THEN
LEAVE CHKREC !GOT A SAFE ONE
ELSE
RETURN(.CNODE);
END;
!LOOK AT THE LIST OF VARIABLES ON THE DOCHNGL LIST
!FOR THIS LOOP. DEFINITION POINT INFO IS NO LONGER
!AVAILABLE, NEITHER ARE THE SYMBOL TABLE FLAGS FROM
!FROM THE DEFINITION POINT ALGORITHM.
!SEE DEF0, AND DEFCHANGE FOR A DESCRIPTION OF
!THE DOCHNGL LIST.
!IF THIS IS ON AN I/O LIST WE ARE IN TROUBLE BECAUSE THE
!OPTIMIZERS WORDS ARE NOT PRESENT. SO CHECK FOR
!ZERO AND QUIT. IT IS IMPOSSIBLE FOR THE CONSTANT
!TO BE DEFINED ON THE LIST (I HOPE)
IF .TOP[SRCOPT] EQL 0 THEN
!ASSUME ON I/O LIST
LEAVE CHKREC;
PA_.TOP[DOCHNGL];
WHILE .PA NEQ 0 DO
BEGIN
IF .A1NODE EQL .PA[LEFTP] THEN
RETURN(.CNODE);
PA_.PA[RIGHTP];
END;
!IF WE GOT HERE IT IS A REGION CONSTANT
!KEEP GOING**********
END
ELSE
BEGIN
!GENERATE CONSTANT WITH THE RIGHT SIGN
IF .CNODE[A1NEGFLG] THEN
BEGIN
A1NODE_MAKECNST(INTEGER,0,-.A1NODE[CONST2]);
CNODE[A1NEGFLG]_0
END;
IF .CNODE[A2NEGFLG] THEN
BEGIN
A1NODE_MAKECNST(INTEGER,0,-.A1NODE[CONST2]);
CNODE[A2NEGFLG]_0
END;
END;
!********************************************************
!
!NOW WE HAVE A REDUCTION AND IT IS IN THE ORDER CONSTANT * INDVAR
!
!*******************************************************
!SEE IF THIS REDUCTION HAS BEEN DONE BEFORE
TEMP_0;
!THE FORMAT OF THE LIST IS
! LEFT HALF WORD POINTS TO REDUCTION VARIBALE
! RIGHT HALF POINTS TO CONSTANT
IF .RDCCNT NEQ 0
THEN BEGIN
LABEL LINCR;
LINCR: INCR I FROM 1 TO .RDCCNT BY 2 DO
IF .RDCLST [.I]<RIGHT> EQL .A1NODE
THEN BEGIN
TEMP _ .RDCLST [.I]<LEFT>;
RDCLST [.I+1] _ .RDCLST [.I+1] + 1; ! USE CNT
LEAVE LINCR; ! SEARCH DONE
END;
END;
!CHECK TO SEE IF THIS REDUCTION CAN BE SUBSUMED
!USE A2NODE (INDVAR AT THIS POINT) AS A FLAG
A2NODE_0;
IF .TEMP EQL 0 THEN
BEGIN
PA_.CNODE[PARENT];
!SAFETY CHECK ON THE VALIDITY OF THE POINTER
IF .PA NEQ 0 THEN
IF .PA[OPRCLS] EQL STATEMENT THEN
IF .PA[OPERSP] EQL ASGNID THEN
BEGIN
PB_.PA[LHEXP];
!IS IT A.O VARIABLE
IF .PB[IDDOTO] EQL SIXBIT".O" THEN
BEGIN
!MAKE IT EASIER FOR US TO
!READ THE CODE BY
!CALLING IT A .R
TEMP_.PB;
TRANSMOGRIFY(.PB,SIXBIT'.R'+MAKNAME(RDCCT));
!UPDATE RDCCT
RDCCT_.RDCCT+1;
!LINK THE .O ASSIGNMENT
!OUT OF THE TREE
PB_.TOP;
LNKOUT:
UNTIL .PB[SRCLINK] EQL .PA DO
BEGIN
!SAVE PB
A2NODE_.PB;
!DON'T CHECK FOR AN I/O STATEMENT
!UNLESS IT'S A STATEMENT
IF .PB[OPRCLS] EQL STATEMENT THEN
!IT COULD BE ON AN I/O
!LIST OR IN THE TREE
IF (.PB[SRCID] GEQ READID) AND
(.PB[SRCID] LEQ ENCOID) THEN
BEGIN
IF (PB_ONIOLST(.PB[IOLIST],.PA) NEQ 0) THEN
LEAVE LNKOUT;
END ELSE !I/O
!IT COULD BE ON
!A LOGICAL IF I/O LIST
IF .PB[SRCID] EQL IFLID THEN
BEGIN
PB_.PB[LIFSTATE];
IF (.PB[SRCID] GEQ READID) AND
(.PB[SRCID] LEQ ENCOID) THEN
IF (PB_ONIOLST(
.PB[IOLIST],.PA) NEQ 0)
THEN
LEAVE LNKOUT;
END;
!RESTORE PB
PB_.A2NODE;
PB_.PB[SRCLINK];
END;
PB[SRCLINK]_.PA[SRCLINK];
A2NODE_1;
END;
END;
IF .A2NODE EQL 0 THEN
TEMP_RDCTMP();
!NOW ADD THIS ONE TO THE LIST. IF THE LIST OVERFLOWS REINITIALIZE
!AND START AGAIN.
IF .RDCCNT GEQ 18
THEN BEGIN
RDCCNT _ 0;
INCR I FROM 0 TO 18 DO
RDCLST [.I] _ 0;
END;
!WE ARE SURE WE CAN NOW ADD
IF .RDCCNT EQL 0 ! IS LIST EMPTY ?
THEN RDCCNT _ 1 ! YES => START @ WORD 1
ELSE RDCCNT _ .RDCCNT + 2; ! NO => NEXT 2 WORDS
RDCLST [.RDCCNT]<LEFT> _ .TEMP;
RDCLST [.RDCCNT]<RIGHT> _ .A1NODE;
RDCLST [.RDCCNT+1] _ 1; ! USE CNT
NAME<LEFT>_ASGNSIZ+SRCSIZ;
!BUILD A NODE OF
! TEMP =M1*CONSTANT
!AND DO PHASE 2 SKELETON
PA_CORMAN();
PA[OPRCLS]_STATEMENT;
PA[SRCID]_ASGNID;
PA[LHEXP]_.TEMP;
PA[A1VALFLG]_1;
NEGFLG_NOTFLG_FALSE;
T_PA[RHEXP]_ARSKOPT(MAKPR1(.PA,ARITHMETIC,MULOP,INTEGER,
.TOP[DOM1],.A1NODE));
IF .T[OPRCLS] EQL DATAOPR THEN
BEGIN
PA[A2VALFLG]_1;
!IF ANY OF THE %&'#" NEG/NOT FLAGS
!GOT SET TRANSFER THIS INFO TO THE STATEMENT
!NODE
IF .NEGFLG THEN
PA[A2NEGFLG]_1
ELSE
IF .NOTFLG THEN
PA[A2NOTFLG]_1;
END;
!LINK THIS STATEMENT IN FRONT OF THE DO LOOP
!ALSO MOVE ANY LABEL THAT IS ON THE
!PHYSICAL SUCCESSOR OF THE PLACE WHERE THE REDUCTION
!INITILAIZATION IS INSERTED BACK TO THE REDUCTION.
!IF THE CONSTANT IS NOT A GENUINE NUMERIC CONSTANT
!THEN INSERT THE REDUCTION AFTER OTHER
!OPTIMIZER STATEMENTS AT LENTRY OTHERWISE JUST
!STICK IT AT LENTRY (REG ALLOC. WILL BE BETTER IN THE
!LATTER CASE 'CUZ ANY INITIAL DO
!DO VALUE COMPUTATION WILL IMMEDIATELY PRECEDE THE
!REDUCTION).
!FIX THE FOLLOWING TEST SO THAT THE MOTION PLACE
! FOR THE .R VARIABLES IS CORRECT WITH RESPECT TO .O
! VARIABLES. THIS IS THE CORRECT FIX FOR
! SPR 14940, INSTEAD OF [244]
!THIS KEEPS THE .R ASSIGNMENTS CLOSER TO
! THE DO LOOP AND ALLOWS CSE WITH .O VARIABLES
! WHICH ARE MOVED ESSENTIALLY TO THE SAME PLACE.
IF .T[OPR1] EQL CONSTFL THEN
T_.LENTRY
ELSE
!TELL FINDTHESPOT TO STOP WHEN IT HITS TOP
T _ FINDTHESPOT (.LENTRY, .TOP);
!NOW LINK IT IN
PA[SRCLINK]_.T[SRCLINK];
T[SRCLINK]_.PA;
!SET UP T FOR NEXT CODE SEQUENCE
T_.PA[SRCLINK];
IF .T[SRCLBL] NEQ 0 THEN
BEGIN
PB_PA[SRCLBL]_.T[SRCLBL];
T[SRCLBL]_0;
PB[SNHDR]_.PA;
END;
!
!BUILD A NODE FOR
! TEMP=TEMP+CONSTANT*M3
!
NAME<LEFT>_ASGNSIZ+SRCSIZ;
PA_CORMAN();
PA[OPRCLS]_STATEMENT;
PA[SRCID]_ASGNID;
PA[LHEXP]_.TEMP;
PA[A1VALFLG]_1;
!THIS STATEMENT IS STILL WITHIN THIS LOOP SO IT WILL BE
!LOCALLY OPTIMIZED NOW
NEGFLG_NOTFLG_T_0;
PB_ARSKOPT(MAKPR1(.PA,ARITHMETIC,MULOP,INTEGER,.TOP[DOM3],.A1NODE));
!IF THE NEGFLG IS SET THEN CHANCES ARE THE STEP SIZE
!IS -1. MKE SURE THE PROPER NEG FLG IS SET ON THE
!NODES TO REFLECT THIS
IF .NEGFLG OR .TOP[SSIZNEGFLG] THEN
IF .PB[OPRCLS] EQL DATAOPR THEN
T_1
ELSE
PB[A1NEGFLG]_NOT .PB[A1NEGFLG];
NEGFLG_NOTFLG_FALSE;
PA[RHEXP]_ARSKOPT(PB_MAKPR1(.PA,ARITHMETIC,ADDOP,INTEGER,.PB,.TEMP));
!IF WE WERE QUEUING A NEGFLG MAKE THE ADD A SUBTRACT
IF .T THEN
PB[A1NEGFLG]_NOT .PB[A1NEGFLG];
!LINK THIS AT LOOP END
!WANT TO LINK IT IN FRONT OF LEND. NEED TO FIND
!THE STATEMENT IN FRONT OF LEND. IT HAS ALREADY
!BEEN FOUND IF RDCLNK IS NOT ZERO. OTHERWISE WE
!WILL DO A LINEAR SEARCH FOR IT
IF .RDCLNK EQL 0 THEN
BEGIN
RDCLNK_.TOP;
WHILE .RDCLNK[SRCLINK] NEQ .LEND DO
RDCLNK_.RDCLNK[SRCLINK];
END;
!RDCLNK NOW POINTS TO THE PLACE
T_.RDCLNK[SRCLINK];
RDCLNK[SRCLINK]_.PA;
PA[SRCLINK]_.T;
!IF T IS LABELED AND IS NOT LEND THEN IT
!MUST BE A PREVIOUS REDUCTION. IF IT IS LABELED
!IT IS BECAUSE LEND WAS LABELED AND REFERENCED AS OTHER
!THAN THE DO TERMINATOR. WE NEED TO MOVE THE LABEL
!BACK TO THE NEW REDUCTION TOO.
IF .T[SRCLBL] NEQ 0 AND .T NEQ .LEND THEN
BEGIN
PB_PA[SRCLBL]_.T[SRCLBL];
T[SRCLBL]_0;
PB[SNHDR]_.PA;
END;
!IF LEND IS LABELED AND THE LABEL IS REFERENCED
!AS A TRANSFER THEN MOVE THE LABEL BACK
!TO THE REDUCTION AND MAKE A NEW ONE FOR THE LOOP
!TERMINATOR
IF .LEND[SRCLBL] NEQ 0 THEN
BEGIN
T_.LEND[SRCLBL];
IF .T[SNDOLVL] NEQ 0 AND .T[SNREFNO] NEQ 2 THEN
BEGIN
PB_GENLAB();
!MOVE LABEL
PA[SRCLBL]_.LEND[SRCLBL];
T[SNHDR]_.PA;
!MAKE PB THE NEW DO LABEL
TOP[DOLBL]_.PB;
PB[SNHDR]_.LEND;
LEND[SRCLBL]_.PB;
PB[SNREFNO]_2;
PB[SNDOLVL]_.T[SNDOLVL];
PB[SNDOLNK]_.T[SNDOLNK];
!ZERO DO LOOP STUFF IN OLD
!LABEL
T[SNREFNO]_.T[SNREFNO]-1;
T[SNDOLVL]_T[SNDOLNK]_0;
END;
END;
END; !HAVE NOT DONE THIS ONE YET
!FIX UP THE VALFLGAS ON THE PARENT ONCE AND FOR
!ALL HERE.
PA_.CNODE[PARENT];
IF .PA[OPRCLS] EQL STATEMENT THEN
BEGIN
IF .PA[SRCID] EQL ASGNID THEN
PA[A2VALFLG]_1;
END ELSE
IF .PA [ARG1PTR] EQL .CNODE
THEN BEGIN
PA [A1VALFLG] _ 1;
%[773]% PA [DEFPT1] _ .TOP; ! Keep it in the loop
%[773]% END
%[773]% ELSE BEGIN
%[773]% PA [A2VALFLG] _ 1;
%[773]% PA [DEFPT2] _ .TOP; ! Keep it in the loop
%[773]% END;
![1110] For all DOs except those in an I/O list (implied DOs),
![1110] also add the reduction varaible to the DOCHNGL list in order
![1110] to keep simple assignments involving .R from leaving the loop.
%[1110]% IF NOT .IMPLDO
%[1110]% THEN
%[1110]% BEGIN
%[1110]% NAME<LEFT>_CHNGSIZ;
%[1110]% PA_CORMAN();
%[1110]% PA[RIGHTP]_.TOP[DOCHNGL];
%[1110]% TOP[DOCHNGL]_.PA; ! Link it onto top of the list
%[1110]% PA[LEFTP]_.TEMP !.R
%[1110]% END;
!FREE THE SPACE USED BY THE REDUCED NODE
SAVSPACE(EXSIZ-1,.CNODE);
!LINK USE OF TEMP INTO THE TREE BY RETURNING IT
.TEMP
END;
!
!*******************************
GLOBAL ROUTINE RDUCINIT=
BEGIN
!INITIALIZE REDUCTION STORAGE. CALLED FROM
!PROPAGATE. IT IS HERE WITH THE CALL IN PROPAGATE
!TO KEEP THE STORAGE OWN.
RDCLNK_0 ;
RDCCNT_0;
INCR I FROM 0 TO 18 DO
RDCLST[.I]_0;
END;
GLOBAL ROUTINE RDCTMP=
BEGIN
! Create a reduction in strength temporary
EXTERNAL SYMTYPE;
REGISTER
%1505% BASE ID; ! Points to STE that is created
SYMTYPE = INTEGER;
NAME = IDTAB;
ENTRY = SIXBIT'.R' +MAKNAME(RDCCT);
RDCCT = .RDCCT+1;
ID = TBLSEARCH();
%1505% ID[IDPSECT] = PSDATA; ! Put the temp in .DATA.
%1505% RETURN .ID ! Return the STE address explicitly
END;
SWITCHES NOSPEC;
! CALLED FROM DOTORFIX
! RETURNS 1 IF USAGE CNT OF .R (IN RDCLST [+1]) = 1
! 0 IF USE CNT NEQ 1 OR .R NOT FOUND
GLOBAL ROUTINE DOTRCNTOK (R) =
BEGIN
INCR I FROM 1 TO .RDCCNT BY 2
DO BEGIN
IF .RDCLST [.I]<LEFT> EQL .R
THEN
IF .RDCLST [.I+1] EQL 1 ! USE CNT
THEN RETURN 1
ELSE RETURN 0;
END; ! OF DO
RETURN 0; ! R NOT FOUND
END; ! OF DOTRCNTOK
END
ELUDOM