Trailing-Edge
-
PDP-10 Archives
-
fortv11
-
gcmnsb.bli
There are 12 other files named gcmnsb.bli in the archive. Click here to see a list.
!COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1974, 1987
!ALL RIGHTS RESERVED.
!
!THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
!ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
!INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
!COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
!OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
!TRANSFERRED.
!
!THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
!AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
!CORPORATION.
!
!DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
!SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
!AUTHOR: NORMA ABEL/HPW/MD/DCE/SJW/JNG/AHM/CDM/TJK
MODULE GCMNSB(RESERVE(0,1,2,3),SREG=#17,FREG=#16,VREG=#15,DREGS=4,GLOROUTINES)=
BEGIN
! REQUIRES FIRST, TABLES, OPTMAC
GLOBAL BIND GCMNSV = #11^24 + 0^18 + #4527; ! Version Date: 1-Jan-86
%(
***** Begin Revision History *****
18 ----- ----- MAKE T A PARAMETER TO CMNLNK
19 ----- ----- DONT USE IDADDR SO DATA OPTS CAN BE DONE
20 _____ _____ FIX FINDTHESPOT TO HANDLE IOLSCLS NODES
21 ----- ----- IN MOVCNST FIX IDOPTIM SETTING AND SEARCH FOR
NON-STATEMENT PARENT
22 ----- ----- DONT CALL CHKINIT WITH AN ARG LIST
23 ----- ----- CALL IOGELO FOR READ/WRITE/ENOCDE/DECODE
24 ----- ----- KEEP CNSMOVFLG SET THRU 2ND CALL TO MOVCNST
25 ----- ----- CALL IOGELO FOR RERED STATEMENT
26 ----- ----- IMPLDO NO LONGER A GLOBAL
27 ----- ----- ADD CHK TO DOTOHASGN TO PREVENT SELF LINKING
WHEN IT EITHER LOOPS OR DELETES
28 ----- ----- ADD CODE TO DOTOHASGN FOR SIMPLE ASSIGNMENT MOTION
29 ----- ----- SAVE AND RESTORE ENTRY[1] IN CHKINIT
MAKE GLOBDEPD ZERO DEFPTS IN FRONT OF THE LOOP
30 ----- ----- FIX FUMBLE IN 29
31 ----- ----- PATCH CHKDOM FOR 29
32 ----- ----- PATCHES MADE SEPARATELY ON 31,45
33 ----- ----- INSERT CODE TO UNDO ARRAY HASH ENTRIES POINTED
TO BY EXPRESSION NODES. ROUTINE SCRUBARRAY
AND CODE IN MOVCNST
34 ----- ----- FORGOT CALL TO SRCUBARRAY LAST TIME
35 ----- ----- FIX UP SOME ARRAY STUFF IN CHKDOM
36 ----- ----- CAUSE GLOBMOV TO SET TOLENTRY BIT IN
SYMBOL OF .O VARIABLE
37 ----- ----- ADD PUTBACKARRAY, AND STUFF FOR ARRAY REFS
UNDER FUNCTIONS AS COMMON SUBS
38 ----- ----- FIX PUTBACKARRAY AND SCRUBARRAY
39 ----- ----- ON CONSTANT MOTION ITERATION , SKIP INNER MORE LOOPS
40 ----- ----- ADD EDITS FROM 31,45
41 ----- ----- ADD CALL TO SCRUBARRAY IN FRONT OF SLING HASH
42 ----- ----- MAKE MAKETRY KNOW ABOUT TREE SHAPE
43 ----- ----- REMOVE ARRAY FUDGE IF EXPR DOESNT MAKE IT
INTO THE HASH TABLE
44 ----- ----- DO NOT NEXTUP ON IOLSCLS NODES
OUT OF MOVCNST
45 ----- ----- TYPO IN PUTBACKARRAY IS KILLING NODES
46 ----- ----- SET AND TEST NOHHASSLE BIT IN CHKDOMINANCE
47 ----- ----- FIX ORDER OF ARGS WHEN BUILDING STGHT NODES
FROM ANRY ONES IN MOVCNST
48 ----- ----- MAKE NEWCOPY AND PUTBACKARRAY USE
LINKED LIST OF ARRAY REFS FROM EXPRESSION
HASH TABLE
49 _____ _____ MAKE A1 AND A2 ARREF CHECK THE VALFLG ON THE
ARRAYREF
50 ----- ----- FNARRAY USING ARAYREF TO CALL XPUNGE INSTEAD OF
FUNCTION REFERENCE
51 ----- ----- PUTBACKARRAY IS NOT ALWAYS
SETTING ARY BUT ALWAYS ZEROS ARY[USECNT]
52 ----- ----- FIX ERROR MESSAGES
53 ----- ----- DITTO
54 ----- ----- CHKDOMINANCE MUST ZERO PHI FOR INVALID
ATTEMPTS TO ENTER AN EXPRESSION
55 ----- ----- PASS NEDSANEG FOR CONSTANT MOTION COMPS
56 ----- ----- MAKE DOTOASGN COGNISCENT FO ARRAY REF STUFF
57 ----- ----- FIX A BAD RETURN FROM CHKDOMINANCE THAT DID
NOT 'TIL NOW ZERO PHI FOR THE ARRAYREF STUFF
58 ----- ----- MAKE SURE DOTOHASGN LOOKS AT ENCODE/DECODE
AND REREAD
59 ----- ----- FIX 58
60 ----- ----- MAJOR CHANGE IN CONCEPT IN FINDTHESPOT.
INSERT NEW STATEMENT AFTER ALL OTHERS
CREATED BY OPTIMIZER AT THIS POINT.
61 ----- ----- REFINE 60 A LITTLE TO PUT THE COMMON SUB
INFRONT OF THE CURRENT STATEMENT IF WE HAPPEN
TO RUN INTO IT.
62 ----- ----- IN CHKDOMINANCE, WHEN AN ARRAY EXPRESSION
FAILS FOR CONSIDERATION AS A COMMON SUB,
REPLACE THE ARRAY PART (NOW A POINTER TO
A HASH ENTRY) WITH A UNIQUE ARRAY REF
BY USING NEWCOPY INSTEAD OF A BLIND SUBS.
OF THE FIRST ARRAY REF
63 ----- ----- SCAN THE PARENT POINTER CHAIN FOR AN EXPRESSION
IN CHKDOMINANCE TO MAKE SURE THAT THE
STATEMENT USED IN DETERMINING THE MOTION PLACE
AND ALSO ELIGIBILITY FOR MOTION IS THE STATEMENT
OF WHICH THE EXPRESSION IS A PART. IF CALLED THRU
NEXTUP NOT DOING THIS MAY CAUSE ERRONEOUS MOTION
PLACES TO BE ESTABLISHED.
64 ----- ----- 63 WILL NOT WORK FOR EXPRESSIONS UNDER AN
IMPLIED DO LOOP. MAKE SURE OPTIMIZER INFO
IS THERE TOO.
65 ----- ----- 63 IS REALLY A GOOD IDEA USE IT TO PREVENT
BOGUS ENTRIES WHICH IS , OF COURSE, ITS PURPOSE.
66 ----- ----- MOVCNST IS GETTING CONFUSED AND CALLING
NEXTUP WHEN IT SHOULD NOT
67 243 14916 INT COMP ERROR BECAUSE DOTOHASGN DOES NOT
TEST FOR FULL OPRS FIELD.
68 244 14940 ADD CONDITION TO FINDTHESPOT
69 340 16989 PREVENT CALL TO MATCHER FROM CHANGING
THE VALUE OF PHI., (DCE)
70 370 17938 TAKE OUT [244] - IT WAS INCORRECT, (DCE)
71 401 17813 GET HASH PTRS OUT OF TREES (ARRAYREFS), (DCE)
72 VER5 ----- TURN OFF "CSE SEEN" FLAG SO GLOBELIM RECALLABLE
REMOVE MOVED .O FROM BUSY & POSTDOM LISTS IN DOTOHASGN
REDUCE .R + X TO .O IN MOVCNST
FIX DOUBLE WHILE LOOP ERROR IN GLOBDEPD
CHECK ORFIXFLG & CALL DOTOFIX IN GLOBDEPD
IGNORE HASH TBL ENTRIES BUILT BY DOTORFIX IN MOVCNST
FIX BUG SO EMPTY HASH ENTRIES ARE IGNORED IN MOVCNST
SET NOALLOC ON SUBSUMED .O IN GLOBDEPD
CHECK GLOBELIM2 IN CHKINIT
CHECK OMOVDCNS IN GLOBDEPD
ZERO ONLY EXPRUSE IN GLOBDEPD
SET OMOVDCNS IN MOVCNST
RESET OMOVDCNS ON .O WHICH BECOMES CSE IN DOTOHASGN
DON'T SUBSUME .O = .R + X IN DOTOHASGN
CALL IOGELO ON 1ST GLOBELIM ONLY IN GLOBELIM &
THEN SET/RESET IMPLIED DO FLAG AROUND CALL, (SJW)
73 416 QA650 ZERO USECNT IN HASH TBL FOR .R+X IN MOVCNST
IF CAN'T MOVE .R+X SO HASH TBL ENTRY WILL
BE IGNORED ON NEXT LOOP THRU TBL, (SJW)
74 437 QA771 DON'T LET DOTOHASGN MOVE .O=EXPR IF .O CAME
FROM .R (EXPR CAN MOVE AS CONSTANT), (SJW)
75 440 QA771 DON'T NEXTUP .O IF CAME FROM .R IN MOVCNST, (SJW)
76 455 QA784 CAN'T MOVE EXPRESSIONS OUT OF IMPLIED DO IF
INSIDE LOGICAL IF, (SJW)
77 456 QA784 FIX FINDTHESPOT SO CALLER TELLS IT WHERE TO STOP
ADD NEW ROUTINE FINDPA FOR GLOBMOV AND DOTOHASGN
CALL FINDTHESPOT WITH 2ND PARAM IN GLOBMOV AND
DOTOHASGN, (SJW)
100 507 ----- FIX EDIT 440 TO ALLOW NEXTUP OF .O WHICH CAME
FROM .R IN MOVCNST IF MOM IS ARITHMETIC, (SJW)
101 513 QA771 IN MOVCNST WHEN .O IS CREATED, PASS ORFIXFLG
UP FROM ANY .O BEING SUBSUMED
CHANGE [507] TO FREE VARAIBLE T IN MOVCNST, (SJW)
102 514 QA806 IN MOVCNST IF NARY, INSURE A .R IS 1ST ARG
SINCE [V5] CODE EXPECTS .R + X NOT X + .R, (SJW)
***** Begin Version 5A ***** 7-Nov-76
103 526 QA1035 IN CHKDOM IF FNARY AND NO MATCH ON "FUNC(ARRAYREF)",
PUT BACK ARRAYREF SO HASH ENTRY NOT IN TREE, (SJW)
***** Begin Version 5B *****
104 640 24971 FIX DOTOHASGN TO REMOVE THE .O ASSIGNMENT FROM
THE DOCHNGL AND BUSY LISTS UNLESS THE ASSIGNMENT
IS IN AN IMPLIED DO, NOT UNLESS SOME USE OF THE
COMMON SUB IS IN AN IMPLIED DO., (JNG)
105 643 25201 DURING SECOND PASS OF CSE ELIMINATION, DO NOT
ALLOW ARRAYREF TO BE PART OF TWO POTENTIAL CSE'S., (DCE)
106 664 QAR SKEWED EXPRESSION WITH A1NGNTFLG IS DANGEROUS, (DCE)
107 665 QAR118 A/B/C(I) - NEVER ALLOW B/C(I) TO BECOME CSE, (DCE)
108 706 27170 ONLY NEXTUP IF OPERATION IS ADD/SUB (NOT MUL,DIV,
OR EXP), (DCE)
109 736 ----- BAD CODE FOR -(.R0-K) USING OPTIMIZER (V5), (DCE)
***** Begin Version 6 *****
110 1101 EGM 12-Jun-81 QAR10-05209
Alter CHKDOMINANCE to avoid moving the motion place back to the
expression containing the common sub.
111 1144 EGM 11-Nov-81 Q10-06632
In MOVCNST, clear ARREFCMNSBFLG properly at the end of hash table
walk loop. Prevents bizzare calls to NEWCOPY and ICEs.
***** End V6 Development *****
1747 CDM 4-May-83 10-33750
The optimizer was trying to hash an array ref SKAR1, when it had
already hashed it SKAR2. This can NOT be allowed, since when an
array ref is hashed, the parent expression node pointing to the
array ref is replaced by a pointer to the hash table entry
(EHASH+n) for that array ref. Before this edit, the code would
try to hash a hash table entry, resulting in a most bizare
looking expression node whose parent pointer points to register
0 or another hash table entry, rather than a valid parent.
***** Begin Version 7 *****
1505 AHM 12-Mar-82
Make GETOPTEMP set the psect index of optimizer temporaries to
PSDATA for extended addressing support.
***** End V7 Development *****
2016 TJK 26-Oct-83
Prevent GLOBELIM from calling HAULASS (which moves assignment
statements out of DO-loops) on potentially zero-trip DO-loops.
***** Begin Version 10 *****
2373 TJK 14-Jun-84
Make FNARRAY more paranoid about character expressions.
2507 CDM 20-Dec-84
Remove IDDOT, IDDOTR which are now in FIRST.
***** End V10 Development *****
***** End Revision History *****
***** Begin Version 11 *****
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].
4516 CDM 2-Oct-85
Phase I.I for VMS long symbols. Pass Sixbit to all error message
routines, do not pass addresses of Sixbit anymore. In later edits
this will pass [length,,pointer to symbol] instead of a pointer to
this to the error message routines.
4527 CDM 1-Jan-86
VMS Long symbols phase II. Convert all internal symbols from
one word of Sixbit to [length,,pointer].
Moved IDVERYFRST to FIRST where it belongs!!
ENDV11
)%
SWITCHES NOLIST;
REQUIRE FIRST.BLI;
REQUIRE TABLES.BLI;
SWITCHES LIST;
SWITCHES NOSPEC;
REQUIRE OPTMAC.BLI;
OWN LSTWARNLINE,
PB,
P1,
P2,
PO,
T,
TS;
MAP BASE T:TS:PB:P1:P2:PO;
FORWARD FINDTHESPOT,
PUTBACKARRAY;
EXTERNAL
HASHIT,
LEND,
LENTRY,
LOK1SUBS,
LOK2SUBS,
LOOP,
%4515% ONEWPTR, ! Returns [1,,pointer] to Sixbit argument
QQ,
SAVSPACE,
TBLSRCH,
TOP;
ROUTINE FINDPA (EXPR) =
BEGIN
! FIND STATEMENT IN WHICH THIS EXPR IS
! CALLED BY GLOBMOV AND DOTOHASGN FOR STOPPING POINT FOR
! FINDTHESPOT
MAP PHAZ2 EXPR;
EXTERNAL SKERR;
LOCAL PHAZ2 P;
P _ .EXPR [PARENT];
WHILE TRUE DO
BEGIN
IF .P EQL 0
THEN SKERR (); ! 0 PAPA IS ERROR
IF .P [OPRCLS] EQL STATEMENT OR
.P [OPRCLS] EQL IOLSCLS
THEN RETURN (.P); ! FOUND PAPA STATEMENT
P _ .P [PARENT];
END; ! OF WHILE TRUE DO
END; ! OF ROUTINE FINDPA
ROUTINE DOTOHASGN(EXPR,PHI)=
BEGIN
!ROUTINE CHECKS THE PARENT OF EXPR.
!IF THE PARENT IS AN ASSIGNMENT STATEMENT OF THE FORM
!.OXXX=EXPR THEN PHI[TEMPER] IS SET TO THE .O
!VARIABLE. THEN THE STATEMENT IS LINKED OUT
!OF THE TREE WHERE IT IS AND INTO THE TREE AT
!PHI[STPT]
!BUT ******* DONT SUBSUME (OR MOVE) .O = .R + X SINCE .R CANT
! MOVE OUTSIDE LOOP
LABEL LINEAR;
EXTERNAL SKERR,TOP;
EXTERNAL SAVSPACE,UNLIST,LENTRY,LOOP;
EXTERNAL UNBUSY;
MAP PHAZ2 TOP;
MAP BASE EXPR:PHI;
REGISTER BASE T:TS;
T _ .EXPR [ARG1PTR];
IF .T [IDDOTO] EQL SIXBIT ".R"
THEN RETURN;
T_.EXPR[PARENT];
IF .T NEQ 0 THEN
BEGIN
IF .T[OPRS] EQL ASGNOS AND .T[SRCISN] EQL 0 THEN
BEGIN
TS_.T[LHEXP];
IF .TS[IDDOTO] EQL SIXBIT".O" THEN
BEGIN
!.O=EXPR CAN'T MOVE IF .O CAME FROM .R SINCE THIS ASSIGNMENT
! STATEMENT IS .R INITIALIZATION. EXPR CAN MOVE AS CONSTANT
IF .TS [ORFIXFLG]
THEN RETURN;
!.O IS NOW A COMSUB EVEN IF IT MOVED AS
! A CONSTANT TO GET HERE
TS [OMOVDCNS] _ 0;
!GET STOPPING POINT FOR FINDTHESPOT
P1 _ FINDTHESPOT (.PHI [STPT],
IF .PHI [STPT] EQL .LENTRY
THEN .TOP
ELSE FINDPA (.PHI [LKER])
);
!LINEAR SEARCH FOR THE STATEMENT IN
!FRONT OF T
P2_.TOP;
LINEAR: WHILE .P2 NEQ 0 DO
BEGIN
IF .P2[SRCLINK] EQL .T THEN LEAVE
LINEAR;
IF (.P2[OPRS] GEQ READOS) AND (.P2[OPRS]
LEQ REREDOS) THEN
BEGIN
LOCAL BASE SAVEP2;
SAVEP2_.P2;
P2_.P2[IOLIST];
WHILE .P2 NEQ 0 DO
BEGIN
IF .P2[SRCLINK] EQL .T THEN LEAVE LINEAR;
P2_.P2[SRCLINK]
END;
P2_.SAVEP2
END;
P2_.P2[SRCLINK]
END;
IF .P2 EQL 0 THEN SKERR();
!SET IDOPTIM FIELD SO THE WE CAN
!GLOBLDEPD THESE LATER
TS[IDOPTIM]_.EXPR;
!CHECK THAT P1 (PLACE GOING) IS
!NOT ALREADY WHERE IT IS (P2)
IF .P1 NEQ .P2 THEN
BEGIN
TS_.P1[SRCLINK];
P1[SRCLINK]_.T;
P2[SRCLINK]_.T[SRCLINK];
T[SRCLINK]_.TS;
END;
PHI[TEMPER]_.T[LHEXP];
!IF THERE IS AN ARRAY INVOLVED THEN
!PUT THE ARRAYREFERENCE BACK IN PLACE
IF .PHI[A1ARY] OR .PHI[A2ARY] THEN
PUTBACKARRAY(.PHI,STGHT);
!IF IT MOVED OUT OF THE LOOP, TAKE IT
!OFF THE LIST OF ITEMS THAT CHANGED IN
!THE LOOP
IF .PHI[STPT] EQL .LENTRY AND .LOOP NEQ 0 THEN
BEGIN
%[640]% !.TOP[SRCOPT] IS ZERO IF .O
%[640]% !ASSIGNMENT IS IN AN IMPLIED DO
%[640]% IF .TOP[SRCOPT] NEQ 0 THEN
BEGIN
IF UNLIST(.TOP[DOCHNGL],.T[LHEXP],CHNGSIZ) THEN
BEGIN
P1_.TOP[DOCHNGL];
TOP[DOCHNGL]_.P1[RIGHTP];
SAVSPACE(CHNGSIZ-1,.P1);
END;
UNBUSY (.T); ! REMOVE FROM BUSY LIST
END;
END;
END;
END;
END;
END;
!**********************************
!
ROUTINE FINDTHESPOT (PLACE, BARRIER) =
!2ND PARAM FOR FINDTHESPOT IS PLACE NOT TO MOVE PAST
BEGIN
MAP BASE PLACE;
MAP BASE BARRIER;
EXTERNAL PREV,CSTMNT;
!PUT AT THE END OF ALL OTHER
!POSSIBLE STATEMENTS AT THIS
!POINT
!THAT WERE CREATED BY THE OPTIMIZER. THE RATHER
!SHAKY TEST OF SRCISN==0 IS USED.
!THE ADDITIONAL CONSTRAINT IS ADDED THAT THE
! STATEMENT WE ARE ABOUT TO PASS BY IS NOT
! THE PARAM BARRIER = TOP IF PLACE = LENTRY,
! ELSE THE STATEMENT THE ORIGINAL EXPR CAME FROM
! (FOUND BY FINDPA FOR CALLER) FOR COMSUB BEING RELOCATED, IE,
! CAN'T PUT .O INITIALIZATION AFTER .O USEAGE
PREV_.PLACE;
PLACE_.PLACE[SRCLINK];
!DONT BOTCH UP I/O LISTS EITHER
WHILE .PLACE[OPRCLS] EQL STATEMENT DO
IF .PLACE[SRCISN] EQL 0
AND .PLACE[SRCID] EQL ASGNID
AND .PLACE NEQ .BARRIER
THEN
BEGIN
PREV_.PLACE;
PLACE_.PLACE[SRCLINK];
END ELSE
RETURN(.PREV);
.PREV
END;
ROUTINE GLOBMOV (CNODE, PHI, OTEMP) =
!++
!PASS GLOBMOV ENTIRE HASH ENTRY FROM CMNMAK
!MOVE GLOBAL COMMON SUB-EXPRESSION TO FINAL RESTING PLACE.
!
! CNODE WILL POINT TO THE COMMON SUB-EXPRESSION ITSELF. (NOT
! A COMMON SUB-EXPRESSION **NODE**.
! OTEMP IS THE LHS OF THE STATEMENT.
! PLACE POINTS TO THE PLACE WHERE THE STATEMENT THAT IS BUILT
! WILL BE LINKED IN.
!
!THE BASIC FUNCTION OF THE ROUTINE IS TO BUILD T=CMNSB STATEMENT
!AND LINK IT INTO THE ENCODED SOURCE TREE.
!--
BEGIN
EXTERNAL LOOP,MAKASGN,LENTRY,TOP;
MAP BASE LOOP;
MAP PHAZ2 PHI:OTEMP:CNODE;
LOCAL PHAZ2 PLACE;
!GENERATE
! T=EXPRESSION NODE
!MAKE SOURCE NODE
!****NOTE****
!CANNOT SET EXPRESSION PARENT
!AS TEMP IS NOT YET LINKED
!BACK IN. MUST SET PARENT IN
!GLOBLDEPD
P1_.CNODE[PARENT];
PO_MAKASGN(.OTEMP,.CNODE );
CNODE[PARENT]_.P1;
!RETURNS POINTING TO THE PLACE TO
!PUT IT.
!CALL FINDTHESPOT WITH 2ND PARAM = PLACE TO STOP
PLACE _ .PHI [STPT];
P1 _ FINDTHESPOT (.PLACE,
IF .PLACE EQL .LENTRY
THEN .TOP
ELSE FINDPA (.PHI [LKER])
);
!LINK IT IN
PO[SRCLINK]_.P1[SRCLINK];
P1[SRCLINK]_.PO;
!IF MOVED OUT OF THE LOOP THEN SET TOLENTRY BIT
IF .PLACE EQL .LENTRY THEN
OTEMP[IDATTRIBUT(TOLENTRY)]_1;
END;
GLOBAL ROUTINE GETOPTEMP(VTYP)=
BEGIN
! Create a .O temporary for the optimizer
EXTERNAL
TBLSEARCH, ! Searches hash table NAME for ENTRY
VERYFRST; ! The counter for naming .Onnnn variables
REGISTER
BASE HEAD;
NAME_IDTAB; ! Specify symbol table
%4515% ENTRY[0] = ONEWPTR(
SIXBIT'.O' + MAKNAME(VERYFRST)); ! Derive the .Onnnn name
VERYFRST_.VERYFRST+1; ! Increment the name counter
HEAD_TBLSEARCH(); ! Look it up in the symbol table
HEAD[VALTYPE]_.VTYP; ! Set the type
%1505% HEAD[IDPSECT]=PSDATA; ! Put the temp in the .DATA. psect
RETURN .HEAD
END;
ROUTINE CHKINIT(VAR)=
BEGIN
!ROUTINE CHECKS TO SEE WHETHER OR NOT VAR IS
!INITIALIZED
! NO WARNINGS ON 2ND GLOBELIM SINCE THEY WERE GIVEN ON 1ST PASS
MAP BASE VAR;
EXTERNAL WARNERR;
!IT IS NOT INITIALIZED (WE ALREADY KNOW ITS A MAIN SECTION OF CODE
!AND THE DEFINITION POINT IS LENTRY) IF
! 1. IT IS NOT IN A DATA STATEMENT
! 2. IT IQ NOT A FORMAL
! 3. IT IS NOT A CONSTANT
! 4. IT IS NOT IN COMMON
! 5. IT IS NOT IN AN EQUIVALENCE STATEMENT
!DO NOT ALLOW CHECK ON COMPILER VAR (.O, .R) !
!FOR THE ARRAY REFERENCE STUFF, CHECK FOR OPRCLS EQL DATAOPR
!IF WE ARE PASSING A HASH TABLE ENTRY THE OPRCLS FIELD
!JUST HAPPEND TO MATCH THE HOP FIELD SO A CHECK ON OPRCLS
!IS VALID
IF .GLOBELIM2 ! NO WARNINGS ON 2ND PASS
THEN RETURN;
IF .VAR[OPRCLS] NEQ DATAOPR THEN RETURN;
IF .VAR [IDDOT] EQL SIXBIT "." ! CANT CHECK COMPILER VARS
THEN RETURN;
IF NOT .VAR[IDATTRIBUT(INDATA)] AND
.VAR[OPR1] NEQ CONSTFL AND
NOT .VAR[FORMLFLG]
AND NOT .VAR[IDATTRIBUT(INCOM)]
AND NOT .VAR[IDATTRIBUT(INEQV)]
AND .LSTWARNLINE NEQ .VAR THEN
BEGIN
!NOTE THE MISSING DOT IS DELIBERATE.
EXTERNAL ISN;
%4516% WARNERR(.VAR[IDSYMBOL],.ISN,E79<0,0>);
LSTWARNLINE_.VAR;
END;
END;
FORWARD NEWCOPY;
ROUTINE CHKDOMINANCE(CNODE,SHAPE)=
BEGIN
EXTERNAL TOP,LENTRY,MAKETRY,BOTTOM,PHI,NAN,MATCHER,HASHIT,TBLSRCH;
EXTERNAL LOOP,LEND,WARNERR,SKERR,ISN,A1NODE;
MAP BASE A1NODE:PHI;
LOCAL ADJPLACE; !FLAG TO SET PLACE BACK TO CORRECT PLACE
LOCAL BASE APHI; !HOLDS HASH POINTER FOR ARRAY ENTRY TO UNDO
MAP PHAZ2 PB;
LOCAL BASE PLACE;
EXTERNAL CSTMNT; !POINTS TO THE STATEMENT
MAP BASE CSTMNT;
OWN BASE TAININGSTMT;
LOCAL ARGUMENTLIST AG;
OWN DEF1PLACE,DEF2PLACE;
!******
!MAKE SURE THAT THE PLACE TO WHICH MOTION WOULD OCCUR
!HAS THE CURRENT STATEMENT (CSTMNT POINTS TO IT) AS POSTDOMINATOR.
!THIS INVOLVES:
! 1.DETERMINING THE PLACE TO WHICH MOTION WOULD OCCUR.
! 2.LOOKING FOR CSTMNT ON THE PREDOMINATOR LIST OF
! THE PLACE TO WHICH MOTION WOULD OCCUR.
! 3. IF 2 IS FALSE THEN THE PARENFLG IS SET ON THE
! STATEMENT (IF AN ASSIGNMENT). THIS IS A FUDGE TO
! PERMIT LOOKING FOR LOCAL COMMON SUBS IN SUCH
! STATEMENTS AT THE END OF OPTIMIZATION (PHA2).
MAP PEXPRNODE CNODE;
!TAKE ARRAY REFERENCES OFF THE TOP
!*!*!*!*!*!*!*!*!*!*!*!*!*!*!*!*!*!*!*
PHI_0;
IF .SHAPE GTR SKEW THEN
BEGIN
CASE .SHAPE-STAR1 OF SET
!STAR1
!STRAIGHT NODE WITH ARRAYREF AS ARGUMENT 1
CHKDOMINANCE(.CNODE[ARG1PTR],UNARY);
!STAR2
!STRAIGHT NODE WITH ARRAYREF AS ARGUMENT 2
CHKDOMINANCE(.CNODE[ARG2PTR],UNARY);
!SKAR1
!SKEWED NODE WITH ARRAYREF AS ARG 1
BEGIN
PB_.CNODE[ARG1PTR];
![643] IF WE GET HERE, WE ARE ABOUT TO HASH AN ARRAY REF IN ORDER TO
![643] BUILD A SKAR1 SHAPED HASH ENTRY. BEFORE DOING THIS, MAKE SURE
![643] THAT THE ARRAY REF HAS NOT ALREADY BEEN HASHED (STRAIGHT)
![643] WITH A LEAF ON ITS OWN LEVEL IN WHICH CASE WE CANNOT
![643] HASH IT AGAIN, SO SET PHI TO ZERO (FAILURE) AND GET OUT!
%[643]% IF .PB[A1VALFLG] THEN PHI_0 ELSE
CHKDOMINANCE(.PB[ARG2PTR],UNARY);
END;
!SKAR2
!SKEWED NODE WITH ARRAYREF AS ARG 2
CHKDOMINANCE(.CNODE[ARG2PTR],UNARY);
!FNARY
!LIBRARY FUNCTION REF WITH ARRAYREF AS ARGUMENT
BEGIN
AG_.CNODE[ARG2PTR];
CHKDOMINANCE(.AG[1,ARGNPTR],UNARY);
END
TES;
IF .PHI NEQ 0 THEN
BEGIN
!SAVE HASH POINTER FOR LATER UNDO IF REQUIRED
APHI_.PHI;
CASE .SHAPE-STAR1 OF SET
!STAR1
FUDGA1;
!STAR2
FUDGA2;
!SKAR1
BEGIN
A1NODE_.CNODE[ARG1PTR];
A1NODE[ARG2PTR]_.PHI;
A1NODE[DEFPT2]_.PHI[STPT];
END;
!SKAR2
FUDGA2;
!FNARY
BEGIN
AG_.CNODE[ARG2PTR];
AG[1,ARGNPTR]_.PHI;
PLACE _ .CNODE [DEFPT2]; ! SAVE DEFPT2
CNODE[DEFPT2]_.PHI[STPT];
PHI_0;
CHKDOMINANCE(.CNODE,UNARY);
IF .PHI NEQ 0
THEN PHI [A2ARY] _ 1
ELSE BEGIN ! PUT BACK ARRAYREF
AG [1,ARGNPTR] _ NEWCOPY (.AG [1,ARGNPTR], .CNODE); ! ARRAYREF'S DAD IS CNODE = FNCALL
CNODE [DEFPT2] _ .PLACE; ! RESTORE DEFPT2
END;
RETURN;
END
TES;
PHI_0;
NOHHASSLE_0;
CHKDOMINANCE(.CNODE,(IF .SHAPE GEQ SKAR1 THEN SKEW
ELSE STGHT));
IF .PHI NEQ 0 THEN
BEGIN
!SET COMMENTS IN OPTMAC FOR NOHHASSLE BIT
!REQUIREMENTS
!BRIEFLY, PHI COULD POSSIBLY NOT BE
!'THE' HASH ENTRY FOR THE ARRAY EXPR
!IT COULD BE AN ENTRY THAT WAS MADE BECAUSE
!OF ONE OR MORE MATCHES (NEXTUP, ETC.).
!NOHHASSLE IS SET IF THIS IS A @POSSIBILITY.
IF .NOHHASSLE THEN RETURN;
IF .SHAPE EQL STAR1
OR .SHAPE EQL SKAR1 THEN
PHI[AR1ARY]_1
ELSE
PHI[AR2ARY]_1;
END ELSE
!THE EXPRESSION A OP ARRAYREF DID NOT
!QUALIFY TO BE HASHED OR MATCHED (PHI IS 0)
!SO WE WANT TO UNDO THE ARRAYREF HASH POINTERS
!FROM THE EXPRESSION NOW.
BEGIN
CASE .SHAPE-STAR1 OF SET
!STAR1
BEGIN
CNODE[ARG1PTR]_NEWCOPY(.APHI,.CNODE);
CNODE[DEFPT1]_0;
END;
!STAR2
BEGIN
CNODE[ARG2PTR]_NEWCOPY(.APHI,.CNODE);
CNODE[DEFPT2]_0;
END;
!SKAR1
BEGIN
A1NODE_.CNODE[ARG1PTR];
A1NODE[ARG2PTR]_NEWCOPY(.APHI,.A1NODE);
A1NODE[DEFPT2]_0;
END;
!SKAR2
BEGIN
CNODE[ARG2PTR]_NEWCOPY(.APHI,.CNODE);
CNODE[DEFPT2]_0;
END
!SHOULD NOT BE HERE WITH FNARY
TES;
END;
END;
RETURN;
END;
!IF EITHER DEFPT IS THE CURRENT STATEMENT DO NOT
!CONSIDER THIS STATEMENT FOR GLOBAL COMMON SUBS.
!DO NOT SET THE FLAG TO CAUSE IT TO GET LOCAL ONES EITHER.
!IF SUCH WERE DONE TROUBLE MIGHT INSUE. IT WOULD ALOS WASTE
!TIME.
IF
BEGIN
%(
IF NODE IS UNARY OR STGHT WE WANT TO CHECK
DEFPT1. IF NODE IS SKEW LOOK AT DEFPT2 IN THE
DAUGHTER OF THE CURRENT EXPRESSION
)%
IF .SHAPE NEQ SKEW
THEN
.CNODE[DEFPT1] EQL .CSTMNT
ELSE
BEGIN
A1NODE_.CNODE[ARG1PTR];
.A1NODE[DEFPT2] EQL .CSTMNT
END
END
OR .CNODE[DEFPT2] EQL .CSTMNT THEN RETURN;
!IN THE FOLLOWING ALGORITHMS, SET TAININGSTMT TO
!BE THE STATEMENT THAT DOES INDEED CONTAIN THE
!EXPRESSION WE ARE CONSIDERING.
TAININGSTMT_.CNODE;
UNTIL .TAININGSTMT[OPRCLS] EQL STATEMENT
OR .TAININGSTMT[OPRCLS] EQL IOLSCLS
DO
BEGIN
TAININGSTMT_.TAININGSTMT[PARENT];
IF .TAININGSTMT EQL 0 THEN SKERR();
END;
IF (.TAININGSTMT[OPRCLS] NEQ STATEMENT)
OR (.TAININGSTMT[SRCOPT] EQL 0) THEN
TAININGSTMT_.CSTMNT;
!AS A TIME TRADE OFF, LOOK IT UP FIRST. IF ALREADY
!THERE WE DO NOT HAVE TO HASSLE WITH DETERMINING IF
!IT SHOULD GO THERE OR NOT
HASHIT(.CNODE,.SHAPE);
PHI_TBLSRCH();
!SAVE VALUE OF PHI AGAINST CHANGE IN CALLS FROM MATCHER
IF .FLAG THEN BEGIN
!THE FOLLOWING CODE ENSURES THAT PHI GETS SET TO
! ZERO IN THE CASE THAT MATCHER FAILED WHEN DEALING WITH AN
! ARRAY REFERENCE. IT HAS THE EFFECT OF KEEPING POINTERS TO
! HASH TABLE ENTRIES (ARRAYREFS) OUT OF THE STATEMENT TREES SO
! THAT THEY CAN NEVER BE LEFT THERE INADVERTENTLY.
LOCAL T;
T_.PHI[USECNT];
APHI_.PHI;
MATCHER(.CNODE,.SHAPE,.NAN,.PHI);
PHI_.APHI;
IF (.PHI[USECNT] EQL .T) AND
(.SHAPE EQL SKEW) AND
.ARREFCMNSBFLG
THEN PHI_0;
RETURN
END;
BEGIN
!MUST TAKE SHAPE INTO CONSIDERATION
IF .SHAPE EQL SKEW THEN
BEGIN
A1NODE_.CNODE[ARG1PTR];
DEF1PLACE_.A1NODE[DEFPT2];
DEF2PLACE_.CNODE[DEFPT2];
!MAKE A1NODE BE LOGICAL ARG1
A1NODE_.A1NODE[ARG2PTR];
END ELSE
BEGIN
DEF1PLACE_.CNODE[DEFPT1];
DEF2PLACE_.CNODE[DEFPT2];
A1NODE_.CNODE[ARG1PTR];
END;
!IF BOTH DEF POINTS ARE THE SAME NO MORE WORK IS NEEDED
IF .DEF1PLACE EQL .DEF2PLACE THEN
PLACE_.DEF1PLACE
ELSE
BEGIN
!UNLESS THE EXPRESSION IS SKEW
!WE DON'T WANT TO RECONSIDER HER
IF .CNSMOVFLG THEN RETURN;
!FOR TYPE CONVERSIONS
! NEGNOTS
! FUNCTION REFS (LIBRARY)
!DEF1PLACE IS ZERO. SO, USE DEF2PLACE
!AND SKIP THE LOOK
IF (.SHAPE EQL UNARY)
AND (.DEF1PLACE EQL 0)
AND (.DEF2PLACE NEQ 0) THEN
PLACE_.DEF2PLACE
ELSE
BEGIN
!CHECK AGAIN NOW THAT SHAPE HAS BEEN
!CONSIDERED IN SETTING DEF1PLACE
!AND DEF2PLACE AND WE ARE SURE THAT
!TAININGSTMT IS SET UP.
IF (.DEF1PLACE EQL .TAININGSTMT) OR
(.DEF2PLACE EQL .TAININGSTMT) THEN
BEGIN
PHI_0;
RETURN;
END;
!NOW ON TO THE REAL ANALYSIS (AT LAST!)
PB_.TAININGSTMT; !PB IS TEMP
DO
PB_.PB[PREDOM]
UNTIL .PB EQL .DEF1PLACE
OR .PB EQL .DEF2PLACE
OR .PB EQL .TOP;
PLACE_.PB;
!WE CAN ONLY LOOK AS FAR AS TOP BUT MAYBE IT IS
!REALLY SUPPOSED TO BE LENTRY
IF .PB EQL .TOP THEN
IF .DEF1PLACE NEQ .TOP THEN
IF .DEF2PLACE NEQ .TOP THEN
PLACE_.LENTRY;
END;
END;
!LOOK FOR SPECAIL CONSTANT MOTION CASE.
!WORK ALREDY DONE JUST SET STPT AND QUIT
IF .CNSMOVFLG THEN
BEGIN
IF .PLACE NEQ .LENTRY THEN RETURN;
PHI_MAKETRY(.PHI,.CNODE,.SHAPE);
IF .SHAPE EQL SKEW THEN PHI[NBRCH]_1;
IF .NAN THEN PHI[NEDSANEG]_1;
PHI[STPT]_.LENTRY;
RETURN;
END;
!CHECK FOR VARIABLE INITIALIZED
!NO MATTER THE SHAPE OF THE NODE A1NODE NOW POINTS
!TO LOGICAL ARG1 AND CNODE[ARG2PTR] TO LOGICAL ARG2.
!DEF1PLACE AND DEF2PLACE POINT TO THE CORRESPONDING
!DEFINITION POINTS. WE WILL NOW USE THIS INFO
!TO CHECK FOR THE VARIBALE BEING INITIALIZED
IF .LOOP EQL 0 THEN !MAIN COFE SECTION
BEGIN
IF .DEF1PLACE EQL .LENTRY THEN
CHKINIT(.A1NODE);
IF .DEF2PLACE EQL .LENTRY THEN
BEGIN
!CHECK FOR A FUNCTION CALL
!AND GET THE ARG
IF .CNODE[OPRCLS] EQL FNCALL THEN
BEGIN
REGISTER ARGUMENTLIST AG;
AG_.CNODE[ARG2PTR];
CHKINIT(.AG[1,ARGNPTR]);
END ELSE
!REGULAR CASE
CHKINIT(.CNODE[ARG2PTR]);
END;
END;
!PLACE NOW POINTS TO THE STATEMENT THAT IS THE DEFPT OF THE
!EXPRESSION. WE CHECK TO SEE IF PA POSTDOMINATES PLACE
!IF THIS IS A MAIN PROGRAM LENTRY (WHICH COULD POSSIBLY BE THE
!VALUE OF PLACE AT THIS POINT) IS THE DUMMY CONTINUE WHICH
!DOES NOT HAVE THE OPTIMIZERS WORDS (POSTDOM, PREDOM ,ETC.)
!THEREFOR, WE WILL TEST AND ADJUST
IF .PLACE EQL 0 THEN
BEGIN
PHI_0;
RETURN;
END;
ADJPLACE_0;
IF .PLACE EQL .LENTRY THEN
(PLACE_.TOP;
ADJPLACE_1);
PB_.PLACE; !PS IS TEMP AGAIN
DO
PB_.PB[POSTDOM]
UNTIL .PB EQL .TAININGSTMT
OR .PB EQL .BOTTOM
OR .PB EQL .LEND
OR .PB EQL 0;
IF .PB EQL 0 THEN SKERR();
!THE GRAPH IS BAD CALL SKERR FOR NOW.
IF .PB EQL .LEND OR .PB EQL .BOTTOM THEN
BEGIN
!MAKE SURE PHI IS ZERO FOR THE UNSUCCESSFUL
!ATTEMPT.
PHI_0;
RETURN;
END;
PHI_MAKETRY(.PHI,.CNODE,.SHAPE);
IF .SHAPE EQL SKEW THEN
PHI[NBRCH]_1;
IF .NAN THEN PHI[NEDSANEG]_1;
IF .ADJPLACE THEN
PHI[STPT]_.LENTRY
ELSE
BEGIN
!TO PREVENT MOTION INTO A LOOP.
!THE POTENTIAL EXISTS IS A STRUCTURE LIKE
!DO
!IF () 10,10,20
!10 CONTINUE
!20 COMPUTE
IF (.PLACE NEQ .TOP) AND (.PLACE[SRCID] EQL DOID) THEN
BEGIN
PB_.PLACE[DOLBL];
![1101] Fix the modified motion place at the continue of the DO,
![1101] instead of just past it, to avoid the possibility of moving it
![1101] to the actual statement containing the common sub.
%[1101]% PLACE_.PB[SNHDR]
END;
PHI[STPT]_.PLACE;
END;
END;
END;
!
!***************************************************
!
EXTERNAL EHASH;
GLOBAL ROUTINE MOVCNST =
BEGIN
!MOVE ALL REGION CONSTANT EXPRESSIONS OUT OF THE LOOP
EXTERNAL DOTRCNTOK, DOTORFIX;
LOCAL BASE HASHP;
EXTERNAL QQ,CSTMNT,ISN,SKERR,CMNMAK;
LABEL GOT1;
MAP BASE PB:QQ:CSTMNT:T;
EXTERNAL EHASHP,LENTRY,MAKEPR,NARY2,STPRECLUDE,CMNLNK,NEXTUP;
OWN CNSTTOGO;
EXTERNAL MAKASGN;
LOCAL BASE CNODE; !USED TO POINT TO EXPRESSION
EXTERNAL LOKCALST;
LOCAL BASE DOTO;
LABEL LWHILE;
!ITERATE THROUGH THE HASH TABLE UNTIL THERE ARE NO MORE
!TO MOVE.
CNSTTOGO_1;
WHILE .CNSTTOGO DO
BEGIN
CNSTTOGO_0;
INCR K FROM 0 TO EHSIZ-1 DO
BEGIN
EHASHP_EHASH[.K]<0,0>;
HASHP_.EHASH[.K];
WHILE .HASHP NEQ 0 DO
BEGIN
LWHILE: BEGIN
IF .HASHP [EMPTY] ! NOT IN USE ?
THEN LEAVE LWHILE; ! IGNORE IT
DOTO _ .HASHP [TEMPER];
IF .DOTO NEQ 0 THEN
IF .DOTO [ORFIXFLG] ! EXPR BUILT BY DOTORFIX
THEN LEAVE LWHILE; ! DONT TOUCH IT
!SET FLAG FOR ARRAY STUFF IS APPROPRIATE
IF .HASHP[A1ARY] OR .HASHP[A2ARY] THEN
%[1144]% ARREFCMNSBFLG_1;
!NOW CHECK FOR CONSTANT MOTION
GOT1:
IF (.HASHP[STPT] EQL .LENTRY) !PLACE TO GO IS ENTRY
AND
(.HASHP[USECNT] EQL 1) !WASN'TA COMMON
!SUB-EXPRESSION
THEN
BEGIN
!DO NOT BE HASTY. IF THIS IS AN
!ARRAY REFERENCE, SKIP IT ANYWAY
IF .HASHP[OPRCLS] EQL ARRAYREF THEN
BEGIN
HASHP[USECNT]_0;
LEAVE GOT1;
END;
CNSTTOGO_1;
!SET FLAG IN HASH TABLE
!SO WE CAN GLOBDEPD
HASHP[MOVDCNS]_1;
!MAKE AN ASSIGNMENT STATEMENT
!OF .OXXXXX=EXPRESSION
CNODE_.HASHP[LKER];
!TRY SUBSUMPTION
IF NOT .HASHP[NBRCH] THEN
DOTOHASGN(.CNODE,.HASHP);
!IF IT WAS SUBSUMED
DOTO _ .HASHP [TEMPER];
IF .DOTO NEQ 0 THEN
BEGIN
HASHP[USECNT]_0;
DOTO [OMOVDCNS] _ 1;
LEAVE GOT1;
END;
!IF THE EXPRESSION IS NARY MAKE A
!STRAIGHT ONE, AND DO THE ELIMINATION
!HASSLE (SEE MATCHER, NARY2 FOR
!BLOODY DESCRIPTION OF THE COMPLETE HASSLE).
IF .HASHP[NBRCH] THEN
BEGIN !OMIGOD ITS NARY
!ON THE OTHERHAND IT MAY
!HAVE BEEN NARY BUT ISNT ANY
!MORE. CHECK AND RESET NBRCH
!FOR FUTURE TESTS.
IF .CNODE[A1VALFLG] THEN
BEGIN
HASHP[NBRCH]_0;
!SET PB
PB_.CNODE;
END
ELSE
BEGIN !U LOSE ITS NARY
QQ_.CNODE[ARG1PTR];
!IF NARY INSURE .R IS 1ST ARG SINCE [V5] CODE EXPECTS .R + X
T _ .CNODE [ARG2PTR];
IF .T [IDDOTR] EQL SIXBIT ".R" AND
.CNODE [OPRCLS] EQL ARITHMETIC
THEN BEGIN
PB _ MAKEPR (.CNODE [OPRCLS],
.CNODE [OPERSP],
.CNODE [VALTYPE],
.CNODE [ARG2PTR],
.QQ [ARG2PTR]);
PB [A1FLGS] _ .CNODE [A2FLGS];
PB [A2FLGS] _ .QQ [A2FLGS];
PB [DEFPT1] _ .CNODE [DEFPT2];
PB [DEFPT2] _ .QQ [DEFPT2];
END
ELSE BEGIN
![664] QUIT IF NGNTFLG SET ON TOP NODE
%[664]% IF .CNODE[A1NGNTFLGS] NEQ 0 THEN (HASHP[USECNT]_0; LEAVE GOT1);
PB_MAKEPR(.CNODE[OPRCLS],
.CNODE[OPERSP],
.CNODE[VALTYPE],
.QQ[ARG2PTR],
.CNODE[ARG2PTR]);
!SET THE FLAGS
PB[A1FLGS]_.QQ[A2FLGS];
PB[A2FLGS]_.CNODE[A2FLGS];
!SET THE DEFPTS
PB[DEFPT1]_.QQ[DEFPT2];
PB[DEFPT2]_.CNODE[DEFPT2];
END;
NARY2(.CNODE);
END;
END ELSE
BEGIN
!IT STRAIGHT, SO DO THE NARY/
!STRAIGHT THING. ALSO SET UP PB
STPRECLUDE(.CNODE);
PB_.CNODE;
END;
!BUILD NODE AND LINK IT IN
! CHECK .R + X -> .O
T _ .PB [ARG1PTR]; ! REA MAKES .R 1ST ARG
IF .PB [OPR1] EQL ADDOPF AND
.T [IDDOTR] EQL SIXBIT ".R"
THEN BEGIN
! .R USE CNT = 1 IFF ONLY USE OF
! OF .R IN LOOP IS .R <- .R + Z
IF DOTRCNTOK (.T)
![736] IF USING DOTORFIX, THEN MUST BE VERY CAREFUL WITH HOW THE
![736] USAGE OF THE .O VARIABLE GETS SET UP (NAN = 0).
%[736]% THEN ( T _ DOTORFIX (.PB, .HASHP);
%[736]% QQ_CMNLNK(.T,.CNODE,
%[736]% IF .HASHP[NBRCH] THEN SKEW ELSE STGHT,
%[736]% 0,.HASHP))
ELSE BEGIN ! CAN'T TOUCH IT
HASHP [USECNT] _ 0; ! IGNORE THIS ENTRY ON NEXT PASS
LEAVE GOT1;
END
END
ELSE
%[736]% BEGIN T _ CMNMAK (.PB, !EXPRESSION
.HASHP[NEDSANEG], !NEEDS A NEG
.HASHP); !POINTER TO HASH
QQ_CMNLNK(.T,.CNODE,IF .HASHP[NBRCH] THEN SKEW
ELSE STGHT,.HASHP[NEDSANEG],
%[736]% .HASHP)
%[736]% END;
DOTO _ .HASHP [TEMPER];
DOTO [OMOVDCNS] _ 1;
!PASS UP ORFIXFLG FROM ANY .O UNDER THIS ONE
IF .PB [A1VALFLG]
THEN BEGIN
T _ .PB [ARG1PTR];
IF .T [IDDOTO] EQL SIXBIT ".O"
THEN DOTO [ORFIXFLG] _ .DOTO [ORFIXFLG] OR .T [ORFIXFLG];
END;
IF .PB [A2VALFLG]
THEN BEGIN
T _ .PB [ARG2PTR];
IF .T [IDDOTO] EQL SIXBIT ".O"
THEN DOTO [ORFIXFLG] _ .DOTO [ORFIXFLG] OR .T [ORFIXFLG];
END;
!CHKDOMINANCE DEPENDS ON CSTMNT
!POINTING TO THE STATEMENT.THEREFORE,
!WE WILL FOLLOW THE PARENT LINKS UNTIL
!!!WE FIND THE STATEMENT
CSTMNT_.QQ;
UNTIL .CSTMNT[OPRCLS] EQL STATEMENT OR
.CSTMNT[OPRCLS] EQL IOLSCLS DO
BEGIN
CSTMNT_.CSTMNT[PARENT];
!!QUIT ON ERROR
IF .CSTMNT EQL 0 THEN SKERR();
END;
!IF WE ARE AT A STATEMENT THAT IS CURRENTLY
!BEING OPTIMIZED
!CAN'T NEXTUP (IE, TRY TO COMBINE INTO BIGGER COMSUB) THIS
! .O'S MOM IF THIS .O CAME FROM .R SINCE .O NOT REALLY CONSTANT
!UNLESS MOM IS ARITHMETIC SINCE ADDITIONAL CONSTANT TERMS
! WILL LEAVE ENTIRE EXPR TO VARY ONLY WITH THE .R INCR
! WHICH BECAME THIS .O'S INCR AT END OF LOOP
IF (.CSTMNT[OPRCLS] EQL STATEMENT) AND
(.CSTMNT[SRCOPT] NEQ 0) AND
![706] WE CAN ONLY NEXTUP THIS KIND OF EXPRESSION IF THE
![706] OPERATION IS ADD OR SUBTRACT (NOT MUL,DIV, OR EXP WHICH ARE
![706] BOTH MUCH MORE DIFFICULT AND NOT WORTH THE EFFORT). MAKE THE
![706] TEST CORRECT - THIS REPLACES PART OF EDIT 513
%[706]% (NOT .DOTO [ORFIXFLG] OR ADDORSUB(QQ))
THEN
BEGIN
ISN_.CSTMNT[SRCISN];
!SEE IF THERE IS NOW ANOTHER
!ONLY IF CSTMNT IS NOT AN IOLSCLS NODE
NEXTUP(.QQ);
END;
!MAKE SURE WE DO NOT CONSIDER THIS ONE AGAIN
HASHP[USECNT]_0;
END; !IF STATEMENT
END; ! OF LWHILE
HASHP_.HASHP[CLINK];
%[1144]% ARREFCMNSBFLG_0; ! MAKE SURE ARRAY FLAG IS OFF
END; !WHILE
END; !INCR
END; !WHILE ON CNSTTOGO
END;
ROUTINE GLOBDEPD (CURVERYFRST) =
BEGIN
!CURVERYFRST IS SIXBIT VALUE OF VERYFRST BEFORE THIS LOOP WAS
! PROCESSED => ONLY GLOBDEP THOSE .O GEQ CURVERYFRST, IE,
! ONLY THOSE CREATED FROM THIS LOOP
!FOR GLOBAL OPTIMIZATION ONLY
!LOOK FOR GROUPS OF STATEMENTS CREATED BY THE OPTIMIZER
!FOR COMMON SUB-EXPRESSION ELIMINATION OR CONSTANT COMPUTATIONS.
!WHEN FOUND, LOOK AT GLOBAL COMMON SUB TEMPS, HASH
!THE EXPRESSIONS TO WHICH THEY CORRESPOND, LOOK THEM UP.
!IF USECNT OF DEPENDENT ONE = USECNT OF PARENT ONE THEN
!SEE IF THE DEPENDENT ONE IS IN THIS GROUP OF STATEMENTS
!. IF THAT IS TRUE THEN ELIMINATE THE DEPENDENT ONE.
EXTERNAL TPREV,PHI,PREV;
OWN PAE;
MAP BASE PAE:T:P1:PO:TPREV:PHI;
LABEL WHL1,WHL2;
LABEL LWHL;
EXTERNAL DOTOFIX; ! FIX .O INCR IF CAME FROM .R
!MACRO TO SET PARENT POINTERS STRAIGHT
MACRO SETDAD=
BEGIN
IF .PAE[SRCID] EQL ASGNID THEN
IF NOT .PAE[A2VALFLG] THEN
BEGIN
PO_.PAE[RHEXP];
PO[PARENT]_.PAE;
END;
END$;
OWN GHEAD,
SAVTOP;
LOCAL UPFRONT;
SAVTOP_.TOP; !SAVE VALUE OF TOP
PAE_.LENTRY;
PREV_.LENTRY;
!SET FLAG TO SAY WE ARE IN FRONT OF THE LOOP
UPFRONT_1;
LWHL: WHILE .PAE NEQ .LEND DO
BEGIN
!PARENT POINTERS COULD NOT BE SET EARLIER. MAKE SURE
!THEY ARE SET NOW. NEED TO LOOK ONLY AT OPTIMIZER
!CREATED ASSIGNMENTS BUT WILL DO IT FOR ALL
!ASSIGNMENTS AS EXTRA ASSURANCE.
GHEAD_.PAE;
!FOR ALL THOSE IN THIS GROUP THAT WE ARE INTERESTED IN
! IE, OPT ASGN STMT WITH LHEXP = .O & NOT A2VAL
WHILE OPTCMN(PAE) DO
BEGIN
PO_.PAE[RHEXP];
!NOW, SET THE PARENT OF THE EXPRESSION
PO[PARENT]_.PAE;
HASHIT(.PO,STGHT);
PHI_TBLSRCH();
!CHECK FOR THERE OR NOT
IF .FLAG THEN
IF .PHI[CMNUNDER] THEN
BEGIN
IF LOK1SUBS(.PO,1) THEN ! RHS = .O OP Y ?
BEGIN
!COMPARE USECNTS
IF (.QQ<RIGHT> EQL .PHI[USECNT] AND .PHI [USECNT] NEQ 0) OR ! QQ = OMOVDCNS,,EXPRUSE OF RHS .O
(.QQ<RIGHT> EQL 1 AND .PHI[MOVDCNS]) OR
(.PHI [MOVDCNS] AND .QQ<LEFT>)
THEN
BEGIN
T _ .PO [ARG1PTR]; ! .O SYMTAB PTR
IF .T [IDVERYFRST] GEQ .CURVERYFRST
THEN BEGIN
IF .T [ORFIXFLG] ! .O CAME FROM .R ?
THEN DOTOFIX (.T, .PAE); ! FIX .O INCR
TPREV_.PREV;
P1_.GHEAD;
WHL1:
!LOOK FROM THE START OF THE GROUP TO HERE
WHILE .P1 NEQ .PAE DO
BEGIN
IF .P1[LHEXP] EQL
.PO[ARG1PTR] THEN
BEGIN
T [IDATTRIBUT (NOALLOC)] _ 1;
TPREV[SRCLINK]_.P1[SRCLINK];
T_.PO[ARG1PTR];
PO[ARG1PTR]_.T[IDOPTIM];
PO[A1VALFLG]_0;
!FIX PARNET
T_.PO[ARG1PTR];
T[PARENT]_.PO;
IF .P1 EQL .GHEAD THEN
GHEAD_.P1[SRCLINK];
!IF IN FRONT OF
!TOP ZERO THE DEFPTS
IF .UPFRONT THEN
T[DEFPT1]_
T[DEFPT2]_
PO[DEFPT1]_
0;
SAVSPACE(ASGNSIZ+SRCSIZ-1,.P1);
LEAVE WHL1;
END;
TPREV_.P1;
P1_.P1[SRCLINK];
END;
END;
END;
END;
!THAT WAS THE FIRST ARG, NOW THE SECOND
!LOKXSUBS RETURNS YHE USECNT OF THE DEPENDENT
!EXPRESSION IN QQ.
IF LOK2SUBS(.PO,1) THEN
BEGIN
IF (.QQ<RIGHT> EQL .PHI[USECNT] AND .PHI [USECNT] NEQ 0) OR
(.QQ<RIGHT> EQL 1 AND .PHI[MOVDCNS]) OR
(.PHI [MOVDCNS] AND .QQ<LEFT>)
THEN
BEGIN
T _ .PO [ARG2PTR]; ! .O SYMTAB PTR
IF .T [IDVERYFRST] GEQ .CURVERYFRST
THEN BEGIN
IF .T [ORFIXFLG] ! .O CAME FROM .R ?
THEN DOTOFIX (.T, .PAE); ! FIX .O INCR
TPREV_.PREV;
P1_.GHEAD;
WHL2:
!LOOK FROM THE START TO THIS ONE
WHILE .P1 NEQ .PAE DO
BEGIN
IF .P1[LHEXP] EQL
.PO[ARG2PTR] THEN
BEGIN
T [IDATTRIBUT (NOALLOC)] _ 1;
TPREV[SRCLINK]_.P1[SRCLINK];
T_.PO[ARG2PTR];
PO[ARG2PTR]_.T[IDOPTIM];
!RESET VALFLG
PO[A2VALFLG]_0;
!FIX PARENT
T_.PO[ARG2PTR];
IF .P1 EQL .GHEAD THEN
GHEAD_.P1[SRCLINK];
!IF IN FRONT OF TOP
!ZERO THE DEFPTS
IF .UPFRONT THEN
T[DEFPT1]_
T[DEFPT2]_
PO[DEFPT2]_
0;
T[PARENT]_.PO;
SAVSPACE(ASGNSIZ+SRCSIZ-1,.P1);
LEAVE WHL2;
END;
TPREV_.P1;
P1_.P1[SRCLINK];
END;
END;
END;
END;
END; !PHI[CMNUNDER]
PAE_.PAE[SRCLINK];
IF .PAE EQL .LEND
THEN LEAVE LWHL;
END;
!RESET FLAG IF WE ARE PASSING THROUGH TOP
IF .PAE EQL .TOP THEN UPFRONT_0;
PREV_.PAE;
PAE_.PAE[SRCLINK];
END;
!CLEANUP THE SYMBOL TABLE ENTRIES
DECR I FROM SSIZ-1 TO 0 DO
BEGIN
PAE_.SYMTBL[.I];
WHILE .PAE NEQ 0 DO
BEGIN
IF .PAE[IDDOTO] EQL SIXBIT".O" THEN
PAE [EXPRUSE] _ 0; ! DONT TOUCH OMOVDCNS,ORFIXFLG
PAE_.PAE[SRCLINK];
END;
END;
!RESTORE THE VALUE OF TOP
TOP_.SAVTOP;
END;
FORWARD SCRUBARRAY;
GLOBAL ROUTINE GLOBELIM (CURVERYFRST) =
!++
!GLOBAL COMMON SUB-EXPRESSION ELIMINATION CONTROLLER
!--
BEGIN
!CURVERYFRST IS SIXBIT VALUE OF VERYFRST BEFORE CALLS
! HERE ON THIS LOOP: TO BE PASSED TO GLOBDEP SO ONLY .O
! CREATED FROM THIS LOOP GET RECOMBINED
EXTERNAL IOGELO,HAULASS,SLINGHASH;
LOCAL BASE OLDPO;
LOCAL PHAZ2 PO;
EXTERNAL CSTMNT,LOOP,ISN,LENTRY,LEND,BOTTOM,TOP;
%2016% MAP BASE CSTMNT:LENTRY:TOP:LOOP;
EXTERNAL ELIM,REA;
CNSMOVFLG_0;
LSTWARNLINE_0;
!PROCESSING ORDER IS :
! 1. ALL ASSIGNMENTS OF THE FORM .OXXXX=EXPR. THIS
! WILL BE A CHEAT AT SUBSUMPTION
! 2. ALL SURE TO BE EXECUTED STATEMENTS (POSTDOMINATORS
! OF TOP
! 3. THEN THE REST IN BUSY ORDER
PO_.TOP;
DO
BEGIN
CSTMNT_.PO;
ISN_.CSTMNT[SRCISN];
IF .ISN EQL 0 THEN
BEGIN
IF .PO[SRCID] EQL ASGNID AND .PO[SRCOPT] NEQ 0 THEN
BEGIN
ELIM(.PO);
PO[CSDONE]_1;
END
END
ELSE
IF .PO[SRCID] GEQ READID AND .PO[SRCID] LEQ REREDID
AND NOT .GLOBELIM2
!CAN'T MOVE EXPRESSIONS OUT OF IMPLIED DO IF INSIDE LOGICAL IF,
! IE, SRCLINK = 0
AND .PO [SRCLINK] NEQ 0 THEN
BEGIN ! PROCESS I/O STATEMENT ON 1ST GLOBELIM ONLY
IMPLDO _ 1; ! PROCESSING IMPLIED DO
IOGELO(.PO);
IMPLDO _ 0; ! IMPLIED DO DONE
END;
PO_.PO[BUSY];
END UNTIL .PO EQL 0;
OLDPO_PO_.TOP;
DO
BEGIN
CSTMNT_.PO;
ISN_.CSTMNT[SRCISN];
IF .PO[SRCID] NEQ DOID AND NOT .PO[CSDONE] THEN
BEGIN
ELIM(.PO);
PO[CSDONE]_1;
END;
OLDPO_.PO;
PO_.PO[POSTDOM];
END UNTIL .PO EQL .OLDPO;
!NOW THE REST IN BUSY ORDER
PO_.TOP;
DO
BEGIN
IF .PO[SRCID] NEQ DOID THEN
IF NOT .PO[CSDONE] THEN
BEGIN
CSTMNT_.PO;
ISN_.CSTMNT[SRCISN];
ELIM(.PO);
END;
PO[CSDONE]_0; ! TURN OFF FLAG SO RECALLABLE
PO_.PO[BUSY];
END UNTIL .PO EQL 0;
!WE DO NOT WANT TO MOVE CONSTANT COMPUTATIONS IF THIS IS THE
!MAIN PROGRAM
!TO DO SO WOULD PESSIMIZE THE CODE.
IF .LOOP NEQ 0 THEN
MOVCNST();
GLOBDEPD (.CURVERYFRST);
SCRUBARRAY();
SLINGHASH();
!GLOBDEPD MAY HAVE CREATED SOME EXPRESSIONS THAT ARE
!COMPOSED OF .O VARIABLES THAT COULD MOVE OUT OF THE
!LOOP AS CONSTANT COMPUTATIONS. WE WILL TRY TO GET THESE NOW.
!ONCE AGAIN THIS IS VALID ONLY IF WE ARE NOT IN MAIN CODE
IF .LOOP NEQ 0 THEN
BEGIN
CNSMOVFLG_1;
PO_.TOP;
WHILE .PO NEQ .BOTTOM DO
BEGIN
!THIS CONCERNS ONLY STATEMENTS
!THAT WERE OPTIMIZER INSERTED
!SKIP INNER MORE DO LOOPS
IF .PO[SRCID] EQL DOID THEN
BEGIN
PO_.PO[DOLBL];
PO_.PO[SNHDR];
END;
IF .PO[SRCOPT] EQL 0 THEN
IF .PO[SRCID] EQL ASGNID THEN
REA(.PO[RHEXP]);
PO_.PO[SRCLINK];
END;
MOVCNST();
CNSMOVFLG_0;
GLOBDEPD (.CURVERYFRST);
%2016% ! Try moving simple assignments, except for F77
%2016% ! potentially zero-trip DO-loops.
%2016%
%2016% IF F77
%2016% THEN
%2016% BEGIN ! F77 case
%2016%
%2016% LOCAL BASE CURDO; ! CURDO points to the
%2016% CURDO = .LOOP[DOSRC]; ! current DO statement node
%2016%
%2016% IF NOT .CURDO[MAYBEZTRIP] ! Never zero-trip?
%2016% THEN HAULASS(); ! Try to move assignments
%2016%
%2016% END ! F77 case
%2016% ELSE HAULASS(); ! Always try for non-F77
END;
!CLEAN UP HASH TABEL
SCRUBARRAY();
!CLEAN OUT EXPRESSION HASH TABLE
SLINGHASH();
END;
GLOBAL ROUTINE SCRUBARRAY=
BEGIN
!GO THROUGH THE EXPRESSION HASH TABLE AND FIX UP
!EXPRESSION NODES THAT AHVE BEEN SOILED BY THE
!ARRAY REFERENCES COMMON SUB PROCESS
EXTERNAL EHASH;
EXTERNAL BASE EHASHP;
MAP BASE P1:P2;
DECR I FROM EHSIZ-1 TO 0 DO
BEGIN
EHASHP_.EHASH[.I];
WHILE .EHASHP NEQ 0 DO
BEGIN
IF NOT .EHASHP[EMPTY] AND .EHASHP[USECNT] EQL 1 THEN
PUTBACKARRAY(.EHASHP,
(IF .EHASHP[NBRCH] THEN SKEW
ELSE STGHT));
EHASHP_.EHASHP[CLINK];
END; !WHILE
END; !DECR
END;
GLOBAL ROUTINE A2ARREF(EXPR)=
BEGIN
!Check conditions for a node of the form:
! STAR2
! OP
! / \
! DATAOPR ARRAYREF
!
!and
! SKAR2
! OP
! / \
! OP ARRAYREF
! / \
! DATAOPR
MAP BASE EXPR;
REGISTER BASE T;
EXTERNAL XPUNGE;
!GET OUT FAST IF ARG2 IS NOT AN ARRAYREF
T_.EXPR[ARG2PTR];
IF .T[OPRCLS] NEQ ARRAYREF THEN
RETURN;
!ITS AN ARRAYREF. DOES IT HAVE A LEAF AS SUBSCRIPT
IF NOT .T[A2VALFLG] THEN RETURN;
!NOW LOOK FOR STRAIGHT CONDITION
ARREFCMNSBFLG_1;
IF .EXPR[A1VALFLG] AND NOT .T[PARENFLG]
THEN ! STAR2
XPUNGE(.EXPR,STAR2)
ELSE
BEGIN ! SKAR2
T_.EXPR[ARG1PTR];
IF .T[OPERATOR] EQL .EXPR[OPERATOR]
AND NOT .T[PARENFLG]
AND .T[A2VALFLG] THEN
![665] BE SURE THAT THE OPERATOR COMMUTES SO THAT WE DO NOT END
![665] UP EXTRACTING B/C(I) FROM A/B/C(I)!
%[665]% IF COMMUTATIVE(EXPR) THEN
XPUNGE(.EXPR,SKAR2);
END; ! SKAR2
ARREFCMNSBFLG_0;
END; ! of A2ARREF
GLOBAL ROUTINE A1ARREF(EXPR)=
BEGIN
!Check conditions for node of the form:
!
! STAR1
! OP (EXPR)
! / \
! ARREF DATAOPR
!
!or
! SKAR1
! OP (EXPR)
! / \
! OP DATAOPR
! / \
! ARREF
!
!SORT ORDER (CANONICALIZATION) MAKE THIS UNLIKELY
!BUT OTHER COMMON SUBS COULD MAKE IT HAPPEN
MAP BASE EXPR;
REGISTER BASE T;
EXTERNAL XPUNGE;
IF .EXPR[OPRCLS] EQL SPECOP THEN RETURN;
IF NOT .EXPR[A2VALFLG] THEN RETURN;
T_.EXPR[ARG1PTR];
ARREFCMNSBFLG_1;
IF .T[OPRCLS] EQL ARRAYREF THEN
BEGIN ! STAR1
IF .T[A2VALFLG] THEN
XPUNGE(.EXPR,STAR1);
END ! STAR1
ELSE
BEGIN ! SKAR1
! Operators of both node must be the same, and T must
! not be a parenthesized espression.
IF(.EXPR[OPERATOR] EQL .T[OPERATOR])
AND NOT .T[PARENFLG] THEN
BEGIN
%1747% LOCAL BASE ARR; ! Array ref
%1747% ARR = .T[ARG2PTR];
%1747% IF .ARR[OPRCLS] EQL ARRAYREF AND .ARR[A2VALFLG] THEN
%1747% BEGIN ! Try to hash SKAR1
%1747%
%1747% ! Must now check if the array ref has
%1747% ! been hashed before this (we can't hash
%1747% ! a hash node!). It has been if it was
%1747% ! found in a STAR2 or SKAR2 position
%1747% ! before, so check to see if there are
%1747% ! leaves (indicated by A*VALFLG) in the
%1747% ! correct positions. If not, then go
%1747% ! ahead and hash!
%1747% !
%1747% ! EXPR
%1747% ! / \
%1747% ! T leaf1
%1747% ! / \
%1747% ! ?1 ARREF
%1747% ! / \
%1747% ! ?2 leaf2
%1747% !
%1747% ! SKAR1 - leaf1 and ARREF (what we want to do)
%1747% ! STAR2 - ?1 and ARREF (already done?)
%1747% ! SKAR2 - leaf2 and ARREF (already done?)
%1747%
%1747% IF NOT .T[A1VALFLG] ! STAR2?
%1747% THEN
%1747% BEGIN ! Not hashed as STAR2
%1747% T = .T[ARG1PTR];
%1747% IF NOT .T[A2VALFLG]
%1747% THEN ! Not hashed as SKAR2
XPUNGE(.EXPR,SKAR1);
%1747% END;
%1747%
%1747% END; ! Try to hash SKAR1
END;
END; ! SKAR1
ARREFCMNSBFLG_0;
END; ! of A1ARREF
GLOBAL ROUTINE NEWCOPY(PHI,DAD)=
BEGIN
!TAKE AN ARRAYREF OFF OF THE LIST
!POINTED TO BY THE LKER FIELD OF PHI
!GIVE IT A DAD OF DAD
MAP BASE PHI;
REGISTER BASE T;
EXTERNAL SKERR;
IF .PHI[LKER] EQL 0 THEN SKERR();
!TAKE NEXT NODE
T_.PHI[LKER];
!TAKE NODE OFF OF LIST
PHI[LKER]_.T[PARENT];
T[PARENT]_.DAD;
.T
END;
GLOBAL ROUTINE PUTBACKARRAY(HASHPTR,SHAPE)=
BEGIN
!IF THE HASH ENTRY CONTIANS AN ARRAY REF AS AN
!AERGUMENT, PUT THE ACTUAL ARRAYREFERENCE NODE
!BACK IN PLACE IN THE EXPRESSION. WITHOUT THIS
!ADJUSTMENT THE EXPRESSION IS LEFT POINTING TO A
!HASH TABLE ENTRY.
MAP BASE HASHPTR;
REGISTER BASE ARY:EXPR;
IF .HASHPTR[A1ARY] THEN
BEGIN
!ARGUMENT 1 OF THIS EXPRESSION IS AN ARRAY REF
!NOTE THAT THIS MAY NOT BE ARG1 (HA1) IN THE
!HASH TABLE
!GET EXPRESSION ITSELF
EXPR_.HASHPTR[LKER];
!NOW CHECK TREE SHAPE
IF .SHAPE EQL SKEW THEN
BEGIN
EXPR_.EXPR[ARG1PTR];
!IT IS ARG2 OF THIS EXPR THAT IS
!ARG1 OF THE EXPRESSION
ARY_.EXPR[ARG2PTR];
EXPR[ARG2PTR]_NEWCOPY(.ARY,.EXPR);
END ELSE
BEGIN
ARY_.EXPR[ARG1PTR];
EXPR[ARG1PTR]_NEWCOPY(.ARY,.EXPR);
END;
ARY[USECNT]_0;
END;
IF .HASHPTR[A2ARY] THEN
BEGIN
!ARGUEMNT 2 IS AN ARRAY REF
EXPR_.HASHPTR[LKER];
!NOW A SIDE TRIP FOR A FUNCTION REFERENCE
IF .HASHPTR[OPRCLS] EQL FNCALL THEN
BEGIN
LOCAL ARGUMENTLIST AG;
AG_.EXPR[ARG2PTR];
ARY_.AG[1,ARGNPTR];
AG[1,ARGNPTR]_NEWCOPY(.ARY,.EXPR);
END ELSE
BEGIN
!DOES NOT MATTER IF IT IS STRAIGHT OR SKEW
!OR UNARY
ARY_.EXPR[ARG2PTR];
EXPR[ARG2PTR]_NEWCOPY(.ARY,.EXPR);
END;
ARY[USECNT]_0;
END;
END;
GLOBAL ROUTINE FNARRAY(EXPR)=
BEGIN
!CALLED OUT OF REA TO HANDLE ARRAY REF SPECIAL CASE
!UNDER A FUNCTION REF
MAP BASE EXPR;
REGISTER BASE TMP;
REGISTER ARGUMENTLIST AG;
EXTERNAL XPUNGE;
!QUIT ON NON-LIBRARY
IF .EXPR[OPERSP] NEQ LIBARY THEN RETURN;
%2373% IF .EXPR[VALTYPE] EQL CHARACTER THEN RETURN;
!LOOK AT ARG LIST
AG_.EXPR[ARG2PTR];
!QUIT IF NOT SINGLE ARG
IF .AG[ARGCOUNT] NEQ 1 THEN RETURN;
!NOW ARRAY REF PART
TMP_.AG[1,ARGNPTR];
%2373% IF .TMP[VALTYPE] EQL CHARACTER THEN RETURN;
IF .TMP[OPRCLS] EQL ARRAYREF THEN
BEGIN
!IF THE SUBSCRIPT IS A LEAF
IF .TMP[A2VALFLG] THEN
BEGIN
!SET FLAG
ARREFCMNSBFLG_1;
!TRY TO ELIMINATE
XPUNGE(.EXPR,FNARY);
!TURN FLAG OFF
ARREFCMNSBFLG_0;
END;
END ELSE
IF .TMP[OPRCLS] EQL DATAOPR THEN
XPUNGE(.EXPR,UNARY);
END;
END
ELUDOM