Trailing-Edge
-
PDP-10 Archives
-
FORTRAN-10_Alpha_31-jul-86
-
ph3g.bli
There are 12 other files named ph3g.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/DCE/SJW/JNG/EGM/TFV/RVM/AHM/TJK/AlB/CDM/MEM
MODULE PH3G(RESERVE(0,1,2,3),SREG=#17,VREG=#15,FREG=#16,DREGS=4,START)=
BEGIN
! REQUIRES FIRST, TABLES, OPTMAC
GLOBAL BIND PH3GV = #11^24 + 0^18 + #4527; ! Version Date: 1-Jan-86
%(
***** Begin Revision History *****
184 ----- ----- INSERTING PRELOADS AT WRONG PLACE IN STRANGE CASE
185 ----- ----- FIX GETPRELOAD NOT TO FALSELY PRELOAD A SUBSET
OF THE ASGN4USED VARIABLES.
186 ----- ----- FIX A ' THAT SHOLD BE " IN SORTNMAKE
PLUS FIX RAYMERIT TO PROPERLY CREDIT
LOCAL COMMON SUBS AS SUBSCRIPTS
187 ----- ----- FIX GETPRELOAD IN SKIPMAT AREAS
188 ----- ----- FIXENTRY IS MISSING PRELOADS
189 ----- ----- TRY AGAIN ON 188
190 ----- ----- MISPLACED END IN FIXENTRY
191 ----- ----- CONCEPTUAL ERROR IN MATERIALIZATIONS
CAUSED BY SUBTLE LOOP STRUCTURE TOGETHER
WITH SUBSUMPTION
192 ----- ----- USE NOINDVARFLG TO PREVENT BAD REGCONTETNS
SUBSTITUTIONS
193 ----- ----- MODIFY MATERIALIZATION CONDITIONS ON
INNER LOOPS ONLY OF A NEST
194 ----- ----- IN CASES 2 AND 4 TURN OFF MATRLZ BIT ONLY
IF INDVAR IS GLOBALLY ALLOCATED.
195 ----- ----- MAKE LEAFLOOKER A CASE STATEMENT AND FIX
SOME MINOR UNOPTIMALITIES
196 ----- ----- SET NOALLOC ON .R VARS GLOBALLY ALLOCATED
196 ---- ----- FIX BOOLEAN NOT TO DO LOADS AND STORES
'TWEEN CALLS
197 ----- ----- GUESS
198 ----- ----- CHECK FOR GLOBALLY ALLOCATED DO INDEX
IN DETERMINING LOWEST AVAILABLE REGISTER
TO GLOBALLY ALLOCATE
199 ----- ----- FIX A COUPLE OF BENCHMARKS PROBLEMS
IN PRELOADING, SAVING, RESTORING
AND MATERIALIZATION
200 ----- ----- REFINE VALUE SUBTRACTED FOR USE AS LIB
FUNCTION ARG AND DO NOT ALLOCATE IF
MERIT ISNT BETTER THAN SIMPLE MOVE
201 ----- ----- IN AN ASSIGNMENT STATEMENT WITH USER FUNCTION
REFERENCES, NOT IMMEDIATELY FOLLOWED BY A CALL
OR ANOTHER STATEMENT WITH A USER FUNCTION
REF SAVE ONLY GLOBALLY ALLOCATED
ARGUMENTS TO THOSE FUNCTIONS
202 ----- ----- FIX 201
203 ---- ----- ONE MORE TIME ON 201
204 ----- ----- ADD BUBBLE SORT TO DO CONBINATION
OF LEAFSUBSTITUTE AND SAVE RESTORE
PUT IT ALL INTO FLIPCODES
205 ----- ----- PUNT
206 ----- ----- DO NOT INCREMENT CALLREFNO IF THERE ARE
NO ARGUMENTS
207 ----- ----- FIX REFERENCES TO PROEPITYP AND PROGNAME
208 ----- ----- DO NOT ALLOCATE A LOOP THAT HAS A USER FUNC.
REFERENCE AS PART OF THE LOOP CONTROL. USRFNREF
209 ----- ----- MACRO CHKGIX WAS ERROREOUSLY CHECKING
GLOBREG INSTEAD OF CHOSEN
FLAG GETS VERY CONFUSED.
210 ----- ----- COMPLEXITY OF DO LOOP ITSELF NO BEING PROPERLY
CONSIDERED
211 ----- ----- CALL DATPROC WHETHER OR NOT A REL FILE IS BEING PRODUCED
212 ----- ----- IN DOUBLE NEST ALLOCATION SAV .OS ASSIGNED
BEFORE LENTRY. THIS IMPLIES THEY HAVE
BEEN SUBSUMBED AND MAY BE USED LATER TOO.
213 ----- ----- USED4ASGND ANALYSIS INCOMPLETE FOR STATEMENTS
THAT CONTAIN USER FUNCTION REFERENCES.
214 ----- ----- OUTER LOOP INDEX ALWAYS GETTING NO PRELOAD
SET. NEED TO CHECK USED4ASGND TOO.
215 ----- ----- MESSING UP RESTORE OF ALLOCATED VARS
IF CALL, USER FUNC REF CASE.
216 ----- ----- 212 HAD A SIDE EFFECT THAT NEED CORRECTING
FOR GUIDE 2 AND 4.
217 ----- ----- 1. DO NOT GLOBALLY ALLOCATE IF BOUNDS SWITCH
IS USED
2. FIX CALLS SO THAT THE SAVE/RESTORE
SEQUENCES WILL WORK WITH NO ARGS
218 ----- ----- ITEM MISSING FROM CASE IN CREDIT
219 ----- ----- BUG THAT SKIPS A REAL STATEMENT WHEN IT
THINKS ITS SKIPPING A MATERIALIZATION
220 ----- ----- NOT SAVING AND RESTORING REGS ON A CALL WITH
NO ARGS. CALL COULD CLOBBER REGS
221 ----- ----- IN SETTING UP PREVIOUS BASIC BLOCK POINTERS
LOGICAL IFS WITH BRANCHS ARE NOT TAKEN
INTO ACCOUNT PROPERLY
222 ----- ----- REGISTER PRELOADS ARE BEING INSERTED IN
FRONT OF LOGICAL IFS WITH BRACHES AS THE
TRUE BRANCH
223 ----- ----- NOT PROPERLY HANDLING LOOPS IN WHICH THE INDEX
IS NEITHER GLOBALLY OR LOCALLY ALLOCATED.
224 ----- ----- BLEW 223 FOR MAIN PROGRAM WITH SINGLE LOOP
225 ----- ----- EMPTY SUBROUTINE DID NOT GET OPTIMIZED. DONT
TRY TO ALLOCATE IT EITHER
226 ----- ----- DO NOT ALLOCATE ANY VARIABLE THAT DOES NOT
AT LEAST SAVE A MOVEM
227 ----- ----- INSERT REGMASK NODE IF BASIC
BLOCK STARTS WITH A LOGICAL IF WITH A BRANCH.
ALSO CLEAN UP GETPRELOAD BY MAKING THE REGMASK
SET UP CODE A MACRO
228 ----- ----- MAKE SETDOIREG COGNISCENT OF DOUBLE PRECISION
INDICES NEEDING AN EVEN ODD PAIR.
229 ----- 240 NOT LEAVING TWO PAIR AND NOT DELETEING
LOCALLY ALLOCATED DO LOOP INDEX REG
FROM GLOBAL CONSIDERATION IF IT IS NOT
WITHIN THE FIRST 10 OF
THE UNSORTED LIST
230 15209 246 BRANCHES IN LOOPS ARE NOT FORCING USED4ASGND ON
231 15952 266 FIX INSERTIONS OF PRELOAD NODES AFTER REGMASK WHEN THERE
ARE NO PREVIOUS LOOP MATERIALIZATIONS TO SKIP
232 16112 277 FIX SUBSTITUTIONS OF REGISTERS TO BE ONLY THE ONES
TO BE SAVED
233 QAR 316 FIX 277 TO DO IT CORRECTLY, USING THE RIGHT BITS, (JNT)
234 17045 332 MAKE LEAFLOOKER TREAT ASSIGN STATEMENTS PROPERLY, (DCE)
235 17545 347 CHANGE RANGE OF SUBSTITUTION OF REGISTERS
TO NOT INCLUDE LOGICAL IF'S AT BEGINNING, (DCE)
236 17545 350 FOR COMMON SUBS, DON'T FORGET TO SET THE
FLAG TO CAUSE PRELOADING IF APPROPRIATE, (DCE)
237 18007 352 FIX EDIT 266 TO WORK CORRECTLY, (DCE)
238 18004 353 FIX ARGUMENTS TO SECOND OF TWO CONSECUTIVE CALLS, (DCE)
239 18704 400 FIX LOGICAL IF BEFORE NESTED DO LOOP, (DCE)
240V ----- VER5 RAISE PRIORITY OF ASSIGNMENT TO MEMORY IN
REGISTER ALLOCATION IN ASCRIBE, (SJW)
240 18869 404 FIX ASSOCIATE VARIABLES (CANNOT LIVE IN REG), (DCE)
241 19121 431 FIX REGSUBDRIVER TO MATERIALIZE VARIABLES THAT
HAVE BEEN ALLOCATED TO REGISTERS AND ARE
INITIALIZED BEFORE THE OUTER LOOP OF A CASE 6
PROGRAM (NESTED DO LOOPS)., (JNG)
242 19484 444 DON'T FORCE PRELOAD OF COMPILER VARIABLES IN
GOTOFORCELOAD IF A GOTO IS ENCOUNTERED., (JNG)
243 19699 454 DON'T SKIP 1 TOO MANY STATEMENTS WHEN PLACING
A PRELOAD AFTER A DO LOOP., (JNG)
244 20463 502 SORT SAVED VS NON-SAVED REGS CORRECTLY IN
FLIPCODES & FAKE ALL NECESSARY COUNTS, (DCE)
***** Begin Version 5A *****
245 23116 615 WHEN PRELOADING REGISTERS, BE CAREFUL WITH
THE PLACEMENT OF LABELS., (DCE)
***** Begin Version 5B *****
246 11277 634 SET USED4ASGND INSTEAD OF ASGND4USED IF
THE ASSIGNMENT IS FOUND IN THE OBJECT
STATEMENT OF A LOGICAL IF, SINCE IT MIGHT
NOT GET EXECUTED., (JNG)
247 25010 641 FIX REG ALLOCATION FOR CALL AS OBJECT OF LOGICAL
IF STMNT JUST BEFORE DO LOOP, (DCE)
248 11427 660 IF(FN(I))GOTO 10 WHERE I IS IN REG GIVES BAD CODE, (DCE)
249 25245 662 PREVENT ILL MEM REF IF DO LOOP DELETED, (DCE)
250 26409 716 CHECK FOR LEGALITY BEFORE OPTIMIZING OUTERMOST LOOP,
(DCE)
251 13537 740 DO REGISTER ALLOCATION FOR UNIT NUMBERS (VARIABLES)
IN OPEN AND CLOSE STATEMENTS., (DCE)
***** Begin Version 6 *****
252 776 EGM 20-Jun-80 10-29609
Preserve CLOGIF when processing the true node of a logical IF.
253 1047 EGM 22-Jan-81 Q10-05325
Add support for TOPS-10 execute only.
254 1051 EGM 9-Feb-81 --------
Make sure loop register globally allocated gets flaged in DO node
(more of local edit 209). Do not do global register optimization
for single loop programs that have CALLs with alternate return
labels (more of edit 716).
1152 EGM 29-Mar-82
Check all OPEN/CLOSE arguments for register substitution, instead
of just UNIT.
***** Begin Version 7 *****
255 1245 TFV 24-Jun-81 ------
Add code to MRP3G to generate high seg descriptors for character
constants, scalars and arrays
256 1406 TFV 27-Oct-81 ------
Call HSDDESC to output .Dnnnn variable compile-time-constant
character descriptors to the HISEG.
257 1454 RVM 7-Jan-82
Do not allocate formats until after optimization is done. This is
necessary so the optimizer, which uses the label fields filled-in
during format allocation, does not cause the compiler to forget
that format labels have had their values nailed down.
***** end V7 Development *****
1726 DCE 9-Feb-83 -----
Put out a JRST around an ENTRY statement when registers are allocated
around the statement. This prevents reinitialization when falling
through the ENTRY statement.
1742 TFV 14-Apr-83
Fix calls to MISCIO. It handles the IOLIST now.
***** End Revision History *****
***** Begin Version 10 *****
2204 TFV 20-Jun-83
Fix ASCRIBE to count I/O statements as CALLs. STOP, PAUSE,
OPEN, CLOSE, and INQUIRE are one call; READ through REREAD are
at least two calls (e.g. IN. and IOLST.). Fix MATLOK to test
all I/O statement END and ERR labels. It has to generate a new
label for the materializations.
2210 AHM 27-Jul-83
Rename DUMPFORMAT to DMPFORMAT to reserve DUMP?? for SIX12.
2211 TFV 18-Aug-83
Add INQUIRE to case statement in LEAFLOOKER. Calls MISCOCI to
do the work.
2237 TJK 14-Nov-83
Rewrite code in SORTNMAKE (defined in GBLALLOC) which puts
elements of CHOSEN with highest merit in GLOBREG. Previously
it stopped looking after GLOBREG was full, which could
severely pessimize the final choices made. It also wrote one
entry too many, a dangerous practice. In addition to this
change, remove some code from ASCRIBE added in edit 2204.
2270 AlB 13-Jan-84
Removed routine NAMESET, which was setting the INNAM attribute
in the symbol table entries of all items in a namelist. That
INNAM bit is now being set in routine NAMESTA during the syntax
parsing.
Routine:
NAMESET
2334 AHM 5-Apr-84
Under /EXTEND, allocate the object program's entry vector in
the .DATA. psect before the call to HISEGBLK in MRP3G.
2355 AHM 3-May-84
Use the symbol ENTAUXSIZE to allocate additional words after
the /EXTEND entry vector. The only auxiliary word for now is
an EFIW for the reenter address.
2375 TJK 15-Jun-84
Allow the global register allocator to handle character data.
Never globally allocate a character variable to a register.
2507 CDM 21-DEC-84
Move IDDOT to FIRST.
***** End V10 Development *****
***** End Revision History *****
***** Begin Version 11 *****
4502 MEM 22-Jan-85
Modified LEAFLOOKER for DELETE statement.
4503 MEM 22-Jan-85
Modified LEAFLOOKER for REWRITE statement.
4504 MEM 22-Jan-85
Modified LEAFLOOKER for UNLOCK statement.
4517 MEM 4-Oct-85
In routine ASCRIBE, if we have a 1-char asmnt then set PC to arg under
the CHAR node instead of to the whole LHEXP of the asmnt.
Don't try to substitute registers for character variables in
REGSUBDRIVER.
4527 CDM 1-Jan-86
VMS Long symbols phase II. Convert all internal symbols from
one word of Sixbit to [length,,pointer]. The lengths will be one
(word) until a later edit, which will store and use long symbols.
ENDV11
)%
! MAIN ROUTINE NAMED CHANGED TO MRP3G FOR SINGLE SEGMENT
!THE MAIN ROUTINE IN THIS MODULE IS MRP3G WHICH IS CALLED FROM PHAZONTROL.
!IT IS THE ONLY GLOBAL ROUTINE IN THE MODULE. THE ROUTINE AUDITOR DOES ALL
!THE REAL WORK OF COMPUTING MERITS, SELECTING ALLOCATIONS AND SUBSTITUTING
!REGCONTENTS NODES FOR THE VARIABLES
!THE MERIT ON A CALL OR FUNCTION IS ACTUALLY NEGATIVE. THIS IS HANDLED IN
!AUDITOR BY SUBTRACTING THE CUMULATED VALUE OF THE NUMBER OF FUNCTION
!REFERENCES (FNREFNO) TIMES THE MERIT FROM THESE TABLES
!THE VECTOR CHOSEN IS USED TO HOLD INFORMATION ABOUT VARIABLES WITH
!GREATEST MERIT. THE ROUTINE LOOKUP (ALSO USED IN DEFINITION POINT
!COMPUTATION) CAN BE USED FOR THE LINEAR SEARCH.
!FORMAT OF CHOSEN
!*************************
! * *
! MERIT * PTR *
! * *
!*************************
!PTR POINTS TO SYMBOL TABLE ENTRY
!WHILE THE RUNNING TALLY IS IN PROGRESS THE CELL MINWD CONTAINS THE MINIMUM
!MERIT ON THE LIST AND THE INDEX OF THAT ITEM ON THE LIST
!MINWD
!**********************************
! * *
! MIN MERIT * INDEX *
! * *
!**********************************
SWITCHES NOLIST;
REQUIRE FIRST.BLI;
REQUIRE TABLES.BLI;
REQUIRE OPTMAC.BLI;
SWITCHES LIST;
SWITCHES NOSPEC;
FORWARD
GOTOINSERT(3),
PLUSUNFLDO(1),
ASCRIBE(1),
ASSOCIA(1),
USRFNWALK(1),
CREDIT(1),
RAYMERIT(1),
CHKMAXLST(1),
MINCOMPUTE,
MELDPLEX,
GRABFNREF(1),
FLIPCODES,
REGSUBDRIVER,
FIXENTRY,
MAKREGMASK,
SKIPMATERIALIZATION(1),
GETPRELOAD,
GETMATERIAL,
GBLALLOC,
BLDREGCONTENTS(1),
GOTOFORCELOAD,
LEAFLOOKER(1),
CALLSAVE(1),
CALRESTORE(1),
LABLLOK(3),
MAKRETU(1),
MAKSTASH(1),
! NAMESET, ![2270] No longer needed
STOWONRETURN,
MATERIALIZE,
MATLOK(3),
INITEM,
MRP3G;
EXTERNAL
BOTTOM,
%1245% CHDECL, ! Flag for character declaration seen
CHOSEN,
%4517% CGERR,
CORMAN,
DATPROC,
%2334% ENTADDR, ! Object address of entry vector
GLOBREG,
%1245% HDRFLG, ! Flag for heading has been output
%1245% HILOC, ! Current high seg break
%1245% HSCHD, ! Routine to generate high seg descriptors for
! character scalars and arrays
%1406% HSDDESC, ! Routine to generate high seg descriptors for
! .Dnnnn compile-time-constant character
! descriptors
%1245% HSLITD, ! Routine to generate high seg descriptors for
! character constants
ITMCT,
LENTRY,
%1245% LOWLOC, ! Current low seg break
LOOKUP,
MAKPR1,
BASE PREV,
QQ,
SPECCASE,
%1245% TCNT, ! Count of temporaries on a line
TOP;
BIND !USED AS INDICES INTO THE MERIT TABLES
LHSUSE=0, !KAMERIT & KIMERIT
DEXUSE=1,
LCTLUSE=2,
FUNUSE=3,
PLAINUSE=4,
ASGNMEM=5;
!FOR VALUES OF THE VARIOUS MERITS ASSIGNED
BIND MERITVAL=PLIT ( 3, !USE ON LHS
3, !USE AS INDEX
6, !LOOP CONTROL
6, !CALL OR FUNCTION REFERENCE
0, !OTHERS
4); ! ASSGN TO MEM
OWN
%776% BASE CLOGIF, !Logical If node being processed by LEAFLOOKER
CALLREFNO, !NUMBER OF CALLS IN THE LOOP
CALLSEEN, !INDICATES 2 CALLS (OR THE LIKE) IN A ROW
CLEANSLATE,
FNREFNO, !NUMBER OF USER FUNCTION REFERENCES
!INNN FRONT OF GBLALLOC.
GUIDE, !INDICATES EXACT ALLOCATION SITUATION. SEE COMMANTS
HEAD,
LASTAT,
LIBFNREFNO, !LIBRARY FUNCTION REFERENCE.
MAXCOMPLEX[10],
MINWD,
OLDCSTMNT, !TO SAVE VALUE OF CSTMNT WHEN NEEDED
P,
%4527% BASE PA,
PB,
PC,
PD,
BASE PREVBB, !POINTS TO THE PASIC BLOCK INFRONT OF A
!DO THAT IS BEING ALLOCATED.
RAISE,
REGAVAIL,
REGTOALC, !NUMBER OF REGISTERS ALLOCATED
SAVCODE, !CODE TO DIRECT SAVING,RESTORING,PRELOADING AND
!MATERIALIZATION FO REGISTERS
SAVHITCH,
SECIDX, !INDEX OF SECOND LEVEL LOOP
BASE STARTSUB,
BASE STOPSUB, !START REGCONTENTS SUBSTIRUTION AT STARTSUB AND STOP
! IT AT STOPSUB
BASE T, !GENERAL TEMP
THISTAT,
BASE WAYBBB; !POINTS TO BASIC BLOCK IN FRONT FOR PREVBB
!*WAY* *B*ACK *B*ASIC *B*LOCK
MAP PEXPRNODE P:PB:PC:PD:THISTAT:LASTAT;
!**;[1726], PH3G @4671(4047 in V6), DCE, 9-Feb-83
!**;[1726], ROUTINE to insert a new GOTO statement
GLOBAL ROUTINE GOTOINSERT(PREV,NEXT,DEST)=
BEGIN
! This routine will create and insert a (new) GOTO statement
! into a program. PA will point to the newly created GOTO statement.
! Parameters:
! PREV points to the statement before the newly created GOTO statement.
! NEXT points to the statement after the GOTO statement.
! DEST points to the statement that the GOTO needs to reach; there
! may or may not be an existing label on statement DEST. If there
! is no label, one is created. PD will point to the label.
EXTERNAL GENLAB;
MAP BASE PREV:NEXT:DEST;
! Do we need to create a label?
IF .DEST[SRCLBL] NEQ 0
THEN
BEGIN
PD=.DEST[SRCLBL]; ! Label already exists
PD[SNREFNO]=.PD[SNREFNO]+1
END
ELSE
BEGIN
DEST[SRCLBL]=PD=GENLAB(); ! Create new label
PD[SNHDR]=.DEST;
PD[SNREFNO]=2
END;
! Create the GOTO Statement
NAME<LEFT>=GOTOSIZ+SRCSIZ;
PA=CORMAN();
PA[OPRCLS]=STATEMENT;
PA[SRCID]=GOTOID;
PA[GOTOLBL]=.PD;
! Link in the GOTO statement node
PREV[SRCLINK]=.PA;
PA[SRCLINK]=.NEXT
END; !Of GOTOINSERT
!MACRO TO DETERMINE IF IT IS LEGAL TO ALLOCATE A LOOP.
!HAVING AN ENTRANCE OR A RETURN MAKES IT ILLEGAL
MACRO LEGALALLOC(NOD)=
(NOT (NOD[HASENT] OR NOD[HASRTRN] OR NOD[USRFNREF]))$;
!MACRO TO COMPARE SAVCODE WITH CODE IN NODE
MACRO CODEMATCH(ITEM)=
(ITEM<ALCFLG> EQL .SAVCODE)$;
!MACRO TO CHECK IF THE DO LOOP INDEX WAS GLOBALLY ALLOCATED
!AND SET THE FIELD IN THE DO LOOP NODE.
!ON THE OTHERHAND IF THE INDEX IS NEITHER LOCALLY NOR GLOBALLY
!ALLOCATED THE DOIREG FIELD MUST BE SET TO THE FIRST FREE REG
!SO THAT THERE IS NOT A CONFLICT.
!THE MODULE OWN MINWD CONTAINS THIS REGISTER NUMBER.
!IF THE INDEX IS DOUBLE PRECISION ALSO ASSURE THAT AN EVEN REG IS
!CHOSEN
MACRO SETDOIREG=
BEGIN
EXTERNAL BASE INDVAR;
EXTERNAL BASE QQ;
DECR I FROM .REGTOALC-1 TO 0 DO
IF .GLOBREG[.I]<RIGHT> EQL .INDVAR THEN
BEGIN
QQ_.CHOSEN[.I];
TOP[DOIREG]_.QQ[TARGTAC];
END;
IF NOT .TOP[IXGALLOCFLG] THEN
IF .TOP[NEDSMATRLZ] OR .TOP[MATRLZIXONLY] THEN
TOP[DOIREG]_(IF .MINWD AND .INDVAR[DBLFLG] THEN .MINWD+1 ELSE .MINWD);
END$;
!MACRO TO SEARCH GLOBALLY ALLOCATED LIST AND SET BIT IN LUP NODE
!IF THE INDEX IS GLOBALLY ALLOCATED
MACRO CHKGIX=
BEGIN
%[1051]% DECR I FROM 31 TO 0 DO
IF .CHOSEN[.I]<RIGHT> EQL .INDVAR THEN
TOP[IXGALLOCFLG]_1;
END$;
!MACRO TO MAKE CODE DONE IN TWO PLACES EASIER TO READ
MACRO EASY1=
BEGIN
STARTSUB_.TOP;
STOPSUB_.BOTTOM;
REGSUBDRIVER();
FLAG_0;
DECR I FROM .REGTOALC-1 TO 0 DO
BEGIN
T_.GLOBREG[.I]<RIGHT>;
IF .T[IDATTRIBUT(INDATA)] THEN
BEGIN
GLOBREG[.I]<ALCFLG>_PRELOAD;
FLAG_1;
END;
END;
SAVCODE_PRELOAD;
GBSYREGS_.CLEANSLATE;
IF .FLAG THEN
CALRESTORE(.TOP);
END$;
!MACRO TO CASE THE STATEMENT AFTER THE ONE POINTED TO BY LOCLNK TO BE LABELED
MACRO LABFRST=
BEGIN
MAP BASE LOCLNK;
REGISTER BASE T;
T_GENLAB();
T[SNHDR]_.LOCLNK;
LOCLNK[SRCLBL]_.T;
T[SNREFNO]_2;
.T
END$;
!MACROS DEFINING THE BITS SET IN THE LEFT HAVE OF A GLOBREG WORLD
!THAT GOVERN SAVES, RESTORES, PRELOADS, MATERIALIZATIONS,
!AND INDICATE VARIOUS PROPERTIES OF THE VARIABLE.
MACRO
AWL=12$, !ALL
PRELOAD=2$, !PRELOAD THIS ONE
MATRLZ=1$, !MATERIALIZE THIS ONE
!DECLARED IN OPTMAC
! ALCFLG=32,4$, !THE FIELD THAT CONTAINS AWL,PRELOAD OR MATRLZ
! ALCFLGS=ALCFLG$,
NOTFORML=31,1$, !NOT A FORMAL VARIABLE
PROGVAR=30,1$, !A PROGRAM DEFINED VARIABLE
NOPRELOAD=29,1$, !DO NOT PRELOAD THIS ONE
! FLAGS DEFINED IN TABLES BUT PART OF THIS WORD
! ASGND4USED=27,1$, !VARIABLE RECEIVES
!A VALUE PRIOR TO ITS FIRST REFERENCE
!IN THIS CONTEXT
! USED4ASGND=28,1$, !VARIABLE IS REFERENCED BEFORE
!AN ASSIGNMENT IN THIS CONTEXT
%[634]% NOTYETSEEN=26,1$, !NEITHER OF ABOVE TWO FLAGS HAS YET
%[634]% !BEEN SET. USED ONLY IN IFLID CASE OF
%[634]% !LEAFLOOKER. NOT GENERALLY CORRECT.
NEDSAV=18,1$; !THIS NEEDS TO BE SAVED ANY WAY
!IN THE ELSE CONDITION, A REGCONTENTS NODE WAS
!SUBSTITUTED DURING COMPLEXITY AND WE MUST
!SET THE GLOBALLY ALLOCATED FLAG AND TAKE THE REGISTER
!FROM THE POOL.
!MACRO TO GET PLACE AT WHICH ALLOCATION IS TO START
MACRO LOWERBD(NOD)=
(IF NOD[NEDSMATRLZ] OR NOD[MATRLZIXONLY]
OR NOD[DOIREG] LSS .MINWD THEN .MINWD
ELSE
BEGIN
CLEANSLATE_CLRBIT(.CLEANSLATE,NOD[DOIREG]);
IF .INDVAR[DBLFLG] THEN
CLEANSLATE_CLRBIT(.CLEANSLATE,NOD[DOIREG]+1);
NOD[DOIREG]+1+.INDVAR[DBLFLG]
END)$;
!MACRO TO DELETE INNERDO LOOP INDEX FROM LIST OF VARIABLE WITH
!MERIT IF IT WAS LOCALLY ALLOCATED.
!UPDATED IN EDIT 240 TO LOOK AT COMPLETE LIST
MACRO REMOVINDVAR=
BEGIN
IF NOT .TOP[NEDSMATRLZ] AND NOT .TOP[MATRLZIXONLY] THEN
DECR I FROM 31 TO 0 DO
IF .CHOSEN[.I]<RIGHT> EQL .INDVAR THEN
BEGIN
CHOSEN[.I]_0;
REGTOALC_.REGTOALC-1;
IF .REGTOALC LEQ 0 THEN RETURN;
END;
END$;
!MACRO TO SWITCH AROUND TWO ENTRIES IN GLOBREG AND CHOSEN. ALSO RESET
!NEDSMATRLZ ON PARAMETER LUP.
!TRADE GINX1 AND GINX2 ENTRIES OF GLOBREG AND CHOSEN
MACRO SWAPG(LUP,GINX1,GINX2)=
BEGIN
REGISTER T;
LUP[NEDSMATRLZ]_0;
LUP[MATRLZIXONLY]_0;
T_.GLOBREG[GINX1]<0,36>;
GLOBREG[GINX1]_.GLOBREG[GINX2]<0,36>;
GLOBREG[GINX2]_.T<0,36>;
GLOBREG[GINX2]<NOPRELOAD>_1;
T_.CHOSEN[GINX1];
CHOSEN[GINX1]_.CHOSEN[GINX2];
CHOSEN[GINX2]_.T;
END$;
ROUTINE PLUSUNFLDO(STMT)=
BEGIN
!UNDO THE AOBJN LOOP ENDING.
!USED WHEN WE ARE NOT 100% SURE THAT WE CAN DO AN AOBJN
!SOME OF THESE CASES ARE:
! 1.NEDSMATRLZ WAS SET BY P2S SO THE UNFLDO CONDITION
! WAS NOT ALSO FOUND
! 2.ITS THE OUTER LOOP OF TWO BEING ALLOCATED
EXTERNAL UNFLDO;
MAP BASE STMT;
UNFLDO(.STMT);
STMT[SSIZONE]_1;
STMT[INITLIMMED]_1;
STMT[SSIZIMMED]_1;
END; ! of PLUSUNFLDO
ROUTINE ASCRIBE(P)=
BEGIN
!**************************************************************
! Tally merit by statement. Set merit to plainuse first.
! Change wherever necessary.
!**************************************************************
%2204% ! Restructure to generate better code, removing a SELECT with
%2204% ! an ALWAYS clause.
MAP PEXPRNODE P;
REGISTER
I,
BASE TMP;
RAISE = .MERITVAL[PLAINUSE];
! If complexity has said this statement needs pairs of regs then
! set GOTEMDBL flag so we will leave two pairs.
IF .P[PAIRMODEFLG] THEN GOTEMDBL = 1;
! First look at any local common subs that may be there
IF .P[SRCOPT] NEQ 0
THEN
BEGIN
TMP = .P[SRCOPT];
WHILE .TMP NEQ 0 DO
BEGIN ! Walk linked list of common subs
CREDIT(.TMP[ARG2PTR]);
TMP = .TMP[SRCLINK];
END; ! Walk linked list of common subs
END;
IF .P[SRCID] EQL ASGNID
THEN
BEGIN ! ASSIGNMENT
PC = .P [LHEXP]; ! Look at LHS
IF .PC [OPRCLS] EQL DATAOPR
THEN
BEGIN ! It is a variable
IF .P [MEMCMPFLG]
THEN RAISE = .MERITVAL [ASGNMEM]
ELSE RAISE = .MERITVAL [LHSUSE];
CREDIT(.PC);
END ! It is a variable
ELSE
BEGIN ! It is not a variable
%4517% CREDIT(.PC);
END;
! Now the right hand side. Give more credit if it is
! there all by itself.
IF .P[A2VALFLG]
THEN RAISE = .MERITVAL[LHSUSE] ! More credit as the lhs gets
ELSE RAISE = .MERITVAL[PLAINUSE];
CREDIT(.P[RHEXP]);
END ! ASSIGNMENT
ELSE IF .P[SRCID] EQL CALLID
THEN
BEGIN ! CALL
IF .P[CALLIST] NEQ 0
THEN CALLREFNO = .CALLREFNO + 1; ! Tally number of calls
END ! CALL
ELSE IF .P[SRCID] EQL IFAID
THEN CREDIT(.P[AIFEXPR]) ! ARITHMETIC IF
ELSE IF .P[SRCID] EQL IFLID
THEN
BEGIN ! LOGICAL IF
CREDIT(.P[LIFEXPR]);
ASCRIBE(.P[LIFSTATE]);
END; ! LOGICAL IF
%2237% ! Removed code for I/O statements, which merely made the
%2237% ! global register allocator paranoid about allocating things,
%2237% ! and resulted pessimal code.
I = (IF .P[SRCCMPLX] GTR 9 THEN 9 ELSE .P[SRCCMPLX]);
MAXCOMPLEX[.I] = .MAXCOMPLEX[.I] + 1;
END; ! of ASCRIBE
ROUTINE ASSOCIA(VAR)=
BEGIN
!CHECK THE LIST OF ASSOCIATE VARIABLES. DO NOT ALLOCATE
!ANY OF THEM. RETURN 1 TO STOP ALLOCATION
EXTERNAL ASSOCPTR;
REGISTER BASE T;
IF .ASSOCPTR EQL 0 THEN RETURN;
T_.ASSOCPTR;
WHILE .T NEQ 0 DO
BEGIN
IF .T[LEFTP] EQL .VAR THEN RETURN(1);
T_.T[RIGHTP];
END;
END; ! of ASSOCIA
%[660]% ROUTINE USRFNWALK(CNODE)=
%[660]% BEGIN
%[660]%
![660] ADD NEW ROUTINE TO HANDLE USER FUNCTIONS WHICH
![660] OCCUR WITHIN IF STATEMENTS - REGISTER ALLOCATION NEEDS IT.
%[660]%
%[660]% LOCAL ARGUMENTLIST ARGNOD,P;
%[660]% EXTERNAL CSTMNT;
%[660]% MAP BASE P:CSTMNT;
%[660]% MAP PEXPRNODE CNODE;
%[660]%
%[660]% CSTMNT[USRFNREF]_1;
%[660]% FNREFNO_.FNREFNO+1;
%[660]%
%[660]% ARGNOD_.CNODE[ARG2PTR]; !PTR TO ARGUMENT LIST
%[660]%
%[660]% INCR I FROM 1 TO .ARGNOD[ARGCOUNT] DO
%[660]% BEGIN
%[660]% P_.ARGNOD[.I,ARGNPTR]; !GET ACTUAL ARGUMENT
%[660]% IF .P[OPRCLS] EQL FNCALL THEN CREDIT(.P) !RECUR
%[660]% ELSE IF .P[OPR1] EQL VARFL THEN
%[660]% IF .CSTMNT[SRCID] EQL IFAID OR
%[660]% (.CSTMNT[SRCID] EQL IFLID AND .CSTMNT[TRUEISBR])
%[660]% THEN P[USRARGUSE]_1 !THIS VARIABLE CANNOT LIVE IN REG
%[660]% END
%[660]%
%[660]% END; !of USRFNWALK
ROUTINE CREDIT(CNODE)=
BEGIN
!INCREMENT MERIT BY RAISE. WALK TREE THRU AUDITOR
!CNODE POINTS TO AN EXPRESSION. RAISE IS GLOBAL TO CREDIT
!AND IS SET BY AUDITOR
EXTERNAL CSTMNT; MAP BASE CSTMNT;
MAP PEXPRNODE CNODE;
CASE .CNODE[OPRCLS] OF SET
!BOOLEAN
BEGIN
CREDIT(.CNODE[ARG1PTR]);
CREDIT(.CNODE[ARG2PTR]);
END;
!DATAOPR
BEGIN
IF .CNODE[OPERSP] EQL VARIABLE OR
.CNODE[OPERSP] EQL FORMLARRAY OR
.CNODE[OPERSP] EQL FORMLVAR THEN
BEGIN
%2375% ! Never globally allocate character variables
%2375% IF .CNODE[VALTYPE] EQL CHARACTER THEN RETURN;
!FOR THE INITIAL RELEASE GLOBALS WILL BE HANDLED
!AS COMMON. SOPHISTACATION CAN COME LATER.
IF .CNODE[IDATTRIBUT(INEQV)] THEN RETURN;
IF .CNODE[IDATTRIBUT(INCOM)] THEN RETURN;
IF .CNODE[IDATTRIBUT(INASSI)] THEN RETURN;
IF .CNODE[IDATTRIBUT(INNAM)] THEN RETURN;
IF .CNODE[IDATTRIBUT(FENTRYNAME)] THEN RETURN;
CNODE[MERIT]_.CNODE[MERIT]+.RAISE;!UPDATE MERIT
!FOR A VARIABLE THAT IS DOUBLE WORD
!SET THE FLAG AND DIVIDE THE MERIT
!JUST ADDED BY 2
IF .CNODE[DBLFLG] THEN
BEGIN
CNODE[MERIT]_.CNODE[MERIT]-.RAISE/2;
GOTEMDBL_1;
END;
IF .CNODE[MERIT] NEQ 0 THEN
CHKMAXLST(.CNODE);
END;
END;
!RELATIONAL
BEGIN
CREDIT(.CNODE[ARG1PTR]);
CREDIT(.CNODE[ARG2PTR]);
END;
!FNCALL
IF .CNODE[OPERSP] NEQ LIBARY THEN
%[660]% USRFNWALK(.CNODE)
ELSE
BEGIN
!LIBRARY FUNCTION. SET BIT IN SYMBOL
!TABLE THAT SAYS THIS IS USED
!AS LIB FUNCTION ARG. SUBTRACT IT AT END
!AS WITH FNREFNO.
LOCAL ARGUMENTLIST ARGNOD,P;
MAP BASE P;
LIBFNREFNO_.LIBFNREFNO+1;
ARGNOD_.CNODE[ARG2PTR]; !PTR TO LIST
INCR I FROM 1 TO .ARGNOD[ARGCOUNT] DO
BEGIN
!PICK UP POINTER TO ACTUAL ARG
P_.ARGNOD[.I,ARGNPTR];
IF .P[OPR1] EQL VARFL THEN
P[LIBARGUSE]_1
ELSE
!MAKE SURE THAT LIBARG REFS
!ARE COUNTED FOR CALLS TO LIB
!THAT ARE FUNCTIONS OF OTHER CALLS TO
!TO THE LIBRARY
IF .P[OPRCLS] EQL FNCALL THEN
CREDIT(.P);
END;
END;
!ARITHMETIC
BEGIN
CREDIT(.CNODE[ARG1PTR]);
CREDIT(.CNODE[ARG2PTR]);
END;
!TYPECNV
BEGIN
CREDIT(.CNODE[ARG2PTR]);
END;
!ARRAYREF
%2375% BEGIN
%2375% ! Don't give extra credit for character array indices
%2375%
%2375% IF .CNODE[VALTYPE] NEQ CHARACTER
%2375% THEN RAYMERIT(.CNODE)
%2375% ELSE IF .CNODE[ARG2PTR] NEQ 0
%2375% THEN CREDIT(.CNODE[ARG2PTR]);
%2375% END;
!CMNSUB !ILLEGAL
BEGIN
END;
!NEGNOT
CREDIT(.CNODE[ARG2PTR]);
!SPECOP
CREDIT(.CNODE[ARG1PTR]);
!FIELDREF !RELEASE GTR 1
BEGIN
END;
!STORCLS
BEGIN
END;
!REGCONTENTS
BEGIN END;
!LABOP
BEGIN
END;
!STATEMENT
BEGIN END;
!IOLSCLS
BEGIN
END;
!INLINFN
BEGIN END;
%2375% !SUBSTRING
%2375% BEGIN
%2375% CREDIT(.CNODE[ARG1PTR]); ! Upper bound
%2375% CREDIT(.CNODE[ARG2PTR]); ! Lower bound
%2375% CREDIT(.CNODE[ARG4PTR]); ! ARRAYREF or DATAOPR
%2375% END;
%2375% !CONCATENATION
%2375% BEGIN
%2375% LOCAL ARGUMENTLIST AG;
%2375% AG = .CNODE[ARG2PTR];
%2375%
%2375% INCR I FROM 2 TO .AG[ARGCOUNT] ! Skip first argument
%2375% DO CREDIT(.AG[.I,ARGNPTR]);
%2375% END;
TES;
END; ! of CREDIT
ROUTINE RAYMERIT(PC)=
BEGIN
!COMPUTE ARRAYREF MERIT
OWN BASE ARGNOD;
MAP PEXPRNODE PC;
!COMPUTE MERIT FOR AN ARRAY SUBSRCIPT.
!FORMALS ARE NOT A SPECIAL CASE HERE AS
!THEY HAVE THE PSEUDO CREATED NODE POINTED TO BY
!THE ARADDRVAR FIELD OF THE SYMBOL TABLE. THIS PSEUDO
!NODE IS IN THE TREE AND WILL GET MERIT.
!TAKE CARE OF CONSTANT SUBSCRIPT (ARG2PTR = 0)
IF .PC[ARG2PTR] EQL 0 THEN RETURN;
ARGNOD_.PC[ARG2PTR]; !SUBSCRIPT
!ONLY GIVE CREDIT FOR INDEX
!IF ITS BY ITSELF
IF .ARGNOD[OPRCLS] EQL DATAOPR THEN
BEGIN
RAISE_.MERITVAL[DEXUSE];
CREDIT(.ARGNOD);
END ELSE
IF .ARGNOD[OPRCLS] EQL CMNSUB THEN
BEGIN
IF .ARGNOD[A2VALFLG] THEN
BEGIN
RAISE_.MERITVAL[DEXUSE];
CREDIT(.ARGNOD[ARG2PTR]);
END;
END ELSE
BEGIN !JUST PLAIN USE
RAISE_.MERITVAL[PLAINUSE];
CREDIT(.ARGNOD);
END;
RAISE_.MERITVAL[PLAINUSE];
END; ! of RAYMERIT
ROUTINE CHKMAXLST(VAR)=
BEGIN
!LOOK AT LIST OF VARIABLES WHICH ARE CURRENTLY OF GREATEST MERIT.
!THE LIST IS IN CHOSEN
!VAR IS THE VARIABLE WHOSE MERIT IS UNDER EXAMINATION
!
LOCAL I;
MAP PEXPRNODE VAR;
I_LOOKUP(.VAR<RIGHT>);
IF .I LSS 32 THEN
CHOSEN[.I]<LEFT>_.VAR[MERIT]
ELSE
BEGIN !VARIABLE IS NOT ON LIST
!IF LIST IS NOT YET FULL (HEAD HAS COUNT) ADD TO THE LIST
IF .HEAD LEQ 31 THEN !HEAD CONTAINS COUNT
(
CHOSEN[.HEAD]<LEFT>_.VAR[MERIT];
CHOSEN[.HEAD]<RIGHT>_.VAR;
HEAD_.HEAD+1;)
ELSE
!IF THIS ONE HAS GREATER MERIT THAN THE
!CURRENT MINIMUM ON THE LIST THEN REPLACE THE
!OLD MINIMUM WITH THIS ONE AND RECOMPUTE THE MINIMUM
BEGIN
IF .MINWD EQL 0 THEN MINCOMPUTE();
IF .VAR[MERIT] GTR .MINWD<LEFT> THEN
BEGIN
CHOSEN[.MINWD<RIGHT>]<LEFT>_.VAR[MERIT];
CHOSEN[.MINWD<RIGHT>]<RIGHT>_.VAR;
MINCOMPUTE();
END; !MIN REPLACEMENT AND RECOMPUTE
END;
END;
END; ! of CHKMAXLST
ROUTINE MINCOMPUTE=
BEGIN
!RECOMPUTE THE MINIMUM OF THE LIST
MINWD<LEFT>_#100000;
DECR K FROM 31 TO 0 DO
BEGIN
IF .CHOSEN[.K]<LEFT> LSS .MINWD<LEFT> THEN
(MINWD<LEFT>_.CHOSEN[.K]<LEFT>;
MINWD<RIGHT>_.K;);
END;
END; ! of MINCOMPUTE
ROUTINE MELDPLEX=
BEGIN
!MELD IN CONSIDERATION OF THE COMPLEXITY OF THE
!EXPRESSIONS INVOLVED AND ADJUST REGTOALC APPROPRIATELY
!
!THIS IS STRICTLY A HEURISTIC:
!THE COMPLEXITY DISTRIBUTION IS EXAMINED.
!THE NUMBER OF REGISTERS AVAILABLE IS DECREASED BY 1
!FOR EACH STATEMENT OF COMPLEXITY GREATER
!THAN THE 4 STANDARD COMPUTATION REGISTERS.
!REGAVAIL ORIGINALLY CONTAINED THE NUMBER OF REGISTERS
!IT WAS INTENDED TO ALLOCATE GLOBALLY.
!REGTOALC CONTAINS THE ACTUALL NUMBER WE WILL ALLOCATE.
!
!THIS ROUTINE WILL ALSO DETERMINE THE TRUE VALUE OF
!REGTOALC, THE NUMBER OF REGISTERS THAT **WILL** BE
!GLOBALLY ALLOCATED. CHOSEN IS EXAMINED TO DETERMINE
!IF THERE ARE ANY ENTRIES AT ALL.
LABEL LOP1;
LOP1:
DECR I FROM 9 TO 4 DO
IF .MAXCOMPLEX[.I] NEQ 0 THEN
BEGIN
REGAVAIL_.REGAVAIL-.I;
LEAVE LOP1;
END;
REGTOALC_.REGAVAIL;
!COUNT NON-ZERO ENTRIES IN CHOSEN
!USE REGAVAIL AS A TEMP
REGAVAIL_0;
DECR I FROM 31 TO 0 DO
IF .CHOSEN[.I] NEQ 0 THEN
REGAVAIL_.REGAVAIL+1;
!NOW SEE IF THIS IS LESS THEN REGTOALC DETERMINED
!FROM THE COMPLEXITIES
IF .REGAVAIL LSS .REGTOALC THEN REGTOALC_.REGAVAIL;
END; ! of MELDPLEX
EXTERNAL CLEANUP;
ROUTINE GRABFNREF(EXPR)=
BEGIN
!EXAMINE EXPR FOR A FUNCTION REFERENCE TO A USER
!FUNCTION. IF ANY GLOBALLY ALLOCATED VARIABLES ARE
!ARGUMENTS TO THE FUNCTION CHANGE THEIR SAVCODE
!<ALCLFG> TO BE MATRLZ
MAP BASE EXPR;
CASE .EXPR[OPRCLS] OF SET
!BOOLEAN
BEGIN
GRABFNREF(.EXPR[ARG1PTR]);
GRABFNREF(.EXPR[ARG2PTR]);
END;
!DATAOPR
RETURN;
!RELATIONAL
BEGIN
GRABFNREF(.EXPR[ARG1PTR]);
GRABFNREF(.EXPR[ARG2PTR]);
END;
!FNCALL
BEGIN
REGISTER ARGUMENTLIST AG;
IF .EXPR[OPERSP] EQL LIBARY THEN
RETURN;
!HERE WE HAVE A GENUINE USER FUNCTION REFERENCE
AG_.EXPR[ARG2PTR];
DECR I FROM .REGTOALC-1 TO 0 DO
BEGIN
!FOR EACH GLOBALLY ALLOCATEREG
INCR ARG FROM 1 TO .AG[ARGCOUNT] DO
BEGIN
!FOR EACH ARGUMENT
IF .AG[.ARG,ARGNPTR] EQL
.GLOBREG[.I]<RIGHT> THEN
GLOBREG[.I]<ALCFLG>_MATRLZ;
END;
END;
END;
!ARITHMETIC
BEGIN
GRABFNREF(.EXPR[ARG1PTR]);
GRABFNREF(.EXPR[ARG2PTR]);
END;
!TYPECNV
GRABFNREF(.EXPR[ARG2PTR]);
!ARRAYREF
BEGIN
IF .EXPR[ARG2PTR] NEQ 0 THEN
GRABFNREF(.EXPR[ARG2PTR]);
END;
!CMNSUB
GRABFNREF(.EXPR[ARG2PTR]);
!NEGNOT
GRABFNREF(.EXPR[ARG2PTR]);
!SPECOP
GRABFNREF(.EXPR[ARG1PTR]);
!FIELDREF
RETURN;
!STORECLS
GRABFNREF(.EXPR[ARG2PTR]);
!REGCONTENTS
RETURN;
!LABOP
RETURN;
!STATEMENT
RETURN;
!IOLSCLS
RETURN;
!INLINFN
BEGIN
GRABFNREF(.EXPR[ARG1PTR]);
IF .EXPR[ARG2PTR] NEQ 0 THEN
GRABFNREF(.EXPR[ARG2PTR]);
END;
%2375% !SUBSTRING
%2375% BEGIN
%2375% GRABFNREF(.EXPR[ARG1PTR]); ! Upper bound
%2375% GRABFNREF(.EXPR[ARG2PTR]); ! Lower bound
%2375% GRABFNREF(.EXPR[ARG4PTR]); ! ARRAYREF or DATAOPR
%2375% END;
%2375% !CONCATENATION
%2375% BEGIN
%2375% LOCAL ARGUMENTLIST AG;
%2375% AG = .EXPR[ARG2PTR];
%2375%
%2375% INCR I FROM 2 TO .AG[ARGCOUNT] ! Skip first argument
%2375% DO GRABFNREF(.AG[.I,ARGNPTR]);
%2375% END;
TES;
END; ! of GRABFNREF
ROUTINE FLIPCODES=
BEGIN
!STUPID BUT EASIER THAN LOTS MORE BUGS.
!CODES WERE INITIALIZED TO AWL.
!SOME MAY HAVE BEEN RESET TO MATRLZ BY GRABFNREF.
!WE WILL BE SAVING AND RESTORING BASED ON AWL
!SO MAKE THOSE THAT SAY AWL NOW SAY MATRLZ AND
!VISA VERSA
!ALSO SORT GLOBREG SO THAT ALL THAT ARE NOT BEING
!SAVED ARE LEAFSUBSTITUTED.
!A MACRO OR TWO FOR LEGIBILITY
LABEL FIND,CHECK,COUNTEM;
LOCAL COUNT;
!REGS THAT ARE SAVED ARE THOSE CONTAINING VARS WHICH ARE ACTUAL
! ARGS TO FUNCTION
EXTERNAL ITMCT; !SET UP BY SORTNMAKE IN GBLALLOC
! TO BE REGTOALC - 1
MACRO SAVED(INX)=
.GLOBREG[.INX]<ALCFLG> EQL AWL$;
MACRO SWAAP(INX1,INX2)=
BEGIN
REGISTER T;
T_.GLOBREG[.INX1]<0,36>;
GLOBREG[.INX1]<0,36>_.GLOBREG[.INX2]<0,36>;
GLOBREG[.INX2]<0,36>_.T<0,36>;
T_.CHOSEN[.INX1];
CHOSEN[.INX1]_.CHOSEN[.INX2];
CHOSEN[.INX2]_.T;
END$;
DECR I FROM .REGTOALC-1 TO 0 DO
IF .GLOBREG[.I]<ALCFLG> EQL AWL THEN
GLOBREG[.I]<ALCFLG>_MATRLZ
ELSE
GLOBREG[.I]<ALCFLG>_AWL;
!SORT GLOBREG SO THAT THOSE THAT ARE NOT SAVED ARE LEAFSUBSTITUTED
! CALL LEAFLOOKER LOOKING ONLY AT THOSE NOT TO BE SAVED
CHECK:
DECR I FROM .REGTOALC-1 TO 0 DO
BEGIN
IF NOT SAVED (I) THEN
FIND:
BEGIN
INCR J FROM 0 TO .I DO
BEGIN
IF SAVED (J) THEN
BEGIN
SWAAP(I,J); ! SORT ITEMS
LEAVE FIND; ! LEAVE INNER LOOP
END;
END;
LEAVE CHECK; ! FINISHED SORT IF NONE FOUND
END;
END; ! HAVE THEM SORTED
COUNT _ 0;
COUNTEM: ! COUNT THE NUMBER NOT SAVED FOR CALL TO LEAFLOOKER
DECR I FROM .REGTOALC-1 TO 0 DO
IF NOT SAVED (I) THEN ! BY SCANNING BACK OVER
BEGIN ! THOSE TO BE SAVED
COUNT _ .I + 1; ! I AT FIRST ONE NOT SAVED: COUNT MUST BE 1-RELATIVE
LEAVE COUNTEM;
END;
IF .COUNT NEQ 0 THEN ! IF SOME NOT SAVED THEN
BEGIN
LOCAL SAVE;
SAVE_.REGTOALC; ! SAVE REAL VALUE
REGTOALC_.COUNT; ! FAKE OUT LEAFLOOKER WITH OUR COUNT
ITMCT _ .REGTOALC - 1; !FAKE OUT LEAFSUBSTITUTE'S CALLEES
LEAFLOOKER(.STARTSUB); ! SUBSTITUTE
REGTOALC_.SAVE;
ITMCT _ .REGTOALC - 1; !RESTORE OLD ITMCT
END;
END; ! of FLIPCODES
ROUTINE REGSUBDRIVER=
BEGIN
!DRIVER ROUITNE FOR SUBSTITUTION OF REGCONTENTS NODES.
!THE SCOPE OF THE SUBSTITUTION STARTS AT STARTSUB AND ENDS AT
!STOPSUB.
EXTERNAL CSTMNT,LENTRY;
LABEL LUP;
%4517% REGISTER BASE LHS;
OWN BASE SAVHITCH;
MAP BASE STARTSUB:STOPSUB;
!RESET THE FLAG TO INDICATE NO SAVING SEQUENCE DONE
SAVEDFLG_0;
CALLSEEN_0; ! INITIALIZE CALLSEEN (NONE YET SEEN)
%[776]% CLOGIF_0; !No logical IF nodes are being processed
!LEAFSUBSTITUTE NEEDS CSTMNT SO WE WILL SAVE THE CURRENT
!VALUE AND PUT IT BACK WHEN WE ARE DONE HERE
!MAKE SURE ALL CODES ARE AWL
DECR I FROM .REGTOALC-1 TO 0 DO
GLOBREG[.I]<ALCFLG>_AWL;
SAVCODE_AWL;
FRSTBB_1; !SET FIRST BASIC BLOCK FLAG
!SKIP ANY CALLS THAT ARE AT THE TOP
WHILE (.STARTSUB[SRCID] EQL CALLID) OR .STARTSUB[USRFNREF] DO
STARTSUB_.STARTSUB[SRCLINK];
!SET FLAG TO INDICATE WE ARE OUTSIDE THE LOOP
!AND DO NOT WHICH TO SUBSTITUTE INTO STATEMENT
!WITH RHEXP=REGCONTENTS
NOINDVARFLG_1;
!SET FLAG IF THIS IS DOUBLE NEST
ASGN4LENTRY_(.GUIDE EQL 6);
OLDCSTMNT_.CSTMNT;
THISTAT_LASTAT_.STARTSUB;
WHILE .STARTSUB NEQ .STOPSUB[SRCLINK] DO
BEGIN
!RESET NOINDVARFLG IF THIS IS "THE" LOOP WE ARE ALLOCATING
IF .STARTSUB EQL .TOP THEN
BEGIN
NOINDVARFLG_0;
!IF ALLOCATING ONLY THE INNER LOOP OF A
!NEST MARK ITEMS THAT WERE ASSIGNED
!OUTSIDE THE LOOP AS NEEDING TO
!TO BE SAVED.
IF .GUIDE EQL 5 THEN
BEGIN
DECR I FROM .REGTOALC-1 TO 0 DO
IF .GLOBREG[.I]<ASGND4USED> THEN
GLOBREG[.I]<NEDSAV>_1;
END;
END;
!IF A DOUBLE NEST AND WE HAVE REACHED THE OUTER LOOP
!THEN WE MUST MARK ALL VARIABLES THAT WERE ALLOCATED TO
!REGISTERS AND WERE ASSIGNED INTO IN THE BASIC BLOCK
!PRECEDING THE OUTER LOOP AS NEEDING MATERIALIZATION
!UNCONDITIONALLY. THIS IS BECAUSE DEFINITION POINT
!ANALYSIS DID NOT MARK THESE VARIABLES AS BEING MODIFIED
!INSIDE THE OUTER LOOP, AND SINCE WE HAVE SUBSTITUTED
!A REGCONTENTS NODE FOR THE ORIGINAL ASSIGNMENT TO
!MEMORY, THE VARIABLE WILL NEVER END UP IN MEMORY
!UNLESS WE EXPLICITLY MATERIALIZE IT.
IF .GUIDE EQL 6 AND .STARTSUB EQL .OLDCSTMNT
THEN
BEGIN
DECR I FROM .REGTOALC-1 TO 0 DO
IF .GLOBREG[.I]<ASGND4USED> THEN
GLOBREG[.I]<NEDSAV>_1;
END;
!IF A DOUBLE NEST AND WE ARE OUTSIDE THE MOTION PLACE
!OF UNSUBSUMED ITEMS IN THE OUTER LOOP MARK
!ANY .O AS NEEDING SAVING
IF .ASGN4LENTRY THEN
BEGIN
!IF THIS IS LENTRY QUIT
IF .STARTSUB EQL .LENTRY THEN
ASGN4LENTRY_0
ELSE
BEGIN
IF .STARTSUB[OPRS] EQL ASGNOS THEN
BEGIN
IF .STARTSUB[A1VALFLG] THEN
BEGIN
T_.STARTSUB[LHEXP];
IF .T[IDDOTO] EQL
SIXBIT".O" THEN
BEGIN
DECR I FROM .REGTOALC-1 TO 0 DO
IF .GLOBREG[.I]<RIGHT> EQL .T THEN
GLOBREG[.I]<NEDSAV>_1;
END;
END;
END;
END;
END;
!SAV WHERE WE START
CSTMNT_.STARTSUB;
SAVHITCH_.STARTSUB[SRCLINK];
!SUBSTITUT IF THERE ARE NO USER FUNCTION REFS
!IF MORE THAN TWO CALLS OCCUR IN A ROW, WE WANT
! TO ALLOW REGCONTENTS SUBSTITUTION ON THE FIRST CALL,
! NONE FOR ALL THE FOLLOWING CALLS (OR THE LIKE), AND THEN
! A RESTORE OF THE REGISTERS PRIOR TO CONTINUING. THE
! VARIABLE CALLSEEN (SET IN LEAFLOOKER) INDICATES WE ARE
! IN SUCH A SITUATION, HAVING SUBSTITUTED IN THE FIRST
! CALL ALREADY.
IF .CALLSEEN NEQ 0 THEN
BEGIN
CALLSEEN_0;
T_.STARTSUB[SRCLINK];
WHILE .T[USRFNREF] OR (.T[SRCID] EQL CALLID) DO
BEGIN
THISTAT_.T;
T_.T[SRCLINK];
END;
SAVHITCH_.T;
CALRESTORE(.THISTAT); !RESTORE REGISTERS FINALLY
SAVEDFLG_0;
! REINITIALIZE SAVE CODES AFTER RESTORATION
DECR I FROM .REGTOALC-1 TO 0 DO
GLOBREG[.I]<ALCFLG>_AWL;
END ELSE
IF NOT .STARTSUB[USRFNREF] THEN
LEAFLOOKER(.STARTSUB)
ELSE
BEGIN
!TURN ON ALL USED4ASGND BITS. THIS MAY
!BE NON-OPTIMAL BUT THERE IS NO CONVENIENT,
!SHORT WAY TO EXAMINE THE EXPRESSIONS AND
!SET THE BIT ONLY IF WE WANT TO. THOSE
!NOT ALREADY ASGND4USED WILL, THEREFORE,
!GET PRELOADED BY GETPRELOAD.
DECR I FROM .REGTOALC-1 TO 0 DO
IF NOT .GLOBREG[.I]<ASGND4USED> THEN
GLOBREG[.I]<USED4ASGND>_1;
!SET FLAG TO INDICATE THAT THERE ARE
!SEVERAL IN A ROW
T_.STARTSUB[SRCLINK];
FLAG_.T[USRFNREF] OR (.T[SRCID] EQL CALLID);
!SPECIAL CASE AN ASSIGNMENT WITH USRFNREF SET
!TO SAVE AND RESTORE ONLY THOSE THAT ARE
!ARGUMENTS
IF .STARTSUB[SRCID] EQL ASGNID THEN
BEGIN
!IF NEXT STATEMENT DOES NOT ALSO
!HAVE ONE OR IS NOT A CALL
!OR ANY PREVIOUS STATEMENT DID NOT
!CAUSE A STORE ALREADY
IF NOT .FLAG AND NOT .SAVEDFLG THEN
BEGIN
GRABFNREF(.STARTSUB[LHEXP]);
GRABFNREF(.STARTSUB[RHEXP]);
FLIPCODES();
END;
END;
!SAVE AND RESTORE AROUND STATEMENT
!SET SAVE CODE
SAVCODE_AWL;
!IF ALL VARIABLES WERE NOT ALREADY MATERIALIZED
!DO IT NOW.
IF NOT .SAVEDFLG THEN
BEGIN
CALLSAVE(.LASTAT);
SAVEDFLG_1;
END;
!IF ITS AN ASSIGNMENT STATEMENT AND THE LEFT HAND
!SIDE SHOULD BE A REG THAN MAKE IT A REG AND DONT DO THE RESTORE
IF (.STARTSUB[SRCID] EQL ASGNID) AND NOT .FLAG THEN
BEGIN
%4517% LHS = .STARTSUB[ARG1PTR];
%4517% IF .LHS[OPR1] EQL CHARFNFL ! 1-char asmnt
%4517% THEN CGERR() !character variables are never
%4517% !selected for global register
%4517% !allocation. (see edit 2375).
%4517% ELSE
%4517% BEGIN !non-character assignment
LUP:
DECR I FROM .REGTOALC-1 TO 0 DO
IF .GLOBREG[.I]<RIGHT> EQL
.STARTSUB[LHEXP] THEN
BEGIN
!DO THE SUBSTITUTION FOR THE
!SINGLE REFERENCE
STARTSUB[LHEXP]_
.CHOSEN[.I];
!SET THE FIELD SO RESTORE
!WILL NOT HAPPEN
GLOBREG[.I]<ALCFLG>_PRELOAD;
LEAVE LUP;
END;
%4517% END
END; !ITS AN ASSIGNMENT
!SKIP TO THE PROPER PLACE TO RESTORE
IF .FLAG THEN
BEGIN
WHILE .T[USRFNREF] OR (.T[SRCID] EQL CALLID) DO
BEGIN
THISTAT_.T;
T_.T[SRCLINK];
END;
SAVHITCH_.T;
END;
!HAVE NOW SKIPPED ALL OR NONE. DO RESTORE
CALRESTORE(.THISTAT);
SAVEDFLG_0;
!REINITIALIZE SAV CODES
DECR I FROM .REGTOALC-1 TO 0 DO
GLOBREG[.I]<ALCFLG>_AWL;
END; !USER FUNCTION CASE
!SKIP OVER POTENTIAL RESTORE STATEMENTS INSERTED
UNTIL .STARTSUB[SRCLINK] EQL .SAVHITCH DO
BEGIN
STARTSUB_.STARTSUB[SRCLINK];
!THE FLAG SHOULD BE RESET ONLY IF WE
!HAVE GENERATED THE RESTORES
SAVEDFLG_0;
END;
LASTAT_.STARTSUB;
THISTAT_STARTSUB_.STARTSUB[SRCLINK];
END; !WHILE
CSTMNT_.OLDCSTMNT;
END; ! of REGSUBDRIVER
ROUTINE FIXENTRY=
BEGIN
LOCAL T;
MAP BASE TOP:T;
OWN ARGUMENTLIST NEWLIST;
!FOR EACH ENTRY:
! FIX THE PROLOGUE
! INSERT PRELOADS
! INSERT MATERIALIZATIONS
!*********************
!MACRO TO SET UP ENTRY LIST INFORMATION
MACRO SETENTRY=
BEGIN
REGISTER BASE REG;
!LOOK AT THE REGCONTENTS NODE
!AND PUT THE REGISTER INTO
!THE ENTAC OF THE ENTRY
!LIST
REG_.CHOSEN[.I];
NEWLIST[.K,ENTAC]_.REG[TARGTAC];
NEWLIST[.K,ENTGALLOCFLG]_1;
!SET A FLAG TO HELP LATTER
GLOBREG[.I]<NOPRELOAD>_1;
END$;
!**;[1726], FIXENT @5677(5044 in V6), DCE, 9-Feb-83
%1726% PREV_0;
T_.TOP;
WHILE .T NEQ 0 DO
BEGIN
IF .T[SRCID] EQL ENTRID THEN
BEGIN
!REINITIALIZE FLAGS AND FIELDS IN GLOBREG TO
!PROPERLY HANDLE MULTIPLE ENTRIES
DECR I FROM .REGTOALC-1 TO 0 DO
BEGIN
GLOBREG[.I]<NOPRELOAD>_0;
GLOBREG[.I]<ALCFLG>_AWL;
!IF THIS IS A SECONDARY ENTRY RESET ASGND4USED
!AND SET USED4ASGND
IF .T[ENTNUM] NEQ 0 THEN
BEGIN
GLOBREG[.I]<ASGND4USED>_0;
GLOBREG[.I]<USED4ASGND>_1;
END;
END;
!CHECK FOR NO PARAMETERS
IF .T[ENTLIST] NEQ 0 THEN
BEGIN
NEWLIST_.T[ENTLIST];
!FOR EACH ALLOCATED REGISTER LOOK AT THE
!PARAMETERS
DECR I FROM .REGTOALC-1 TO 0 DO
BEGIN
INCR K FROM 1 TO .NEWLIST[ARGCOUNT] DO
BEGIN
!IF A PARAMETER MATCHES AN
!ALLOCATED VARIABLE
IF .NEWLIST[.K,ARGNPTR] EQL
.GLOBREG[.I]<RIGHT> THEN
BEGIN
SETENTRY;
END ELSE
BEGIN
!IF ITS A FORMAL ARRAY
!WE HAVE TO COMPARE THE
!KLUDGED ENTRY POINTED TO BY
!THE DIMENSION TABLE
REGISTER BASE TMP;
TMP_.GLOBREG[.I]<RIGHT>;
IF.TMP[OPERSP] EQL FORMLARRAY THEN
BEGIN
TMP_.TMP[IDDIM];
IF NOT .TMP[ADJDIMFLG] THEN
IF .TMP[ARADDRVAR] EQL .GLOBREG[.I]<RIGHT> THEN
SETENTRY;
END;
END;
END;
END;
END; !PARAMETERS
!PROLOGUE IS FIXED. DO PRELOADS
FLAG_0; !USE TO SAY IF THERE ARE SOME
DECR I FROM .REGTOALC-1 TO 0 DO
BEGIN
!CHECK ASGND4USED AND SET NOPRELOAD
IF .GLOBREG[.I]<ASGND4USED> THEN
GLOBREG[.I]<NOPRELOAD>_1;
END;
DECR I FROM .REGTOALC-1 TO 0 DO
BEGIN
IF NOT .GLOBREG[.I]<NOPRELOAD>
THEN
BEGIN
GLOBREG[.I]<ALCFLG>_PRELOAD;
FLAG_1;
END;
END;
SAVCODE_PRELOAD;
!**;[1726], FIXENTRY @5759(5126 in V6), DCE, 9-Feb-83
%1726% IF .FLAG
%1726% THEN
%1726% BEGIN
! Initialize registers at the entry point, but first
! we must make sure that there will be a jump around the
! entry point which gets us PAST these initializations!
! Otherwise we will "initialize" on our way around.
%1726% GOTOINSERT(.PREV,.T,.T[SRCLINK]); !The jump around
%1726% PA[SRCLBL]=.T[SRCLBL]; ! Put label(s) from ENTRY stmnt
%1726% T[SRCLBL]=0; ! onto the JRST statement.
%1726% CALRESTORE(.T); !The initializations
%1726% END; !Of initializing registers
END; !AN ENTRY STATEMENT
%1726% PREV_.T; !Save previous stmnt pointer
T_.T[SRCLINK]; !MOVE ON TO NEXT ONE
END; !WHILE ON T
!NOW DO MATERIALIZATIONS
!USE FLAG TO INDICATE PRESENCE AGAIN
FLAG_0;
DECR I FROM .REGTOALC-1 TO 0 DO
BEGIN
!IF THERE ARE MULTIPLE ENTRIES WE HAVE TO
!SAVE THE OPTIMIZER VARIABLES TOO. OTHERWISE
!WE DO NOT
IF .FLGREG<MULTENT> THEN
BEGIN
IF .GLOBREG[.I]<PROGVAR> THEN
BEGIN
FLAG_1;
GLOBREG[.I]<ALCFLG>_MATRLZ;
END;
END ELSE
BEGIN
IF .GLOBREG[.I]<NOTFORML> AND
.GLOBREG[.I]<PROGVAR> THEN
BEGIN
GLOBREG[.I]<ALCFLG>_MATRLZ;
FLAG_1;
END;
END;
END;
SAVCODE_MATRLZ;
IF .FLAG THEN
STOWONRETURN();
END; ! of FIXENTRY
ROUTINE MAKREGMASK=
BEGIN
!CONSTRUCT AND RETURN A POINTER TO A REGMASK NODE
REGISTER BASE T;
EXTERNAL CORMAN;
NAME<LEFT>_SRCSIZ;
T_CORMAN();
T[OPRCLS]_STATEMENT;
T[SRCID]_REGMASK;
.T
END; !of MAKREGMASK
ROUTINE SKIPMATERIALIZATION(STNODE)=
BEGIN
!SKIP OVER MATERIALIZATION NODES INSERTED BY THE GLOBAL
!ALLOCATOR. CALLED BY GETPRELOAD TO PREVENT PRELOADS
!FROM BEING INSERTED IN FRONT OF MATERIALIZATIONS FROM
!A PREVIOUS (CONTIGUOUS) GLOBALLY ALLOCATED LOOP.
MAP BASE STNODE;
REGISTER BASE RHNODE:TMP;
!MAY ALSO NEED TO SKIP A REGMASK NODE
TMP_.STNODE;
IF .STNODE[SRCID] EQL REGMASK THEN
BEGIN
STNODE_.STNODE[SRCLINK];
END;
WHILE .STNODE[SRCID] EQL ASGNID AND .STNODE[SRCISN] EQL 0 DO
BEGIN
IF .STNODE[A1VALFLG] AND .STNODE[A2VALFLG] THEN
BEGIN
RHNODE_.STNODE[RHEXP];
IF .RHNODE[OPRCLS] EQL REGCONTENTS THEN
BEGIN
TMP_.STNODE;
STNODE_.STNODE[SRCLINK]
END
ELSE
RETURN(.TMP);
END ELSE
RETURN(.TMP);
END;
.TMP
END; ! of SKIPMATERIALIZATION
ROUTINE GETPRELOAD=
BEGIN
!FOR CASES 5 AND 6 DETERMINE WHICH VARIABLES NEED
!PRELOADING AND FIND THE SPOT TO INSERT THE PRELOADS
!CAUSE THE PRELOADS TO HAPPEN
EXTERNAL BOTTOM;
MAP BASE T:BOTTOM:PREVBB;
EXTERNAL INDVAR,LOCLNK,GBSYREGS;
MAP BASE LOCLNK;
REGISTER BASE PRELLOC; !PRELOAD LOCATION
!**************************
!USEFUL MACRO
!**************************
!
!INSERT REGMASKNODE AT PRELLOC
MACRO INSERTMASK=
BEGIN
T_MAKREGMASK();
T[NEWREGSET]_.GBSYREGS<LEFT>;
T[SRCLINK]_.PRELLOC[SRCLINK];
PRELLOC[SRCLINK]_.T;
PRELLOC_.T;
END$;
!***************************
!FIRST DETERMINE WHO NEEDS PRELOADING
!A VARIABLE DOES NOT NEED TO BE PRELOADED IF:
! IT IS ASSIGNED BEFORE ITS INITIAL USE
! DURING REGCONTENTS SUBSTITUTION THIS
! INFO HAS BEEN COLLECTEDAND LEFT IT BITS IN
! GLOBREG.
T_.PREVBB;
!IF THIS JUST RANDOMLY HAPPENS TO BE AN ENTRY
!MOVE T UP BY 1 STATEMENT
IF .T[SRCID] EQL ENTRID THEN T_.T[SRCLINK];
!USE FLAG TO TELL WHETHER OR NOT ANY PRELOADS ARE NECESSARY
FLAG_0;
!NOW SET FUNCTION INDICATORS
DECR I FROM .REGTOALC-1 TO 0 DO
!FIRST A PASS TO CHECK USED4ASGND AND SET NO PRELOAD
IF .GLOBREG[.I]<ASGND4USED> THEN
GLOBREG[.I]<NOPRELOAD>_1
ELSE
GLOBREG[.I]<NOPRELOAD>_0;
DECR I FROM .REGTOALC-1 TO 0 DO
IF NOT .GLOBREG[.I]<NOPRELOAD> THEN
BEGIN
GLOBREG[.I]<ALCFLG>_PRELOAD;
FLAG_1;
END;
!MAKE THE PROPER REGMASK NODE AND
!STICK IT IN FRONT
!IF PREVBB IS A CONTINUE
!THEN WE CAN STICK THEM AT PREVBB WITH NO HARM
!UNLESS THERE IS A REGMASK IMMEDIATELY FOLLOWING
!(E.G. TWO CONTIGUOUS LOOPS) IN WHICH CASE JUST
!CHANGE THE REGMASK PATTERN
T_.PREVBB[SRCLINK];
IF .T[SRCID] EQL REGMASK THEN PREVBB_.T;
IF .PREVBB[SRCID] EQL CONTID THEN
BEGIN
!IF DO LOOPS END HERE OR NOT WE WILL DO THIS
!SET PRELOAD LOCATION AND
!TRANSFORM THIS INTO A REGMASK NODE
IF .PREVBB[SRCLBL] EQL 0 THEN
BEGIN
PRELLOC_.PREVBB;
PREVBB[SRCID]_REGMASK;
PREVBB[NEWREGSET]_.GBSYREGS<LEFT>;
END ELSE
BEGIN
!LABELED CONTINUE. MAKE A SEPARATE
!REGMASK NODE AND PUT IT AFTER THE
!CONTINUE
PRELLOC_MAKREGMASK();
PRELLOC[SRCLINK]_.PREVBB[SRCLINK];
PREVBB[SRCLINK]_.PRELLOC;
PRELLOC[NEWREGSET]_.GBSYREGS<LEFT>;
END;
!UPDATE PRELLOC SO PRELOADS WILL GO
!AFTER MATERIALIZATIONS (IF ANY).
PRELLOC_SKIPMATERIALIZATION(.PRELLOC);
END ELSE
IF .PREVBB[SRCID] EQL REGMASK THEN
BEGIN
! SET REGMASK
PREVBB[NEWREGSET]_.GBSYREGS<LEFT>;
!IF THERE ARE PREVIOUSLY INSERTED MATERIALIZATIONS
! THEN SET THE PLACE FOR INSERTION OF PRELOADS
! AFTER THE MATERIALIZATIONS. IF THERE ARE
! NO MATERIALIZATIONS TO SKIP, PUT THE PRELOADS
! DIRECTLY AFTER THE REGMASK.
! THIS WORKS WITH ONLY ONE TO SKIP
PRELLOC_SKIPMATERIALIZATION(.PREVBB);
END
ELSE
!IF IT IS A DO LOOP. PUT THE PRELOADS HERE AND CHECK
!FOR THE DO INDEX BEING GLOBALLY ALLOCATED
IF .PREVBB[SRCID] EQL DOID THEN
BEGIN
PRELLOC_.PREVBB;
DECR I FROM .REGTOALC-1 TO 0 DO
IF .GLOBREG[.I]<RIGHT> EQL .PREVBB[DOSYM] THEN
BEGIN
T_.CHOSEN[.I];
PREVBB[DOIREG]_.T[TARGTAC];
!INSURE NO PRELOAD
GLOBREG[.I]<ALCFLG>_AWL;
END;
INSERTMASK;
END
ELSE
!IF ITS A CALL DONT GO ANY FURTHER EITHER
IF (.PREVBB[SRCID] EQL CALLID) OR .PREVBB[USRFNREF] THEN
BEGIN
PRELLOC_.PREVBB;
!SKIP OVER CALLS IN A SEQUENCE
!OR STATEMENTS WITH USER FUNCTION REFERENCES.
!THESE WERE SKIPPED IN RECONTENTS SUBSTITUTION TOO.
WHILE (.PRELLOC[SRCID] EQL CALLID) OR .PRELLOC[USRFNREF] DO
BEGIN
PREVBB_.PRELLOC;
PRELLOC_.PRELLOC[SRCLINK];
END;
PRELLOC_.PREVBB;
INSERTMASK;
END ELSE
!IF ITS A LOGICAL IF WITH A BRANCHING STATMENT AS THE
!TRUE BRANCH, THEN MAKE IT BE THE PRELOAD LOCATION
![641] IF LOGICAL IF STATEMENT HAS A CALL STATEMENT AS ITS
![641] RESULT, WE WANT TO PASS IT BY FOR PRELOADING TO
![641] PREVENT THE PRELOADED REGISTERS FROM GETTING LOADED AFTER
![641] THE MATERIALIZATIONS THAT THE CALL STATEMENT WOULD GENERATE.
%[641]% IF .PREVBB[SRCID] EQL IFLID THEN
%[641]% BEGIN
%[641]% T_.PREVBB[LIFSTATE];
%[641]% IF .PREVBB[TRUEISBR] OR (.T[SRCID] EQL CALLID)
%[641]% THEN (PRELLOC_.PREVBB; INSERTMASK)
END
ELSE
BEGIN
!LOOK FOR THE STATEMENT INFRONT OF PREVBB
!MAKE A REGMASK NODE, STICK IT IN AND
!SET PRELLOC TO IT
!START LOOKING FOR THE STATEMENT IN FRONT OF PREVBB AT
!WAYBBB
PRELLOC_.WAYBBB;
!DO NOT ADJUST IF WAYBBB AND PREVBB ARE THE
!SAME. IN THIS CASE THEY ARE THE START OF THE PROGRAM
IF .WAYBBB EQL .PREVBB THEN
ELSE
WHILE .PRELLOC[SRCLINK] NEQ .PREVBB DO
PRELLOC_.PRELLOC[SRCLINK];
!ALSO GET RID OF STICKING IT IN FRONT OF THE ENTRY
WHILE .PRELLOC[SRCID] EQL ENTRID DO
PRELLOC_.PRELLOC[SRCLINK];
!ALSO CHECK IF PREVBB IS AN ENTRY
IF .PREVBB[SRCID] EQL ENTRID THEN
PRELLOC_.PREVBB;
!ALSO CHECK FOR A DO LOOP AND SET THE DO REGISTER
!TO USE THE GLOBAL REGISTER IF IT IS ALLOCATED
IF .PRELLOC[SRCID] EQL DOID THEN
BEGIN
DECR I FROM .REGTOALC-1 TO 0 DO
IF .GLOBREG[.I]<RIGHT> EQL .PRELLOC[DOSYM] THEN
BEGIN
T_.CHOSEN[.I];
PRELLOC[DOIREG]_.T[TARGTAC];
!DONT PRELOAD IT
GLOBREG[.I]<ALCFLG>_AWL;
END;
END;
!NOW MAKE THE REGMASK NODE
INSERTMASK;
IF .PREVBB[SRCLBL] NEQ 0 THEN
!WE MUST BE MORE CAREFUL HERE IN CASE THE PRELOAD HAS BEEN
! DONE AFTER THE STATEMENT AT PREVBB. THIS MAY BE THE
! CASE IF THE PREVIOUS BASIC BLOCK BEGINS THE SUBROUTINE,
! AND IS LABELED. IN THIS CASE, THE DANGER IS THAT THE LABEL
! WOULD BE MOVED DOWN IN THE CODE TO THE PRELOAD LOCATION WHICH
! IS NOT THE INTENT!
IF .PREVBB[SRCLINK] NEQ .PRELLOC THEN
BEGIN
!IF PREVBB WAS LABELED MOVE THE LABEL TO
!THE NEW NODE JUST MADE
PRELLOC[SRCLBL]_T_.PREVBB[SRCLBL];
T[SNHDR]_.PRELLOC;
PREVBB[SRCLBL]_0;
END;
END;
SAVCODE_PRELOAD;
!DO ACTUAL PRELOADS ONLY IF FLAG IS SET
IF .FLAG THEN
CALRESTORE(.PRELLOC);
!ONE MORE THING. IF ALLOCATING A LOOP NEST
!WE MUST INSERT A REGMASK NODE AT THE END OF
!THE INNER LOOP TO PREVENT THE LOCAL ALLOCATOR
!FROM ACCIDENTLY RELEASING THE INNER LOOPS INDEX REG
IF .GUIDE EQL 6 THEN
BEGIN
T_MAKREGMASK();
T[NEWREGSET]_.GBSYREGS<LEFT>;
!LINK IT IN AT BOTTOM
T[SRCLINK]_.BOTTOM[SRCLINK];
BOTTOM[SRCLINK]_.T;
END;
END; ! of GETPRELOAD
ROUTINE GETMATERIAL=
BEGIN
!IN CASES 5 AND 6 SET CODES FOR MATERIALIZATION
!AND CAUSE THEM TO HAPPEN
EXTERNAL BASE CSTMNT;
LABEL L1;
!USE FLAG TO DETERMINE IF THERE ARE ANY
FLAG_0;
DECR I FROM .REGTOALC-1 TO 0 DO
BEGIN
IF .GLOBREG[.I]<ALCFLG> EQL PRELOAD THEN
BEGIN
!SAVE ANY THAT WERE PRELOADED
GLOBREG[.I]<ALCFLG>_MATRLZ;
FLAG_1;
END ELSE
BEGIN
T_.CSTMNT[DOLBL];
!GET THE LIST OF VARIABLES CHANGED IN THIS
!LOOP FROM THE LABEL TABLE OF THE TERMINATING
!LABEL
T_.T[SNSTATUS];
L1:
!NOW WALK THE LINKED LIST AND SAVE ALL CHANGED
WHILE .T NEQ 0 DO
BEGIN
IF .GLOBREG[.I]<RIGHT> EQL .T[LEFTP] THEN
IF .GLOBREG[.I]<PROGVAR> THEN
BEGIN
GLOBREG[.I]<ALCFLG>_MATRLZ;
FLAG_1;
LEAVE L1;
END;
T_.T[RIGHTP];
END;
!IF THIS IS AN INNERLOOP ONLY WE WILL
!ASSUME THAT WE ARE DOING ONLY IT BECAUSE
!THERE ARE PARALLEL INNER ONES. THE ASSUMPTION
!CAN DO NO HARM. WE THEN ALSO NEED TO SAVE
!ANY .O VARIABLES THAT WERE ASSIGNED
!BEFORE USED AND ALSO SUBSUMED. UNFORTUNATELY
!WE DO NOT HAVE THIS LATTER INFO SO WE WILL
!JUST USE THE FIRST AND NOT BE PERFECTLY
!OPTIMAL.
IF .GUIDE GEQ 5 THEN
BEGIN
IF .GLOBREG[.I]<NEDSAV> THEN
BEGIN
GLOBREG[.I]<ALCFLG>_MATRLZ;
FLAG_1;
END;
END;
END; !ELSE PART
END; !DECR LOOP
!NOW DO IT
SAVCODE_MATRLZ;
IF .FLAG THEN
MATERIALIZE();
END; ! of GETMATERIAL
ROUTINE GBLALLOC=
BEGIN
EXTERNAL CSTMNT,GBSYREGS,INDVAR,GBSYCT;
MAP BASE INDVAR;
EXTERNAL EXITNO;
EXTERNAL UNFLDO,LENTRY;
EXTERNAL DOVARSUBSTITUTE;
MAP BASE TOP:BOTTOM:CSTMNT:P;
%2237% ROUTINE SORTNMAKE =
%2237% BEGIN
%2237%
%2237% ! This routine determines which entries of CHOSEN should be
%2237% ! allocated to registers and makes regcontents nodes for those
%2237% ! that should. Upon return REGTOALC contains the exact number
%2237% ! of items allocated.
%2237%
%2237% LABEL INSERT, SEARCH, MAKNODS;
%2237%
%2237% ! Place the entries of CHOSEN with the highest merit in
%2237% ! GLOBREG, but don't let GLOBREG grow larger than REGTOALC.
%2237% ! The entries in GLOBREG will be sorted by merit. This is
%2237% ! essentially a straight insertion sort.
%2237%
%2237% IF .REGTOALC GTR 0 ! Skip insert code if we're not allocating any
%2237% THEN
%2237% BEGIN ! Safe to insert
%2237%
%2237% REGISTER GLOBIX; ! GLOBREG index where we insert choice
%2237% REGISTER CURMERIT; ! Merit value of choice to be inserted
%2237% REGISTER GLOBSZ; ! Current size of GLOBREG
%2237%
%2237% GLOBSZ = 0; ! GLOBREG is initially empty
%2237%
%2237% INCR CHOICEI FROM 0 TO 31 ! Look at each entry in CHOSEN
%2237% DO IF .CHOSEN[.CHOICEI] NEQ 0 ! Ignore zero entries
%2237% THEN
%2237% INSERT: BEGIN ! Non-zero choice
%2237%
%2237% ! Try to insert the CHOICEI entry of CHOSEN
%2237% ! into GLOBREG.
%2237%
%2237% CURMERIT = .CHOSEN[.CHOICEI]<LEFT>; ! Save merit
%2237%
%2237% ! Now see if GLOBREG is full. If it isn't,
%2237% ! increase the size. Otherwise, see if the
%2237% ! current choice has more merit than the last
%2237% ! entry in GLOBREG (which will have the lowest
%2237% ! merit of all GLOBREG entries). If it
%2237% ! doesn't, simply leave the insertion code.
%2237% ! Otherwise continue without increasing the
%2237% ! size of GLOBREG, which effectively deletes
%2237% ! the last entry.
%2237%
%2237% IF .GLOBSZ NEQ .REGTOALC
%2237% THEN GLOBSZ = .GLOBSZ+1
%2237% ELSE IF .CURMERIT LEQ .GLOBREG[.GLOBSZ-1]<LEFT>
%2237% THEN LEAVE INSERT;
%2237%
%2237% GLOBIX = .GLOBSZ; ! Initialize place to insert
%2237%
%2237% ! Now search through GLOBREG until we find the
%2237% ! position where the current choice belongs,
%2237% ! moving GLOBREG entries up along the way.
%2237% ! When we leave the loop, GLOBIX will be the
%2237% ! offset into GLOBREG where the current choice
%2237% ! should be inserted.
%2237%
%2237% SEARCH: WHILE (GLOBIX = .GLOBIX-1) GTR 0
%2237% DO IF .CURMERIT LEQ .GLOBREG[.GLOBIX-1]<LEFT>
%2237% THEN LEAVE SEARCH
%2237% ELSE GLOBREG[.GLOBIX] = .GLOBREG[.GLOBIX-1];
%2237%
%2237% ! GLOBIX is now the GLOBREG offset where the
%2237% ! current choice will be inserted.
%2237%
%2237% GLOBREG[.GLOBIX] = .CHOSEN[.CHOICEI]; ! Insert it
%2237%
%2237% END; ! Non-zero choice
%2237%
%2237% REGTOALC = .GLOBSZ; ! Reset to number we want to allocate
%2237%
%2237% END; ! Safe to insert
!NOW REGTOALC HAS THE NUMBER OF VARIABLES THAT
!WE WANT TO ALLOCATE. SOME MAY BE DOUBLE AND
!SO ALL WILL NOT ACTUALLY GET ALLOCATED. MAKE
!THOSE ADJUSTMENTS AND REGCONTENTS NODES FOR THOSE
!THAT WILL ACTUALLY BE ALLOCATED.
!MINWD WILL CONTAIN THE NUMBER OF THE REGISTER TO ALLOCATE
!EACH TIME. HEAD WILL CONTAIN THE LIMIT NUMBER BEYOND WHICH
!WE SHALL NOT GO. REGS INCLUDING HEAD MAY BE ALLOCATED.
!MINWD IS SET PRIOR TO THE CALL TO THIS ROUTINE
!IF THERE WERE DOUBLE WORD QUANTITIES IN THE LOOP
!WE MUST MAKE SURE THAT THE LOCAL ALLOCATOR IS LEFT
!AN EVEN-ODD PAIR.
IF .GOTEMDBL THEN
HEAD_#10
ELSE
HEAD_#12;
!NOW WE KNOW WHERE TO START AND WHERE TO STOP.
!START AT MINWD. STOP AT HEAD.
MAKNODS:
INCR I FROM 0 TO .REGTOALC-1 DO
BEGIN
PD_0; !SET FLAG
GLOBREG[.I]<LEFT>_0; !ZERO MERIT HALF OF WD
PA_.GLOBREG[.I];
!IF ITS A DOUBLE WORD MAKE SURE ITS
!EVEN
IF .PA[DBLFLG] THEN
BEGIN
IF .MINWD THEN
MINWD_.MINWD+1;
!IF ITS STILL LEGIT
IF .MINWD+1 LSS .HEAD THEN
!SET FLAG
PD_1;
END ELSE !NOT DBLWORD
PD_(.MINWD LSS .HEAD);
!PD NOW SAYS IFS IT OK TO ALLOCATE.
!MINWD POINTS TO THE REGISTER NUMBER
IF .PD THEN
BEGIN
CHOSEN[.I]_BLDREGCONTENTS(.PA);
MINWD_.MINWD+1+.PA[DBLFLG];
!ALSO SET SOME FLAGS IN THE LEFT HALF OF
!OF THE ASSOCIATED GLOBREG ENTRY THAT
!RECORD SOME OF THE PROPERTIES OF THE
!VARIABLE JUST ALLOCATED.
!IS IT A FORMAL
IF NOT .PA[FORMLFLG] THEN
GLOBREG[.I]<NOTFORML>_1;
!IS IT A PROGRAMMER DEFINED VARIABLE
IF .PA[IDDOT] NEQ SIXBIT"." THEN
GLOBREG[.I]<PROGVAR>_1
ELSE
!IF ITS A .R DO NOT ALLOCATE THE VARAIBLE
IF .PA[IDDOTO] EQL SIXBIT".R" THEN
PA[IDATTRIBUT(NOALLOC)]_1;
END ELSE
!NOT LEGIT TO ALLOCATE
BEGIN
REGTOALC_.I;
LEAVE MAKNODS;
END;
END; !INCR LOOP
!REGTOALC AT LAST CONTAINS THE NUMBER WE ARE (WILL BE AND
!HAVE BEEN) ALLOCATING.
!SET ITMCT
ITMCT_.REGTOALC-1;
!SET GLOBALS INCASE THIS IS GUIDE 1-4 WILL BE RESET ELSEWHERE IF
!GUIDE IS 5 OR 6
GBSYREGS_.CLEANSLATE<0,36>;
GBSYCT_ONESCOUNT(.GBSYREGS);
END; ! of SORTNMAKE
!*************************************************
!AN OUTLINE OF THE PLAN:
!THE CALLER OF THIS ROUTINE HAS DETERMINED THE CASE (THERE ARE
!SIX OF THEM AND SET AN INDICATOR(GUIDE). THE PARAMETERS FOR THE
!BASIC DETERMINATION (TOP, BOTTOM) WERE ALSO SET. ALL CASES
!FOLLOW THE SAME PATH THROUGH QUITTING IF WE DONT WANT TO
!ALLOCATE ANY. THEN:
!CASE 1:
! A MAIN PROGRAM WITH NO LOOPS
! ----------------------------
! SORTNMAKE
! SUBSTITUTE
! PRELOAD THOSE IN DATA
!CASE 2:
! A MAIN PROGRAM WITH A SINGLE LOOP
! ---------------------------------
! RESET BOUNDS
! CASE 1
!CASE 3:
! A SUBPROGRAM WITH NO LOOPS
! --------------------------
! SORTNMAKE
! SUBSTITUTE
! FOR EACH ENTRY:
! FIX PROLOGUE
! PRELOAD
! MAKE FORMALS NOT ON ALL LISTS
! STOWON RETURN (FORMALS MARKED ABOVE + PROGRAMMER VARS.
!CASE 4:
! A SUBPROGRAM WITH A LOOP
! ------------------------
! RESET BOUNDS
! CASE 3
!CASE 5:
! AN INNER LOOP ONLY
! ------------------
! IF LOCAL ALLOC INDEX REMOVE IT FROM LIST IF THERE
! SET LOWER BOUND OF ALLOCATION REG NUMBER (MINWD)
! SORTNMAKE
! IF INDEX ON LIST MAKE IT FIRST
! SUBSTITUTE
! DETERMINE PRELOADS NEEDED (NOT SET IN PREVBB OR 1ST BB)
! PRELOAD
! MATERIALIZE ON EXITS
!CASE 6:
! OUTER AND INNER LOOPS
! ---------------------
! IF LOCAL ALLOC INDEX TAKE IT OFF LIST IF THERE
! SORTNMAKE
! IF INNER LOOP INDEX ON LIST MAKE IT FIRST
! IF OUTER LOOP INDEX ON LIST MAKE IT SECOND
! SUBSTITUTE
! DETERMINE PRELOADS NEEDED
! PRELOAD
! MATERIALIZE ALL AT EXITS FROM BOTH LOOPS
!BASIC DETERMINATION OF THE DESIRABILITY OF ALLOCATION.
!DETERMINE VALUE OF RAISE WHICH DEPENDS ON
! USE OF THE VARIABLE
!CALLS CREDIT TO WALK TREES ETC.
IF .FLGREG<BOUNDS> THEN RETURN;
HEAD_0; !INITILIZE FOR EXTRIES INTO CHOSEN
LIBFNREFNO_FNREFNO_CALLREFNO_0;
!COMPUTE MERITS FOR VARIABLES IN THE LOOP
P_.TOP[SRCLINK];
!PUT THE COMPLEXITY OF THE LOOP ITSELF INTO THE DISTRIBUTION
MAXCOMPLEX[(IF .TOP[SRCCMPLX] GTR 9 THEN 9
ELSE .TOP[SRCCMPLX])]_1;
!ALSO CONSIDER IF THE LOOP ITSELF HAS ANY DOUBLE PRECISION
!INVOLVED IN ANY OF ITS COMPUTATIONS.
IF .TOP[PAIRMODEFLG] THEN GOTEMDBL_1;
!MAKE A SPECIAL CASE IF GUIDE IS 6 (ALLOCATING INNER AND
!OUTER LOOPS BOTH) TO GIVE
!THE OUTER INDEX A LITTLE CREDIT. BUT NOT A LOT
IF .GUIDE EQL 6 THEN
BEGIN
RAISE_.MERITVAL[LCTLUSE];
CREDIT(.CSTMNT[DOSYM]);
END;
!SAVE CSTMNT
OLDCSTMNT_.CSTMNT;
WHILE .P NEQ .BOTTOM[SRCLINK] DO
BEGIN
CSTMNT_.P;
ASCRIBE(.P);
P_.P[SRCLINK];
END;
!RESTORE CSTMNT
CSTMNT_.OLDCSTMNT;
!DO NOT BOTHER WITH ANY VARIABLE THAT IS NOT AT LEAST GOING TO
!SAVE A MOVE (I.E. HAS AT LEAST THE MERIT OF A SINGLE LHS).
DECR I FROM .HEAD-1 TO 0 DO
BEGIN
IF .CHOSEN[.I]<LEFT> LEQ .MERITVAL[LHSUSE]
!UNDER NO CIRCUMSTANCES CAN AN ASSOCIATE VAR LIVE
! IN A REGISTER
OR ASSOCIA(.CHOSEN[.I]<RIGHT>)
THEN CHOSEN[.I]_0;
END;
!NOW SUBTRACT FNREFNO FROM ALL
!ADJUST FNREFNO TO INCLUDE CALLS TO
FNREFNO_.FNREFNO+.CALLREFNO;
!IF ANY GO NEGATIVE DELETE FROM LIST
! ADJUST FNREFNO TO REFLECT THE ACTUAL COST OF THE NUMBER OF
! FUNCTION REFERENCES AND CALLS
FNREFNO_.FNREFNO*.MERITVAL[FUNUSE];
!ALSO ADJUST LIBFNREFNO
!BUT LIBRARY FUNCTIONS ARE ONLY HALF OF USER FUNCTIONS
!BECAUSE THERE IS ONLY THE STORE COST
LIBFNREFNO_.LIBFNREFNO*(.MERITVAL[FUNUSE]/2);
INCR K FROM 0 TO .HEAD-1 DO
BEGIN
IF .CHOSEN[.K]<LEFT> LSS .FNREFNO THEN !ITS GOING NEGATIVE
CHOSEN[.K]_0
ELSE
BEGIN
CHOSEN[.K]<LEFT>_.CHOSEN[.K]<LEFT>-.FNREFNO;
!IF WE ARE STILL IN THE GAME DEDUCT LIBFNREFNO TOO IF
!IT APPLIES.
P_.CHOSEN[.K]<RIGHT>;
![660] HAS THE VARIABLE BEEN FLAGGED AS NOT ABLE TO LIVE IN REGISTER?
%[660]% IF .P[USRARGUSE] THEN CHOSEN[.K]_0 ELSE
IF .P[LIBARGUSE] THEN
BEGIN
IF .CHOSEN[.K]<LEFT> LSS .LIBFNREFNO THEN
CHOSEN[.K]_0
ELSE
CHOSEN[.K]<LEFT>_.CHOSEN[.K]<LEFT>-.LIBFNREFNO;
END;
END;
END;
!CONSIDER ACTUAL COMPLEXITY OF EXPRESSIONS INVOLVED
!
MELDPLEX();
CLEANUP();
!END OF DETERMINATION OF BASIC DESIRABILITY SECTION. THIS IS PERFORMED
!IN ALL CASES.
CLEANSLATE_.GBSYREGS;
!DONT BOTHER WITH THE PROCESS, IF WE ARE NOT GOING TO ALLOCATE ANY
IF .REGTOALC LEQ 0 THEN
RETURN;
!NOW WE WILL REALLY ALLOCATE SOMETHING.
!SET THE CONTROL FIELD ON ALL ALLOCATED VARIABLES TO
!AWL.
DECR I FROM .REGTOALC-1 TO 0 DO
GLOBREG[.I]<ALCFLGS>_AWL;
!NOW WALK TREE AND PUT IN ALLOCATIONS
SPECCASE_1; !FLAG FOR LEAFSUBSTITUTE
MINWD_2;
!ZERO LENTRY
LENTRY_0;
!NOW DEPENDING ON THE VALUE OF GUIDE FOLLOW THE PLAN OUTLINED
!ABOVE
CASE .GUIDE OF SET
BEGIN END; !ZERO IS ILLEGAL
!CASE 1 MAIN PROGRAM WITH NO LOOPS
BEGIN
SORTNMAKE();
EASY1;
END;
!CASE 2 MAIN PROGRAM SINGLE LOOP
BEGIN
!TAKE INDUCTION VARIABLE FROM LIST IF LOCALLY ALLOCATED
REMOVINDVAR;
!UNDO THE AOBJN ENDING IF NEDSMATRLZ WAS SET BY P2S
!ALSO RESET NEDSMATRLZ AND MATRLZIXONLY
CHKGIX;
IF (.TOP[NEDSMATRLZ] OR .TOP[MATRLZIXONLY]) AND .TOP[IXGALLOCFLG] THEN
BEGIN
PLUSUNFLDO(.TOP);
TOP[NEDSMATRLZ]_0;
TOP[MATRLZIXONLY]_0;
IF .CALLREFNO NEQ 0 THEN TOP[MATRLZCTLONLY]_1;
END;
!RESET BOUNDS
MINWD_LOWERBD(.TOP);
IF .MINWD NEQ 2 THEN TOP[IXGALLOCFLG]_1;
!SET BOTTOM UP TO THE END STATEMENT
BOTTOM_.SORCPTR<RIGHT>;
SORTNMAKE();
SETDOIREG;
!ALSO EXPAND THE SCOPE FOR THE SUBSTITUTION. UNFUDGDO
!HAS ADJUSTED SORCPTR LEFT TO POINT TO THE PSEUDO
!DO LOOP NODE. UNFUDGDO IS IN PHA2.
TOP_.SORCPTR<LEFT>;
EASY1;
END;
!CASE 3 SUBPROGRAM WITH NO LOOPS
BEGIN
SORTNMAKE();
STARTSUB_.TOP;
STOPSUB_.BOTTOM;
REGSUBDRIVER();
FIXENTRY();
END;
!CASE 4 SUBPROGRAM WITH A SINGLE LOOP
BEGIN
!SEE COMMENT IN CASE 2
!TAKE LOCALLY ALLOCATED INDUCTION VARIABLE OFF LIST
REMOVINDVAR;
CHKGIX;
!DONT AOBJN IT NOR MATERIALIZE THE INDEX
IF (.TOP[NEDSMATRLZ] OR .TOP[MATRLZIXONLY]) AND .TOP[IXGALLOCFLG] THEN
BEGIN
PLUSUNFLDO(.TOP);
TOP[NEDSMATRLZ]_0;
TOP[MATRLZIXONLY]_0;
IF .CALLREFNO NEQ 0 THEN TOP[MATRLZCTLONLY]_1;
END;
TOP_.SORCPTR<LEFT>;
MINWD_LOWERBD(.TOP);
IF .MINWD NEQ 2 THEN TOP[IXGALLOCFLG]_1;
BOTTOM_.TOP[DOLBL];
BOTTOM_.BOTTOM[SNHDR];
!SORT, MAKE REGCONTENTS NODES AND SUBSTITUE THEM
SORTNMAKE();
STARTSUB_.TOP;
STOPSUB_.BOTTOM;
REGSUBDRIVER();
!SET REG FIELD IN DO NODE IF GLOBALLY ALLOCATED
SETDOIREG;
FIXENTRY();
END;
!CASE 5 INNER LOOP ONLY
BEGIN
!TAKE THE INDEX OFF THE LIST IF IT WAS LOCALLY
!ALLOCATED
REMOVINDVAR;
!SET MINWD
MINWD_LOWERBD(.TOP);
IF .MINWD NEQ 2 THEN TOP[IXGALLOCFLG]_1;
!SORT THE LIST, MAKE REGCONTENTS NODES
SORTNMAKE();
!PREVENT ANY FALSE COMPARES
SECIDX_-1;
!MAKE THE INDEX VARIABLE FIRST ON THE LIST OF IT IS
!NOW ON THE LIST AT ALL
DECR I FROM .REGTOALC-1 TO 0 DO
BEGIN
IF .GLOBREG[.I]<RIGHT> EQL .INDVAR THEN
BEGIN
SWAPG(.TOP,.I,0);
TOP[IXGALLOCFLG]_1;
!IF ITS AOBJN AND THERE ARE CALLS
!MAKE IT NOT AOBJN AND SAVE THE CONTROL
!WORD ONLY
IF .TOP[FLCWD] AND .CALLREFNO NEQ 0 THEN
BEGIN
PLUSUNFLDO(.TOP);
TOP[MATRLZCTLONLY]_1;
END;
!ALSO SET NOPRELOAD FLAG
GLOBREG[0]<NOPRELOAD>_1;
END;
END;
!SET THE FIELD OF THE DO LOOP NODE THAT TELLS IT
!WHICH REGISTER TO USE FOR THE INDEX
SETDOIREG;
!SET STARTSUB AND STOPSUB AND DO SUBSTITUTION
T_.TOP[DOLBL];
WAYBBB_.T[SN1STLAB];
PREVBB_STARTSUB_.T[SNNXTLAB];
!DO NOT ALLOW THE BASIC BLOCK TO BEGIN WITH A
! LOGICAL IF STATEMENT. THIS PREVENTS FUTURE PRELOADS
! OF REGISTERS FROM HAPPENING IN FRONT OF AN IF STATEMENT
! WHICH MIGHT MEAN POOR CODE. STEP THE STARTSUB TO THE
! NEXT STATEMENT INSTEAD.
IF .STARTSUB[SRCID] EQL IFLID
THEN STARTSUB_.STARTSUB[SRCLINK];
STOPSUB_.BOTTOM;
REGSUBDRIVER();
!COLLECT AND CAUSE PRELOADS TO HAPPEN
GETPRELOAD();
!COLLECT AND CAUSE MATERILIZATIONS TO HAPPEN
GETMATERIAL();
!MAKE A REGMASK NODE
!TO INDICATE END OF SCOPE OF MODIFIED GBSYREGS
CSTMNT_MAKREGMASK();
CSTMNT[NEWREGSET]_#177760;
CSTMNT[SRCLINK]_.BOTTOM[SRCLINK];
BOTTOM[SRCLINK]_.CSTMNT;
END;
!CASE 6 INNER AND OUTER LOOP
BEGIN
EXTERNAL CSTMNT; MAP BASE CSTMNT;
!A SYNOPSIS OF THE CAST
!TOP- POINTS TO INNER LOOP
!CSTMNT-POINTS TO OUTER LOOP
!BOTTOM-POINTS TO END OF INNER LOOP
!INDVAR-POINTS TO INNER LOOP INDEX VARIABLE
!TAKE LOCALLY ALLOCATED INDEX FROM LIST
REMOVINDVAR;
!UNDO THE AOBJN PART OF THE OUTER LOOP
!WE CANNOT DO THE ANALYSIS TO PERMIT IT TO STAY
!AS AN AOBJN. ALSO SETTING THE IMMEDIATE FLAG WOULD
!BE A DRAG.
IF .CSTMNT[FLCWD] THEN
PLUSUNFLDO(.CSTMNT);
!SET MINWD
MINWD_LOWERBD(.TOP);
IF .MINWD NEQ 2 THEN TOP[IXGALLOCFLG]_1;
!SORT AND MAKE REGCONTENTS NODES
SORTNMAKE();
!ESTABLISH SECIDX AS POINTER TO OUTER LOOP INDEX
SECIDX_.CSTMNT[DOSYM];
!GET INDEX VARIABLES INTO TOP SPOTS IN GLOBREG
!IF THEY ARE THER AT ALL
DECR I FROM .REGTOALC-1 TO 0 DO
BEGIN
IF .GLOBREG[.I]<RIGHT> EQL .INDVAR THEN
BEGIN
SWAPG(.TOP,.I,0);
TOP[IXGALLOCFLG]_1;
IF .CALLREFNO NEQ 0 THEN
TOP[MATRLZCTLONLY]_1;
END
ELSE
IF .GLOBREG[.I]<RIGHT> EQL .SECIDX THEN
BEGIN
!WE HAVE TO CHECK TO SEE IF THIS
!IS THE ONLY ONE
IF .REGTOALC NEQ 1 THEN
SWAPG(.CSTMNT,.I,1);
CSTMNT[IXGALLOCFLG]_1;
CSTMNT[NEDSMATRLZ]_0;
CSTMNT[MATRLZIXONLY]_0;
CSTMNT[MATRLZCTLONLY]_1;
!ALSO SET FIELD IN DO STATEMENT
!NODE (CSTMNT)
!THE SWAP HAS ALREADY OCCURRED
T_.CHOSEN[(QQ_(IF .REGTOALC EQL 1 THEN 0 ELSE 1))];
CSTMNT[DOIREG]_.T[TARGTAC];
!SAVE THE CONTOL WORD IF THERE WERE
!CALLS
IF .CALLREFNO NEQ 0 THEN
CSTMNT[MATRLZCTLONLY]_1;
!ALSO SET NO PRELOAD
GLOBREG[.QQ]<NOPRELOAD>_1;
END;
END;
!SET THE REGISTER FOR THE DO LOOP INDEX
SETDOIREG;
!SET UP PARAMETERS FOR SUBSTITUTION
T_.CSTMNT[DOLBL];
WAYBBB_.T[SN1STLAB];
PREVBB_STARTSUB_.T[SNNXTLAB];
STOPSUB_.T[SNHDR];
LENTRY_.CSTMNT[DOPRED];
!DO NOT ALLOW A LOGICAL IF STATEMENT TO BEGIN THE
! BASIC BLOCK WHICH PRECEDES THE SET OF NESTED LOOPS
IF .STARTSUB[SRCID] EQL IFLID THEN STARTSUB_.STARTSUB[SRCLINK];
REGSUBDRIVER();
!NOW PRELOAD AS CASE 5
GETPRELOAD();
!AND MATERIALIZE AT OUTSIDE OF OUTER LOOP
TOP_.CSTMNT;
BOTTOM_.STOPSUB;
GETMATERIAL();
!MAKE REGMASK NODE TO RESET GBSYREGS
CSTMNT_MAKREGMASK();
CSTMNT[SRCLINK]_.BOTTOM[SRCLINK];
BOTTOM[SRCLINK]_.CSTMNT;
CSTMNT[NEWREGSET]_#177760;
END;
TES;
END; ! of GBLALLOC
ROUTINE BLDREGCONTENTS(VAR)=
BEGIN
EXTERNAL CLOBBREGS;
REGISTER BASE T;
MAP BASE VAR:QQ;
!NEED TO COPY VALTYPE STUFF ETC. FROM SYMBOLTABLE
QQ_MAKPR1(0,REGCONTENTS,0, .VAR[VALTYPE],0, .VAR);
QQ[TARGTAC]_QQ[TARGADDR]_.MINWD;
QQ[INREGFLG]_1;
!RESET BITS IN CLEASLATE IT SAY REGS ARE USED.
!SET BITS IN CLOBBREGS TO SAY BITS ARE USED.
CLEANSLATE_CLRBIT(.CLEANSLATE,.MINWD);
CLOBBREGS_SETBIT(.CLOBBREGS,.MINWD);
!IF DOUBLE PRECISION DO IT FOR MIN+1 ALSO
IF .VAR[DBLFLG] THEN
BEGIN
CLEANSLATE_CLRBIT(.CLEANSLATE,.MINWD+1);
CLOBBREGS_SETBIT(.CLOBBREGS,.MINWD+1);
END;
.QQ
END; ! of BLDREGCONTENTS
ROUTINE GOTOFORCELOAD=
BEGIN
%ROUTINE TO FORCE PRELOADING OF VARIABLES NOT DEFINED WHEN A BRANCH
STATEMENT IS ENCOUNTERED%
DECR I FROM .REGTOALC-1 TO 0 DO
!NO NEED TO PRELOAD COMPILER VARIABLES JUST ON THE BASIS OF
!A GOTO, SINCE THE GOTO WAS ALREADY CONSIDERED WHEN PLACING
!USES AND ASSIGNMENTS OF COMPILER VARIABLES (.O & .R)
IF .GLOBREG[.I]<PROGVAR> THEN !IF NOT A COMPILER VARIABLE
IF NOT .GLOBREG[.I]<ASGND4USED> THEN
GLOBREG[.I]<USED4ASGND>_1;
END; ! of GOTOFORCELOAD
EXTERNAL LEAFSUBSTITUTE,IOSUBSTITUTE;
ROUTINE LEAFLOOKER(P)=
BEGIN
!***************************************************************
! Walks down expression nodes under a statement to perform leaf
! substitution for any references within the expression to
! GLOBREG (a vector) with the corresponding element in the
! vector CHOSEN. Also used to substitute the REGCONTENTS node
! for the DO induction variable on innermost DO loops.
!
! P - points to the statement.
!***************************************************************
EXTERNAL CSTMNT,MISCIO,DOVARSUBSTITUTE,SWAPEM,LOWLIM;
%1742% EXTERNAL MISCOCI;
LOCAL BASE TMP;
MAP PEXPRNODE P:TOP;
![776] Make CLOGIF a module OWN so REGSUBDRIVER can intialize it
%[776]% LOWLIM = 0;
! Look for common sub-expressions that may be there from local
! elimination on statements that do not postdominate the entry
! of their loop.
IF (TMP = .P[SRCCOMNSUB]) NEQ 0
THEN DO
BEGIN
IF .TMP[A2VALFLG]
THEN
BEGIN
DECR I FROM .ITMCT TO 0 DO
BEGIN
IF .TMP[ARG2PTR] EQL .GLOBREG[.I]<RIGHT>
THEN
BEGIN
TMP[ARG2PTR] = .CHOSEN[.I];
! DON'T FORGET TO SET ASGND4USED HERE TO CAUSE
! PRELOADING OF REGCONTENTS NODE IF APPROPRIATE.
! WITHOUT THIS, A STATEMENT LIKE:
! A(K)=B(K) WHICH PRECEDES A DO LOOP WITH AN
! ASSIGNMENT TO K MAY GET BAD CODE GENERATED FOR IT.
! IN FACT NO PRELOAD OF K WOULD HAPPEN, SO THAT THE
! ASSIGNMENT WOULD LOOK FOR K IN A REGISTER WHICH
! HAD NOT BEEN PRELOADED (INITIALIZED).
IF NOT .GLOBREG[.I]<ASGND4USED>
THEN GLOBREG[.I]<USED4ASGND> = 1;
! SET THE IMMED FLAG IF IT IS AN
! AOBJN GUY.
IF .TOP[FLCWD] AND
.GLOBREG[.I]<RIGHT> EQL .TOP[DOSYM]
THEN TMP[A2IMMEDFLG] = 1;
END;
END;
END
ELSE LEAFSUBSTITUTE(.TMP[ARG2PTR]);
END UNTIL (TMP = .TMP[CLINK]) EQL 0;
CASE .P[SRCID] OF SET
BEGIN ! Assignment
TMP = .P[RHEXP];
IF .TMP[OPRCLS] EQL REGCONTENTS AND .NOINDVARFLG
THEN RETURN;
LEAFSUBSTITUTE(.P[RHEXP]);
LEAFSUBSTITUTE(.P[LHEXP]);
! RESET BB FLAG. CODE MAY NOT BE IDEAL BUT WILL ALWAYS BE RIGHT
FRSTBB = 0;
END; ! Assignment
LEAFSUBSTITUTE(.P[ASISYM]); ! ASSIGN
BEGIN ! CALL
! IF NOT PREVIOUSLY SAVED OR NOT IN THE FIRST BASIC
! BLOCK, SAVE EVERYBODY
IF NOT .SAVEDFLG AND NOT .FRSTBB
THEN
BEGIN
CALLSAVE(.LASTAT);
SAVEDFLG = 1;
END;
IF .P[CALLIST] NEQ 0
THEN
BEGIN
LOCAL ARGUMENTLIST ARGL;
ARGL = .P[CALLIST];
INCR I FROM 1 TO .ARGL[ARGCOUNT] DO
BEGIN
TMP = .ARGL[.I,ARGNPTR];
IF .TMP[OPRCLS] NEQ LABOP AND .TMP[OPRCLS] NEQ DATAOPR
THEN LEAFSUBSTITUTE(.ARGL[.I,ARGNPTR]);
END;
END;
! ONLY RESTORE IF THE NEXT STATEMENT WOULD NOT CAUSE A
! SAVE AGAIN RIGHT AWAY SET TMP TO THE NEXT STATEMENT.
! IF THIS CALL WAS THE TRUE BRANCH OF THE LOGICAL IF
! MAKE IT THE NEXT STATEMENT
TMP = (IF .P[SRCLINK] NEQ 0
THEN .P[SRCLINK]
ELSE IF .CLOGIF NEQ 0
THEN .CLOGIF[SRCLINK]);
! SET CALLSEEN IF TWO CALLS IN A ROW (OR THE LIKE) THIS
! WILL TRIGGER THE SKIPPING OF ALL CALLS AFTER THE FIRST
! BACK IN REGSUBDRIVER
IF .TMP[USRFNREF] OR .TMP[SRCID] EQL CALLID
THEN CALLSEEN = 1
ELSE CALRESTORE(IF .P[SRCLINK] NEQ 0
THEN .P
ELSE .THISTAT);
FRSTBB = 0;
END; ! CALL
BEGIN END; ! CONTINUE
BEGIN ! DO
!CHECK TO MAKE SURE WE SHOULD HAVE ONE
IF .GUIDE GEQ 5
THEN DOVARSUBSTITUTE(.P);
FRSTBB = 0;
END; ! DO
FRSTBB = 0; ! ENTRY
BEGIN END; ! COMMONSUB
GOTOFORCELOAD(); ! GOTO - FORCE PRELOADING
BEGIN ! ASSIGNED GOTO
GOTOFORCELOAD();
LEAFSUBSTITUTE(.P[AGOTOLBL]);
END; ! ASSIGNED GOTO
BEGIN ! COMPUTED GOTO
GOTOFORCELOAD();
LEAFSUBSTITUTE(.P[CGOTOLBL]);
END; ! COMPUTED GOTO
BEGIN ! ARITHMETIC IF
GOTOFORCELOAD();
LEAFSUBSTITUTE(.P[AIFEXPR]);
END; ! ARITHMETIC IF
BEGIN ! LOGICAL IF
LEAFSUBSTITUTE(.P[LIFEXPR]);
!FUDGE CSTMNT TO POINT TO THE OTHER STATEMENT
CLOGIF = TMP = .CSTMNT;
CSTMNT = .P[LIFSTATE];
%[634]% !REMEMBER WHICH GLOBREG'S HAVEN'T YET BEEN SEEN
%[634]% DECR I FROM .REGTOALC-1 TO 0
%[634]% DO
%[634]% BEGIN
%[634]% IF NOT .GLOBREG[.I]<ASGND4USED>
%[634]% AND NOT .GLOBREG[.I]<USED4ASGND>
%[634]% THEN
%[634]% GLOBREG[.I]<NOTYETSEEN> = TRUE
%[634]% ELSE
%[634]% GLOBREG[.I]<NOTYETSEEN> = FALSE
%[634]% END;
%[634]% !PROCESS THE OBJECT STATEMENT
LEAFLOOKER(.P[LIFSTATE]);
%[634]% !NOW: IF LEAFLOOKER SAW ANY ASSIGNMENTS, WE NEED TO
%[634]% !CHANGE THEM TO REFERENCES, SINCE THEY MIGHT NOT GET
%[634]% !EXECUTED. THEREFORE, SEE IF ANY GLOBREG'S HAVE
%[634]% !ASGND4USED SET NOW THAT DIDN'T BEFORE.
%[634]% DECR I FROM .REGTOALC-1 TO 0
%[634]% DO
%[634]% BEGIN
%[634]% IF .GLOBREG[.I]<NOTYETSEEN>
%[634]% THEN
%[634]% BEGIN
%[634]% GLOBREG[.I]<NOTYETSEEN> = FALSE;
%[634]% IF .GLOBREG[.I]<ASGND4USED>
%[634]% THEN
%[634]% BEGIN
%[634]% GLOBREG[.I]<ASGND4USED> = FALSE;
%[634]% GLOBREG[.I]<USED4ASGND> = TRUE
%[634]% END
%[634]% END
%[634]% END;
CSTMNT = .TMP;
%[776]% CLOGIF = 0; !Done with logical IF node
END; ! LOGICAL IF
IF .P[RETEXPR] NEQ 0 ! RETURN
THEN LEAFSUBSTITUTE(.P[RETEXPR]);
BEGIN END; ! STOP
BEGIN ! READ
FRSTBB = 0;
%1742% MISCIO(.P);
END; ! READ
BEGIN ! WRITE
%1742% MISCIO(.P);
END; ! WRITE
BEGIN ! DECODE
FRSTBB = 0;
%1742% MISCIO(.P);
END; ! DECODE
BEGIN ! ENCODE
FRSTBB = 0;
%1742% MISCIO(.P);
END; ! ENCODE
BEGIN ! REREAD
FRSTBB = 0;
%1742% MISCIO(.P);
END; ! REREAD
%1742% MISCIO(.P); ! FIND
%1742% MISCOCI(.P); ! CLOSE
%4502% MISCIO(.P); ! DELETE
%4503% MISCIO(.P); ! REWRITE
%1742% MISCIO(.P); ! BACKSPACE
%1742% MISCIO(.P); ! BACKFILE
%1742% MISCIO(.P); ! REWIND
%1742% MISCIO(.P); ! SKIPFILE
%1742% MISCIO(.P); ! SKIPRECORD
%1742% MISCIO(.P); ! UNLOAD
%4504% MISCIO(.P); ! UNLOCK
%1742% MISCIO(.P); ! ENDFILE
%[740]% BEGIN END; ! END
%[740]% BEGIN END; ! PAUSE
%1742% MISCOCI(.P); ! OPEN
BEGIN END; ! SFN
BEGIN END; ! FORMAT
BEGIN END; ! BLT
BEGIN END; ! REGMASK - change set of available registers -
! inserted by global register allocator
%2211% MISCOCI(.P); ! INQUIRE
TES;
! Reset first basic block flag if statement is labeled
IF .P[SRCLBL] NEQ 0 THEN FRSTBB = 0;
END; ! of LEAFLOOKER
ROUTINE CALLSAVE(HOOK)=
!MATERIALIZE EVERYTHING IN A REGISTER BEFORE A CALL OR FUNCTION REFERENCE
BEGIN
MAP BASE PREV;
!MAKSTASH WILL MAKE THE CORRECT SET OF
!ASSIGNMENTS AND WILL LINK THEM TO
!ITS PARAMETER. WE MUST LINK THIS SET OF
!ASSIGNMENTS TO THE INITIAL VALUE OF HOOK[SRCLINK]
!MAKSTASH RETURNS A POINTER TO THE LAST STATEMENT
!IT CREATED.
MAP BASE HOOK;
LOCAL T;
T_.HOOK[SRCLINK];
HOOK_MAKSTASH(.HOOK);
HOOK[SRCLINK]_.T;
END; ! of CALLSAVE
ROUTINE CALRESTORE(HOOK)=
BEGIN
MAP BASE HOOK:PREV:QQ;
LABEL LOADEM;
EXTERNAL MAKASGN;
!PUT VALUES BACK INTO REGISTERS AFTER A FUNCTION CALL OR REFERENCE
PREV_.HOOK;
!SAVE THE LINK ON THIS ONE TO LINK UP THE END
PD_.HOOK[SRCLINK];
INCR I FROM 0 TO .REGTOALC-1 DO
LOADEM:
BEGIN
IF NOT CODEMATCH(.GLOBREG[.I]) THEN LEAVE LOADEM;
QQ_MAKASGN(.CHOSEN[.I],.GLOBREG[.I]);
PREV[SRCLINK]_.QQ; !LINK UP
!SET FLAGS AND FIELDS NECESSRY FOR CG
QQ[A1SAMEFLG]_1;
QQ[SRCCMPLX]_1;
T_.CHOSEN[.I];
QQ[ASMNTREG]_.T[TARGTAC];
PREV_.QQ;
END;
PREV[SRCLINK]_.PD;
END; ! of CALRESTORE
ROUTINE LABLLOK(STMT,LABLE,MATLAB)=
BEGIN
!LOOK AT LABEL LISTS FOR LABEL.
!REPLACE IN WITH MATLAB.
MAP PEXPRNODE STMT;
!IF THERE IS AN ASSIGNED GO TO WITHOUT ANY ASSIGNS
!WE COULD STILL BE HERE. SO WE HAVE TO CHECK FOR
!THE ABSENCE OF A LIST.
!A COMPUTES GO TO SHOULD NEVER HAVE GOTOLIST 0
IF .STMT[GOTONUM] EQL 0 THEN
BEGIN
IF .STMT[GOTOLBL] EQL .LABLE THEN
BEGIN
STMT[GOTOLBL]_.MATLAB;
!MAKE THE STATEMENT A STRAIGHT GO TO
STMT[SRCID]_GOTOID;
END;
END ELSE
DECR I FROM .STMT[GOTONUM]-1 TO 0 DO
IF @(.STMT[GOTOLIST]+.I) EQL .LABLE THEN
BEGIN
PC_.STMT[GOTOLIST]+.I;
PC[CESLNK]_.MATLAB;
END;
END; !of LABLLOK
ROUTINE MAKRETU(HOOK)=
BEGIN
!HOOK POINTS TO THE PLACE WE WILL BUILD A RETURN STATEMENT
!WE WILL RETURNA POINTER TO THE RETURN STATEMENT MADE
MAP BASE P:HOOK;
NAME<LEFT>_SRCSIZ+RETUSIZ;
P_CORMAN();
P[OPRCLS]_STATEMENT;
P[SRCID]_RETUID;
P[SRCLINK]_.HOOK[SRCLINK];
HOOK[SRCLINK]_.P;
.P
END; ! of MAKRETU
ROUTINE MAKSTASH(HOOK)=
BEGIN
!MAKE AND LINK ALL THE ASSIGNMENT STATEMENTS FOR
!A MATERIALIZATION
!HOOK IS SET TO THE PLACE TO LINK THE FIRST ONE.
!MAKSTASH RETURNS A POINTER TO THE LAST ONE MADE
!ALSO SET LOCLNK TO THE FIRST ASSIGNMENT MADE
EXTERNAL TOP,INDVAR,LOCLNK,MAKASGN;
MAP BASE P:TOP:HOOK:LOCLNK;
LABEL SAVEM;
LOCLNK_.HOOK;
PREV_.HOOK;
DECR K FROM .REGTOALC-1 TO 0 DO
SAVEM:
BEGIN
IF .GLOBREG[.K]<ALCFLG> NEQ .SAVCODE THEN LEAVE SAVEM;
P_MAKASGN(.GLOBREG[.K],.CHOSEN[.K]);
!SPECIAL CHECK TO SET FLAGS
IF .GLOBREG[.K] EQL .INDVAR THEN
IF .TOP[FLCWD] THEN
P[A2IMMEDFLG]_1;
!COMPLETE HOOKUP. MAY BE ALTERED OUTSIDE
P[SRCLINK]_.HOOK[SRCLINK];
HOOK[SRCLINK]_.P;
HOOK_.P;
END; !END OF DECR LOOP ON REGTOALC
!MAKE LOCLNK POINT TO THE FIRST STATEMENT INSERTED
IF .HOOK NEQ .LOCLNK THEN LOCLNK_.LOCLNK[SRCLINK];
.HOOK
END; ! of MAKSTASH
%( This routine removed in edit 2270
ROUTINE NAMESET=
BEGIN
EXTERNAL NAMLPTR;
MAP BASE QQ;
!ONE SMALL CHORE. GO THROUGH ANY NAMELISTS AND SET THE
!BIT IN THE SYMBOL FOR VARIBALES IN THE NAMELIST
QQ_.NAMLPTR<LEFT>;
WHILE .QQ NEQ 0 DO
BEGIN
INCR I FROM 0 TO .QQ[NAMCNT]-1 DO
BEGIN
REGISTER BASE T1;
T1_@(.QQ[NAMLIST]+.I);
T1[IDATTRIBUT(INNAM)]_1;
END;
QQ_.QQ[CLINK];
END;
END; ! of NAMESET
)%
ROUTINE STOWONRETURN=
BEGIN
!LOOK FOR ALL RETURN STATEMENTS AND STORE ALLOCATED
!VARIABLES AWAY.
!MACRO TO TRANSFORM ITS PARAMETER INTO A GO TO STATEMENT.
!PARAMETER MUST BE MAPPED TO BASE AND BE A RETURN. NOTE THAT
!THIS WILL NOT WORK IF THE SIZE (RELATIVE) OF THE NODES
!CHANGES.
MACRO MAKAGO(NOD,LABLE)=
BEGIN
NOD[SRCID]_GOTOID;
NOD[GOTOLBL]_.LABLE;
END$;
LABEL WHLPREV;
OWN BASE RETSPOT;
EXTERNAL BASE LOCLNK;
EXTERNAL GENLAB;
MAP BASE BOTTOM:PD:TOP;
LOCAL BASE STMT;
MAP BASE PREV:HEAD:PA:QQ;
!BOTTOM SHOULD POINT TO THE STATEMENT BEFORE THE END
!IF IT DOES NOT MAKE IT DO SO
UNTIL .BOTTOM[SRCLINK] EQL .SORCPTR<RIGHT> DO
BOTTOM_.BOTTOM[SRCLINK];
!IF IT IS NOT AN ABSOLUTE BRANCH INSERT A RETURN.
IF .BOTTOM[SRCID] EQL GOTOID OR
.BOTTOM[SRCID] EQL STOPID OR
.BOTTOM[SRCID] EQL RETUID THEN
LOCLNK_.BOTTOM
ELSE
BEGIN
LOCLNK_MAKRETU(.BOTTOM);
LOCLNK[SRCLINK]_.SORCPTR<RIGHT>;
END;
RETSPOT_0; !NO RETURN STORES MADE.
STMT_.SORCPTR<LEFT>;
WHILE .STMT NEQ 0 DO
BEGIN
HEAD_.STMT;
PREV_.STMT;
WHLPREV:
WHILE 1 DO
BEGIN
!SPECIFICALLY QUIT IF A RETURN OR BOTTOM
IF .PREV[SRCID] EQL ENDID THEN RETURN;
IF .PREV[SRCID] EQL RETUID THEN LEAVE WHLPREV;
!THOSE LOGICAL IFS, ONCE AGAIN,
!CAUSE A SPECIAL SIDE TRIP.
IF .PREV[SRCID] EQL IFLID THEN
BEGIN
PA_.PREV[LIFSTATE];
!LOOK TO SEE IF TRUE BRANCH IS A RETURN
IF .PA[SRCID] EQL RETUID THEN
BEGIN
!IF WE ALREADY HAVE A SET OF
!RETURN MATERIALIZATIONS THEY ARE
!LABELED BY RETSPOT (NON-ZERO)
!IF THIS IS A RETURN(I) MAKE A
!SEPARATE ONE TOO
IF .RETSPOT NEQ 0 AND .PA[RETEXPR] EQL 0 THEN
MAKAGO(PA,RETSPOT)
ELSE
BEGIN
!MAKE A SET OF MATERIALIZATIONS
!THROW THEM IN AT THE END
!SAVE OUR PLACE
PD_.PREV;
PREV_MAKSTASH(.LOCLNK);
!PREV POINTS TO LAST ONE
!OF ASSIGNMENTS NOW
!MAKE A RETURN HERE TOO
PREV_MAKRETU(.PREV);
!PREV NOW POINTS TO THAT
!RETURN.
!SET A FLAG SO WE KNOW WE
!MADE IT. THIS IS NEEDED
!SO THAT WHEN IT IS ENCOUNTERED
!LATER WE DO NOT MAKE AN
!INFINITE LOOP
PREV[A2NOTFLG]_1;
!LABEL THE FIRST SAVE
QQ_LABFRST;
!SEE IF THIS A RETURN (I)
IF .PA[RETEXPR] NEQ 0 THEN
BEGIN
PREV[RETEXPR]_.PA[RETEXPR];
PA[RETEXPR]_0;
END ELSE
RETSPOT_.QQ;
!NOTE THAT
!THIS TRUE BRANCH
!CAN NEVER BE LABELED
!RESET LOCLNK
LOCLNK_.PREV;
!RESET PREV
PREV_.PD;
MAKAGO(PA,QQ);
END;
END;
END;
HEAD_.PREV;
PREV_.PREV[SRCLINK];
END; !WHILE 1 DO
!HEAD NOW POINTS TO THE STATEMENT BEFORE
!A RETURN AND PREV TO THE RETURN.
PREV_.HEAD;
HEAD_.HEAD[SRCLINK];
! PREV POINTS TO THE STATEMENT BEFORE THE
!RETURN, HEAD TO THE RETURN ITSELF
!ON THE OTHERHAND IF WE ALREADY HAVE A SET OF
!STORES MADE UP, RETSPOT POINTS TO THE LABEL
!AND WE CAN CHEAPLY MAKE THIS RETURN A GO TO THAT LABEL
!BUT FIRST WE MUST CHECK THAT THIS IS NOT
!A RETURN MADE BY A TRUE BRANCH OF A LOGICAL IF
IF .HEAD[A2NOTFLG] THEN
BEGIN
HEAD[A2NOTFLG]_0; !LETS BE TIDY
RETURN;
END;
IF (.RETSPOT NEQ 0) AND (.HEAD[RETEXPR] EQL 0) THEN
BEGIN
MAKAGO(HEAD,RETSPOT)
END ELSE
BEGIN
!DO IT ALL NOW
PREV_MAKSTASH(.PREV);
!LABEL THE FIRST ONE
QQ_LABFRST;
IF .HEAD[RETEXPR] EQL 0 THEN RETSPOT_.QQ;
END;
!FINAL LINK UP
PREV[SRCLINK]_.HEAD;
STMT_.HEAD[SRCLINK];
END; !WHILE ON STMT
END; ! of STOWONRETURN
ROUTINE MATERIALIZE=
BEGIN
EXTERNAL EXITNO;
MAP BASE EXITNO;
EXTERNAL GENLAB;
EXTERNAL INDVAR;
MAP PHAZ2 TOP;
EXTERNAL CHOSEN,REGTOALC,GLOBREG,SAVSPACE;
EXTERNAL LOCLNK;
MAP BASE LOCLNK;
MAP BASE BOTTOM:HEAD:PD;
MAP PEXPRNODE QQ;
MAP PEXPRNODE PREV;
!MATERIALIZE VARIABLES ASSIGNED TO REGISTERS
ROUTINE SETBBALCFIELDS=
BEGIN
!LOCAL ROUITNE TO SET TWO FIELDS IN THE
!MATERIALIZATION NODES CREATED TO HELP THE
!BASIC BLOCK ALLOCATOR KEEP GLOBALLY
!ALLOCATED VARIABLES IN REGISTERS
PREV_.LOCLNK;
!THE INSERTED STATEMENTS ARE BETWEEN LOCLNK
!AND HEAD
WHILE .PREV NEQ .HEAD DO
BEGIN
PREV[SRCSONNXTUSE]_0;
PREV[SRCSAVREGFLG]_1;
PREV_.PREV[SRCLINK];
END;
END; ! of SETBBALCFIELDS
!BOTTOM POINTS AT A CONTINUE WHICH HAS A FIELD THAT
!POINTS TO THE LINKED LISTS OF EXITS.
!SET UP TWO MODULE OWNS
PREV_.BOTTOM;
HEAD_.BOTTOM[SRCLINK];
!IF THE FULLFILLMENT EXIT IS THE ONLY ONE GET OUT NOW
IF .BOTTOM[OPTINFO] EQL 0 THEN
BEGIN
!FULFILLMENT EXIT ONLY
SAVCODE_MATRLZ;
!IF EITHER INDEX IS ON THE LIST
!DONT LET IT BE SAVED AT ALL
IF .INDVAR NEQ 0 THEN
IF .GLOBREG[0]<RIGHT> EQL .INDVAR THEN
GLOBREG[0]<ALCFLG>_AWL;
IF .SECIDX NEQ 0 THEN
IF .GLOBREG[1]<RIGHT> EQL .SECIDX THEN
GLOBREG[1]<ALCFLG>_AWL
ELSE
!IF IT IS THE ONLY ONR ALLOCATED IT IS FIRST
IF .GLOBREG[0]<RIGHT> EQL .SECIDX THEN
RETURN;
PREV_MAKSTASH(.BOTTOM);
PREV[SRCLINK]_.HEAD;
SETBBALCFIELDS();
RETURN;
END;
SAVCODE_MATRLZ;
!GENERATE MATERIALIZATIONS FOR FULLFILLMENT EXIT TOO
PREV_MAKSTASH(.BOTTOM);
!NOW THE OTHER (EARLY EXITS) EXITS REMAIN TO BE
!PROCESSED. AFTER THE MATERIALIZATIONS FROM THE
!FULLFILLMENT EXIT MAKE A GOTO AROUND THE OTHER
!MATERIALIZATIONS WE WILL GENERATE.
!IF THERE ARE MORE EXITS THAN STANDARD THEN
! 1. MAKE THE STATEMENT AFTER BOTTOM BE A GO TO
! AROUND THE MATERIALIZATIONS
! 2. CREATE A LABEL FOR THE ATATEMENT AFTER BOTTOM
! IF NECESSARY.
IF .HEAD[SRCLBL] NEQ 0 THEN
PD_.HEAD[SRCLBL]
ELSE
BEGIN
PD_GENLAB();
HEAD[SRCLBL]_.PD;
PD[SNHDR]_.HEAD;
PD[SNREFNO]_2;
END;
!MAKE THE GO TO
NAME<LEFT>_GOTOSIZ+SRCSIZ;
PA_CORMAN();
PA[OPRCLS]_STATEMENT;
PA[SRCID]_GOTOID;
PA[GOTOLBL]_.PD;
!ADJUST LINKS
PA[SRCLINK]_.HEAD;
PREV[SRCLINK]_.PA;
PREV_.PA;
!FOR EACH EXIT MAKE A SET OF
!ASSIGNMENTS AND A GO TO THE EXIT LABEL
!THATS THE EASY PART
EXITNO_.BOTTOM[OPTINFO];
WHILE .EXITNO NEQ 0 DO
BEGIN
OWN BASE THSEXT; !PTR TO CURRENT ITEM ON EXITLST
THSEXT_.EXITNO[LEFTP];
PREV_MAKSTASH(.PREV);
!MAKE THE GO TO STATEMENT NODE
NAME<LEFT>_GOTOSIZ+SRCSIZ;
PA_CORMAN();
PA[OPRCLS]_STATEMENT;
!DETERMINE IF IT IS AN ASSIGNED GO TO OR A REGULAR ONE
!NOTE * NEVER * HERE WITH A COMPUTED GO TO
IF .THSEXT[OPRCLS] EQL LABOP THEN
PA[SRCID]_GOTOID
ELSE
PA[SRCID]_AGOID;
PA[GOTOLBL]_.THSEXT;
PREV[SRCLINK]_.PA;
PA[SRCLINK]_.HEAD;
PREV_.PA;
!NOW THE TIME CONSUMING PART.
!LOOK A THE ORIGINAL BRANCH STATEMENT.
!CHANGE IT TO BRANCH TO QQ.
P_.TOP[SRCLINK];
QQ_LABFRST;
WHILE .P NEQ .BOTTOM[SRCLINK] DO
BEGIN
MATLOK(.P,.THSEXT,.QQ);
P_.P[SRCLINK];
END;
EXITNO_.EXITNO[RIGHTP];
END; !FOR EACH EXIT
!SET BASIC BLOCK ALLOCATOR FIELDS ON INSERTED STATEMENTS
SETBBALCFIELDS();
!THATS ALL!!!!!
END; ! of MATERIALIZE
ROUTINE MATLOK(PB,LABL,NEWLAB)=
BEGIN
!PB IS POINTER TO THE STATEMENT
!THIS ROUTINE LOOKS AT ALL POSSIBLE BRANCHES AND SUBSTITUTES
!NEWLAB FOR AN LABEL REFERENCE THAT MATCHES LABL
!EXTRA LEVEL NEEDED FOR LOGICAL IF STATEMENT
MAP PHAZ2 PB;
%2204% ! Look at END and ERR for I/O statements
%2204% IF (.PB[SRCID] GEQ READID AND .PB[SRCID] LEQ ENDFID) OR
%2204% .PB[SRCID] EQL OPENID OR .PB[SRCID] EQL INQUID
%2204% THEN
%2204% BEGIN ! I/O statement
%2204% IF .PB[IOERR] EQL .LABL THEN PB[IOERR] = .NEWLAB;
%2204% IF .PB[IOEND] EQL .LABL THEN PB[IOEND] = .NEWLAB;
%2204% RETURN; ! Done - return now
%2204% END;
SELECT .PB[SRCID] OF NSET !ALL BRANCHING STATEMENTS
GOTOID: BEGIN !GO TO
IF .PB[GOTOLBL] EQL .LABL THEN
PB[GOTOLBL]_.NEWLAB;
END;
CGOID: BEGIN !COMPUTED GO TO
LABLLOK(.PB,.LABL,.NEWLAB);
!CESLNK IS RIGHT HALF THROUGH THE STRUCTURE
END;
AGOID: BEGIN !ASSIGNED GO TO - OPTIONAL LIST IS PRESENT
LABLLOK(.PB,.LABL,.NEWLAB);
END;
IFLID: BEGIN !LOGICAL IF
MATLOK(.PB[LIFSTATE],.LABL,.NEWLAB);
END;
IFAID: BEGIN !ARITHMETIC IF
IF .PB[AIFLESS] EQL .LABL THEN
PB[AIFLESS]_.NEWLAB;
IF .PB[AIFEQL] EQL .LABL THEN
PB[AIFEQL]_.NEWLAB;
IF .PB[AIFGTR] EQL .LABL THEN
PB[AIFGTR]_.NEWLAB;
END;
CALLID: BEGIN !CALL - MAY HAVE LABEL AS PARAMETER
IF .PB[CALLIST] NEQ 0 THEN
BEGIN
LOCAL ARGUMENTLIST ARGL;
ARGL_.PB[CALLIST];
INCR J FROM 1 TO .ARGL[ARGCOUNT] DO
BEGIN
PA_.ARGL[.J,ARGNPTR];
IF .PA[OPRCLS] EQL .LABOP THEN
BEGIN
IF .PA EQL .LABL THEN
ARGL[.J,ARGNPTR]_.NEWLAB;
END;
END;
END;
END;
TESN;
END; ! of MATLOK
ROUTINE INITEM=
BEGIN
EXTERNAL GBSYREGS,GBSYCT;
!REINITIALIZE SOME GLOBALS
DECR I FROM 31 TO 0 DO
CHOSEN[.I]_0;
DECR I FROM 15 TO 0 DO
GLOBREG[.I]_0;
GOTEMDBL_0;
!ALSO SET SOME OWNS
MINWD_0;
DECR I FROM 9 TO 0 DO
MAXCOMPLEX[.I]_0;
!ALSO INITIALIZE SOME GLOBALS
CLEANSLATE_
GBSYREGS_#177760000000;
GBSYCT_12;
REGAVAIL_8;
END; ! of INITEM
%[1047]% PORTAL ROUTINE MRP3G=
BEGIN
LABEL ALCREGS;
%1245% EXTERNAL ALCAVARS,ALCQVARS,ALCCON,HISEGBLK;
EXTERNAL RETNCT,ASVCT;
EXTERNAL INITREGCANDIDATES,CMPBLOCK;
EXTERNAL ALLOCATE,RELINIT;
EXTERNAL STBSYR,STRGCT,ALCSTMNT,LENTRY;
EXTERNAL GBSYREGS,GBSYCT;
%1454% EXTERNAL FORMPTR;
%2210% EXTERNAL DMPFORMAT; ! Allocates and writes FORMATs
EXTERNAL ALCBLOCK,NOBBREGSLOAD,INIRGSTATE;
EXTERNAL DOCNT,DOWDP;
!CONTROL GLOBAL REGISTER ALLOCATION
LABEL EXAMSTAT;
EXTERNAL CSTMNT,INDVAR,ISN;
MAP BASE TOP:P:CSTMNT:LENTRY:BOTTOM:WAYBBB;
DOWDP_0;
!INITIALIZE THE RELFILE IF ONE WAS REQUESTED
IF .FLGREG<OBJECT> THEN
RELINIT();
!ALLOCATE ARRAYS AND SCALARS, COMMON AND EQUIVALENCE
ALLOCATE();
%2270 No longer need this routine %
%2270 NAMESET(); !SET INNAM BIT FOR VARIABLES IN NAMELISTS %
RETNCT_0; !CT OF RETURN STMNTS
ASVCT_0; !CT OF ASSIGNMENTS OF THE FN VAL THAT DIRECTLY PRECEDE RETURN STMNTS
!GET COMPLEXITY FOR ALL STATEMENTS
INITREGCANDIDATES();
CSTMNT_.SORCPTR<LEFT>;
WHILE .CSTMNT NEQ 0 DO
CMPBLOCK();
!NOW GO THROUGH ONCE MORE AND SAVE AWAY
! 1. THE PREVIOUS BASIC BLOCK IN THE LABEL TABLE
! 2. THE STATEMENT IN FRONT OF THE PREVIOUS BASIC BLOCK
!FOR THIS PURPOSE THE DEFINITION A BASIC BLOCK IS SLIGHTLY
!DIFFERENT THAN FOR THE LOCAL ALLOCATOR. A BASIC BLOCK STARTS
!AT A DO, ENTRY OR LABELED STATEMENT.
WAYBBB_PREVBB_
CSTMNT_.SORCPTR<LEFT>;
WHILE .CSTMNT NEQ 0 DO
BEGIN
!IS IT A DO
IF .CSTMNT[SRCID] EQL DOID THEN
BEGIN
!YES, IS IT ONE THAT CAN POTENTAILLY GET ALLOCATED
IF .CSTMNT[EXTALLOC] OR .CSTMNT[INNERDOFLG] THEN
BEGIN
!STASH THINGS AWAY IN THE LABEL TABLE
!SNNXTLAB POINTS TO PREVIOUS BB
!SN1STLAB POINTS TO STATEMENT BEFORE
!PREVIOUS BB.
T_.CSTMNT[DOLBL];
!SAVE PREVBB IN SNNXTLAB
T[SNNXTLAB]_.PREVBB;
!NOW DO THE FINE TUNING
IF .WAYBBB NEQ .PREVBB THEN
UNTIL .WAYBBB[SRCLINK] EQL .PREVBB DO
WAYBBB_.WAYBBB[SRCLINK];
!NOW SAVE IT
T[SN1STLAB]_.WAYBBB;
END; !LOOP WE CARE ABOUT
WAYBBB_.PREVBB;
PREVBB_.CSTMNT;
END ELSE !NOT A DO
![641] BE MORE CAREFUL FOR A LOGICAL IF STATEMENT WITH CALL STATEMENT
![641] AS THE RESULT - DO NOT WANT TO INCLUDE IT FOR REGISTER
![641] SUBSTITUTIONS SINCE IT CAUSES PRELOAD PROBLEMS.
%[641]% IF .CSTMNT[SRCID] EQL IFLID THEN
%[641]% BEGIN
%[641]% T_.CSTMNT[LIFSTATE];
%[641]% IF .CSTMNT[TRUEISBR] OR (.T[SRCID] EQL CALLID) THEN
%[641]% (WAYBBB_.PREVBB; PREVBB_.CSTMNT)
%[641]% END ELSE
!IS IT LABELED. WE HAVE ALREADY REMOVED UNREFERENCED LABELS
!IS IT AN ENTRY
IF (.CSTMNT[SRCID] EQL ENTRID) OR (.CSTMNT[SRCLBL] NEQ 0)
OR .CSTMNT[USRFNREF]
![641] REMOVE LOGICAL IF CASE (INSERT ABOVE A MORE COMPLETE TEST)
OR (.CSTMNT[SRCID] EQL CALLID) THEN
BEGIN
WAYBBB_.PREVBB;
PREVBB_.CSTMNT;
END;
!DONE WITH SPECIAL STUFF. LOOK AT NEXT STATEMENT
CSTMNT_.CSTMNT[SRCLINK];
END; !WHILE ON CSTMNT
NOBBREGSLOAD_FALSE;
INIRGSTATE(); !INITIALIZE FOR BB REG ALLOCATION
INITEM();
GUIDE_0;
ALCREGS: !BLOCK IN WHICH REG ALLOC IS PERFORMED
BEGIN
IF .DLOOPTREE EQL 0 THEN !NO LOOPS PRESENT
BEGIN
!IT IS EITHER A A MAIN OR SUB PROGRAM.
!SEE WHICH
IF .FLGREG<PROGTYP> EQL MAPROG THEN
GUIDE_1
ELSE
!CHECK FOR &$# BLOCK DATA
IF .FLGREG<PROGTYP> EQL BKPROG THEN
LEAVE ALCREGS
ELSE
GUIDE_3;
!SET UP GLOBALS FOR ALLOCATION ROUTINE
LENTRY_TOP_.SORCPTR<LEFT>;
!PHA2 HAS LEFT THIS AS THE FUDGED DO NODE
BOTTOM_.TOP[DOLBL];
!UNLESS THIS IS AN EMPTY SUBPROGRAM. IN THIS CASE
!IT IS NOT SET UP AND THE LABEL FIELS WILL BE ZERO
!SO WE WILL QUIT
IF .BOTTOM EQL 0 THEN LEAVE ALCREGS;
BOTTOM_.BOTTOM[SNHDR];
!BOTTOM POINTS TO THE STATEMENT BEFORE THE END STATEMENT
![716] CHECK LEGALITY OF DOING OPTIMIZATIONS FOR OUTERMOST LOOP
%[716]% IF LEGALALLOC(.TOP) THEN
GBLALLOC();
END ELSE
BEGIN
!LOOPS ARE PRESENT
!EXAMINE THE CODE
CSTMNT_.SORCPTR<LEFT>;
EXAMSTAT:
WHILE .CSTMNT NEQ 0 DO
BEGIN
!WE ONLY CARE ABOUT DO LOOPS
IF .CSTMNT[SRCID] EQL DOID THEN
BEGIN
GUIDE_0;
INITEM();
!IS IT AN INNER ONE
IF .CSTMNT[INNERDOFLG] THEN
BEGIN
T_.CSTMNT[DOLBL];
!LOOK AT PREVBB STORED IN
!LABEL TABLE AND SEE IF IT
!IS A MAIN OR SUB PROGRAM
IF (.T[SNNXTLAB] EQL .SORCPTR<LEFT>
OR .T[SNNXTLAB] EQL 0) AND
.DOCNT EQL 1 THEN
BEGIN
IF .FLGREG<PROGTYP> EQL MAPROG THEN
GUIDE_2
ELSE
GUIDE_4;
![1051] If it is legal to allocate this
![1051] loop, then set the parameters
![1051] and do the optimizations
%[1051]% IF LEGALALLOC(.CSTMNT) THEN
%[1051]% BEGIN
%[1051]% LENTRY_TOP_.CSTMNT;
%[1051]% BOTTOM_.T[SNHDR];
%[1051]% INDVAR_.TOP[DOSYM];
%[1051]% GBLALLOC()
%[1051]% END;
LEAVE EXAMSTAT;
END ELSE
BEGIN
!THE PREVIOUS BASIC BLOCK
!IS A LOOP. SEE IF IT IS
!LEGAL TO ALLOCATE THE LOOP
IF LEGALALLOC(.CSTMNT) THEN
BEGIN
GUIDE_5;
LENTRY_TOP_.CSTMNT;
BOTTOM_.T[SNHDR];
INDVAR_.TOP[DOSYM];
GBLALLOC();
END ELSE
!CANNOT ALLOCATE IT
!SO SKIP OVER IT
CSTMNT_.T[SNHDR];
END;
END ELSE
!IT IS NOT AN INNER LOOP
BEGIN
!SEE IF IT IS SECOND LEVEL
IF .CSTMNT[EXTALLOC] THEN
BEGIN
!FIND THE SINGLE INNER ONE
TOP_.CSTMNT[SRCLINK];
![662] IF AN INNER DO LOOP WAS INACCESSIBLE (AND HENCE THROWN AWAY),
![662] THEN WE MAY END UP WITH ZERO (END OF PROG) - CHECK FOR IT.
%[662]% WHILE .TOP[SRCID] NEQ DOID AND .TOP NEQ 0 DO
TOP_.TOP[SRCLINK];
!TOP NOW POINTS TO THE INNER DO
%[662]% IF .TOP NEQ 0 THEN
IF LEGALALLOC(.CSTMNT) AND
LEGALALLOC(.TOP) THEN
BEGIN
GUIDE_6;
!SETT UP THE PARMS
T_.TOP[DOLBL];
BOTTOM_.T[SNHDR];
LENTRY_.TOP;
INDVAR_.TOP[DOSYM];
GBLALLOC();
END;
!WE WILL CATCH THE INNER ONE
!IF IT ALONE IS LEGAL WHEN WE
!GET TO IT WITH CSTMNT
END;
END;
END; !STATEMENT IS A DO LOOP
CSTMNT_.CSTMNT[SRCLINK];
END; !WHILE ON CSTMNT
END; !LOOPS PRESENT
!NOW CLEAN UP THE LABEL TABLE
INCR I FROM 0 TO LASIZ-1 DO
BEGIN
EXTERNAL LABTBL;
T_.LABTBL[.I];
WHILE .T NEQ 0 DO
BEGIN
T[SNNXTLAB]_0;
T[SNCADDRWD]_0;
T_.T[CLINK];
END;
END;
!NOW, ONE MORE PASS TO COMPLETE THE BASIC BLOCK ALLOCATION
CSTMNT_.SORCPTR<LEFT>;
!DEPENDING ON THE VALUE OF GUIDE CALL THE LOCAL ALLOCATOR
!IN A COUPLE OF DIFFERENT WAYS
IF .GUIDE GEQ 5 THEN
BEGIN
GBSYREGS_#177760000000;
GBSYCT_12;
END;
WHILE .CSTMNT NEQ 0 DO
ALCBLOCK();
END; !END OF BLOCK "ALCREGS"
!ALLOCATE TEMPS AND CONSTANTS ETC.
%1245% HDRFLG _ 0; ! Heading not output yet
%1245% TCNT = 0;
%1245% ALCAVARS();
%1245% ALCQVARS();
DATPROC(); !PROCESS DATA STATEMENTS BEFORE CONSTANTS
%1245% ALCCON();
! Dump the format statements into the .REL file if there are some
%1454% IF .FORMPTR NEQ 0
%2210% THEN DMPFORMAT();
%2334% IF EXTENDED AND .FLGREG<OBJECT> AND .FLGREG<PROGTYP> EQL MAPROG
%2334% THEN
%2334% BEGIN ! EXTENDED MAIN PROGRAM
%2334% ENTADDR = .LOWLOC; ! Save address of entry vector
%2355% LOWLOC = .LOWLOC+ENTVECSIZE+ENTAUXSIZE; ! Allocate space for it
%2334% END; ! EXTENDED MAIN PROGRAM
HISEGBLK(); !GENERATE THE HISEG BLOCK IN REL FILE
!TO TELL LOADER SIZE OF LOSEG
%1245% ! Output high seg descriptors for character constants
%1245% HDRFLG _ 0; ! Heading not output yet
%1245% HSLITD();
%1245% ! Output high seg descriptors for character scalars and arrays
%1245% ! If we had character declarations in FORTB
%1245% IF .CHDECL EQL -1 THEN HSCHD();
%1406% ! Output high seg descriptors for .Dnnnn compile-time-constant
%1406% ! character descriptors
%1406% HSDDESC();
END; ! of MRP3G
!****************************************************
!THIS IS THE MAIN PROGRAM FOR THE GLOBAL
!REGISTER ALLOCATION OVERLAY
!*******************************************************
MACHOP POPJ=#263;
!CALL THE CONTROL ROUTINE MRP3G
MRP3G();
!GO BACK TO THE PHASE CONTROL ROUTINE
POPJ(#17,0)
END
ELUDOM