Trailing-Edge
-
PDP-10 Archives
-
AP-D480B-SB_1978
-
defpt.bli
There are 26 other files named defpt.bli in the archive. Click here to see a list.
!THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
! OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
!COPYRIGHT (C) 1972,1977 BY DIGITAL EQUIPMENT CORPORATION
!AUTHOR NORMA ABEL/HPW/JNG/DCE
MODULE DEFPT(RESERVE(0,1,2,3),SREG=#17,VREG=#15,FREG=#16,DREGS=4)=
BEGIN
GLOBAL BIND DEFPV = 5^24 + 1^18 + 119; !VERSION DATE: 2-JUN-77
%(
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
116 252 14967 SELECTIT NOT CHECKING FOR SPECOP AND POSSIBLY OTHER OPS
117 315 16667 FIX VDEFPT TO RECOGNIZE ARRAYREFS WITH CONSTANT
SUBSCRIPTS, NOT OPTIMALLY, BUT AT LEAST NOT WRONG
118 453 19695 DON'T CONSIDER THE DEFPT OF VARIABLES MODIFIED
INSIDE LOOPS TO BE THE DO STATEMENT.
***** BEGIN VERSION 5A *****
119 575 22820 MAKE ZAPLEVEL MORE CLEVER IN USE OF THE STACK
TO PREVENT STACK OVERFLOWS.
END OF REVISION HISTORY
)%
SWITCHES NOLIST;
REQUIRE FIRST.BLI;
REQUIRE TABLES.BLI;
REQUIRE OPTMAC.BLI;
SWITCHES LIST;
!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 LENTRY,QQ;
EXTERNAL ASSOCPT;
OWN PCE;
MAP BASE ASSOCPT; !USED FOR LINKED LIST OF ASSOCIATE VARIABLES
MAP PEXPRNODE PCE;
OWN P,PA,PB,PC,HEAD,PAE;
OWN MOREFLG,LSTVAR,T;
EXTERNAL TOP,BOTTOM,CHOSEN,LOOPNO,LOOKUP;
MAP PHAZ2 P:QQ:PA:PB:PC:HEAD:PAE;
OWN MASK,CHNGLST;
OWN DISPIX; !PLIT DISPATCH INDEX
FORWARD CHKNAML,CHKUNIQ;
OWN GOTVAL; !FLAG FOR ASSIGNED HERE
!THAT IT GIT IT VALUE HERE
!DISPATCH TO USE FCNLOK TO BOTH SELECT ANS SET BITS.
!A SPACE ECONOMY AT A SLIGHT TRADE OFF IN TIME.
FORWARD SELECTIT,SETIT,SETGOTVAL;
BIND SETSEL = PLIT (
SELECTIT,
SETIT,
SETGOTVAL);
FORWARD DEFWORK;
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];
IF .ELEM[OPRCLS] EQL DATAOPR THEN
(.SETSEL[.DISPIX])(.ELEM)
ELSE
(.SETSEL[.DISPIX])(.ELEM[ARG1PTR]);
EPTR_.EPTR[CLINK];
END;
END;
!
!
!*****************************************************
!
!
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
!THE FIELD IDCHOS (IN THE SYMBOL TABLE) IS SET TO THE
!LOOP NUMBER TO INDICATE THAT THIS VARIABLE WAS CONSIDERED IN THIS
!LOOP. 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
!FIRST CHECK VALIDITY OF PARAMETER. IT SHOULD BE A DATAOPR
!OR AN ARRAYREF
IF .VAR[OPRCLS] EQL LABOP THEN
RETURN
ELSE
IF .VAR[OPRCLS] EQL DATAOPR THEN
BEGIN
IF .VAR[OPERSP] EQL CONSTANT OR .VAR[OPERSP] EQL FORMLFN THEN
RETURN;
END ELSE
IF .VAR[OPRCLS] EQL ARRAYREF THEN
BEGIN
SELECTIT(.VAR[ARG1PTR]);
RETURN;
%**;[252],DEFPT,JNT,05-MAR-75%
%**;[251],IN SELECTIT @ 3634%
END ELSE ![252] IF NONE OF THE ABOVE
RETURN; ![252] THEN GET OUT
!HERE WE HAVE A SYMBOL TABLE ENTRY
!SO WE WILL PROCESS IT.
VAR[IDCHOS]_.LOOPNO;
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;
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;
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;
!*****************************************************
ROUTINE THROINCOMMON=
BEGIN
!PUT COMMON VARIABLES ON THE CHOOSEN LIST
MAP BASE PCE;
!DONT DO IT FOR HEARVALUED STUFF (DISPIX=2)
IF .DISPIX EQL 2 THEN RETURN;
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;
ROUTINE ANPARMS(ARGLSTPT)=
BEGIN
!PUT THE PARAMETERS ON THE PARAMTER LIST (ARGLSTPT)
!ON THE CHOSEN LIST
MAP ARGUMENTLIST ARGLSTPT;
MAP BASE PCE;
INCR K FROM 1 TO .ARGLSTPT[ARGCOUNT] DO
BEGIN
(.SETSEL[.DISPIX])(.ARGLSTPT[.K,ARGNPTR]);
END;
END;
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
SWAPARGS(CNODE);
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;
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;
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
IF .EXPR[OPERSP] NEQ LIBARY THEN
BEGIN
THROINCOMMON();
ANPARMS(.EXPR[ARG2PTR]);
END;
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
TES;
END;
ROUTINE ASSOCIA=
BEGIN
!LOOK AT LINKED LIS OF ASSOCIATE VARIABLES (FROM OPENS OR
!DEFINE FILES 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;
!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
IF .P[IORECORD] NEQ 0 THEN
BEGIN
ASSOCIA();
THROINCOMMON();
END;
END$;
ROUTINE DEF0 =
BEGIN
!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.
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
DECR I FROM 31 TO 0 DO
CHOSEN[.I]_0;
!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;
!*******************************************************
!
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;
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;
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;
IF .STMT[SRCID] GTR REREDID THEN RETURN;
!NOTHING ABOVE REREAD IS OF CONCERN
!SET MODULE OWN THAT IS INDEX TO DISPATCH
DISPIX_1;
DEFWORK(.STMT);
END;
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;
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], ZAPLEVEL @4058, DCE, 2-JUN-77
!**;[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], ZAPLEVEL @4106, DCE, 2-JUN-77
%[575]% PRED_.PRED[CESLNK];
END; !WHILE THERE ARE PREDECESSORS
END; !ROUTINE 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.
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;
!**;[453] Insert @ line 4130 in SWAMP JNG 18-Sep-76
%[453]% !IF P'S PREDOMINATOR IS A DO STATEMENT WHICH ISN'T TOP, THEN
%[453]% !SET THE BITS IN P FOR ALL VARS CHANGED IN THE LOOP.
%[453]% PA_.P[PREDOM];
%[453]% IF (.PA NEQ .TOP) AND (.PA[SRCID] EQL DOID) THEN
%[453]% DEFCHANGE(.PA);
END;
FORWARD SPECBRCHK;
ROUTINE DEF1 =
BEGIN
MAP PHAZ2 T;
!
!INITIALIZE ACC FOR DEFINITION POINT CALCULATION
!DETERMINE IF THERE IS AN INTERFERRING
!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];
!THE SPECIAL CASE
IF .P EQL .TOP[SRCLINK] THEN
BEGIN
LOCAL SAVP;
SAVP_.P;
!A SPECAIL 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
!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;
!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
!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 YERMINATOR
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;
!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
T_.P[PREDOM];
T[LEVEL]_1;
!NOW START CHECKING ON PREDECESSORS
T_.P[PREDPTR];
!T IS A POINTER TO THE PREDECESSOR LIST
PA_.T[CESLNK];
!PA POINTS TO THE NEXT LINK
T_.T[CESSOR];
!T POINTS TO FIRST PREDECESSOR
!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
!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;
!CALL ROUTINE TO CHECK BRANCHES THAT SET VALUES
!SEE COMMENTS IN CALLED ROUTINE FOR DETAILS
SPECBRCHK();
END;
!*******************************************************
!
!*******************************************************
!
MAP PHAZ2 PB;
ROUTINE SETGOTVAL(VAR)=
BEGIN
!THE GLOBAL TREEPTR POINTS TO S SYMBOL TABLES ENTRY.
!IF IT EQUALS VAR THEN SET GOTVAL TO 1
EXTERNAL TREEPTR;
IF .VAR EQL .TREEPTR THEN GOTVAL_1;
END;
GLOBAL ROUTINE READHERE(IOLSTT)=
%(**********************************************************************
ROUTINE TO DETERMINE IF A VARIABLE WAS INITIALIZED
AT THE IOLSCLS ELEMENT IOLSTT
**********************************************************************)%
BEGIN
EXTERNAL TREEPTR;
MAP BASE IOLSTT;
CASE .IOLSTT[OPERSP] OF SET
%DATACALL% BEGIN
LOCAL BASE ELEM;
ELEM_.IOLSTT[DCALLELEM];
IF .ELEM[OPRCLS] EQL DATAOPR THEN
(.SETSEL[.DISPIX])(.ELEM)
ELSE
(.SETSEL[.DISPIX])(.ELEM[ARG1PTR])
END;
%SLISTCALL% BEGIN
LOCAL BASE ELEM;
ELEM_.IOLSTT[SCALLELEM];
IF .ELEM[OPRCLS] EQL DATAOPR THEN
(.SETSEL[.DISPIX])(.ELEM)
ELSE
(.SETSEL[.DISPIX])(.ELEM[ARG1PTR])
END;
%IOLSTCALL% BEGIN
LOCAL BASE IOELEM;
IOELEM_.IOLSTT[IOLSTPTR];
WHILE .IOELEM NEQ 0 DO
BEGIN
READHERE(.IOELEM);
IOELEM_.IOELEM[CLINK]
END
END;
%E1LISTCALL% BEGIN
LOKELIST(.IOLSTT[ELSTPTR])
END;
%E2LISTCALL% BEGIN
LOKELIST(.IOLSTT[ELSTPTR])
END
TES
END;
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
BEGIN
IF .INPFLAG THEN
READHERE(.IOLSTT)
END
ELSE
IF .IOLSTT[OPRS] EQL ASGNOS THEN
BEGIN
LOCAL BASE ELEM;
ELEM_.IOLSTT[LHEXP];
IF .ELEM[OPRCLS] EQL DATAOPR THEN
(.SETSEL[.DISPIX])(.ELEM)
ELSE
(.SETSEL[.DISPIX])(.ELEM[ARG1PTR])
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; !SETGTRD
ROUTINE HEREVALUED(STMT, VAR)=
BEGIN
!SEE IF THE VARIABLE VAR GETS A VALUE AT STATEMENT STMT.
!IF SO RETURN 1 ELSE RETURN 0
EXTERNAL TREEPTR;
MAP BASE VAR:STMT;
IF .STMT[SRCID] GTR REREDID THEN RETURN 0;
!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;
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;
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);
IF .TSTMT EQL .TOP THEN RETURN(.LENTRY);
IF HEREVALUED(.TSTMT,.CNODE) THEN RETURN(.TSTMT);
TSTMT_.TSTMT[PREDOM];
END;
END;
.CDEFPT !JUST IN CASE
END;
!**********************************************************
!
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
RETURN;
!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
%**;[315],DEFPT,JNT,10-JUL-75%
%**;[315],IN VDEFPT @ 4515 IN !ARRAYREF%
IF .P[ARG2PTR] EQL 0 ![315] IF ITS A CONSTANT SS
THEN ![315] WE WOULD LIKE IT TO BE LENTRY
![315] BUT THAT BOMBS AND WE WANT THIS IN V4A
P[DEFPT2]_.PAE ![315] SO SETTLE FOR WHAT WORKS
ELSE ![315]
P[DEFPT2]_GETDEF(.P[ARG2PTR],.PAE,.P[DEFPT2]) ![315]
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
TES;
END;
!************************************************************
!
!TO MAKE CODE LOOK NEATER THIS MACRO IS USED
MACRO DATAGET=
IF .P[OPRCLS] EQL DATAOPR THEN RETURN
ELSE VDEFPT(.P)$;
ROUTINE DEFPT(STMT)=
BEGIN
!AFTER INTERFERING ASSIGNMENT INFORMATION IS COLLECTED
!USE IT TO COMPUTE DEFINITION POINTS FOR LEAVES AND EXPRESIONS
!CONTROL AT THE STATEMENT LEVEL
!THIS IS THE STATEMENT LEVEL ROUTINE AS OPPOSED TO THE
!EXPRESSION LEVEL ROUTINE WHICH IS VDEFPT (VARIABLE DEFPT).
EXTERNAL IOSTDFPT; !COMPUTE DEFPTS IN I/O LIST <IOPT>
MAP BASE TOP;
MAP PHAZ2 STMT;
PAE_.STMT; !PAE USED IN LOWER ROUTINES
IF .STMT[SRCID] EQL ASGNID THEN
BEGIN
P_.STMT[LHEXP];
IF .P[OPRCLS] EQL ARRAYREF THEN
VDEFPT(.P);
P_.STMT[RHEXP];
IF .P[OPRCLS] EQL DATAOPR THEN STMT[OPDEF]_GETDEF(.P,.STMT,0)
ELSE
VDEFPT(.P);
END;
IF .STMT[SRCID] EQL DOID THEN
!SKIP IT IF THIS IS THE CURRENT DO WE ARE PROCESSING
BEGIN
IF NOT .STMT[FLCWD] AND .STMT[SRCOPT] NEQ 0 THEN
BEGIN
P_.STMT[DOLPCTL];
IF .P[OPR1] EQL CONSTFL THEN
!STMT[DOPDEF]_.LENTRY
ELSE
IF .P[OPRCLS] EQL DATAOPR THEN
!STMT[DOPDEF]_GETDEF(.P,.STMT)
ELSE
VDEFPT(.P);
END;
END;
IF .STMT[SRCID] EQL IFLID THEN
BEGIN
P_.STMT[LIFEXPR];
DATAGET;
DEFPT(.STMT[LIFSTATE]);
END;
IF .STMT[SRCID] EQL IFAID THEN
BEGIN
P_.STMT[AIFEXPR];
DATAGET;
END;
IF .STMT[SRCID] EQL CALLID THEN
BEGIN
IF .STMT[CALLIST] NEQ 0 THEN
BEGIN
LOCAL ARGUMENTLIST AG;
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;
IF .STMT[SRCID] GEQ READID AND .STMT[SRCID] LEQ REREDID THEN
BEGIN
IF .STMT[IOLIST] NEQ 0 THEN
BEGIN
IOSTDFPT(.STMT)
END
END;
END;
!
!***************************************
!
GLOBAL ROUTINE DEFDRIV=
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];
WHILE .MOREFLG DO
BEGIN
T_0;
!EACH ROUTINE IS A SEPARATE PASS OVER THE
!ENCODED SOURCE FOR THE CURRENT LOOP
DEF0(); !PICK 32 VARIALES
!IF THERE WERE NO VARIABLES (WRITE STATEMENT ONLY,
!FOR EXAMPLE, QUIT HERE
IF .T EQL 0 THEN
MOREFLG_0
ELSE
BEGIN
DEF1(); !INITIALIZE THE MASK
END;
!NOW WE ARE READY TO ACRUALLY GET DEFINITION POINTS
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;
!
!*************************************************
!
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
%**;[235],DEFPT,MD,23-JAN-75%
%**;[235],IN CHKNAML @ 4721%
NPTR_.NLPTR[IDCOLINK]; ![235] 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
(.SETSEL[.DISPIX])(@(.NPTR[NAMLIST]+.I));
END;
!ITS NOT A NAME LIST NAME
END;
END;
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;
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;
END;
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.
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
IF .P[SRCID] GEQ READID AND .P[SRCID] LEQ CLOSID 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;
ROUTINE DEFWORK(P)=
BEGIN
!MAIN ROUITN;INE TO DO ALL THE DEFPOINT WORK.
!CALLED BY HEREVALUES, DEF0 AND DEFCHANGE
REGISTER BASE TMP;
MAP PHAZ2 P;
EXTERNAL CSTMNT,INPFLAG;
MAP BASE CSTMNT;
IF .P[SRCID] GEQ CLOSID THEN RETURN;
CASE .P[SRCID] OF SET
%ASGNID%
BEGIN
TMP_.P[LHEXP];
IF .TMP[OPRCLS] EQL DATAOPR THEN
(.SETSEL[.DISPIX])(.TMP)
ELSE
(.SETSEL[.DISPIX])(.TMP[ARG1PTR]);
FCNLOK(.P[RHEXP]);
END;
%ASSIID%
BEGIN
TMP_.P[ASISYM];
IF .TMP[OPRCLS] EQL DATAOPR THEN
(.SETSEL[.DISPIX])(.TMP)
ELSE
IF .TMP[OPRCLS] EQL ARRAYREF THEN
(.SETSEL[.DISPIX])(.TMP[ARG1PTR]);
END;
%CALLID%
BEGIN
!PUT COMMONIN THE LIST
THROINCOMMON();
!PUT PARAMETERS ON THE LIST
IF .P[CALLIST] NEQ 0 THEN
ANPARMS(.P[CALLIST]);
END;
%CONTID%
BEGIN END;
%DOID%
BEGIN
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;
%ENTRID%
BEGIN END;
%COMNSUB%
BEGIN END;
%GOTOID%
BEGIN END;
%AGOID%
FCNLOK(.P[AGOTOLBL]);
%CGOTOID%
FCNLOK(.P[CGOTOLBL]);
%IFAID%
FCNLOK(.P[AIFEXPR]);
%IFLID%
FCNLOK(.P[LIFEXPR]);
%RETUID%
IF .P[RETEXPR] NEQ 0 THEN
FCNLOK(.P[RETEXPR]);
%STOPID%
BEGIN END;
%READID%
BEGIN
INPFLAG_1;
IF .P[IOLIST] NEQ 0 THEN
BEGIN
SETGTRD(.P[IOLIST]);
RANDIO(P);
END ELSE
CHKNAML(.P[IONAME]);
END;
%WRITID%
BEGIN
!YOU ARE SURPRISED TO FIND A WRITE HERE. IT IS RELEVANT ONLY
!IF IT IS RANDOM ACCESS. IN THAT CASE ANY ASSOCIATE VAIABLES
!MUST BE CONSIDERED. ALSO COMMON
SETGTRD(.P[IOLIST]);
RANDIO(P);
END;
%DECOID%
BEGIN
INPFLAG_1;
SETGTRD(.P[IOLIST]);
END;
%ENCOID%
BEGIN
IF .P[IOVAR] NEQ 0 THEN
BEGIN
TMP_.P[IOVAR];
IF .TMP[OPRCLS] EQL DATAOPR THEN
(.SETSEL[.DISPIX])(.P[IOVAR])
ELSE
(.SETSEL[.DISPIX])(.TMP[ARG1PTR]);
SETGTRD(.P[IOLIST]);
END;
END;
%REREDID%
BEGIN
INPFLAG_1;
SETGTRD(.P[IOLIST]);
END;
%FINDID%
RANDIO(P);
TES;
INPFLAG_0;
END;
END
ELUDOM