Trailing-Edge
-
PDP-10 Archives
-
FORTRAN-10_Alpha_31-jul-86
-
tstr.bli
There are 12 other files named tstr.bli in the archive. Click here to see a list.
!COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1974, 1986
!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.
MODULE TSTR(RESERVE(0,1,2,3),SREG=#17,VREG=#15,FREG=#16,DREGS=4)=
BEGIN
! REQUIRES FIRST, TABLES, OPTMAC
GLOBAL BIND TSTRV = #11^24 + 0^18 + #4527; ! Version Date: 1-Jan-86
%(
***** 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.
***** End Revision History *****
***** Begin Version 10 *****
2211 TFV 18-Aug-83
Fix LOKINDVAR. Add INQUIRE case. Also check more I/O
specifiers for references to the DO loop index.
2377 TJK 16-Jun-84
Correct the case for a DO statement in LOKINDVAR added in edit
1057. It shouldn't look at DOM2, since this isn't used after
DOLPCTL is created. Also add some explicit zero returns in
TESTREPLACE.
***** End V10 Development *****
***** End Revision History *****
***** Begin Version 11 *****
4500 MEM 22-Jan-85
Look for references to the do index in the expressions pointed to by
IOKEY in OPEN statements.
4501 MEM 22-Jan-85
Look for references to the do index in the expression pointed to by
IOKEY in READ statements.
4502 MEM 22-Jan-85
Modify LOKINDVAR for DELETE statement.
4503 MEM 22-Jan-85
Modify LOKINDVAR for REWRITE statement.
4504 MEM 22-Jan-85
Modify LOKINDVAR for UNLOCK statement.
4515 CDM 20-Sep-85
Phase I for VMS long symbols. Create routine ONEWPTR for Sixbit
symbols. For now, return what is passed it. For phase II, return
[1,,pointer to symbol].
4527 CDM 1-Jan-86
VMS Long symbols phase II. Convert all internal symbols from
one word of Sixbit to [length,,pointer]. The lengths will be one
(word) until a later edit, which will store and use long symbols.
ENDV11
)%
SWITCHES NOLIST;
REQUIRE FIRST.BLI;
REQUIRE TABLES.BLI;
SWITCHES LIST;
REQUIRE OPTMAC.BLI;
FORWARD
TESTREPLACE,
IOLOK(1),
OPCLOLOK(1),
LOKINDVAR(1),
SUPPLANT,
ONIOLST(2),
REDUCE(2),
RDUCINIT,
RDCTMP,
DOTRCNTOK(1);
OWN
RDCCNT,
%1166% RDCLST [19];
EXTERNAL
ARSKOPT,
BOTTOM,
CONTVAR,
CORMAN,
CSTMNT,
DOWDP,
FINDTHESPOT,
GENLAB,
GETOPTEMP,
INDVAR,
LENTRY,
LEND,
LPRDCCT,
MAKCONTINUE,
MAKPR1,
NEGFLG,
NOTFLG,
%4515% ONEWPTR, ! Returns [1,,pointer] to Sixbit argument
PREV,
RDCCT,
BASE RDCLNK,
SAVSPACE,
SYMTYPE,
TBLSEARCH,
TOP,
TRANSMOGRIFY,
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
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.
%2377% IF .INDVAR[FORMLFLG] AND .TOP[HASRTRN] THEN RETURN 0;
!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
%2377% IF .TOP[NEDSMATRLZ] OR .TOP[MATRLZIXONLY] THEN RETURN 0;
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; ! of TESTREPLACE
ROUTINE IOLOK(STMNT)=
BEGIN
!***************************************************************
! Look for references to the DO loop index in the expressions
! under an I/O statement. Return 0 if there are none, else
! return 1.
!***************************************************************
%2211% ! Rewritten by TFV on 18-Aug-83
MAP BASE STMNT;
REGISTER
CONT, ! Flag for does contain references
BASE TMP; ! Convenient temp
CONT = 0; ! Reset flag
IF (TMP = .STMNT[IOUNIT]) NEQ 0 ! Check UNIT=
THEN CONT = .CONT OR CONTVAR(.TMP,.INDVAR);
IF (TMP = .STMNT[IOFORM]) NEQ 0 ! Check FMT=
THEN IF .TMP NEQ #777777 ! Not list-directed
THEN CONT = .CONT OR CONTVAR(.TMP,.INDVAR);
IF (TMP = .STMNT[IORECORD]) NEQ 0 ! Check REC=
THEN CONT = .CONT OR CONTVAR(.TMP,.INDVAR);
IF (TMP = .STMNT[IOIOSTAT]) NEQ 0 ! Check IOSTAT=
THEN CONT = .CONT OR CONTVAR(.TMP,.INDVAR);
%4501% IF (TMP = .STMNT[IOKEY]) NEQ 0 ! Check IOKEY=
%4501% THEN CONT = .CONT OR CONTVAR(.TMP,.INDVAR);
TMP = .STMNT[IOLIST]; ! Check IOLIST
WHILE .TMP NEQ 0 DO
BEGIN
IF .TMP[OPRCLS] EQL STATEMENT
THEN CONT = .CONT OR LOKINDVAR(.TMP)
ELSE CONT = .CONT OR CONTVAR(.TMP,.INDVAR);
TMP = .TMP[CLINK];
END;
RETURN .CONT
END; ! of IOLOK
ROUTINE OPCLOLOK(STMNT)=
BEGIN
!***************************************************************
! Look for references to the DO loop index in the expressions
! under an OPEN, CLOSE, or INQUIRE statement. Return 0 if there
! are none, else return 1.
!***************************************************************
%2211% ! Rewritten by TFV on 18-Aug-83
%4500% LOCAL OPNKEYLIST KVALLST;
MAP BASE STMNT;
REGISTER
CONT, ! Flag for does contain references
BASE TMP, ! Convenient temp
OPENLIST ARVALLST;
CONT = 0; ! Reset flag
IF (TMP = .STMNT[IOUNIT]) NEQ 0 ! Check UNIT=
THEN CONT = .CONT OR CONTVAR(.TMP,.INDVAR);
IF (TMP = .STMNT[IOFILE]) NEQ 0 ! Check FILE=
THEN CONT = .CONT OR CONTVAR(.TMP,.INDVAR);
IF (TMP = .STMNT[IOIOSTAT]) NEQ 0 ! Check IOSTAT=
THEN CONT = .CONT OR CONTVAR(.TMP,.INDVAR);
IF .STMNT[OPSIZ] NEQ 0
THEN
BEGIN ! Check other specifiers
ARVALLST = .STMNT[OPLST]; ! Get list
DECR I FROM (.STMNT[OPSIZ] - 1) TO 0 DO ! Check them
IF (TMP = .ARVALLST[.I,OPENLPTR]) NEQ 0
THEN CONT = .CONT OR CONTVAR(.TMP,.INDVAR);
END; ! Check other specifiers
%4500% IF (KVALLST = .STMNT[IOKEY]) NEQ 0 ! Get list of keys
%4500% THEN
%4500% BEGIN
%4500% INCR I FROM .KVALLST[NUMKEYS] TO 1
%4500% DO
%4500% BEGIN
%4500% ! Check expression for lower bound of this key
%4500% TMP = .KVALLST[.I,KEYLOW];
%4500% CONT = .CONT OR CONTVAR(.TMP,.INDVAR);
%4500%
%4500% ! Check expression for upper bound of this key
%4500% TMP = .KVALLST[.I,KEYHIGH];
%4500% CONT = .CONT OR CONTVAR(.TMP,.INDVAR);
%4500% END;
%4500% END;
RETURN .CONT
END; ! of OPCLOLOK
GLOBAL ROUTINE LOKINDVAR(STMNT)=
BEGIN
!***************************************************************
! Look for references to the DO loop index in the expressions
! under a statement. Return 0 if there are none, else return 1.
!***************************************************************
%2211% ! Rewritten by TFV on 18-Aug-83
MAP BASE STMNT;
REGISTER ARGUMENTLIST AG;
! If we are in the I/O optimizations, must make a special check
! for an IOLSCLS node and call CONTVAR which handles them.
IF .STMNT[OPRCLS] EQL IOLSCLS
THEN RETURN(CONTVAR(.STMNT,.INDVAR));
CASE .STMNT[SRCID] OF SET
RETURN(CONTVAR(.STMNT[LHEXP],.INDVAR) OR ! ASSIGNMENT
CONTVAR(.STMNT[RHEXP],.INDVAR));
RETURN(CONTVAR(.STMNT[ASISYM],.INDVAR)); ! ASSIGN
IF (AG = .STMNT[CALLIST]) NEQ 0 ! CALL
THEN
BEGIN
DECR I FROM .AG[ARGCOUNT] TO 1 DO
IF CONTVAR(.AG[.I,ARGNPTR],.INDVAR)
THEN RETURN 1;
END
ELSE RETURN 0;
RETURN 0; ! CONTINUE
%2377% ! Only check DOM1, DOM3, and DOLPCTL for DO statements. DOM2
%2377% ! isn't used after DOXPN.
%1057% RETURN(CONTVAR(.STMNT[DOM1],.INDVAR) OR ! DO - look at initial,
%2377% CONTVAR(.STMNT[DOM3],.INDVAR) OR ! step size, and
%1057% CONTVAR(.STMNT[DOLPCTL],.INDVAR)); ! loop control
RETURN 0; ! ENTRY
RETURN 0; ! COMNSUB
RETURN 0; ! GOTO
RETURN(CONTVAR(.STMNT[AGOTOLBL],.INDVAR)); ! ASSIGNED GO TO
RETURN(CONTVAR(.STMNT[CGOTOLBL],.INDVAR)); ! COMPUTED GO TO
RETURN(CONTVAR(.STMNT[AIFEXPR],.INDVAR)); ! ARITHMETIC IF
RETURN(CONTVAR(.STMNT[LIFEXPR],.INDVAR)); ! LOGICAL IF
IF .STMNT[RETEXPR] NEQ 0 ! RETURN
THEN RETURN(CONTVAR(.STMNT[RETEXPR],.INDVAR))
ELSE RETURN 0;
RETURN 0; ! STOP
RETURN IOLOK(.STMNT); ! READ
RETURN IOLOK(.STMNT); ! WRITE
RETURN IOLOK(.STMNT); ! DECODE
RETURN IOLOK(.STMNT); ! ENCODE
RETURN IOLOK(.STMNT); ! REREAD
RETURN IOLOK(.STMNT); ! FIND
RETURN OPCLOLOK(.STMNT); ! CLOSE
%4502% RETURN IOLOK(.STMNT); ! DELETE
%4503% RETURN IOLOK(.STMNT); ! REWRITE
RETURN IOLOK(.STMNT); ! BACKSPACE
RETURN IOLOK(.STMNT); ! BACKFILE
RETURN IOLOK(.STMNT); ! REWIND
RETURN IOLOK(.STMNT); ! SKIPFILE
RETURN IOLOK(.STMNT); ! SKIPRECORD
RETURN IOLOK(.STMNT); ! UNLOAD
%4504% RETURN IOLOK(.STMNT); ! UNLOCK
RETURN IOLOK(.STMNT); ! ENDFILE
RETURN 0; ! END
RETURN 0; ! PAUSE
RETURN OPCLOLOK(.STMNT); ! OPEN
RETURN 0; ! SFN
RETURN 0; ! FORMAT
RETURN 0; ! BLT
RETURN 0; !
RETURN OPCLOLOK(.STMNT); ! INQUIRE
TES;
END; ! of LOKINDVAR
GLOBAL ROUTINE SUPPLANT=
BEGIN
!PERFORM A TEST REPLACEMENT ON THE FIRST ELEMENT IN
!RDCLST.
LOCAL BASE RINIT:RINCR:PA:PB;
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; ! of SUPPLANT
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; ! of ONIOLST
GLOBAL ROUTINE REDUCE(CNODE)=
BEGIN
LABEL CHKREC,LNKOUT;
OWN TEMP;
LOCAL
%4527% BASE A1NODE,
A2NODE,
PA,
%4527% BASE PB,
T;
MAP OBJECTCODE DOWDP;
MAP PEXPRNODE CNODE:A2NODE:PA: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,
%4527% ONEWPTR( 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; ! of REDUCE
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; ! of RDUCINIT
GLOBAL ROUTINE RDCTMP=
BEGIN
! Create a reduction in strength temporary
REGISTER
%1505% BASE ID; ! Points to STE that is created
SYMTYPE = INTEGER;
NAME = IDTAB;
%4515% ENTRY = ONEWPTR(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; ! of RDCTMP
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