Trailing-Edge
-
PDP-10 Archives
-
FORTRAN-10_Alpha_31-jul-86
-
defpt.bli
There are 26 other files named defpt.bli in the archive. Click here to see a list.
!COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1972, 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.
!AUTHOR NORMA ABEL/HPW/JNG/DCE/TFV/EGM/CKS/AHM/TJK/AlB/MEM
MODULE DEFPT(RESERVE(0,1,2,3),SREG=#17,VREG=#15,FREG=#16,DREGS=4)=
BEGIN
GLOBAL BIND DEFPTV = #11^24 + 0^18 + #4517; ! Version Date: 4-Oct-85
%(
***** Begin Revision History *****
92 ----- ----- GENERATE DEFPTS IN I/O LISTS
93 ----- ----- REMOVE 2ND PARAMTER TO GETDEF
94 ----- ----- MAKE SETGTRD GLOBAL AND RETURN A VALUE INSTEAD
OF SETTING GOTVAL
95 ----- ----- ADD ELIST HANDLING TO ALL LEVELS
96 ----- ----- PUT PARAMETER TO GETDEF BACK
97 ----- ----- FIX DEF1 TO PREVENT MOTION INTO DO LOOPS
THAT HAPPEN TO BE TOP[BUSY] = TOP[SRCLINK]
98 ----- ----- CALL IOSTDFPT FOR ENCODE/DECODE/READ/WRITE
99 ----- ----- EXTRACT CASE STATEMENT FROM SETGTRD AND
MAKE A GLOBAL ROUTINE READHERE
100 ----- ----- ADD REREDID TO I/O OPTIMIZATIONS
101 ----- ----- FIX SETONSUC SERIOUS CONCEPT PROBLEM
CAUSING INCORRECT MOTION
102 ----- ----- FIXES TO LOKELIST, READHERE, AND SETGTRD
FOR I/O OPTIMIZATION
103 ----- ----- SELECT AND SET VARIABLES ASSIGNED ON
THE I/O LIST
104 ----- ----- CLEAN UP AND CREATE DEFWORK
105 ----- ----- FIX 104
106 ----- ----- ADD CODE FOR MOTION OF SIMPLE ASSIGNMENTS
107 ----- ----- FIX 106
108 ----- ----- ADD CODE FOR ARRAY COMMON SUB EXPRESSIONS
109 ----- ----- MOVE CALL TO CLEABUP OUT OF DEFDRI INTO
PROPAGATE
110 ----- ----- FIX LABEL TEST IN SPECBRCHK
111 ----- ----- SORT MULTIPLY NODES FOR BETTER REDUCTION
112 ----- ----- MAKE DEF PT STUFF IN GENERAL AWARE OF THE
FACT THAT AN IMPLIED DO LOOP CHANGES THE
VALUE OF THE DO LOOP INDEX
113 ----- ----- SELECTIT, ETC. IS MISHANDLING LABELS
114 ----- ----- DEFWORK NOT TAKING ACCOUNT OF ASSIGN
STATEMENTS
115 235 FIX NAMELIST PROBLEM, (MD)
116 252 14967 SELECTIT NOT CHECKING FOR SPECOP AND POSSIBLY OTHER OPS,
(JNT)
117 315 16667 FIX VDEFPT TO RECOGNIZE ARRAYREFS WITH CONSTANT
SUBSCRIPTS, NOT OPTIMALLY, BUT AT LEAST NOT WRONG, (JNT)
118 453 19695 DON'T CONSIDER THE DEFPT OF VARIABLES MODIFIED
INSIDE LOOPS TO BE THE DO STATEMENT., (JNG)
***** Begin Version 5A *****
119 575 22820 MAKE ZAPLEVEL MORE CLEVER IN USE OF THE STACK
TO PREVENT STACK OVERFLOWS., (DCE)
120 671 NVT WHEN SWAPPING ARGS, SWAP DEF PTS TOO, (DCE)
***** Begin Version 6 *****
121 760 TFV 1-Oct-79 ------
Add handling for IOSTAT variable, it's an implicit assignment
Include all I/O statements in test for END/ERR= branching
122 763 EGM 24-Apr-80 13913
Cause ENTRY formals to take part in definition point determination
123 1010 EGM 12-Aug-80 10-29839
Make sure CHKNAML passes only the address of a NAMELIST entry, not the
full argument word.
124 1034 DCE 4-Dec-80 -----
Fix function call arguments so that arguments (especially nested
ones) which change get noticed. Example F(G(X)) may change X.
125 1113 CKS 17-Jun-81
Prevent code motion from moving CSEs to statements which have more
than one successor. To do this, modify SETONSUC to set ACC bits for
variables which are assigned in statement STMT in STMT's successors
and postdominator. See comments in SPECBRCHK.
126 1126 AHM 22-Sep-81 Q20-01654
Remove last vestiges of CALL DEFINE FILE in a comment.
***** Begin Version 7 *****
***** End V7 Development *****
***** End Revision History *****
***** Begin Version 10 *****
2204 TFV 20-Jun-83
Add definition point handling for INQUIRE and fix deficiencies
with I/O definition points. All I/O statements can have IOSTAT=
which is the definition point for its argument. Also must check
for function call arguments in the expressions for UNIT, FMT,
REC, and IOSTAT and all OPEN/CLOSE/INQUIRE specifiers. Most
INQUIRE arguments are also modified by the INQUIRE statement.
2372 TJK 14-Jun-84
Restructure to allow the SETSEL routines to handle SUBSTRING
and ARRAYREF nodes (as well as DATAOPRs). Use DEFPTSS for the
definition point of ARG4PTR in a SUBSTRING. Handle character
data. Fix many, many bugs, mostly involving missing checks
for function references with side effects. Fix problems with
edit 1034.
2427 AlB 17-Jul-84
Removed reference to IDCHOS in SELECTIT, and reference to IDUSED
in GETDEF. These fields were not being used anywhere else, and
thus do not need to be initialized.
2522 DCE 8-Mar-85 QAR 853010
Correct definition point algorithm for character assignment
statements. Since they are converted to CALL statements, it looked
as if all of COMMON had to be marked as being possibly redefined
for every assignment statement, by calling THROINCOMMON. This is a
very slow routine, especially when it is called mulitple number of
times. This edit does NOT call it for library functions, which the
character assignment statements are.
2525 DCE 19-Mar-85 QAR 853010
Speed up optimization of programs with very large symbol tables.
When the optimizer wants to mark variables in COMMON as potentially
changed (for a CALL statement, for example), the entire symbol
table gets searched for variables which are both in COMMON and in
the CHOSEN list (with DISPIX=1). This is too time-consuming. When
the CHOSEN list is set up, keep a CMNMASK word which indicates which
elements of the CHOSEN list represent COMMON blocks, and use this
mask to update the ACC field in THROINCOMMON instead of doing symbol
table walk(s).
***** End V10 Development *****
2550 MEM 11-Sep-85
Only parameters of a statement function were used to calculate the
definition points of variables, however, the body of the statement
function must be used in definition point calculations also. A
variable, other than a parameter to the statement function, may be
changed by itself being a parameter in a function call within the
statement function.
2555 MEM 31-Oct-85
Correction to edit 2550.
***** End Revision History *****
***** Begin Version 11 *****
4501 MEM 7-Jan-85
Modify macro RANDIO so that when it checks if IORECORD is non-zero,
it will also check if IOKEY is non-zero.
4502 MEM 7-Jan-85
Add a case for the DELETE statement to the case statement in DEFWORK.
4503 MEM 7-Jan-85
Add a case for the REWRITE statement to the case statement in DEFWORK.
4517 MEM 4-Oct-85
In DEFWORK if we have a 1-char asmnt then call SETSEL[.DISPIX] on
the arg under the CHAR node instead of on the whole LHEXP of the asmnt.
ENDV11
)%
SWITCHES NOLIST;
REQUIRE FIRST.BLI;
REQUIRE TABLES.BLI;
REQUIRE OPTMAC.BLI;
SWITCHES LIST;
FORWARD
LOKELIST(1),
SELECTIT(1),
CHKUNIQ(1),
THROINCOMMON,
ANPARMS(1),
RSORT(1),
FCNLOK(1),
ASSOCIA,
DEF0 ,
SETIT(1),
DEFCHANGE(1),
ONLYONEPRED(1),
ZAPLEVEL(1),
SWAMP,
DEF1 ,
SETGOTVAL(1),
READHERE(1),
SETGTRD(1),
HEREVALUED(2),
GETDEF(3),
VDEFPT(1),
DEFPT(1),
DEFDRIV,
CHKNAML(1),
SETONSUC(1),
SPECBRCHK,
%2204% DEFIO(1), ! Definition points for I/O specifiers
%2204% DEFOCI(1), ! Definition points for OPEN/CLOSE/INQUIRE specifiers
DEFWORK(1);
!THE CONTROLLING ROUTINE IN THIS MODULE IS DEFDRIV. IT IS
!CALLED FROM PHA2. IT DIRECTS THE CALLING OF ALL THE OTHER
!(LOCAL) ROUTINES IN THIS MODULE. THE READER SHOULD START WITH
!THE ROUTINE DEFDRIV. IT APPEARS AT THE END OF THE MODULE
!(SAVE FOR INITDEF).
EXTERNAL
BASE ASSOCPT, ! Used for linked list of ASSOCIATE variables
BOTTOM,
CHOSEN,
LENTRY,
LOOKUP,
LOOPNO,
PHAZ2 QQ,
%2372% SKERR, ! Used to ICE the compiler
TOP,
%2372% BASE TREEPTR; ! Used as a global. Moved EXTERNAL here.
OWN PEXPRNODE PCE;
OWN P,PA,PB,PC,HEAD,PAE;
OWN MOREFLG,LSTVAR,T;
MAP PHAZ2 P:PA:PB:PC:HEAD:PAE;
OWN MASK,CHNGLST;
OWN DISPIX; !PLIT DISPATCH INDEX
OWN GOTVAL, !FLAG FOR ASSIGNED HERE
!THAT IT GIT IT VALUE HERE
%2525% CMNMASK; ! Mask of COMMON blocks in CHOSEN
!DISPATCH TO USE FCNLOK TO BOTH SELECT AND SET BITS.
!A SPACE ECONOMY AT A SLIGHT TRADE OFF IN TIME.
BIND SETSEL = PLIT (
SELECTIT,
SETIT,
SETGOTVAL);
ROUTINE LOKELIST(EPTR)=
BEGIN
!EXAMINE E1 AND E2 LISTS AND CALL THE CORRECT
!SELSEL ROUTINE.
!EPTR POINTS TO THE ELIST NODE.
MAP BASE EPTR;
REGISTER BASE ELEM;
WHILE .EPTR NEQ 0 DO
BEGIN
ELEM_.EPTR[E2ARREFPTR];
%2372% (.SETSEL[.DISPIX])(.ELEM);
EPTR_.EPTR[CLINK];
END;
END; ! of LOKELIST
ROUTINE SELECTIT(VAR)=
BEGIN
EXTERNAL CORMAN,UNIQVAL,UNLIST,SAVSPACE;
MAP PHAZ2 CHNGLST:TOP:UNIQVAL;
MAP PEXPRNODE VAR;
!SELECT VARIABLES TO PARTICIPATE IN THE DEFINITION POINT
!IDDEF INDICATES THAT THE VARAIBLE HAS PARTICIPATED IN THE
!DEFINITION POINT COMPUTATION.
!32 VARIABLES ARE SELECTED. THERE ADDRESS ARE PUT INTO THE VECTOR CHOSEN.
!AS A VARIABLE IS CHOSEN IT IS ALSO ADDED TO THE LIST OF VARIABLES
!THAT ARE CHANGED IN THIS LOOP WHICH IS KEPT WITH THE DO LOOP
!AFTER PROCESSING AS IT GOES FORTH INTO THE OUTSIDE WORLD.
!THE VARIABLE LSTVAR IS USED TO HOLD THE PLACE OF THE ALGORITHM IN
!PROCESSING STATEMENTS IN CASE MORE THAN 32 EXIST.
!ALGORTHM
%2372% IF .VAR[OPRCLS] EQL SUBSTRING
%2372% THEN VAR = .VAR[ARG4PTR]; ! Get get full string
%2372%
%2372% IF .VAR[OPRCLS] EQL ARRAYREF
%2372% THEN VAR = .VAR[ARG1PTR]; ! Get array name
%2372%
%2372% IF .VAR[OPRCLS] NEQ DATAOPR
%2372% THEN RETURN;
%2372%
%2372% IF.VAR[OPERSP] EQL CONSTANT OR .VAR[OPERSP] EQL FORMLFN
%2372% THEN RETURN;
!HERE WE HAVE A SYMBOL TABLE ENTRY
!SO WE WILL PROCESS IT.
! VAR[IDCHOS]_.LOOPNO; %2427 removed%
IF .T LSS 32 AND NOT .VAR[IDDEF] THEN
BEGIN
!EQUIVALENCED VARIABLES ARE NOT HANDLED
IF .VAR[IDATTRIBUT(INEQV)] THEN RETURN;
IF .VAR[IDATTRIBUT(INCOM)] THEN
PC_.VAR[IDCOMMON] ELSE
PC_.VAR;
INCR K FROM 0 TO 31 DO
IF .CHOSEN[.K] EQL .PC THEN
BEGIN
CHKUNIQ(.PC);
RETURN;
END;
!IF WE ARE HERE THE VARIBALE IS NOT ALREADY
!SELECTED. SO WE WILL DO THAT NOW
CHOSEN[.T]_.PC;
%2525% ! Mark COMMON blocks in CMNMASK for use by THROINCOMMON
%2525% IF .VAR[IDATTRIBUT(INCOM)]
%2525% THEN CMNMASK = SETBIT(.CMNMASK,.T);
VAR[IDDEF]_1;
T_.T+1;
!ADD THIS VARIABLE TO THE LIST OF
!CHANGED IN THIS LOOP
PC_.CHNGLST;
NAME<LEFT>_CHNGSIZ;
CHNGLST_CORMAN();
IF .PC NEQ 0 THEN
PC[RIGHTP]_.CHNGLST
ELSE
TOP[DOCHNGL]_.CHNGLST;
CHNGLST[LEFTP]_.VAR;
IF .T EQL 32 THEN LSTVAR_.P;
!BUILD ITEM ON UNIQUE VALUE LIST TOO.
PC_.UNIQVAL;
NAME<LEFT>_UNIQSIZ;
UNIQVAL_CORMAN();
UNIQVAL[RIGHTP]_.PC;
!PUT VARIABLE IN IN ALL CASES
UNIQVAL[LEFTP]_.VAR;
!SAVE ISN
UNIQVAL[OPTISNVAL]_.ISN;
END ELSE
!THIS IS POTENTIALLY AN ADDITIONAL ASSIGNMENT AND WE NEED
!TO TAKE IT OFF THE UNIQUE VALUR LIST
CHKUNIQ(.VAR);
END; ! of SELECTIT
ROUTINE CHKUNIQ(VAR)=
BEGIN
EXTERNAL UNIQVAL,SAVSPACE,UNLIST;
MAP PHAZ2 UNIQVAL:PC:VAR;
!REMOVE VAR FROM UNIQUE VALUE LIST
PC_.UNIQVAL;
WHILE .PC NEQ 0 DO
BEGIN
!IF ITS ON THE LIST AND THE ISNS DO NOT MATCH
!TAKE IT OFF
IF .PC[LEFTP] EQL .VAR THEN
BEGIN
IF .PC[OPTISNVAL] NEQ .ISN THEN
IF UNLIST(.UNIQVAL,.VAR,UNIQSIZ)
THEN
BEGIN
PC_.UNIQVAL;
UNIQVAL_.UNIQVAL[RIGHTP];
SAVSPACE(UNIQSIZ-1,.PC);
END;
RETURN;
END;
PC_.PC[RIGHTP];
END;
END; ! of CHKUNIQ
ROUTINE THROINCOMMON=
BEGIN
!PUT COMMON VARIABLES ON THE CHOOSEN LIST
%2372% ! Note that a check for EQUIVALENCE is missing here. However,
%2372% ! GETDEF ends up using the current statement as the definition
%2372% ! point for variables in COMMON or EQUIVALENCE anyway, so this
%2372% ! whole routine is useless. But, it could be made useful
%2372% ! someday...
MAP BASE PCE;
!DONT DO IT FOR HEARVALUED STUFF (DISPIX=2)
IF .DISPIX EQL 2 THEN RETURN;
%2525% ! We may be trying to set bits in the ACC field (for
%2525% ! DISPIX=1). Rather than walking the entire symbol table,
%2525% ! use the saved bit mask of all COMMON blocks in CHOSEN
%2525% ! which we built up when DISPIX=0. This speeds up
%2525% ! compilation substantially for programs with large symbol
%2525% ! tables.
%2525% IF .DISPIX EQL 1
%2525% THEN
%2525% BEGIN
%2525% P[ACC] = .P[ACC] OR .CMNMASK;
%2525% RETURN
%2525% END;
INCR K FROM 0 TO SSIZ-1 DO
BEGIN
PCE_.SYMTBL[.K];
WHILE .PCE NEQ 0 DO
BEGIN
IF .PCE[IDATTRIBUT(INCOM)] THEN
(.SETSEL[.DISPIX])(.PCE);
PCE_.PCE[CLINK];
END;
END;
END; ! of THROINCOMMON
ROUTINE ANPARMS(ARGLSTPTR)=
BEGIN
%2372% ! Edit 1034 had a lot of problems. This edit is a rewrite of
%2372% ! this routine, and should correct those problems. Basically,
%2372% ! any parameter which may have its value altered must be noted
%2372% ! (by the SETSEL dispatch call), and nested function
%2372% ! references must be noted (by the FCNLOK call). Sorry, no
%2372% ! time to add a full routine header.
MAP ARGUMENTLIST ARGLSTPTR;
REGISTER BASE ARGPTR;
INCR I FROM 1 TO .ARGLSTPTR[ARGCOUNT]
DO
BEGIN ! For each argument
ARGPTR = .ARGLSTPTR[.I,ARGNPTR]; ! Get the argument
(.SETSEL[.DISPIX])(.ARGPTR); ! It may be changed
FCNLOK(.ARGPTR); ! Check for nested functions
END; ! For each argument
END; ! of ANPARMS
ROUTINE RSORT(CNODE)=
BEGIN
!SORT THIS MULTIPLY NODE SO THAT THE DO LOOP
!INDUCTION VARIABLE (INDVAR) IS ON THE TOP
!OF ANY NARY TREE. IT WILL ALSO PUT IT TO THE
!RIGHT ON BINARY TREES.
EXTERNAL SWAP2DOWN,INDVAR;
MAP BASE CNODE;
REGISTER BASE T;
!IS IT A BOTTOM MOST TREE
IF .CNODE[A1VALFLG] AND .CNODE[A2VALFLG] THEN
BEGIN
!SWITCH ARGS IF THE DO LOOP VARIABLE IS
!ARG1
IF .CNODE[ARG1PTR] EQL .INDVAR THEN
![671] WHEN SWAPPING ARGS, SWAP DEF PTS TOO
%671% (SWAPARGS(CNODE);
%671% T_.CNODE[DEFPT2];
%671% CNODE[DEFPT2]_.CNODE[DEFPT1];
%671% CNODE[DEFPT1]_.T);
END ELSE
BEGIN
!IT IS NOT A BOTTOM-MOST TREE. CHECK FOR NARY
!DOWNWARD
T_.CNODE[ARG1PTR];
IF NARYNODE(T,CNODE) THEN
BEGIN
!IF THE LOWER BRANCH IS A LEAF AND THE INDUCION
!VARIABLE THEN SWITCH THEM
IF .T[ARG2PTR] EQL .INDVAR THEN
SWAP2DOWN(.CNODE,.T);
END;
END;
END; ! of RSORT
ROUTINE FCNLOK(EXPR)=
BEGIN
!EXAMINE EXPRESSION EXPR FOR FUNCTION REFERENCES
!IF ANY ARE FOUND PUT COMMON AND THE PARAMETERS ON THE
!SELECTED LIST (THE VECTOR CHOSEN).
MAP BASE EXPR;
%2372% REGISTER ARGUMENTLIST ARGLSTPTR; ! Pointer to argument list
CASE .EXPR[OPRCLS] OF SET
!BOOLEAN
BEGIN
FCNLOK(.EXPR[ARG1PTR]);
FCNLOK(.EXPR[ARG2PTR]);
END;
!DATAOPR
RETURN;
!RELATIONAL
BEGIN
FCNLOK(.EXPR[ARG1PTR]);
FCNLOK(.EXPR[ARG2PTR]);
END;
!FNCALL
BEGIN
%2550% LOCAL BASE ARG1:SFNODE;
%2372% ARGLSTPTR = .EXPR[ARG2PTR];
IF .EXPR[OPERSP] NEQ LIBARY THEN
BEGIN
THROINCOMMON();
%2372% ANPARMS(.ARGLSTPTR);
%2550% ARG1 = .EXPR[ARG1PTR]; ! Function name
%2550% IF .ARG1[IDATTRIBUT(SFN)]
%2550% THEN
%2550% BEGIN
%2550% SFNODE = .ARG1[IDSFNODE]; ! SFN node
%2555% IF .SFNODE[USRFNREF]
%2555% THEN
%2555% BEGIN
%2555% SFNODE = .SFNODE[SFNEXPR]; ! ASMNT NODE
%2555% FCNLOK(.SFNODE[RHEXP]);
%2555% END;
%2550% END;
END
%2372% ELSE
%2372% BEGIN ! Check for nested functions
%2372%
%2372% INCR I FROM 1 TO .ARGLSTPTR[ARGCOUNT]
%2372% DO FCNLOK(.ARGLSTPTR[.I,ARGNPTR]);
%2372%
%2372% END; ! Check for nested functions
END;
!ARITHMETIC
BEGIN
FCNLOK(.EXPR[ARG1PTR]);
FCNLOK(.EXPR[ARG2PTR]);
!IF WE ARE SELECTING (DISPIX=0) THEN
!SORT MULTIPLIES TO IMPROVE REDUCTIONS
IF .DISPIX EQL 0 THEN
CASE .EXPR[OPERSP] OF SET
%ADD% ;
%SUB% ;
%MULTIPLY%
RSORT(.EXPR);
%DIV% ;
%EXP% BEGIN END
TES;
END;
!TYPECNV
FCNLOK(.EXPR[ARG2PTR]);
!ARRAYREF
IF .EXPR[ARG2PTR] NEQ 0 THEN
FCNLOK(.EXPR[ARG2PTR]);
!CMNSUB
RETURN;
!NEGNOT
FCNLOK(.EXPR[ARG2PTR]);
!SPECOP
FCNLOK(.EXPR[ARG1PTR]);
!FIELDREF
RETURN;
!STORECLS
RETURN;
!REGCONTENTS
RETURN;
!LABOP
RETURN;
!STATEMENT
RETURN;
!IOLSCLS
RETURN;
!INLINFIN
BEGIN
FCNLOK(.EXPR[ARG1PTR]);
IF .EXPR[ARG2PTR] NEQ 0 THEN
FCNLOK(.EXPR[ARG2PTR]);
END;
%2372% !SUBSTRING
%2372% BEGIN
%2372% FCNLOK(.EXPR[ARG1PTR]); ! Upper bound
%2372% FCNLOK(.EXPR[ARG2PTR]); ! Lower bound
%2372% FCNLOK(.EXPR[ARG4PTR]); ! ARRAYREF or DATAOPR
%2372% END;
%2372% !CONCATENATION
%2372% BEGIN
%2372% ARGLSTPTR = .EXPR[ARG2PTR];
%2372%
%2372% INCR I FROM 2 TO .ARGLSTPTR[ARGCOUNT] ! Skip first arg
%2372% DO FCNLOK(.ARGLSTPTR[.I,ARGNPTR]);
%2372% END;
TES;
END; ! of FCNLOK
ROUTINE ASSOCIA=
BEGIN
![1126] !LOOK AT LINKED LIST OF ASSOCIATE VARIABLES (FROM OPENS)
![1126] !AND SELECT SET OF INDICATE SET HERE FOR
!THESE VARIABLES. THE MODULE OWN DISPIX IS SET TO CALL THE
!CORRECT ROUTINE BY THE CALLER OF THIS ROUITNE.
REGISTER BASE LP;
LP_.ASSOCPT;
WHILE .LP NEQ 0 DO
BEGIN
(.SETSEL[.DISPIX])(.LP[LEFTP]);
LP_.LP[RIGHTP];
END;
END; ! of ASSOCIA
!MACRO TO TEST RANDOM ACCESS PROPERTY OF AN I/O STATEMENT
!POINTED TO BY P AND CALL THE CORRECT SETSEL ROUTINE
MACRO RANDIO(P)=
BEGIN
%4501% IF (.P[IORECORD] NEQ 0)
%4501% AND (.P[IOKEY] EQL 0)
%4501% THEN
BEGIN
ASSOCIA();
THROINCOMMON();
END;
END$;
ROUTINE DEF0=
!++
! DEF0 is used to select up to 32 variables on which to perform
! definition point analysis. It first zeros the global vector CHOSEN,
! which is used to hold pointers to the selected variables. It also
! initializes a few other globals and module OWNs. It then makes an
! explicit call to SELECTIT to select the DO-variable of the current
! DO-loop (if it hasn't already been processed). It then walks the
! statements of the current DO-loop in BUSY list order, calling DEFWORK
! (with DISPIX set to zero, indicating SELECTIT is to be called) for
! each statement. When 32 variables have been selected, it stops
! walking the statements and remembers where it left off so that it can
! start there when the next set of up to 32 variables are to be
! selected.
!--
!LOOK AT STATEMENTS THAT POTENTAILLY ASSIGN A VALUE TO A
!VARIABLE. CALL THE ROUTINE SELECTIT TO SELECT THE
!VARIABLE. FUNCTIONS WITH SIDE EFFECTS WILL PRODUCE
!BAD RESULTS.
BEGIN
EXTERNAL CSTMNT,ISN;
MAP BASE CSTMNT;
MAP BASE PCE;
MAP PHAZ2 TOP;
!SET DISPATCH INDEX TO EXECUTE SELECTIT
DISPIX_0;
LSTVAR_-1; !INITIALIZE LSTVAR
! Also initialize CHOSEN, which is used to hold pointers to the
! selected variables.
DECR I FROM 31 TO 0
DO CHOSEN[.I]_0;
%2525% CMNMASK_0; ! Initialize COMMON mask too.
!MAKE SURE WE GET THE INDUCTION VARIABLE
IF .TOP[SRCID] EQL DOID THEN
SELECTIT(.TOP[DOSYM]);
!PICK FIRST 32 UNIQUE LHS TO PROCESS
DO
BEGIN
CSTMNT_.P;
ISN_.P[SRCISN];
DEFWORK(.P);
!TEST FOR JUST HAVING FILLED UP THE 32
!IF WE DONT TEST NOW BY THE TIME WE UPDATE
!P WE WILL HAVE PASTED LSTVAR
IF .P EQL .LSTVAR THEN
BEGIN
MOREFLG_1;
RETURN;
END;
P_.P[BUSY];
END UNTIL .P EQL 0 OR .P EQL .LSTVAR;
IF .P EQL 0 THEN MOREFLG_0;
END; ! of DEF0
ROUTINE SETIT(VAR)=
BEGIN
!SET THE BIT IN THE ACC FIELD OF THE MODULE-OWN,P,
!TO INDICATE THAT THE VARIABLE VAR IS DEFINED AT
!SOME PREDECESSOR OF P.
MAP BASE VAR;
MAP PHAZ2 P;
LOCAL I;
%2372% IF .VAR[OPRCLS] EQL SUBSTRING
%2372% THEN VAR = .VAR[ARG4PTR]; ! Get get full string
%2372%
%2372% IF .VAR[OPRCLS] EQL ARRAYREF
%2372% THEN VAR = .VAR[ARG1PTR]; ! Get array name
%2372%
%2372% IF .VAR[OPRCLS] NEQ DATAOPR
%2372% THEN RETURN;
%2372%
%2372% IF.VAR[OPERSP] EQL CONSTANT OR .VAR[OPERSP] EQL FORMLFN
%2372% THEN RETURN;
IF .VAR[IDDEF] THEN !THIS VARIABLE IS ELIGIBLE FOR
!CONSIDERATION
BEGIN
I_LOOKUP(.VAR);
IF .I LSS 32 THEN
P[ACC]_SETBIT(.P[ACC],.I);
END;
END; ! of SETIT
ROUTINE DEFCHANGE(STMT)=
BEGIN
!EXAMINE STATEMENTS THAT CAUSE VALUES OF VARAIBLES TO CHANGE
!AND CALL SETIT OR SETREAD TO SET BITS IN THE MASK FOR THAT
!WORD. MASK EXPLAINED IN COMMENTS THAT GO WITH DEF1.
!NOTE:
!THE BIT WILL BE SET IN THE MASK ASSOCIATED WITH THE MODULE
!OWN P WI;HICH POINTS TO A STATEMENT.
MAP PHAZ2 STMT;
!SET MODULE OWN THAT IS INDEX TO DISPATCH
DISPIX_1;
DEFWORK(.STMT);
END; ! of DEFCHANGE
ROUTINE ONLYONEPRED(NODE)=
BEGIN
!A VERSION TWO ROUTINE TO CHECK IF A NODE
!HAS ONLY ONE PREDECESSOR. CURRENTLY ONLY USED IN
!CONJUNCTION WITH ZAPLEVEL (IMMEDIATELY FOLLOWING)
!IF THE NODE HAS A SINGLE PREDECOSSOR A POINTER
!TO THAT PREDECESSOR IS RETURN ELSE 0 IS RETURNED.
!THE GLOBAL QQ IS USED AS A TEMP.
EXTERNAL QQ;
REGISTER PHAZ2 T;
MAP PHAZ2 NODE:QQ;
T_.NODE[PREDPTR]; !START OF PREDECESSOR CHAIN
QQ_.T[CESLNK]; !LINK TO NEXT ON CHAIN
!IF QQ IS POINTING TO A ZERO WORD THERE IS ONLY ONE PREDECESSOR
IF .QQ[CESLNK] EQL 0 THEN
RETURN (.T[CESSOR]) !RETURN THAT PREDECESSOR
ELSE
RETURN 0
END; ! of ONLYONEPRED
ROUTINE ZAPLEVEL(PRED)=
BEGIN
!ROUTINE ZEROES THE LEVEL FIELD FOR ALL NODES ON ALL
!PATHS BETWEEN PRED (A STATEMENT NODE) AND .P[PREDOM].
!P IS SET UP EXTERNALLY TO THIS ROUTINE. AN EFFORT
!IS MADE NOT TO RECURSE FOR STRAIGHT LINE PATHS,
!THUS MINIMIZING THE STACK REQUIRED.
MAP PHAZ2 PRED;
OWN NODE,SINGLPRED;
MAP PHAZ2 NODE;
![575] REMOVE THE LOCAL SYMBOL PLSTPTR SO THAT LESS STACK SPACE
![575] WILL BE USED DURING RECURSIVE CALLS OF THIS ROUTINE. THE
![575] VARIABLE PRED WILL NOW DO DOUBLE DUTY - COMING IN AS THE
![575] STATEMENT NODE, AND BEING USED TO CYCLE THROUGH ALL OF THE
![575] PREDECESSORS OF THE ORIGINAL PARAMETER. THIS CHANGE
![575] REDUCES THE STACK SPACE USED FROM 4 TO 3 LOCATIONS PER CALL
![575] TO THIS ROUTINE.
%575% PRED_.PRED[PREDPTR];
![575] PRED IS NOW THE PTR TO THE PREDECESSOR LIST OF THE ORIGINAL PRED
!FOR EACH PREDECESSOR ON THE LIST
%575% WHILE .PRED[CESLNK] NEQ 0 DO
BEGIN
!POINTER TO AN ACTUAL PREDECESSOR
%575% NODE_.PRED[CESSOR];
!SET THE FLAG THAT HELPS US ITERATE INSTEAD OF RECURSING
SINGLPRED_1;
!NOW ITERATE
WHILE .SINGLPRED DO
BEGIN
!IS THIS NODE ELIGIBLE, I.E.
! IS IT NOT P[PREDOM]
! DOES THE LEVEL FIELD NEED TO BE ZEROED
IF .NODE NEQ .P[PREDOM] AND .NODE[LEVEL] NEQ 0 THEN
BEGIN
!YES TEH NODE IS ELIGIBLE
!ZERO THE LEVEL FIELD
NODE[LEVEL]_0;
!NOW SEE IF IT HAS A SINGLE PREDECESSOR
IF (QQ_ONLYONEPRED(.NODE)) NEQ 0 THEN
!SET NODE TO THE PREDECESSOR
!RETURNED BY ONLYONEPRED AND
!ITERATE
NODE_.QQ
ELSE
BEGIN
!THERE IS MORE THAN ONE
!PREDECESSOR, SO WE MUST RECURSE
ZAPLEVEL(.NODE);
!RESET THE FLAG INDICATING ITERATION
!RATHER THAN RECURSION.
SINGLPRED_0;
END;
END ELSE
!THE NODE IS NOT ELIGIBLE
!RESET FLAG TO STOP LOOP
SINGLPRED_0;
END; !WHILE ON SONGLPRED
!NOW LOOK AT THE NEXT PREDECESSOR ON THE LIST
%575% PRED_.PRED[CESLNK];
END; !WHILE THERE ARE PREDECESSORS
END; ! of ZAPLEVEL
ROUTINE SWAMP=
BEGIN
!MAKE AND FOLLOW A MOORE FLOOD ORDERING OF NODES BETWEEN
!P AND P[PREDOM] SETTING BITS IN THE MASK AT P FOR
!VARIABLES CHANGED AT ANY OF THE NODES TRAVERSED.
! The main thing to remember about SWAMP is that it simply
! follows predecessor pointers up from P, without looking at
! or backing up beyond the immediate pre-dominator of P. For
! each statement it visits, it sets ACC bits in P for all
! selected variables which potentially become redefined at
! that statement. It doesn't look at the immediate
! pre-dominator of P, nor does it look at P itself.
MAP PHAZ2 P:T;
OWN PHAZ2 TAIL;
TAIL_HEAD_.P;
!WHILE CONDITION WILL STOP ON ZERO OR THE FIELD SET TO 1 (PROCESSED MARK).
WHILE .HEAD GTR #1000 DO
BEGIN
!PROCESS THE PREDECESSORS OF HEAD
T_.HEAD[PREDPTR];
WHILE .T[CESLNK] NEQ 0 DO
BEGIN
PA_.T[CESSOR];
!PA IS NOW A REAL SUCCESSOR
!IF IT IS NOT ALREADY DONE OR THE PREDOMINAATOR OF P
!PROCESS IT
IF .PA NEQ .P[PREDOM] THEN
BEGIN
IF .PA[LEVEL] EQL 0 THEN
BEGIN
!NOTE PA PROCESSED BY SETTING LEVEL NON-ZERO
PA[LEVEL]_1;
!ADD IT TO THE END OF THE CHAIN
TAIL[LEVEL]_.PA;
!UPDATE THE TAIL OF THE CHAIN
TAIL_.PA;
!SET THE %&$#% BIT
DEFCHANGE(.PA);
END;
END;
T_.T[CESLNK];
END;
HEAD_.HEAD[LEVEL];
END; !WHILE ON HEAD;
!IF P'S PREDOMINATOR IS A DO STATEMENT WHICH ISN'T TOP, THEN
!SET THE BITS IN P FOR ALL VARS CHANGED IN THE LOOP.
PA_.P[PREDOM];
IF (.PA NEQ .TOP) AND (.PA[SRCID] EQL DOID) THEN
DEFCHANGE(.PA);
END; ! of SWAMP
ROUTINE DEF1=
!++
! DEF1 is used to set the ACC bits for each statement in the current
! DO-loop. Each ACC bit (bits 0-32 are used) corresponds to the
! variable pointed to by that entry in CHOSEN. These bits are later
! used by DEFPT to determine the actual definition points.
!
! The basic idea is that the ACC bit for a variable V in a statement S
! will be set if V can potentially become redefined along some path from
! the immediate pre-dominator of S to S. This path does not include the
! immediate pre-dominator of S, but it may include loops through S.
! However, it generally doesn't include S itself. This should become
! clearer when the actual algorithm is described.
!--
BEGIN
MAP PHAZ2 T;
!
!INITIALIZE ACC FOR DEFINITION POINT CALCULATION
!DETERMINE IF THERE IS AN INTERFERING
!ASSIGNMENT BETWEEN NODE AND IMMEDIATE
!PREDOMINATOR
!THE INITIALIZATION ALGORITHM IS:
!1. LOOK AT ALL IMMEDIATE PREDECESSORS OF A NODE
!2. IF THE PREDECESSOR IS NOT THE PREDOMINATOR THEN
! SET THE BIT IN THE MASK WHICH CORRESPOND TO ANY
! VARIABLE ASSIGNED A VALUE AT THAT PREDECESSOR.
!A SPECIAL CASE IS THE FIRST STATEMENT AFTER THE DO LOOP
!TO PREVENT COMPUTATIONS THAT ARE COMPOSED OF VARIABLES
!ASSIGNED IN THE LOOP FROM ERRONEOUSLY MOVING OUTSIDE THE LOOP
!THIS STATEMENT WILL HAVE THE BITS SET FOR ALL THE VARIABLES
!ON THE DOCHNGL LIST TOO.
MAP PHAZ2 TOP;
EXTERNAL CSTMNT,ISN;
LOCAL BASE ITM;
MAP BASE CSTMNT;
!
P_.TOP;
P[ACC]_0;
P_.TOP[BUSY];
! DEF1 first makes some special checks on TOP and the
! statement after it, setting ACC bits (by a call to SETIT) in
! the statement following the DO statement for all variables
! changed by the DO-loop (if there is one). This is to
! prevent illegal motion out of loops.
!THE SPECIAL CASE
IF .P EQL .TOP[SRCLINK] THEN
BEGIN
LOCAL SAVP;
SAVP_.P;
!A SPECIAL CASE OF THE SPECIAL CASE
!IF THIS IS A DO LOOP SET THE BITS ON THE
!CONTINUE AND NOT ON THE LOOP
IF .P[SRCID] EQL DOID THEN
BEGIN
P_.P[DOLBL];
P_.P[SNHDR];
END;
ITM_.TOP[DOCHNGL];
WHILE .ITM NEQ 0 DO
BEGIN
!DOCHNGL IS A LINKED LIST OF VARIABLES
!CHANGED IN THIS LOOP.
!THE LEFT HALF OF THE WORD
!POINTS TO THE VARIABLE, THE RIGHT
!HALF TO THE NEXT LIST ITEM. IT IS
!TERMINATED WITH A ZERO
SETIT(.ITM[LEFTP]);
ITM_.ITM[RIGHTP];
END;
IF .TOP[SRCID] EQL DOID THEN SETIT(.TOP[DOSYM]);
!RESTORE SAVED VALUE OF P AND PROCEED
P_.SAVP;
END;
! It then walks walks the module OWN P from TOP[BUSY] to the
! end of the BUSY list.
!THE CAST OF CHARACTERS FOR THE NEXT WHILE LOOP IS
!P THE STATEMENT ON WHICH MASK BITS ARE INITIALIZED
!IF THE PREDECESSOR IS THE PREDOMINATOR SET NO BITS
!IF NOT ZERO THE LEVEL FIELD OF THE
!OPTIMIZERS WORDS AND USE IT TO FLOOD AND SET BITS
!FOR ALL VARIABLES ASSIGNED AT ALL NON_PREDOMINATING
!PREDECESORS.
!FOR ALL STATEMENTS
DO
BEGIN
! If P points to a DO statement, it calls SETIT for
! each variable on the change-list (DOCHNGL) for that
! DO statement.
!FOR A DO LOOP THAT IS NOT TOP SET THE BITS ON THE
!DO LOOP TOO INCASE SOMETHING BELOW THE TERMINATOR
!IS NOT PREDOMINATED BY THE TERMINATOR
IF .P NEQ .TOP AND .P[SRCID] EQL DOID THEN
BEGIN
ITM_.P[DOCHNGL];
WHILE .ITM NEQ 0 DO
BEGIN
!DOCHNGL IS A LINKED LIST
!THE LEFT HALF OF THE WORD
!POINTS TO THE VARIABLE, THE RIGHT
!HALF TO THE NEXT LIST ITEM. IT IS
!TERMINATED WITH A ZERO
SETIT(.ITM[LEFTP]);
ITM_.ITM[RIGHTP];
END;
END;
! Then, regardless of what P points to, it does the
! following:
!TRY TO ELIMINATE SOME TIME AND EFFORT BY NOT
!DOING THIS FOR A NODE IF IT HAS 1 PREDECESSOR
!WHICH (BY DEFINITION) IS ITS PREDOMINATOR
!SET THE LEVEL FIELD OF P[PREDOM] TO BE NON-ZERO
! The LEVEL field of the immediate pre-dominator of P
! is set to 1.
T_.P[PREDOM];
T[LEVEL]_1;
!NOW START CHECKING ON PREDECESSORS
T_.P[PREDPTR];
!T IS A POINTER TO THE PREDECESSOR LIST
! The module OWN PA is set to the second predecessor
! link of P (i.e., the CESLNK field of the PREDPTR
! field of P).
PA_.T[CESLNK];
!PA POINTS TO THE NEXT LINK
T_.T[CESSOR];
!T POINTS TO FIRST PREDECESSOR OF P
! Make a test to see if we can avoid calling SWAMP
! (the routine which sets ACC bits in the general
! case). If T is the immediate pre-dominator of P,
! and if PA[CESLNK] is zero (meaning PA must point to
! RGRAPH and T is the only predecessor of P), then it
! can avoid calling SWAMP. In this case, it makes one
! more check to see if PA[CESLNK] is zero and T points
! to a DO statement. If so, it calls DEFCHANGE (which
! calls DEFWORK with DISPIX set to 1), passing it T.
!MAKE SURE THERE ARE NONE OTHERS
!PA POINTS TO NEXT LINK WORD. IF THERE IS ONLY ONE
!PA IS A POINTER TO A WORD OF ZEROES.
!THIS IS A DOUBLE SAFE CHECK. IF BLISS EVER DOES BETTER
!ON BOOLEANS IT WILL ELIMINATE BUMMERS FAST.
IF .T NEQ .P[PREDOM] OR .PA[CESLNK] NEQ 0
THEN
BEGIN
! If it cannot avoid the call to SWAMP, it first sets
! the LEVEL field of P to zero. It then calls
! ZAPLEVEL, which zeros the LEVEL field of all
! statements on all paths between the immediate
! pre-dominator of P and P. Finally, it calls SWAMP
! to actually set the ACC bits. To do this, SWAMP
! uses the LEVEL field to create a linked list, which
! is basically a reverse BUSY list which stops at the
! immediate pre-dominator of P. It first sets HEAD
! and TAIL to P. Then it loops. For each predecessor
! PA of HEAD which isn't the immediate pre-dominator
! of P and which has a zero LEVEL field (i.e., it
! hasn't been visited yet), it sets the LEVEL field to
! one and the LEVEL field of TAIL to point to PA, then
! resets TAIL to point to PA. Finally, it calls
! DEFCHANGE, which will set the ACC bits in P for all
! selected variables changed in PA (DEFCHANGE merely
! calls DEFWORK with DISPIX set to one). When it's
! finished with all predecessors of HEAD, it resets
! HEAD to HEAD[LEVEL] and loops. It decides it's
! finished when HEAD is less than or equal to 1000
! (octal). This is meant to distinguish pointers from
! the other values of LEVEL (which should be zero and
! 1, unless ZAPLEVEL isn't working properly).
! Finally, after it has finished looping, SWAMP checks
! to see if the immediate pre-dominator of P is a DO
! statement other than TOP. If so, it calls DEFCHANGE
! to set ACC bits in P for all variables potentially
! changed by that DO statement.
!TO INSURE AGAINST A FLUKE
P[LEVEL]_0;
ZAPLEVEL(.P);
SWAMP();
END
!ON THE OTHERHAND IF THIS IS A SINGLE PREDECESSOR
!AND IT IS THE PREDOMINATOR AND IT IS A DO LOOP
!WE WANT TO SET THE BITS FOR ALL VARIABLES IN THE LOOP
ELSE
IF .PA[CESLNK] EQL 0 AND .T[SRCID] EQL DOID THEN
DEFCHANGE(.T);
P_.P[BUSY];
END UNTIL .P EQL 0;
! After DEF1 has looped through all statements, it calls
! SPECBRCHK to set ACC bits under a number of special cases to
! prevent bad code from being generated.
!CALL ROUTINE TO CHECK BRANCHES THAT SET VALUES
!SEE COMMENTS IN CALLED ROUTINE FOR DETAILS
SPECBRCHK();
END; ! of DEF1
MAP PHAZ2 PB;
ROUTINE SETGOTVAL(VAR)=
BEGIN
!THE GLOBAL TREEPTR POINTS TO A SYMBOL TABLE ENTRY.
!IF IT EQUALS VAR THEN SET GOTVAL TO 1
%2372% MAP BASE VAR;
%2372% IF .VAR[OPRCLS] EQL SUBSTRING
%2372% THEN VAR = .VAR[ARG4PTR]; ! Get get full string
%2372%
%2372% IF .VAR[OPRCLS] EQL ARRAYREF
%2372% THEN VAR = .VAR[ARG1PTR]; ! Get array name
%2372%
%2372% IF .VAR[OPRCLS] NEQ DATAOPR
%2372% THEN RETURN;
%2372%
%2372% IF.VAR[OPERSP] EQL CONSTANT OR .VAR[OPERSP] EQL FORMLFN
%2372% THEN RETURN;
%2372%
%2372% IF .VAR EQL .TREEPTR THEN GOTVAL = 1;
END; ! of SETGOTVAL
GLOBAL ROUTINE READHERE(IOLSTT)=
%(**********************************************************************
ROUTINE TO DETERMINE IF A VARIABLE WAS INITIALIZED
AT THE IOLSCLS ELEMENT IOLSTT
**********************************************************************)%
BEGIN
EXTERNAL INPFLAG;
MAP BASE IOLSTT;
CASE .IOLSTT[OPERSP] OF SET
%DATACALL% BEGIN
LOCAL BASE ELEM;
ELEM_.IOLSTT[DCALLELEM];
%2372% IF .INPFLAG THEN (.SETSEL[.DISPIX])(.ELEM);
%2372% FCNLOK(.ELEM);
END;
%SLISTCALL% BEGIN
LOCAL BASE ELEM;
%1034% IF NOT .INPFLAG THEN RETURN;
ELEM_.IOLSTT[SCALLELEM];
%2372% (.SETSEL[.DISPIX])(.ELEM);
END;
%IOLSTCALL% BEGIN
LOCAL BASE IOELEM;
%1034% IF NOT .INPFLAG THEN RETURN;
IOELEM_.IOLSTT[IOLSTPTR];
WHILE .IOELEM NEQ 0 DO
BEGIN
READHERE(.IOELEM);
IOELEM_.IOELEM[CLINK]
END
END;
%E1LISTCALL% BEGIN
%1034% IF NOT .INPFLAG THEN RETURN;
LOKELIST(.IOLSTT[ELSTPTR])
END;
%E2LISTCALL% BEGIN
%1034% IF NOT .INPFLAG THEN RETURN;
LOKELIST(.IOLSTT[ELSTPTR])
END
TES
END; ! of READHERE
GLOBAL ROUTINE SETGTRD(IOLSTT)=
BEGIN
!EXAMINE THE IOLIST POINTED TO BY IOLSTT FOR
!A SINGLE VARIABLE TREEPTR.
EXTERNAL INPFLAG;
MAP BASE IOLSTT;
WHILE .IOLSTT NEQ 0 DO
BEGIN
IF .IOLSTT[OPRCLS] NEQ STATEMENT THEN
![1034] Don't forget function calls in I/O statements
%1034% READHERE(.IOLSTT)
ELSE
IF .IOLSTT[OPRS] EQL ASGNOS THEN
BEGIN
%2372% (.SETSEL[.DISPIX])(.IOLSTT[LHEXP]);
%2372%
%2372% ! The left hand side should never be an array
%2372% ! reference, but just in case this changes,
%2372% ! we'll check for function references anyway.
%2372% ! The right hand side should always be
%2372% ! checked.
%2372%
%2372% FCNLOK(.IOLSTT[LHEXP]); ! Check LHS just in case
%2372% FCNLOK(.IOLSTT[RHEXP]); ! RHS must always be checked
END ELSE
!TAKE NOTE OF THE FACT THAT THE DO LOOP
!INDEX CHANGES IF THIS IS A LOOP
IF .IOLSTT[OPRS] EQL DOOS THEN
(.SETSEL[.DISPIX])(.IOLSTT[DOSYM]);
IOLSTT_.IOLSTT[CLINK];
END
END; ! of SETGTRD
ROUTINE HEREVALUED(STMT,VAR)=
BEGIN
!SEE IF THE VARIABLE VAR GETS A VALUE AT STATEMENT STMT.
!IF SO RETURN 1 ELSE RETURN 0
MAP BASE VAR:STMT;
!SET TREEPTR TO VAR FOR USE IN DEEPER ROUTINES
TREEPTR_.VAR;
!INITIALIZE GOTVAL TO 0
GOTVAL_0;
!SET DISPIX
DISPIX_2;
DEFWORK(.STMT);
.GOTVAL
END; ! of HEREVALUED
GLOBAL ROUTINE GETDEF(CNODE,STMT,CDEFPT)=
BEGIN
EXTERNAL INDVAR; !THE DO INDUCTION VARIABLE
LOCAL PDE; !A TEMPORARY
REGISTER PHAZ2 TSTMT;
!COMPUTE ACTUAL DEFINITION POINT OF A LEAF NODE
!THIS ALGORITHM IS:
!LOOK UP THE VARIABLE IN QUESTION (CNODE)
!IF IT IS IN CHOSEN THEN CREATE A 36 BIT MASK WHICH HAS
!THE BIT CORRESPONDING TO THE VARIABLE ON IN THE MASK.
!STARTING WITH THE ACC OF THE CURRENT STATEMENT AND
!THIS MASK WITH SUCCESSIVE ACC FIELDS ON THE PREDOMINATOR
!CHAIN OF THE STATEMENT UNTIL THE MASK IS NOT ZERO. THIS
!INDICATES AN INTERFERRING ASSIGNMENT IN THAT INTERVAL.
!RETURN THE DEFINITION POINT AS THIS PLACE.
EXTERNAL PHAZ2 TOP;
MAP PHAZ2 CNODE;
!
IF .CNODE[OPRCLS] EQL REGCONTENTS THEN RETURN(.TOP);
IF .CNODE[OPRCLS] NEQ DATAOPR THEN RETURN(0)
ELSE
!IT SHOULD NOT BE A CONSTANT OR FORMAL FUNCTION
IF .CNODE[OPERSP] EQL CONSTANT OR
.CNODE[OPERSP] EQL FORMLFN THEN RETURN(.LENTRY);
IF .CNODE EQL .INDVAR THEN RETURN(.TOP);
IF NOT .CNODE[IDDEF] THEN
BEGIN
IF NOT .MOREFLG THEN
BEGIN
! CNODE[IDUSED]_1; %2427 removed%
IF .CNODE[IDATTRIBUT(INCOM)] OR
.CNODE[IDATTRIBUT(INEQV)] THEN
RETURN(.STMT)
ELSE
!IF THE DO STATEMENT IS LABELED
!WE MIGHT BE IN ROUTBLE IF WE SAY LENTRY
!SPECIALLY IF LENTRY IS AN ASSIGNMENT OF THAT
!VARIABLE TO A CONSTANT (I.E. IT WILL
!GET PROPAGATED.
RETURN(IF .TOP[SRCLBL] NEQ 0 THEN .TOP ELSE .LENTRY);
END;
END ELSE
BEGIN
!JUST TO MAKE SURE AVOID EQUIVALENCE LIKE THE PLAQUE.
!EQUIVALENCE LISTS ARE NOT PROCESSED UNTIL REGISTER
!ALLOCATION
IF .CNODE[IDATTRIBUT(INCOM)] THEN RETURN(.STMT);
IF .CNODE[IDATTRIBUT(INEQV)] THEN RETURN(.STMT);
PDE_LOOKUP(.CNODE);
IF .PDE GTR 32 THEN RETURN .CDEFPT;
MASK_0;
MASK_SETBIT(.MASK,.PDE);
TSTMT_.STMT; !PT TO STATEMENT
WHILE 1 DO
BEGIN
IF (.TSTMT[ACC] AND .MASK) NEQ 0 THEN RETURN(.TSTMT);
%2372% IF .TSTMT EQL .TOP
%2372% THEN
%2372% BEGIN ! We've reached TOP
%2372%
%2372% ! Check to see if the DO-loop control
%2372% ! expression might change CNODE (i.e., with a
%2372% ! function reference). If so, we can't return
%2372% ! LENTRY, but must instead return
%2372% ! TOP[SRCLINK], which is the CONTINUE
%2372% ! statement after TOP. Note that TOP may be a
%2372% ! CONTINUE if we're at the top-level, in which
%2372% ! case we're safe.
%2372%
%2372% IF .TOP[SRCID] EQL DOID
%2372% THEN
%2372% BEGIN ! TOP is a genuine DO statement
%2372%
%2372% TREEPTR = .CNODE; ! Test CNODE
%2372% GOTVAL = 0; ! Initialize result
%2372% DISPIX = 2; ! Use SETGOTVAL
%2372% FCNLOK(.TOP[DOLPCTL]); ! Look for FNCALLs
%2372% IF .GOTVAL THEN RETURN .TOP[SRCLINK];
%2372%
%2372% END; ! TOP is a genuine DO statement
%2372%
%2372% RETURN .LENTRY; ! Safe to return LENTRY
%2372%
%2372% END; ! We've reached TOP
IF HEREVALUED(.TSTMT,.CNODE) THEN RETURN(.TSTMT);
TSTMT_.TSTMT[PREDOM];
END;
END;
.CDEFPT !JUST IN CASE
END; ! of GETDEF
ROUTINE VDEFPT(PNODE)=
BEGIN
!WALK AN EXPRESSION TREE COMPUTING DEFINITION POINTS OF LEAFS (VARIABLES)
EXTERNAL ARGCONE;
REGISTER PHAZ2 P;
P_.PNODE;
CASE .P[OPRCLS] OF SET
!BOOLEAN
BEGIN
IF .P[A1VALFLG] THEN
P[DEFPT1]_GETDEF(.P[ARG1PTR],.PAE,.P[DEFPT1])
ELSE
VDEFPT(.P[ARG1PTR]);
IF .P[A2VALFLG] THEN
P[DEFPT2]_GETDEF(.P[ARG2PTR],.PAE,.P[DEFPT2])
ELSE
VDEFPT(.P[ARG2PTR]);
END;
!DATAOPR
BEGIN END;
!RELATIONAL
BEGIN
IF .P[A1VALFLG] THEN
P[DEFPT1]_GETDEF(.P[ARG1PTR],.PAE,.P[DEFPT1])
ELSE
VDEFPT(.P[ARG1PTR]);
IF .P[A2VALFLG] THEN
P[DEFPT2]_GETDEF(.P[ARG2PTR],.PAE,.P[DEFPT2])
ELSE
VDEFPT(.P[ARG2PTR]);
END;
!FNCALL
BEGIN
LOCAL ARGUMENTLIST AG;
AG_.P[ARG2PTR];
INCR I FROM 1 TO .AG[ARGCOUNT] DO
VDEFPT(.AG[.I,ARGNPTR]);
!GIVE ARG A DEFPT ON SINGLE
!ARGUMENT LIBRARY FUNCTIONS
IF ARGCONE(.P) THEN
P[DEFPT2]_GETDEF(.AG[1,ARGNPTR],.PAE,.P[DEFPT2]);
END;
!ARITHMETIC
BEGIN
IF .P[A1VALFLG] THEN
P[DEFPT1]_GETDEF(.P[ARG1PTR],.PAE,.P[DEFPT1])
ELSE
VDEFPT(.P[ARG1PTR]);
IF .P[A2VALFLG] THEN
P[DEFPT2]_GETDEF(.P[ARG2PTR],.PAE,.P[DEFPT2])
ELSE
VDEFPT(.P[ARG2PTR]);
END;
!TYPCNV
IF .P[A2VALFLG] THEN
P[DEFPT2]_GETDEF(.P[ARG2PTR],.PAE,.P[DEFPT2])
ELSE
VDEFPT(.P[ARG2PTR]);
!ARRAYREF
BEGIN
IF .P[A2VALFLG] THEN
IF .P[ARG2PTR] EQL 0 !IF ITS A CONSTANT SS
THEN !WE WOULD LIKE IT TO BE LENTRY
!BUT THAT BOMBS AND WE WANT THIS IN V4A
P[DEFPT2]_.PAE !SO SETTLE FOR WHAT WORKS
ELSE
P[DEFPT2]_GETDEF(.P[ARG2PTR],.PAE,.P[DEFPT2])
ELSE
VDEFPT(.P[ARG2PTR]);
!LOOK AT ARRAYNAME TOO
P[DEFPT1]_GETDEF(.P[ARG1PTR],.PAE,.P[DEFPT1]);
END;
!CMNSUB
IF .P[A2VALFLG] THEN
P[DEFPT2]_GETDEF(.P[ARG2PTR],.PAE,.P[DEFPT2])
ELSE
VDEFPT(.P[ARG2PTR]);
!NEGNOT
IF .P[A2VALFLG] THEN
P[DEFPT2]_GETDEF(.P[ARG2PTR],.PAE,.P[DEFPT2])
ELSE
VDEFPT(.P[ARG2PTR]);
!SPECOP
IF .P[A1VALFLG] THEN
P[DEFPT1]_GETDEF(.P[ARG1PTR],.PAE,.P[DEFPT1])
ELSE
VDEFPT(.P[ARG1PTR]);
!FIELDREF
BEGIN END; !NOT RELEASE 1
!STORECLS
BEGIN END;
!REGCONTENTS
!IT MUST BE THE INDUCTION VARIABLE
BEGIN END; !SHOULDNT GET HERE
!LABOP
BEGIN END;
!STATEMENT
BEGIN END;
!IOLSCLS
BEGIN END;
!INLINFN
BEGIN
IF .P[A1VALFLG] THEN
P[DEFPT1]_GETDEF(.P[ARG1PTR],.PAE,.P[DEFPT1])
ELSE
VDEFPT(.P[ARG1PTR]);
IF .P[ARG2PTR] NEQ 0 THEN
BEGIN
IF .P[A2VALFLG] THEN
P[DEFPT2]_GETDEF(.P[ARG2PTR],.PAE,.P[DEFPT2])
ELSE
VDEFPT(.P[ARG2PTR]);
END;
END;
%2372% !SUBSTRING
%2372% BEGIN
%2372% LOCAL BASE ARG4; ! Holds ARG4PTR
%2372%
%2372% IF .P[A1VALFLG]
%2372% THEN P[DEFPT1] = GETDEF(.P[ARG1PTR],.PAE,.P[DEFPT1])
%2372% ELSE VDEFPT(.P[ARG1PTR]);
%2372%
%2372% IF .P[A2VALFLG]
%2372% THEN P[DEFPT2] = GETDEF(.P[ARG2PTR],.PAE,.P[DEFPT2])
%2372% ELSE VDEFPT(.P[ARG2PTR]);
%2372%
%2372% ARG4 = .P[ARG4PTR];
%2372% IF .ARG4[OPRCLS] EQL DATAOPR
%2372% THEN P[DEFPTSS] = GETDEF(.ARG4,.PAE,.P[DEFPTSS])
%2372% ELSE VDEFPT(.ARG4);
%2372% END;
%2372% !CONCATENATION
%2372% BEGIN
%2372% LOCAL ARGUMENTLIST AG;
%2372% AG = .P[ARG2PTR];
%2372%
%2372% INCR I FROM 2 TO .AG[ARGCOUNT] ! Skip first argument
%2372% DO VDEFPT(.AG[.I,ARGNPTR]);
%2372% END;
TES;
END; ! of VDEFPT
ROUTINE DEFPT(STMT)=
BEGIN
!***************************************************************
! After interfering assignment information is collected, compute
! definition points for leaves and expressions under the
! statement. The defpts are recorded at the statement level.
! VDEFPT actually computes the defpts for the expressions and
! leaves.
!***************************************************************
%2204% ! Rewritten by TFV, on 20-Jun-83
EXTERNAL IOSTDFPT; !COMPUTE DEFPTS IN I/O LIST <IOPT>
REGISTER ARGUMENTLIST AG;
MAP
BASE TOP,
PHAZ2 STMT;
PAE = .STMT; !PAE USED IN LOWER ROUTINES
IF .STMT[SRCID] EQL ASGNID
THEN
BEGIN ! Assignment
P = .STMT[LHEXP];
%2372% IF .P[OPRCLS] NEQ DATAOPR
THEN VDEFPT(.P);
P = .STMT[RHEXP];
IF .P[OPRCLS] EQL DATAOPR
%2372% THEN STMT[OPDEF] = GETDEF(.P,.STMT,.STMT[OPDEF])
ELSE VDEFPT(.P);
END ! Assignment
ELSE IF .STMT[SRCID] EQL DOID
THEN
BEGIN ! DO
! Skip it if this is the current DO we are processing
IF NOT .STMT[FLCWD] AND .STMT[SRCOPT] NEQ 0
THEN
BEGIN
P = .STMT[DOLPCTL];
IF .P[OPRCLS] NEQ DATAOPR
THEN VDEFPT(.P);
END;
END ! DO
ELSE IF .STMT[SRCID] EQL IFLID
THEN
BEGIN ! Logical IF
P = .STMT[LIFEXPR];
IF .P[OPRCLS] NEQ DATAOPR
THEN VDEFPT(.P);
%2372% ! Note that STMT[LIFSTATE] is also on the BUSY list
END ! Logical IF
ELSE IF .STMT[SRCID] EQL IFAID
THEN
BEGIN ! Arithmetic IF
P = .STMT[AIFEXPR];
IF .P[OPRCLS] NEQ DATAOPR
THEN VDEFPT(.P);
END ! Arithmetic IF
ELSE IF .STMT[SRCID] EQL CALLID
THEN
BEGIN ! CALL
IF .STMT[CALLIST] NEQ 0
THEN
BEGIN
AG = .STMT[CALLIST];
INCR K FROM 1 TO .AG[ARGCOUNT] DO
BEGIN
PB = .AG[.K,ARGNPTR];
IF .PB[OPRCLS] NEQ DATAOPR
THEN VDEFPT(.PB);
END;
END;
END ! CALL
ELSE IF .STMT[SRCID] GEQ READID AND .STMT[SRCID] LEQ REREDID
THEN
BEGIN
IF .STMT[IOLIST] NEQ 0
THEN IOSTDFPT(.STMT);
END;
END; ! of DEFPT
GLOBAL ROUTINE DEFDRIV=
!++
! The top-level routine in DEFPT is DEFDRIV. This routine is called from
! MRP2 to calculate definition points for the current DO-loop. It requires
! the forward and reverse program graphs for the current DO-loop, as well
! as the pre- and post-dominators for the current DO-loop.
!
! There are basically three passes to the definition point algorithm. The
! first pass (DEF0) selects up to 32 variables for definition point
! analysis. The second pass (DEF1) sets the ACC bits in the optimizer
! words for each statement indicating which of those variables become
! redefined on some path between that statement's immediate pre-dominator
! and that statement (possibly passing through that statement more than
! once). The third pass (DEFPT) actually fills in the definition points.
! This three-pass process repeats for each set of 32 variables until all
! variables in the currentDO-loop have been processed.
!--
BEGIN
!CONTROLER FOR THE DEFINITION POINT ALGORITHM
EXTERNAL CSTMNT,ISN;
EXTERNAL UNIQVAL;
MAP PHAZ2 CSTMNT:TOP;
UNIQVAL_0;
CHNGLST_0;
MOREFLG_1;
P_.TOP[BUSY];
! If 32 variables were selected, loop back to step 2 to process the
! next set of 32.
WHILE .MOREFLG DO
BEGIN
T_0;
!EACH ROUTINE IS A SEPARATE PASS OVER THE
!ENCODED SOURCE FOR THE CURRENT LOOP
! Call DEF0 to select up to 32 variables. Each selected
! variable is added to the list of currently selected
! variables. It is also marked as having been selected so
! it never becomes selected again (for example, in the next
! batch of 32 variables that are selected).
DEF0(); !PICK 32 VARIALES
!IF THERE WERE NO VARIABLES (WRITE STATEMENT ONLY,
!FOR EXAMPLE, QUIT HERE
! If some variables were selected, call DEF1 to set the ACC
! bits indicating where they become redefined.
IF .T EQL 0 THEN
MOREFLG_0
ELSE
BEGIN
DEF1(); !INITIALIZE THE MASK
END;
!NOW WE ARE READY TO ACTUALLY GET DEFINITION POINTS
! Visit all statements in the current DO-loop in BUSY list
! order. For each statement, call DEFPT to fill in
! definition points for all selected variables and
! constants (this is done even if DEF1 is skipped so
! constants don't get missed).
CSTMNT_.TOP[BUSY]; !SKIP CURRENT LOOP
WHILE .CSTMNT NEQ 0 DO
BEGIN
ISN_.CSTMNT[SRCISN];
DEFPT(.CSTMNT);
CSTMNT_.CSTMNT[BUSY];
END;
P_.LSTVAR;
END;
END; ! of DEFDRIV
ROUTINE CHKNAML(NLPTR)=
BEGIN
!ROUTINE TO CHECK A NAME LIST.
!IT:
! 1. DETERMINES IF NLPTR POINTS TO A NAMELIST NAME
! SYMBOL TABLE ENTRY
! 2. IF SO, IT SEARCHS THE LINKED LIST OF NAMELIST
! STATEMENTS FOR THE MATCHING NAMELIST
! 3. IT THEN SETS THE BITS (SELECTIT,SETIT,SETGOTVAL)
! USING THE DISPIX SET UP BY THE CALLER
OWN BASE NPTR;
LABEL NLLOK;
MAP BASE NLPTR;
EXTERNAL NAMLPTR;
BIND M1RH=#000000777777; !-1 IN RIGHT HALF WORD
!FIRST SEE IF NLPTR POINTS TO A NAMELIST SYMBOL TABLE ENTRY
IF .NLPTR NEQ 0 AND .NLPTR NEQ M1RH THEN
BEGIN
IF .NLPTR[IDATTRIBUT(NAMNAM)] THEN
BEGIN
NPTR_.NLPTR[IDCOLINK]; !GET POINTER
!WE HAVE LOOKED AT LIST WE HAVE TO QUIT IF
!NPTR IS ZERO
IF .NPTR EQL 0 THEN RETURN;
!NPTR POINTS TO THE NAME LIST STATEMENT ENTRY
INCR I FROM 0 TO .NPTR[NAMCNT]-1 DO
%1010% (.SETSEL[.DISPIX])(.(.NPTR[NAMLIST]+.I)<RIGHT>);
END;
!ITS NOT A NAME LIST NAME
END;
END; ! of CHKNAML
ROUTINE SETONSUC(STMT)=
BEGIN
!COMPANION ROUITNE TO SPECBRCHK
!OR THE MASK OF STMT INTO EACH OF ITS SUCCESSORS IF IT IS NOT ZERO
REGISTER SUCLSTPTR,T;
MAP PHAZ2 STMT:SUCLSTPTR:T;
LOCAL PHAZ2 SAVEP;
LOCAL ACCSAVE;
%1113% ACCSAVE _ .STMT[ACC]; ! SAVE ACC BITS
%2372% ! Edit 1113 was making a bad test, since the last link in
%2372% ! every successor list is FGRAPH. This test has been removed.
%2372% ! Perhaps a better test will be added someday.
%1113% SAVEP _ .P; ! SAVE P, ARG TO DEFCHANGE
%1113% P _ .STMT; ! SET ACC BITS IN STMT FOR EACH
%1113% DEFCHANGE(.STMT); ! VARIABLE ASSIGNED BY STMT
%1113% P _ .SAVEP; ! RESTORE P
IF .STMT[ACC] NEQ 0 THEN
BEGIN
!SET IT ON THE POST DOMINATOR JUST TO BE 10000000%
!SURE
T_.STMT[POSTDOM];
T[ACC]_.T[ACC] OR .STMT[ACC];
SUCLSTPTR_.STMT[SUCPTR];
!FOLLOW SUCCESSOR CHAIN
WHILE .SUCLSTPTR[CESLNK] NEQ 0 DO
BEGIN
!LOOK AT ACTUAL SUCCESSOR
T_.SUCLSTPTR[CESSOR];
T[ACC]_.T[ACC] OR .STMT[ACC];
!NEXT SUCCESSOR
SUCLSTPTR_.SUCLSTPTR[CESLNK];
END; !WHILE
END;
%1113% STMT[ACC] _ .ACCSAVE;
END; ! of SETONSUC
ROUTINE SPECBRCHK=
BEGIN
!ROUTINE CHECKS ALL BRANCHING STATEMENTS.
!IF SOMETHING IS DEFINED AT A BRANCHING STATEMENT
!THE APPROPRIATE BIT MUST BE SET ON THE IMMEDIATE
!SUCCESSORS OF THE BRANCH IN ORDER TO ASSURE THAT
!CASES SUCH AS THE FOLLOWING DO NOT
!CAUSE INCORRECT CODE.
!EXAMPLE:
! A LOGICAL IF (CONTAINING A FUNCTION) CALL IS THE
! DEFINITION POINT OF AN ARGUMENT TO THE FUNCTION CALL.
! WITHOUT THIS ADDITIONAL PROCESSING, IF THE
! MOTION PLACE OF AN EXPRESSION WAS THE LOGICAL IF
! THE COMPUTATION WOULD BE INSERTED ONLY ON THE
! FALSE BRANCH. SETTING THE BITS ON THE SUCCESSORS
! INSURES THAT THE LOGICAL IF WILL NOT TURN OUT TO
! BE THE MOTION PLACE.
!
![1113] ADDITIONALLY, SET ACC BITS FOR EACH VARIABLE ASSIGNED
!BY THE BRANCHING STATEMENT ITSELF.
!
!THIS BUSINESS IS NECESSARY TO PREVENT A STATEMENT WHICH BOTH
!BRANCHES AND ASSIGNS VALUES FROM BECOMING THE DEF POINT FOR ANY
!VARIABLE. IF SUCH A STATEMENT WERE CHOSEN AS THE MOTION PLACE FOR A
!CSE, THE CSE CALCULATION WOULD HAVE TO BE PUT ON EACH SUCCESSOR OF THE
!STATEMENT. INSTEAD, THIS SCHEME PREVENTS A STATEMENT WITH MULTIPLE
!SUCCESSORS FROM BEING IDENTIFIED AS THE DEF POINT OF THE VARIABLES
!WHICH IT ASSIGNS. ACC BITS ARE SET IN EACH SUCCESSOR (SO THAT CSE
!MOVEMENT WILL STOP WHEN IT HITS THE SUCCESSOR) AND THE POSTDOMINATOR
!(SO THAT MOVEMENT OF CSES WHICH OCCUR AFTER THE POSTDOMINATOR WILL HIT
!THE POSTDOMINATOR AND STOP THERE).
LABEL L1;
MAP PHAZ2 P:TOP;
P_.TOP[BUSY];
WHILE .P NEQ 0 DO
BEGIN
!FIRST A GENERAL BRANCH
IF .P[SRCID] GEQ GOTOID AND .P[SRCID] LEQ IFLID THEN
SETONSUC(.P)
ELSE
!A CALL
!WITH LABLE ARGUMENTS
IF .P[SRCID] EQL CALLID THEN
BEGIN
LOCAL ARGUMENTLIST AG;
L1:
IF .P[CALLIST] NEQ 0 THEN
BEGIN
AG_.P[CALLIST];
INCR I FROM 1 TO .AG[ARGCOUNT] DO
BEGIN
REGISTER BASE T;
T_.AG[.I,ARGNPTR];
IF .T[OPRCLS] EQL LABOP THEN
BEGIN
SETONSUC(.P);
LEAVE L1;
END;
END;
END;
END ELSE
%760% IF (.P[SRCID] GEQ READID AND .P[SRCID] LEQ ENDFID) OR
%2204% .P[SRCID] EQL OPENID OR .P[SRCID] EQL INQUID
%760% THEN
!ITS AN I/O STATEMENT. IT IS A BRANCH IF THERE IS AN
!END OR ERR SPECIFIED
IF .P[IOERR] NEQ 0 OR .P[IOEND] NEQ 0 THEN
SETONSUC(.P);
!NEXT STATEMENT
P_.P[BUSY];
END; !WHILE
END; ! of SPECBRCHK
ROUTINE DEFIO(P)=
BEGIN
%2204% ! Written by TFV on 20-Jun-83
!***************************************************************
! Check definition points for UNIT, FMT, REC, and IOSTAT
! specifiers for an I/O statement. Look for function arguments
! that might be modified. The IOSTAT variable or arrayref is
! always modified.
!***************************************************************
REGISTER BASE TMP;
MAP PHAZ2 P;
! Check for function calls.
%2372% IF (TMP = .P[IOUNIT]) NEQ 0
%2372% THEN
%2372% BEGIN ! Non-zero UNIT
%2372%
%2372% FCNLOK(.TMP);
%2372%
%2372% IF .TMP[VALTYPE] EQL CHARACTER
%2372% THEN IF .P[SRCID] EQL WRITID
%2372% THEN (.SETSEL[.DISPIX])(.TMP); ! Internal file WRITE
%2372%
%2372% END; ! Non-zero UNIT
IF (TMP = .P[IOFORM]) NEQ 0
THEN IF .TMP NEQ #777777 ! Not list directed either
THEN FCNLOK(.TMP);
IF (TMP = .P[IORECORD]) NEQ 0 THEN FCNLOK(.TMP);
IF (TMP = .P[IOIOSTAT]) NEQ 0
THEN
BEGIN ! IOSTAT was specified
FCNLOK(.TMP); ! Check it for function calls
! It's always modified by the I/O statement
%2372% (.SETSEL[.DISPIX])(.TMP);
END; ! IOSTAT was specified
END; ! of DEFIO
ROUTINE DEFOCI(P)=
BEGIN
%2204% ! Written by TFV on 20-Jun-83
!***************************************************************
! Check definition points for OPEN, CLOSE, and INQUIRE
! specifiers. Look for function arguments that might be
! modified. The IOSTAT variable or arrayref is always modified.
! All INQUIRE specifiers except UNIT or FILE are also modified.
!***************************************************************
REGISTER
BASE TMP,
OPENLIST OPENL,
ISINQUIRE; ! Convenient flag
MAP PHAZ2 P;
! Check for function calls.
IF (TMP = .P[IOUNIT]) NEQ 0 THEN FCNLOK(.TMP);
IF (TMP = .P[IOFILE]) NEQ 0 THEN FCNLOK(.TMP);
IF (TMP = .P[IOIOSTAT]) NEQ 0
THEN
BEGIN ! IOSTAT was specified
FCNLOK(.TMP); ! Check it for function calls
! It's always modified by the I/O statement
%2372% (.SETSEL[.DISPIX])(.TMP);
END; ! IOSTAT was specified
OPENL = .P[OPLST]; ! pointer to other specifiers
ISINQUIRE = .P[SRCID] EQL INQUID; ! loop invariant test
DECR I FROM .P[OPSIZ] - 1 TO 0 DO
BEGIN ! Walk down specifier list
! Get specifier expression
IF (TMP = .OPENL[.I,OPENLPTR]) NEQ 0
THEN
BEGIN ! Non-zero specifier
FCNLOK(.TMP); ! Check it for function calls
%2372% ! INQUIRE always modifies the variable or
%2372% ! arrayref, and ASSOCIATE variables are always
%2372% ! modified.
%2372%
%2372% IF .ISINQUIRE OR .OPENL[.I,OPENLCODE] EQL OPNCASSOCIATE
%2372% THEN (.SETSEL[.DISPIX])(.TMP);
END; ! Non-zero specifier
END; ! Walk down specifier list
END; ! of DEFOCI
ROUTINE DEFWORK(P)=
BEGIN
!MAIN ROUTINE TO DO ALL THE DEFPOINT WORK.
!CALLED BY HEREVALUES, DEF0 AND DEFCHANGE
REGISTER BASE TMP;
%763% REGISTER ARGUMENTLIST ALST; ! FOR ENTRY FORMALS
MAP PHAZ2 P;
EXTERNAL CSTMNT,INPFLAG;
MAP BASE CSTMNT;
%2204% IF .P[SRCID] EQL CLOSID OR .P[SRCID] EQL OPENID OR
%2204% .P[SRCID] EQL INQUID
%2204% THEN
%2204% BEGIN ! OPEN, CLOSE, or INQUIRE
%2204% DEFOCI(.P); ! Check the specifiers
%2204% RETURN ! Done - leave now
%2204% END; ! OPEN, CLOSE, or INQUIRE
%2204% IF (.P[SRCID] GEQ READID AND .P[SRCID] LEQ ENDFID)
%2204% THEN DEFIO(.P); ! I/O statement - check the specifiers
CASE .P[SRCID] OF SET
BEGIN ! ASSIGNMENT
%4517% TMP = .P[LHEXP];
%4517% IF .TMP[OPR1] EQL CHARFNFL
%4517% THEN (.SETSEL[.DISPIX])(.TMP[ARG1PTR]) ! 1-char assignment
%4517% ELSE (.SETSEL[.DISPIX])(.TMP); ! non-char assignment
%2372% FCNLOK(.P[LHEXP]);
%2372% FCNLOK(.P[RHEXP]);
END; ! ASSIGNMENT
BEGIN ! ASSIGN
%2372% (.SETSEL[.DISPIX])(.P[ASISYM]);
END; ! ASSIGN
BEGIN ! CALL
%2372% ! Note that a special check for character assignments
%2372% ! would make them less pessimal. This should be added
%2372% ! if character definition points are ever used.
%2522% ! Put COMMON in the list if this is not a character
%2522% ! assignment statement, which would appear as a library
%2522% ! function. Library functions don't change COMMON!
%2522%
%2522% TMP = .P[CALSYM];
%2522% IF NOT .TMP[IDLIBFNFLG] THEN THROINCOMMON();
! Put PARAMETERs on the list
IF .P[CALLIST] NEQ 0 THEN ANPARMS(.P[CALLIST]);
END; ! CALL
BEGIN END; ! CONTINUE
BEGIN ! DO
FCNLOK(.P[DOLPCTL]);
!THIS MUST BE INNER TO THE ONE CURRENTLY BEING
!PROCESSED
!MAKE SURE THAT WE NOTE THE VARIABLES CHANGED IN IT
!IN THE ALGORITHM
TMP_.P[DOCHNGL];
WHILE .TMP NEQ 0 DO
BEGIN
(.SETSEL[.DISPIX])(.TMP[LEFTP]);
TMP_.TMP[RIGHTP];
END;
END; ! DO
%763% BEGIN ! ENTRY
%763% IF (ALST _ .P[ENTLIST]) NEQ 0 THEN
%763% BEGIN
%763% INCR K FROM 1 TO .ALST[ARGCOUNT] DO
%763% BEGIN
%2372% IF (TMP = .ALST[.K,ARGNPTR]) NEQ 0
%2372% THEN (.SETSEL[.DISPIX])(.TMP);
%763% END;
%763% END;
%763% END; ! ENTRY
BEGIN END; ! COMMON SUB
BEGIN END; ! GOTO
FCNLOK(.P[AGOTOLBL]); ! ASSIGNED GOTO
FCNLOK(.P[CGOTOLBL]); ! COMPUTED GOTO
FCNLOK(.P[AIFEXPR]); ! ARITHMETIC IF
FCNLOK(.P[LIFEXPR]); ! LOGICAL IF
IF .P[RETEXPR] NEQ 0 ! RETURN
THEN FCNLOK(.P[RETEXPR]);
BEGIN END; ! STOP
BEGIN ! READ
INPFLAG_1;
IF .P[IOLIST] NEQ 0 THEN
BEGIN
SETGTRD(.P[IOLIST]);
RANDIO(P);
END ELSE
CHKNAML(.P[IONAME]);
END; ! READ
BEGIN ! WRITE
! You are surprised to find a WRITE here. It is
! relevant if it is random access; in that case any
! associate vaiables must be considered, also common,
! also function call arguments may change value - hence
! the call to SETGTRD.
SETGTRD(.P[IOLIST]);
RANDIO(P);
END; ! WRITE
BEGIN ! DECODE
INPFLAG_1;
SETGTRD(.P[IOLIST]);
END; ! DECODE
BEGIN ! ENCODE
IF .P[IOVAR] NEQ 0 THEN
BEGIN
%2372% (.SETSEL[.DISPIX])(.P[IOVAR]);
SETGTRD(.P[IOLIST]);
END;
END; ! ENCODE
BEGIN ! REREAD
%2372% SKERR(); ! REREAD is really READ now.
END; ! REREAD
RANDIO(P); ! FIND
%4502% BEGIN END; ! CLOSE
%4502%
%4502% BEGIN ! DELETE
%4502% IF (.P[IOKEY] EQL 0)
%4502% THEN
%4502% BEGIN
%4502% ASSOCIA();
%4502% THROINCOMMON();
%4502% END;
%4502% END;
%4503% BEGIN ! REWRITE
%4503% SETGTRD(.P[IOLIST]);
%4503% END;
%4502% BEGIN END; ! BACKSPACE
%4502% BEGIN END; ! BACKFILE
%4502% BEGIN END; ! REWIND
%4502% BEGIN END; ! SKIPFILE
%4502% BEGIN END; ! SKIPRECORD
%4502% BEGIN END; ! UNLOAD
%4502% BEGIN END; ! ENDFILE
%4502% BEGIN END; ! END
%4502% BEGIN END; ! PAUSE
%4502% BEGIN END; ! OPEN
%4502% BEGIN END; ! STATEMENT FUNCTION
%4502% BEGIN END; ! FORMAT
%4502% BEGIN END; ! BLTID
%4502% BEGIN END; ! REGMARK
%4502% BEGIN END; ! INQUIRE
TES;
INPFLAG_0;
END; ! of DEFWORK
END
ELUDOM