Trailing-Edge
-
PDP-10 Archives
-
fortv11
-
strega.bli
There are 26 other files named strega.bli in the archive. Click here to see a list.
!COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1972, 1987
!ALL RIGHTS RESERVED.
!
!THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
!ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
!INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
!COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
!OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
!TRANSFERRED.
!
!THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
!AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
!CORPORATION.
!
!DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
!SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
!AUTHOR: S. MURPHY/HPW/DCE/SJW/JNG/TFV/EGM/EDS/AHM/CDM/RVM/TJK/MEM
MODULE STREGA(SREG=#17,VREG=#15,FREG=#16,DREGS=4,RESERVE(0,1,2,3)) =
BEGIN
GLOBAL BIND STREGV = #11^24 + 0^18 + #4522; ! Version Date: 5-Nov-85
%(
***** Begin Revision History *****
178 ----- ----- ADD ROUTINES ALCE1LIST AND ALCE2LIST TO
PERFORM ALLOCATON FOR E1LISTCALL AND
E2LISTCALL NODES
179 ---- ----- MODIFY "ALCCALL" SO THAT DONT ASSUME ALL
REGS ARE CLOBBERED BY A CALL TO "ADJ1." AND "ADJG."
ALSO, INSERT CODE IN CMSTMN TO CHECK WHETHER A STMNT
INCLUDES ANY FN CALLS AND SET "FNCALLSFLG" IN
THE STMNT NODE IF IT DOES.
ALSO, REMOVE CODE FROM "CMSTMN" THAT CAUSED PAIRMODEFLG
TO NEVER BE SET IN AN IO STMNT (BECAUSE IO
STMNTS DIDNT HAVE FLAGS FIELDS ONCE UPON A TIME)
185 ----- ----- ADD CODE TO PROCESS COMMON SUBS ON CALL STMNTS
(HAVE SKIPPED SOME VERSION NUMBERS FOR THE
EXPERIMENTAL REGISTER 0 VERSION)
186 ----- ----- IN "ALCAIF" IF THE REG TO BE TESTED MUST FIRST
BE LOADED (IE IF "A1SAMEFLG" IS NOT SET), DO
NOT ALLOW REGISTER 0 TO BE USED (SINCE WE LOAD
THE REG WITH A SKIP INSTRUCTION)
187 ----- ----- IN "ALCASMNT", DO NOT CALL "ALCINTMP" TO
TARGET THE RHS TO THE LHS VAR IF THE LHS IS A
REGCONTENTS (THIS ONLY OCCURS IF "LHINREGALC"
HAS FAILED TO TARGET THE RHS TO THE LHS REG)
188 ----- ----- CORRECT TYPO IN 187
189 ----- ----- ADD CODE TO HANDLE AN ARBITRARY EXPRESSION
AS AN ARG IN AN OPEN STMNT
190 ----- ----- ADD CODE TO HANDLE AN ARBITRARY EXPRESSION
AS A UNIT NUMBER
191 ----- ----- FIX LHINREG TO CORRECTLY HANDLE DOUBLE
PRECISION ARRAYREF.
192 ----- ----- FIX ALCIOLIST TO PASS CORRECT DP REG BITS
193 ----- ----- MAKE ARRAY-REFS AS UNITS,RECORDS,AND UNDER OPEN/CLOSE
WORK BY CALLING "ALCTVARR" SO THAT A PTR TO THE STORECLS
NODE CAN BE LINKED UNDER THE STMNT NODE
194 ----- ----- CHANGE ALL CALLS TO THE MACRO "CLBNXREG"
INTO CALLS TO THE ROUTINE "CLOBBNX"
195 ----- ----- IN ALCE1LIST,ALCE2LIST, FOR COUNT OR INCR
AN ARRAY REF, LINK THE STORECLS NODE IN UNDER
THE E1/E2LISTCALL NODE
196 ----- ----- IN "LHINREGALC", WHEN ARE TARGETTING TO REG 0,
ALLOW REG 1 TO BE USED IN THE COMPUTATION
197 ----- ----- IN "ALCASMNT", WHEN CALL "SAVEREG" TO REMEMBER
THAT THE VAL OF RHS IS IN A REG - IF A1NEGFLG
WAS SET AND THE VAR IS DOUBLE-PREC, THE REGISTER
WILL BE NEGATED (SINCE THERE IS NO "MOVN" FOR DP)
HENCE THE REG WONT CONTAIN THE VAR
198 ----- ----- SAME FIX AS 197 - ANOTHER CALL TO "SAVEREG"
199 ----- ----- ONLY CALL FNVALCH1 IF WE ARE IN A FUNCTION
INSTEAD OF FOR EVERY ASSIGNMENT
200 ----- ----- IN ALCASMNT, IN LOCAL ROUTINE "SETREGFORA2VAL"
WHEN CHECK FOR SPECIAL CASE OF NEGATED AOBJN WD,
MUST NOW LOOK AT "A1NEGFLG" (FORMERLY A2NEGFLG)
201 ----- ---- IN STCMOPEN AND ALCOPEN, MUST CHECK FOR THE VAL
OF AN OPEN PARAM EQUAL TO ZERO BEFORE WALKING
DOWN THE TREE (SINCE THE ARG "DIALOG" CAN HAVE A
NULL VAL)
202 254 15425 FOR RELATIONALS, DO NOT ALLOCATE CMNSUB TO 0 SINCE
WE MIGHT HAVE JUST MADE A SETO 0,0
203 261 15772 CLEAR REGSTATE EACH STATEMENT IF DEBUG:LABELS
204 270 16013 CLEAR REGSTATE FOR ALL VARIABLES POSSIBLY CLOBBERED
IN A NAMELIST INPUT STATEMENT.
205 300 ----- FIX 204 TO ONLY CHECK RIGHT HALF FOR -1
206 301 16154 REALIZE THAT FUNCTION CALLS WILL CLOBBER ANY
ARGUMENTS LEFT IN 1 BY FUNCTION PROLOGS
207 310 16602 ALLOCATE UNIT BEFORE OPEN AND CLOSE ARGS
208 311 16665 ALLOCATE REGS IN ALCIOCALL ONLY FOR NON-DATA ITEMS
209 363 18269 PREVENT COMPLEMENTED VAR FROM BEING SAVED, (DCE)
210 403 18961 BAD CODE FOR I=I/J OR A=B*A, (DCE)
211 446 20652 BAD CODE FOR I=I*3 AND I=I**7 (QAR753), (SJW)
212 471 20309 BAD CODE FOR LOGICAL LHS IN COMMON OR EQUIVALENCE, (DCE)
213 503 19976 ON A(L) = FUNCT. CALL, DON'T LEAVE L IN REG 1.
IF EVALUATING LH FIRST, (JNG)
***** Begin Version 5A ***** 7-Nov-76
214 522 20819 ON AN ARRAYREF IN AN IOLIST WHEN WE'RE OUT OF
REGS, CHECK NEGFLGS BEFORE USING EXISTING REG
CONTAINING DESIRED SUBSCRIPT., (JNG)
215 527 20317 CLOBBER ALL COMMON OR EQUIV VARS ON RANDOM READ,
WRITE, FIND SINCE ASSOCIATE VAR IS UNKNOWN TO US!
216 532 20323 TREAT ARRAY AS ASSOCIATE VARIABLE CORRECTLY, (DCE)
217 546 22030 FIX OPERATIONS WHICH CLOBBER NEXT REGISTER (IDIV), (DCE)
218 616 22345 BE CAREFUL ALLOCATING NEW REGISTER FOR I/O LIST ELEMENT,
(DCE)
219 625 23122 SET INREGFLG IN LHINREGALC WHEN WE KNOW THAT
THE NODE WILL BE CALCULATED TO A REG. THIS
FIXES LOGICAL EXPRESSIONS LIKE A=A.OR.(X.GT.Y), (JNG)
***** Begin Version 5B *****
220 721 ----- A=A*B MUST INVALIDATE REGISTER FOR VARIABLE A
(IN CASE OTHER VARS LIVE THERE TOO)., (DCE)
221 744 28463 DOUBLE WORD ARRAY REFS IN I/O SLISTS AND ELISTS
MAY DOUBLY USE AN ODD NUMBERED REGISTER., (DCE)
***** Begin Version 6 *****
222 760 TFV 1-Oct-79 ------
Add handling for IOSTAT= variable, both in comlexity and in allocation
The variable is always clobbered (implicit assignment)
223 764 EGM 24-Apr-80 29279
Do not allocate a register for an I/O list element that is an
immediate array reference
224 1067 EDS 13-May-81 31074
Do not set register 1 available if there are any common subs
for this statement which have been allocated to register 1.
226 1123 AHM 21-Sep-81 Q20-01650
Make ALCIOS work for IOSTAT=arrayref
229 1142 EGM 28-Oct-81 Q10-06254
Prevent internal error when IOLISTCALL node complexity count is greater
than 63 (the 6 bits worth which is stored in the field).
***** Begin Version 6A *****
1161 EGM 25-Jun-82
Don't forget to invalidate reg contents when LH of assigment is to a
reg (contents node) and RH references that reg, but not in such a way
that computation can occur directly to that reg (LHINREGALC fails).
***** Begin Version 7 *****
225 1220 DCE 2-Jun-81 -----
Allocate registers for assignment statements to DO variables,
and for temps for fn calls as top level I/O elements.
227 1274 TFV 20-Oct-81 ------
Fix calls to NXTTMP, the arg is now the size of the temp in words.
228 1404 AHM/TFV 26-Oct-81 ------
Fix ALCIOCALL to agree with ALCIOLST in that IOLIST elements which
live in AC0 must be stored into a temp.
230 1413 CDM 4-Nov-81
Fix of
IF ... (A AND B) ...
to
IF ... (IF A THEN B
ELSE FALSE) ...
Because the B clause may reference a field which might not exist
(?ICE or trash being compared resulting) unless the A clause is true.
231 1475 RVM 8-Feb-82
Make ALCUNIT call ALCCHARRAY to do allocation for character array
references. Before, ALCUNIT called ALCTVARR for any array reference,
but this is incorrect, as ACLTVARR inserts a store class node above
a character arrays ref.
1474 TFV 15-Mar-82
Add a new argument to CMPFNARGS. Character concatenation
expressions also use CMPFNARGS, the first argument is not yet
allocated for concatenations so it must be ignored by CMPFNARGS.
1516 CKS 22-Mar-82
Add CMPFMT and ALCFMT to do complexity and register allocation for
FMT= expressions.
1555 CKS 10-Jun-82
Put check in ALCFMT to prevent it trying to allocate absent formats
or FMT=* formats. Also don't look at IDATTRIBUT(NAMNAM) without
checking to be sure the expression is a simple variable.
1561 CKS 15-Jun-82
Remove call of ALCCHARRAY added by edit 1475. Always call
ALCTVARR and have it call ALCCHARRAY if necessary.
1642 CDM 11-Oct-82
Fix ALCDECENC so that it can handle character array refs. Call
ALCINREG to decide which array allocation routine to call.
1663 SRM 5-Nov-82
Fix bug in allocation for implied DO loops that have been
folded into SLISTs by /OPT. The assignment statement to store
the final value of the loop was erroneously using ACs that
were in use holding items preceding the loop in the IO list.
Added the routine ALCASCHAIN and called it from ALCE1LIST
and ALCE2LIST.
1700 CKS 23-Nov-82
Convert STBSYR to double mode before allocating I/O statement
specifiers if the specifier is double mode. (Like character
expressions.)
***** End V7 Development *****
1723 SRM 3-Feb-83
In allocation for assignment for a function value (in LHINREGALC),
do not make AC 1 legal if already in double mode.
The following program erroneously generated a
call to DFL.1:
DOUBLE PRECISION FUNCTION DFN(LL,J)
DOUBLE PRECISION D1(0:10)
DFN=J*D1(LL)
END
1753 TFV 19-May-83 20-19158
Turn on the STOREFLG bit in common subexpressions of loop index
variables which have to be put into .Qnnnn variables because no
free registers are left. ((THIS IS A DAY 1 BUG.))
1757 TFV 2-Jun-83 10-33567A
The assignment a = a * 3 + 4 generates the wrong code /opt if a
is targeted to a register. The P2PL1 (power of two plus one)
specop must be computed in a different register. the specop
EXPCIOP has the same problem. ((THIS IS A DAY 1 BUG.))
2000 CDM 15-Sep-83 10-34135
Statement IF (I1.EQ.1) MSK=MSK.AND..NOT.1 generates bad code
because it is noticed that the constant 1 already lives in a
register. This results in setting both A1SAMEFLG and
A1IMMEDFLG, something which should never be done. When the
"same" is set, we now clear the "immed". Otherwise we access
off a table in OPGNTA (accessed by the A1* flags) and ICE
(TOPS10) or create bad code (TOPS20).
2023 TJK 12-Dec-83
Have ALCIOCALL call ALCTARY for character array references in
an IO list when there aren't enough free regs. Previously the
TARGADDR field wasn't being set, resulting in incorrect code,
and sometimes causing an ICE or illegal instruction trap.
2040 TJK 23-Feb-84
Reorder calls for complexity, register allocation, and code
generation of I/O keywords. Most of this was already done in
V10 in edit 2201, although register allocation for FIND was
still incorrect.
2041 TJK 23-Feb-84
Make check for ARG2NODE consistent with check for ARG1NODE in
LHINREGALC. Before this edit, CMPRHINLH was being called when
it shouldn't. This routine was in turn calling CMPNODINLH,
which set TREEPTR to the ARG2PTR of the expression passed to
it for a call to ALCINREG. When the expression had no
ARG2PTR, TREEPTR was being set to zero and ALCINREG looped
recursively until the stack overflowed.
2047 TJK 20-Apr-84
ALCIOCALL was allocating single-word I/O list elements to
registers when double precision arithmetic was involved. The
result was that alternating registers were being used. This
threw off the complexity calculation, since there were many
free registers but not enough consecutive register pairs.
This edit prevents ALCINREG from being called for an I/O list
element if the I/O statement has the PAIRMODEFLG flag set
(i.e., the global flag PAIRMODE is set) and there are fewer
then 2 free register pairs.
Note that this still doesn't correct all cases of this
problem. To properly handle all cases, a routine must be
added which is similar to ALCINTMP but which forces the value
to memory. In addition, register allocation for double
precision array references should be improved to require no
more than one free register pair.
2065 MEM 3-Jul-84 10-34774
ALCIOLST should not allocate a two word .Qnnnn variable
for character function results or set STOREFLG.
2072 DCE 10-Oct-84
Prevent a register from being used twice in ALCMEM. A separate
register is needed, the allocated register was being loaded
twice, clobbering the old value.
***** End Revision History *****
***** Begin Version 10 *****
2201 TFV 30-Mar-83
Do complexity and allocation walks for INQUIRE statement. Add
new case to CMSTMN and ALCSTMN. The work is actually done by
STCMOPEN and ALCOPEN.
2203 TFV 7-Jun-83
Fix allocation for FMT= and FILE= in I/O statements. Only
allocate a .Qnnnn variable for character expressions, not
character constants and variables.
2226 TJK 6-Oct-83
Remove STREGA, an ancient routine which is never called anywhere.
2275 CDM 24-Jan-84
Move zeroing of DOWDP from routine LPIXSUB (substitute
REGCONTENTS nodes for DO induction variable) to routine CMSTMN
(complexity walk for statements). It was being zeroed before
the complexity for the last statement of the DO loop was being
processed. This meant that it was not known in the processing
of the last statement of a DO loop that the statement was in an
innermost DO loop.
Move REQUIRE statements to before EXTERNAL declarations.
2302 TJK 2-Feb-84
Add new flag IDCLOBB to the IDFNATTRIB field of a symbol table
entry. This flag is set for certain library routines (called
as subroutines). It indicates that ACs are not preserved by
the call.
Have CHASGN generate calls to CASNM. instead of CHASN. for
single-source character assignments, and CNCAM. instead of
CONCA. for character concatenation assignments. Also have it
set IDCLOBB for these routines, which don't preserve ACs.
Replace a check for CONCA. with a check for CNCAM. in SKCALL.
Have ALCCALL mark registers 2-15 (octal) as being clobbered if
IDCLOBB is set.
2314 AHM 26-Feb-84
Eliminate immediate arguments for OTSKFSIZ (format size)
FOROTS arguments because size of large arrays don't fit in 18
bits. Make CMPFMT fill ARACONSIZ in from ARASIZ for
non-adjustably dimensioned Hollerith arrays.
2317 AHM 6-Mar-84
Eliminate immediate values for OTSKEDSIZ (ENCODE/DECODE record
size) FOROTS arguments because the value need not fit in 18
bits under extended addressing. Make CMPDECENC mark constant
IOCNTs for allocation.
2335 TJK 6-Apr-84
Change some AND's to THEN-IF's in STCMASMNT to prevent an
illegal memory reference.
2363 TJK 6-Jun-84
Add code to do register allocation for arbitrary expressions
in E1 lists and E2 lists (ALCE1LIST and ALCE2LIST). Also move
some calls to VARCLOBB in ALCIOCALL so that the variables are
marked as clobbered after register allocation instead of
before.
2364 TJK 6-Jun-84
Add a call to ENDSMZTRIP in ALCIOLST. If it returns TRUE,
mark all registers as being clobbered since we're at the end
of a MAYBEZTRIP DO-loop.
2401 TJK 19-Jun-84
Add calls to DOTDCHECK in CMPUNIT, CMPFMT, CMPFILE, and
STCMOPEN. DOTDCHECK tries to create .Dnnnn compile time
constant descriptors for substring references.
2463 AHM 8-Oct-84
Don't let ARREQLLH believe that ARRAYREFs with different
OPERSPs are the same. Not strictly necessary, because
ARREFBIGs can't be passed to ARREQLLH at the moment, but we
might as well be safe.
***** End V10 Development *****
2572 MEM 12-Mar-86
Complexity walk, register allocation and code generation must be done
in the same order. For the open statement the register allocation was
done in the reverse order from complexity and code generation.
***** End Revision History *****
***** Begin Version 11 *****
4500 MEM 22-Jan-85
Added routine CMPOPKEY to compute the complexity of the expressions
pointed to by the IOKEY field in the source tree node, and added
routine ALCOPKEY to allocate the registers used by the expressions
pointed to by IOKEY.
4501 MEM 22-Jan-85
Added CMPRDKEY to compute the complexity of the expression pointed to
by the IOKEY field in the source tree node, and added ALCRDKEY to
allocate the registers used by the expression pointed to by the IOKEY
field in the source tree node.
4502 MEM 22-Jan-85
Modified CMSTMN and ALCSTMN for DELETE statement.
4503 MEM 22-Jan-85
Modified CMSTMN and ALCSTMN for REWRITE statement.
4504 MEM 22-Jan-85
Modified CMSTMN and ALCSTMN for UNLOCK statement.
4517 MEM 4-Oct-85
Modify ALCASMNT for register allocation of 1-char asmnts.
4522 MEM 5-Nov-85
Modify ALCASMNT for register allocation of 1-char asmnts when
LHS and/or RHS or asmnt may have an unincremented bytepointer.
ENDV11
)%
SWITCHES NOLIST;
REQUIRE FIRST.BLI;
REQUIRE TABLES.BLI;
SWITCHES LIST;
BIND REG0=0; !REGISTER 0 - THIS REG IS FREQUENTLY AN EXCEPTION
FORWARD
CMSTMN(0),
ALCTMP(0),
ALCSTMN(0),
STCMASMNT(0),
STCMAGO(0),
STCMCGO(0),
STCMSTOP(0),
CMPDECENC(0),
STCMCSB(0),
ALCASMNT(0),
ALCMEMCMP(0),
ORDERMEMCMP(0),
ALCAGO(0),
ALCCGO(0),
ALCDECENC(0),
ALCOPEN(0),
ALCCMNSB(0),
STCMLIF(0),
STCMAIF(0),
SCMASSI(0),
STCMOPEN(0),
ALCE1LIST(3),
ALCE2LIST(3),
ALCASCHAIN(3),
ALCLIF(0),
ALCAIF(0),
ALCASSI(0),
ALCCALL(0),
ALCIOLST(0),
ALCIOCALL(1),
LHINREGALC(0);
EXTERNAL
ADDREGCANDATE, ! ROUTINE IN BASIC BLOCK ALLOCATOR WHICH ADDS A
! VAR TO THE SET OF VARS THAT CAN BE LEFT IN
! REGS
AFREEREG, ! ROUTINE TO GET A FREE REGISTER TO USE. IF
! POSSIBLE, IT RETURNS A REG WHICH WILL NOT BE
! USEFUL LATER IN THIS BASIC BLOCK. IF NOT,
! RETURNS THE REG WHOSE NEXT USE IS FURTHEST
! AWAY
ALCARRAY, ! Allocation for numeric array refs
ALCCNT,
ALCDOEND,
ALCDOSTMT,
ALCENTRY,
ALCFNARGS,
ALCINREG, ! Allocate into a register
ALCINTMP, ! Allocate into a temp variable
%4500% ALCSTAYINTMP, ! Allocate into a temp variable
ALCNARG,
ALCRETURN,
ALCRL1,
ALCSFN,
ALCTVARR, ! ALLOCATE THE VAL OF AN ARRAY ELEM TO A TEMP
%1123% ALCTARY, ! Wedges the address in a temp
ALOCONST,
ASSOCPT, ! GLOBAL POINTING TO LIST OF ALL ASSOC VARS
! IN THIS SUBPROGRAM
C1H,
C1L,
%2275% BASE CDONODE, ! Current Do loop statement, if in an innermost DO.
CGERR, ! Illegal memory reference message
CLOBBCOMEQV,
CLOBBNX, ! NEED THIS TO TEST IF THE NEXT REGISTER WILL BE
! CLOBBERED.
CLOBBREGS, ! WD CONTAINING BIT PTN FOR REGS CLOBBERED BY
! THIS ROUTINE
CLRRGSTATE, ! ROUTINE TO CLEAR THE BASIC BLOCK ALLOCATOR TABLES
! SO THAT ALL ASSUMPTIONS ABOUT THE CONTENTS OF REGS
! ARE NO LONGER HELD
CMPFNARGS,
CMPLBL,
CMPLIOLST,
CMPLREL,
CMPLXARRAY,
BASE CSTMNT, ! Current statement
DBLMODE, ! THIS FLAG WORD IS SET WHEN A STATEMENT IS
! BEING ALLOCATED DOUBLE-PRECISION MODE (IE FOR
! AN ASSIGNMENT STMNT IF THE TOP-LEVEL
! EXPRESSIONS ARE DOUBLE-PRECISION)
DNEGCNST,
%2401% DOTDCHECK, ! Tries to create compile time constant .Dnnnn
%2401% ! substring descriptors
%2275% OBJECTCODE DOWDP, ! Info on compiling in innermost DO loops
%2364% ENDSMZTRIP, ! Checks if CSTMNT ends a MAYBEZTRIP DO-loop
EXCHARGS, ! ROUTINE TO EXCHANGE ARG1 AND ARG2 OF AN
! OPERATOR IF POSSIBLE
FNREF, ! GLOBAL THAT GETS SET WHEN PROCESSING A STMNT
! THAT CONTAINS FN CALLS
FNVALCHK, ! ROUTINE TO CHECK FOR THE CASE OF AN ASSIGNMENT
! OF A FN VAL DIRECTLY PRECEEDING A RETURN
FNVLCH1, ! CHECK FOR ASSIGNMENT OF FN VAL DIRECTLY BEFORE
! RETURN
FREEPAIRS, ! ROUTINE TO COUNT THE NUMBER OF EVEN-ODD REG
! PAIRS INDICATED TO BE FREE BY A BIT PATTERN IN
! WHICH 0'S REPRESENT BUSY REGS, 1'S REPRESENT
! FREE REGS
GBSYCT,
GBSYREGS,
GETRGPAIR, ! ROUTINE TO GET A PAIR OF FREE REGISTERS
INPFLAG, ! THIS FLAG IS TRUE WHILE PROCESSING AN IOLSIST
! FOR A STMNT THAT DOES INPUT, FALSE WHILE
! PROCESSING AN IOLIST FOR A STMNT THAT DOES
! OUTPUT
LPIXSUB, ! ROUTINE TO SUBSTITUTE REGCONTENTS NODES FOR
! REFERENCES TO THE LOOP INDEXIN AN INNERMOST DO
! LOOP
MAKEPR,
MAKPR1,
NOBBREGSLOAD, ! THIS FLAG IS TRUE WHEN NODES ARE BEING
! PROCESSED WHICH ARE NOT ALWAYS EXECUTED WHEN
! THE BLOCK IN WHICH THE ARE CONTAINED IS
! EXECUTED (EG FOR THE STMNT UNDER A LOG IF).
! WHEN THIS FLAG IS SET, CANNOT ASSUME THAT REGS
! SET BY EVAL OF THE NODE HAVE A GIVEN VAL
NXTTMP, ! Get an n-word temporary
PAIRMODE, ! GLOBAL WHICH WILL BE SET TO TRUE WHILE
! PERFORMING COMPLEXITY PASS OVER ANY NODE THAT
! REQUIRES AN ADJACENT PAIR OF REGISTERS
PRCNSTARG,
REGCLOBB, ! THIS ROUTINE IS CALLED WHENEVER AN ALLOCATION
! IS PERFORMED WHICH WOULD CAUSE THE PREVIOUS
! CONTENTS OF A REG TO BE CLOBBERED IT CLEARS
! THE BB REG ALLOC ENTRIES FOR THAT REG
REGCONTAINING, ! ROUTINE OF BASIC BLOCK ALLOCATOR WHICH CHECKS
! WHETHER ANY REG HOLDS A GIVEN VAR. IF SO IT IT
! RETURNS THE REG, IF NOT IT RETURNS -1
REGTOUSE,
RESNAME,
RGTOSAVE,
RGTOU1,
SAVEREG, ! ROUTINE TO ADD A REGISTER TO THE SET OF REGS
! WHOSE CONTENTS THE BB ALLOCATOR KNOWS ABOUT
SAVREGCONTAINING, ! ROUTINE IN BASIC BLOCK ALLOCATOR
! (MODULE "CMPBLO") WHICH CHECKS WHETHER
! A VAR COULD HAVE BEEN LEFT IN A REG
! FROM A PREV STMNT AND IF SO MARKS THAT
! STMNT TO LEAVE THE VAR
SETCOMPLEXITY,
SETTAC,
SETTARGINREG,
STBSYR,
STCMSFN,
STCMDO,
STCMRETURN,
STCMSUB,
STRGCT,
PEXPRNODE TREEPTR,
VARCLOBB; ! THIS ROUTINE IS CALLED WHENEVER A NODE IS
! PROCESSED WHICH WOULD CLOBBER THE VAL OF A
! VARIABLE. IT CLEARS ANY BB ALLOC ENTRIES THAT
! REFER TO THAT VAR
GLOBAL ROUTINE CMSTMN=
BEGIN
!***************************************************************
! Performs complexity analysis on a statement. Called with the
! global CSTMNT pointing to the statement to be processed. The
! complexity walk, allocation walk, and code generation walk
! must do the fields for each statement in the same order.
!***************************************************************
%1474% BIND NOTINCONCAT = FALSE; ! Flag for CMPFNARGS. It means
! that the first argument must
! be processed.
GLOBAL FNREF; !GLOBAL THAT WILL GET SET IF ANY FN CALLS ARE
! ENCOUNTERED IN PROCESSING A STMNT
OWN PEXPRNODE RECNO; !PTR TO SYMBOL TABLE OR CONSTANT TABLE ENTRY
! FOR A RECORD NUMBER FOR AN IO STMNT
%(***DEFINE A ROUTINE TO USE TO ALLOCATE CORE FOR ANY CONSTANT USED AS
A RECORD NUMBER IN AN IO STMNT***)%
ROUTINE CMPRECNO=
BEGIN
IF (RECNO_.CSTMNT[IORECORD]) NEQ 0
THEN
BEGIN
IF .RECNO[OPR1] EQL CONSTFL
THEN ALOCONST(.RECNO)
%(***IF RECORD NUMBER IS AN EXPRESSION
PERFORM COMPLEXITY WALK ON IT***)%
ELSE
BEGIN
TREEPTR_.RECNO;
SETCOMPLEXITY();
END;
END
END;
ROUTINE CMPUNIT=
BEGIN
%2201% ! Rewritten by TFV, on 30-Mar-83
! Compute complexity of UNIT= if specified
IF .CSTMNT[IOUNIT] NEQ 0
THEN
%2401% BEGIN ! Non-zero UNIT
%2401% ! See if we have a substring which can be
%2401% ! replaced with a .Dnnnn compile time constant
%2401% ! descriptor.
%2401%
%2401% CSTMNT[IOUNIT] = TREEPTR = DOTDCHECK(.CSTMNT[IOUNIT]);
IF .TREEPTR[OPR1] EQL CONSTFL
THEN ALOCONST(.TREEPTR)
ELSE IF .TREEPTR[OPRCLS] NEQ DATAOPR
THEN SETCOMPLEXITY();
%2401% END; ! Non-zero UNIT
END;
ROUTINE CMPFMT= ! [1516] New
BEGIN
%2314% REGISTER DIMENTRY DTE; ! Dimension table for Hollerith array
TREEPTR = .CSTMNT[IOFORM];
IF .TREEPTR NEQ 0
THEN IF EXTSIGN(.TREEPTR) NEQ -1
THEN IF .TREEPTR[OPRCLS] NEQ LABOP
THEN
BEGIN
%2401% ! See if we have a substring which can be
%2401% ! replaced with a .Dnnnn compile time constant
%2401% ! descriptor.
%2401%
%2401% CSTMNT[IOFORM] = TREEPTR = DOTDCHECK(.TREEPTR);
IF .TREEPTR[OPR1] EQL CONSTFL
THEN ALOCONST(.TREEPTR)
%2314% ELSE IF .TREEPTR[DATOPS1] EQL ARRAYNM1 ! FMT=ARRAY ?
%2314% THEN ! (Formal or local)
%2314% BEGIN ! ARRAY
![2314] Non-adjustably dimensioned Hollerith arrays need a constant
![2314] allocated for the OTSKFSIZ FOROTS argument. Create the
![2314] constant now if some other FMT= hasn't already.
%2314% DTE = .TREEPTR[IDDIM]; ! Point to dim table
%2314% IF NOT .DTE[ADJDIMFLG]
%2314% AND .DTE[ARACONSIZ] EQL 0
%2314% THEN
%2314% BEGIN ! ALLOCATE
%2314% DTE[ARACONSIZ] = MAKECNST(INTEGER,
%2314% 0, .DTE[ARASIZ]);
%2314% ALOCONST(.DTE[ARACONSIZ]);
%2314% END; ! ALLOCATE
%2314% END ! ARRAY
ELSE IF .TREEPTR[OPRCLS] NEQ DATAOPR
THEN SETCOMPLEXITY();
END;
END;
ROUTINE CMPFILE=
BEGIN
%2201% ! Written by TFV, on 30-Mar-83
! Compute the complexity of FILE= for OPEN/CLOSE/INQUIRE
IF .CSTMNT[IOFILE] NEQ 0
THEN
%2401% BEGIN ! Non-zero FILE
%2401% ! See if we have a substring which can be
%2401% ! replaced with a .Dnnnn compile time constant
%2401% ! descriptor.
%2401%
%2401% CSTMNT[IOFILE] = TREEPTR = DOTDCHECK(.CSTMNT[IOFILE]);
IF .TREEPTR[OPR1] EQL CONSTFL
THEN ALOCONST(.TREEPTR)
ELSE IF .TREEPTR[OPRCLS] NEQ DATAOPR
THEN SETCOMPLEXITY();
%2401% END; ! Non-zero FILE
END;
%[760]% ROUTINE CMPIOS=
%[760]% %(***Routine to perform complexity walk for an iostat variable which
is an array-ref***)%
%[760]% BEGIN
%[760]% IF .CSTMNT[IOIOSTAT] NEQ 0
%[760]% THEN
%[760]% BEGIN
%[760]% TREEPTR_.CSTMNT[IOIOSTAT];
%[760]% IF .TREEPTR[OPRCLS] NEQ DATAOPR ! not simple var
%[760]% THEN SETCOMPLEXITY();
%[760]% END;
%[760]% END;
ROUTINE CMPRDKEY=
!++
! FUNCTIONAL DESCRIPTION:
!
! TO PERFORM COMPLEXITY PASS FOR THE IOKEY FIELD IN THE SOURCE TREE NODE
!
! FORMAL PARAMETERS:
!
! None
!
! IMPLICIT INPUTS:
!
! CSTMNT PTR TO READ STATEMENT NODE
!
! IMPLICIT OUTPUTS:
!
! None
!
! ROUTINE VALUE:
!
! None
!
! SIDE EFFECTS:
!
! None
!
!--
BEGIN ! [4501] New
IF .CSTMNT[IOKEY] NEQ 0
THEN
BEGIN ! Non-zero IOKEY
! See if we have a substring which can be
! replaced with a .Dnnnn compile time constant
! descriptor.
CSTMNT[IOKEY] = TREEPTR = DOTDCHECK(.CSTMNT[IOKEY]);
IF .TREEPTR[OPR1] EQL CONSTFL
THEN ALOCONST(.TREEPTR)
ELSE IF .TREEPTR[OPRCLS] NEQ DATAOPR
THEN SETCOMPLEXITY();
END; ! Non-zero IOKEY
END;
ROUTINE CMPOPKEY=
!++
! FUNCTIONAL DESCRIPTION:
!
! TO PERFORM COMPLEXITY PASS FOR THE IOKEY FIELD IN THE SOURCE TREE NODE
!
! FORMAL PARAMETERS:
!
! None
!
! IMPLICIT INPUTS:
!
! CSTMNT PTR TO OPEN STATEMENT NODE
!
! IMPLICIT OUTPUTS:
!
! None
!
! ROUTINE VALUE:
!
! None
!
! SIDE EFFECTS:
!
! None
!
!--
BEGIN ! New [4500]
REGISTER PEXPRNODE KEYVAL; !PTR TO SYMBOL OR CONSTANT TABLE ENTRY
! FOR THE VALUE TO BE PASSED TO FOROTS
! FOR A GIVEN ARG
REGISTER OPNKEYLIST KEYVALLST; !LIST OF ARGS UNDER THIS OPEN STMNT
REGISTER CMPL1;
OWN CMPLXMAX; !MAXIMUM COMPLEXITY OF THE ARGS
IF .CSTMNT[IOKEY] NEQ 0
THEN
BEGIN
CMPLXMAX=0;
KEYVALLST=.CSTMNT[IOKEY];
%(***WALK THRU THE LIST OF KEYS - FOR ANY UPPER OR LOWER BOUND
OF A KEY THAT IS A CONSTANT OR A LITERAL ALLOCATE CORE
FOR THAT CONSTANT/LITERAL***)%
INCR I FROM 1 TO (.KEYVALLST[NUMKEYS])
DO
BEGIN
IF .KEYVALLST[.I,KEYLOW] NEQ 0
THEN
BEGIN ! Key has a value
! perform complexity pass for lower bound
! See if we have a substring which can be
! replaced with a .Dnnnn compile time constant
! descriptor.
KEYVALLST[.I,KEYLOW] = KEYVAL = DOTDCHECK(.KEYVALLST[.I,KEYLOW]);
IF .KEYVAL[OPRCLS] EQL DATAOPR !VAL A VAR OR CONST
THEN
! Allocate core for a constant
(IF .KEYVAL[OPR1] EQL CONSTFL THEN ALOCONST(.KEYVAL))
ELSE !VAL AN EXPRESSION (OR ARRAYREF)
BEGIN
! Perform "complexity" pass over this
! expression. If its complexity is
! greater than the maximum, change the
! maximum.
TREEPTR=.KEYVAL;
IF (CMPL1=SETCOMPLEXITY()) GTR .CMPLXMAX
THEN CMPLXMAX=.CMPL1;
END;
! perform complexity pass for upper bound
! See if we have a substring which can be
! replaced with a .Dnnnn compile time constant
! descriptor.
KEYVALLST[.I,KEYHIGH] = KEYVAL = DOTDCHECK(.KEYVALLST[.I,KEYHIGH]);
IF .KEYVAL[OPRCLS] EQL DATAOPR !VAL A VAR OR CONST
THEN
! Allocate core for a constant
(IF .KEYVAL[OPR1] EQL CONSTFL THEN ALOCONST(.KEYVAL))
ELSE !VAL AN EXPRESSION (OR ARRAYREF)
BEGIN
! Perform "complexity" pass over this
! expression. If its complexity is
! greater than the maximum, change the
! maximum.
TREEPTR=.KEYVAL;
IF (CMPL1=SETCOMPLEXITY()) GTR .CMPLXMAX
THEN CMPLXMAX=.CMPL1;
END;
END; ! key has a value
END;
END; ! IOKEY NEQ 0
END; ! of CMPOPKEY
%(***IF WE ARE IN A DO LOOP IN WHICH THE
LOOP INDEX LIVES IN A REGISTER, SUBSTITUTE "REGCONTENTS" NODES FOR
ALL REFERENCES TO THE LOOP INDEX THAT OCCUR IN THIS STMNT***)%
LPIXSUB();
PAIRMODE_FALSE; !INIT GLOBAL WHICH WILL BE USED TO DETERMINE WHETHER THIS
! STATEMENT INCLUDES ANY EXPRESSIONS THAT REQUIRE REGISTER PAIRS
FNREF_FALSE; !INIT GLOBAL THAT WILL BE USED TO DETERMINE WHETHER THIS STMNT
! CONTAINS ANY FN REFERENCES
%(***SRCID OF STMNT DETERMINES ACTION TO BE TAKEN***)%
CASE .CSTMNT[SRCID] OF SET
STCMASMNT(); ! ASSIGNMENT
SCMASSI(); ! ASSIGN
BEGIN ! CALL
CSTMNT[SRCCMPLX]_(IF .CSTMNT[CALLIST] EQL 0
THEN 0
%1474% ELSE CMPFNARGS(.CSTMNT[CALLIST],FALSE,NOTINCONCAT));
STCMCSB(); ! PROCESS ANY COMMON SUBS
END;
CSTMNT[SRCCMPLX]_0; ! CONTINUE
STCMDO(); ! DO
STCMSUB(); ! ENTRY
STCMASMNT(); ! COMMON SUB (SAME AS ASMNT
CSTMNT[SRCCMPLX]_0; ! GOTO
STCMAGO(); ! ASSIGNED GOTO
STCMCGO(); ! COMPUTED GOTO
STCMAIF(); ! ARITHMETIC IF
STCMLIF(); ! LOGICAL IF
STCMRETURN(); ! RETURN
STCMSTOP(); ! STOP
BEGIN ! READ
CMPUNIT();
%1516% CMPFMT();
CMPRECNO();
%[760]% CMPIOS(); ! set iostat complexity
%4501% CMPRDKEY(); ! set IOKEY complexity
CMPLIOLST();
END;
BEGIN ! WRITE
CMPUNIT();
%1516% CMPFMT();
CMPRECNO();
%[760]% CMPIOS(); ! set iostat complexity
CMPLIOLST();
END;
%[760]% BEGIN ! DECODE
%1516% CMPFMT();
%[760]% CMPIOS(); ! set iostat complexity
%[760]% CMPDECENC();
%[760]% END;
%[760]% BEGIN ! ENCODE
%1516% CMPFMT();
%[760]% CMPIOS(); ! set iostat complexity
%[760]% CMPDECENC();
%[760]% END;
%[760]% BEGIN ! REREAD
%[760]% CMPUNIT();
%1516% CMPFMT();
%[760]% CMPIOS(); ! set iostat complexity
%[760]% CMPLIOLST();
END;
BEGIN ! FIND
CMPUNIT();
CMPRECNO();
%[760]% CMPIOS(); ! set iostat complexity
END;
BEGIN ! CLOSE
CMPUNIT();
%2201% CMPFILE(); ! set FILE= complexity
%[760]% CMPIOS(); ! set iostat complexity
STCMOPEN();
END;
%4502% BEGIN ! DELETE
%4502% CMPUNIT();
%4502% CMPRECNO();
%4502% CMPIOS(); ! set iostat complexity
%4502% END;
%4503% BEGIN ! REWRITE
%4503% CMPUNIT();
%4503% CMPFMT();
%4503% CMPIOS(); ! set iostat complexity
%4503% CMPLIOLST();
%4503% END;
%[760]% BEGIN ! BACKSPACE
%[760]% CMPUNIT();
%[760]% CMPIOS(); ! set iostat complexity
%[760]% END;
%[760]% BEGIN ! BACKFILE
%[760]% CMPUNIT();
%[760]% CMPIOS(); ! set iostat complexity
%[760]% END;
%[760]% BEGIN ! REWIND
%[760]% CMPUNIT();
%[760]% CMPIOS(); ! set iostat complexity
%[760]% END;
%[760]% BEGIN ! SKIPFILE
%[760]% CMPUNIT();
%[760]% CMPIOS(); ! set iostat complexity
%[760]% END;
%[760]% BEGIN ! SKIP RECORD
%[760]% CMPUNIT();
%[760]% CMPIOS(); ! set iostat complexity
%[760]% END;
%[760]% BEGIN ! UNLOAD
%[760]% CMPUNIT();
%[760]% CMPIOS(); ! set iostat complexity
%[760]% END;
%4504% BEGIN ! UNLOCK
%4504% CMPUNIT();
%4504% CMPIOS(); ! set iostat complexity
%4504% END;
%[760]% BEGIN ! ENDFILE
%[760]% CMPUNIT();
%[760]% CMPIOS(); ! set iostat complexity
%[760]% END;
CSTMNT[SRCCMPLX]_0; ! END
STCMSTOP(); ! PAUSE
BEGIN ! OPEN
CMPUNIT();
%2201% CMPFILE(); ! set FILE= complexity
%[760]% CMPIOS(); ! set iostat complexity
%4500% CMPOPKEY(); ! set IOKEY= complexity
STCMOPEN();
END;
STCMSFN(); ! SFN
CSTMNT[SRCCMPLX]_0; ! FORMAT
CSTMNT[SRCCMPLX]_0; ! BLT (NOT IN RELEASE 1)
CSTMNT[SRCCMPLX]_0; ! GLOBAL ALLOCATOR ID
%2201% BEGIN ! INQUIRE
%2201% CMPUNIT();
%2201% CMPFILE(); ! set FILE= complexity
%2201% CMPIOS(); ! set iostat complexity
%2201% STCMOPEN();
END;
TES;
!If any expressions were encountered that required adjacent reg pairs
!set flag in stmnt
IF .PAIRMODE THEN CSTMNT[PAIRMODEFLG]_1;
!If any fn calls were encountered set flag in stmnt
IF .FNREF THEN CSTMNT[FNCALLSFLG]_1;
%2275% ! If we are in an innermost DO loop and this statement is the
%2275% ! terminating statement of the loop, then we are leaving the
%2275% ! inner loop. Turn off the global variable containing
%2275% ! information for REGCONTENTS node substitution in an innermost
%2275% ! DO loop.
%2275%
%2275% IF .DOWDP NEQ 0 ! Innermost DO
%2275% THEN IF .CSTMNT[SRCLBL] EQL .CDONODE[DOLBL] ! Stmnt's = DO's label?
%2275% THEN DOWDP = 0; ! Mark; no longer in DO
END; ! of CMSTMN
ROUTINE ALCTMP = ! [1700] New
! Call ALCINTMP for I/O specifier. Convert
! STBSYR to double mode if expression is double mode.
BEGIN
LOCAL BSYRG1, FRGCT1;
IF NOT .TREEPTR[DBLFLG]
THEN ALCINTMP(NXTTMP(1),.STBSYR,.STRGCT)
ELSE
BEGIN
BSYRG1 = DPBSYREGS(.STBSYR);
FRGCT1 = ONESCOUNT(.BSYRG1);
ALCINTMP(NXTTMP(2),.BSYRG1,.FRGCT1);
END;
END; ! ALCTMP
GLOBAL ROUTINE ALCSTMN=
!***************************************************************
! Routine to perform local register allocation for a statement.
! Called with the global CSTMNT pointing to the statement to be
! processed, STBSYR which has a bit set for each register
! available for use in evaluating this statement, and STRGCT
! which is the count of the number of registers available. The
! complexity walk, allocation walk, and code generation walk
! must do the fields for each statement in the same order.
!***************************************************************
BEGIN
ROUTINE ALCUNIT=
%(***ROUTINE TO PERFORM REG ALLOC FOR A UNIT NUMBER WHICH IS
AN EXPRESSION OR ARRAYREF***)%
BEGIN
%2201% IF (TREEPTR = .CSTMNT[IOUNIT]) NEQ 0
%2201% THEN IF .TREEPTR[OPRCLS] NEQ DATAOPR !IF NOT A SIMPLE VAR OR CONST
THEN
BEGIN
IF .TREEPTR[OPRCLS] EQL ARRAYREF
!FOR AN ARRAYREF - MUST LINK A STORECLS NODE UNDER THE STATEMENT NODE
THEN CSTMNT[IOUNIT]_ALCTVARR(.STBSYR,.STRGCT)
%1700% ELSE ALCTMP(); ! Allocate a 1 or 2 word .Q temp
END;
END; ! of ALCUNIT
ROUTINE ALCFMT= ! [1516] New
%(*** Routine to do reg allocation for FMT= expression. This
is either a label, array name, scalar, or character expression.
The only nontrivial case is the character expression. ***)%
BEGIN
TREEPTR_.CSTMNT[IOFORM];
%1555% IF .TREEPTR NEQ 0 ! FMT is specified
%1555% THEN IF EXTSIGN(.TREEPTR) NEQ -1 ! FMT is not *
THEN IF .TREEPTR[VALTYPE] EQL CHARACTER ! FMT is char expr
%2203% THEN IF .TREEPTR[OPRCLS] NEQ DATAOPR ! is not var or const
%1700% THEN ALCTMP(); ! allocate it
END; ! ALCFMT
ROUTINE ALCFILE=
BEGIN
%2201% ! Written by TFV, on 30-Mar-83
%2201% ! Allocate FILE= for OPEN/CLOSE/INQUIRE
IF (TREEPTR = .CSTMNT[IOFILE]) NEQ 0 ! FILE is specified
%2203% THEN IF .TREEPTR[OPRCLS] NEQ DATAOPR ! is not var or const
THEN ALCTMP();
END; ! of ALCFILE
%[760]% ROUTINE ALCIOS=
%[760]% %(*** Routine to perform reg alloc for an iostat variable
Note that the variable is always clobbered since
this is an implicit assignment***)%
%[760]% BEGIN
%[760]% IF .CSTMNT[IOIOSTAT] NEQ 0
%[760]% THEN
%[760]% BEGIN
%[760]% TREEPTR_.CSTMNT[IOIOSTAT];
%[760]% IF .TREEPTR[OPRCLS] EQL ARRAYREF
%1123% THEN ! Store the address of the element and
%1123% ! indirect through it in the arg block
%1123% CSTMNT[IOIOSTAT]_ALCTARY(.STBSYR,.STRGCT);
%1123%
%[760]% VARCLOBB(.CSTMNT[IOIOSTAT]); ! always clobber var
%[760]% END;
%[760]% END; ! of ALCIOS
ROUTINE ALCRANDIO=
%(*************
PERFORM REG ALLOC FOR RANDOM ACCESS IO.
MUST PERFORM ALLOCATION FOR THE CALC OF THE RECORD NUMBER
AND ALSO BB ALLOCATOR MUST ASSUME THAT THE VALS OF ALL ASSOCIATE
VARIABLES ARE CHANGED.
*************)%
BEGIN
REGISTER ASSCELEM; !AN ELEMENT ON THE LINKED LIST OF ASSOC-VAR PTRS
IF (TREEPTR_.CSTMNT[IORECORD]) EQL 0 !IF DO NOT HAVE RANDOM ACCESS
THEN RETURN; ! NO PROCESSING IS NEEDED
IF .TREEPTR[OPRCLS] NEQ DATAOPR !IF THE RECORD NUMBER IS NOT A SIMPLE VAR OR CONST
THEN
BEGIN
IF .TREEPTR[OPRCLS] EQL ARRAYREF
!FOR AN ARRAYREF - MUST LINK A STORECLS NODE UNDER THE STATEMENT NODE
THEN CSTMNT[IORECORD]_ALCTVARR(.STBSYR,.STRGCT)
%1700% ELSE ALCTMP(); ! Allocate a 1 or 2 word .Q temp
END;
ASSCELEM_.ASSOCPT;
UNTIL .ASSCELEM<RIGHT> EQL 0 !LOOK AT ALL ASSOC VARS IN THE PROGRAM
! RIGHT HALF OF EACH ENTRY ON THE LINKED
! LIST PTS TO NEXT ELEM
DO
BEGIN
[email protected]<RIGHT>; !GET THE CONTENTS OF THE NEXT ELEMENT
VARCLOBB(.ASSCELEM<LEFT>); !LEFT HALF OF WD ON ASSOC VAR
! LIST PTS TO SYM TABLE ENTRY FOR THE VAR
END;
! IF THE OPEN OCCURS OUTSIDE THIS PROGRAM MODULE, THEN
!WE MUST ASSUME THAT ALL COMMON/EQUIV VARS ARE CLOBBERED
!SINCE THEY COULD BE ASSOCIATE VARIABLES!
CLOBBCOMEQV();
END; !of ALCRANDIO
ROUTINE CHECKNLIST (LISTPTR)=
%( CHECK THE LIST OF VARIABLES POINTED TO BY A NAMELIST NAME
AND CLEAR OUT ANY WHICH ARE CURRENTLY LIVING IN REGISTERS
SINCE THEY MAY BE CLOBBERED DURING AN INPUT REFERENCING
THAT NAMELIST NAME.
*************)%
BEGIN
REGISTER T1;
MAP BASE LISTPTR;
!LISTPTR POINTS TO A NAMELIST BLOCK CONTAINING POINTERS
! TO ALL THE VARIBLES SYMBOL TABLE ENTRIES
INCR I FROM 0 TO .LISTPTR[NAMCNT]-1 DO !SCAN THRU THE LIST OF POINTERS
BEGIN
T1_@(.LISTPTR[NAMLIST]+.I); !GET THE SYMBOL TABLE POINTER
VARCLOBB(.T1<RIGHT>); !GET RID OF IT IF IN REG
END;
END; ! of CHECKNLIST
ROUTINE ALCRDKEY=
!++
! FUNCTIONAL DESCRIPTION:
!
! Performs register allocation expression pointed to by the IOKEY field.
!
! FORMAL PARAMETERS:
!
! None
!
! IMPLICIT INPUTS:
!
! CSTMNT PTR TO OPEN STATEMENT NODE
!
! IMPLICIT OUTPUTS:
!
! None
!
! ROUTINE VALUE:
!
! None
!
! SIDE EFFECTS:
!
! None
!
!--
BEGIN
IF (TREEPTR = .CSTMNT[IOKEY]) NEQ 0
THEN IF .TREEPTR[OPRCLS] NEQ DATAOPR !IF NOT A SIMPLE VAR OR CONST
THEN
BEGIN
IF .TREEPTR[OPRCLS] EQL ARRAYREF
!FOR AN ARRAYREF - MUST LINK A STORECLS NODE UNDER THE STATEMENT NODE
THEN CSTMNT[IOKEY]_ALCTVARR(.STBSYR,.STRGCT)
ELSE ALCTMP(); ! Allocate a 1 or 2 word .Q temp
END;
END; ! of ALCRDKEY
ROUTINE ALCOPKEY=
!++
! FUNCTIONAL DESCRIPTION:
!
! Performs register allocation for the lower and upper bounds
! of the keys that are expressions pointed to by the IOKEY field.
! Global INPFLAG is TRUE for INQUIRE and indicates that the
! arguments are modified.
!
! FORMAL PARAMETERS:
!
! None
!
! IMPLICIT INPUTS:
!
! IMPFLAG THIS STMNT DOES INPUT
! CSTMNT PTR TO OPEN STATEMENT NODE
!
! IMPLICIT OUTPUTS:
!
! None
!
! ROUTINE VALUE:
!
! None
!
! SIDE EFFECTS:
!
! None
!
!--
BEGIN ! New [4500]
REGISTER OPNKEYLIST KEYVALLST; !list of keys
IF .CSTMNT[IOKEY] NEQ 0
THEN
BEGIN
KEYVALLST = .CSTMNT[IOKEY];! List of arguments under the stmnts
! Walk thru the list of keys, perform register allocation
! for the calculation of any upper and lower bound of a key
! that is not a variable or const
DECR I FROM .KEYVALLST[NUMKEYS] TO 1 DO
BEGIN
! Expression node for the val of the lower bound of the Ith key
TREEPTR = .KEYVALLST[.I,KEYLOW];
IF .TREEPTR[OPRCLS] NEQ DATAOPR
THEN
BEGIN
! Allocate a 1 word .Q temp
IF .TREEPTR[OPRCLS] NEQ ARRAYREF
THEN ALCSTAYINTMP(NXTTMP(1),.STBSYR,.STRGCT)
! Allocate variable to temp
ELSE KEYVALLST[.I,KEYLOW] = ALCTVARR(.STBSYR,.STRGCT)
END;
! INQUIRE clobbers its arguments
IF .INPFLAG THEN VARCLOBB(.TREEPTR);
! Expression node for the val of the upper bound of the Ith key
TREEPTR = .KEYVALLST[.I,KEYHIGH];
IF .TREEPTR[OPRCLS] NEQ DATAOPR
THEN
BEGIN
! Allocate a 1 word .Q temp
IF .TREEPTR[OPRCLS] NEQ ARRAYREF
THEN ALCSTAYINTMP(NXTTMP(1),.STBSYR,.STRGCT)
! Allocate variable to temp
ELSE KEYVALLST[.I,KEYHIGH] = ALCTVARR(.STBSYR,.STRGCT);
END;
! INQUIRE clobbers its arguments
IF .INPFLAG THEN VARCLOBB(.TREEPTR);
END;
END;
END; ! of ALCOPKEY
DBLMODE_FALSE; !FLAG WILL BE SET TO TRUE WHEN A STATEMENT IS PROCESSED
! IN DOUBLE-WD MODE (IE USES REG PAIRS). INITIALIZE IT TO FALSE.
IF .CSTMNT[PAIRMODEFLG] !IF THIS STATEMENT REQUIRES ANY ADJACENT REG PAIRS
THEN PAIRMODE_TRUE ! INIT GLOBAL INDICATING THAT AT LEAST
ELSE PAIRMODE_FALSE; ! ONE FREE PAIR SHOULD ALWAYS BE LEFT
IF .FLGREG<DBGLABL> !FORGET ABOUT OPTIMIZING REGISTER
THEN !USAGE ACROSS STATEMENTS IF FORDDT MAY CHANGE
CLRRGSTATE(); !VALUES IN CORE
%(***ACTION TO BE TAKEN IS DETERMINED BY THE SRCID***)%
CASE .CSTMNT[SRCID] OF SET
ALCASMNT(); !ASSIGNMENT
ALCASSI(); !ASSIGN
ALCCALL(); !CALL
BEGIN END; !CONTINUE
ALCDOSTMT(); !DO
ALCENTRY(); !ENTRY
ALCASMNT(); !COMMON SUB - SAME AS ASSIGNMENT
BEGIN END; ! GOTO
ALCAGO(); ! ASSIGNED GOTO
ALCCGO(); ! COMPUTED GOTO
ALCAIF(); ! ARITH IF
ALCLIF(); ! LOGICAL IF
ALCRETURN(); ! RETURN
BEGIN END; ! STOP
BEGIN ! READ
ALCUNIT();
INPFLAG = TRUE; !SET GLOBAL FLAG TO INDICATE THAT THE IOLIST TO
! BE PROCESSED DOES INPUT
IF .CSTMNT[IONAME] NEQ 0 !SEE IF NAMELIST
AND .CSTMNT[IONAME] NEQ #777777 !TYPE READ
THEN !YES
BEGIN
LOCAL BASE T1;
T1_.CSTMNT[IONAME];
%1555% IF .T1[OPR1] EQL VARFL
THEN IF .T1[IDATTRIBUT(NAMNAM)] EQL 1
! SEE IF NAMELIST BIT IS ON IN SYMBOL TABLE
! ENTRY THEN CLEAR ANY REGISTERS CONTAINING
! VARIABLES IN THE NAMELIST
THEN CHECKNLIST(.T1[IDCOLINK]);
END;
%1516% ALCFMT();
ALCRANDIO();
%[760]% ALCIOS(); ! process iostat
%4501% ALCRDKEY(); ! process IOKEY field
ALCIOLST(); !PROCESS THE IOLIST
END;
BEGIN ! WRITE
ALCUNIT();
INPFLAG = FALSE; ! SET GLOBAL FLAG TO INDICATE THAT THE
! IOLIST TO BE PROCESSED DOES NOT DO INPUT
%1516% ALCFMT();
ALCRANDIO();
%[760]% ALCIOS(); ! process iostat
ALCIOLST();
END;
BEGIN ! DECODE
INPFLAG = TRUE; !SET GLOBAL FLAG TO INDICATE THAT THE IOLIST
! TO BE PROCESSED DOES INPUT
%1516% ALCFMT();
%[760]% ALCIOS(); ! process iostat
ALCDECENC(); ! ENCODE/DECODE
END;
BEGIN ! ENCODE
INPFLAG = FALSE; ! SET GLOBAL FLAG TO INDICATE THAT THE
! IOLIST TO BE PROCESSED DOES NOT DO INPUT
%1516% ALCFMT();
%[760]% ALCIOS(); ! process iostat
ALCDECENC(); ! ENCODE/DECODE
END;
BEGIN !REREAD
ALCUNIT();
INPFLAG = TRUE; !SET GLOBAL FLAG TO INDICATE THAT THE IOLIST TO
! BE PROCESSED DOES INPUT
%1516% ALCFMT();
%[760]% ALCIOS(); ! process iostat
ALCIOLST();
END;
%[760]% BEGIN ! FIND
%2040% ALCUNIT();
%2040% ALCRANDIO();
%2040% ALCIOS(); ! process iostat
%[760]% END;
%[760]% BEGIN ! CLOSE
%[760]% ALCUNIT();
%2201% ALCFILE(); ! allocate FILE=
%[760]% ALCIOS(); ! process iostat
%2201% ! Set flag for this statement does not do input
%2201% INPFLAG = FALSE;
%[760]% ALCOPEN();
%[760]% END;
%4502% BEGIN ! DELETE
%4502% ALCUNIT();
%4502% ALCRANDIO();
%4502% ALCIOS(); ! process iostat
%4502% END;
%4503% BEGIN ! REWRITE
%4503% ALCUNIT();
%4503% INPFLAG = FALSE; ! SET GLOBAL FLAG TO INDICATE THAT THE
%4503% ! IOLIST TO BE PROCESSED DOES NOT DO INPUT
%4503% ALCFMT();
%4503% ALCRANDIO();
%4503% ALCIOS(); ! process iostat
%4503% ALCIOLST();
%4503%
END;
%[760]% BEGIN ! BACKSPACE
%[760]% ALCUNIT();
%[760]% ALCIOS(); ! process iostat
%[760]% END;
%[760]% BEGIN ! BACKFILE
%[760]% ALCUNIT();
%[760]% ALCIOS(); ! process iostat
%[760]% END;
%[760]% BEGIN ! REWIND
%[760]% ALCUNIT();
%[760]% ALCIOS(); ! process iostat
%[760]% END;
%[760]% BEGIN ! SKIPFILE
%[760]% ALCUNIT();
%[760]% ALCIOS(); ! process iostat
%[760]% END;
%[760]% BEGIN ! SKIPRECORD
%[760]% ALCUNIT();
%[760]% ALCIOS(); ! process iostat
%[760]% END;
%[760]% BEGIN ! UNLOAD
%[760]% ALCUNIT();
%[760]% ALCIOS(); ! process iostat
%[760]% END;
%4504% BEGIN ! UNLOCK
%4504% ALCUNIT();
%4504% ALCIOS(); ! process iostat
%4504% END;
%[760]% BEGIN ! ENDFILE
%[760]% ALCUNIT();
%[760]% ALCIOS(); ! process iostat
%[760]% END;
BEGIN END; ! END
BEGIN END; ! PAUSE
BEGIN ! OPEN
ALCUNIT();
%2201% ALCFILE(); ! allocate FILE=
%[760]% ALCIOS(); ! process iostat
%2201% ! Set flag for this statement does not do input
%2201% INPFLAG = FALSE;
%4500% ALCOPKEY(); ! allocate KEY=
ALCOPEN();
END;
ALCSFN(); ! SFN
BEGIN END; ! FORMAT
BEGIN END; ! BLT (NOT IN RELEASE 1)
BEGIN ! GLOBAL ALLOCATOR ID - INDICATING THAT THE SET of
! REGISTERS AVAILABLE SHOULD CHANGE SET OF REGS TO BE
! USED IN STATEMENTS FOLLOWING
GBSYREGS<LEFT>_.CSTMNT[NEWREGSET];
GBSYCT_ONESCOUNT(.GBSYREGS);
END;
%2201% BEGIN ! INQUIRE
%2201% ALCUNIT();
%2201% ALCFILE(); ! allocate FILE=
%2201% ALCIOS(); ! process iostat
%2201% ! Set flag for this statement does input
%2201% INPFLAG = TRUE;
%2201% ALCOPEN();
%2201% END;
TES;
%(***IF THIS STATEMENT HAS A LABEL, PERFORM REG ALLOC FOR ANY DO-LOOP TERMINATION
IMPLIED BY THAT LABEL****)%
IF .CSTMNT[SRCLBL] NEQ 0
THEN ALCDOEND(.CSTMNT[SRCLBL]);
END; ! of ALCSTMN
GLOBAL ROUTINE STCMASMNT=
%(***************************************************************************
ROUTINE TO PERFORM THE COMPLEXITY PASS FOR AN ASSIGNMENT
STATEMENT.
DETERMINES THE NUMBER OF REGS NECESSARY FOR COMPUTATION OF THE
LEFT AND RIGHT SIDES AND FOR ALL COMMON SUBEXPRESSIONS.
DETERMINES WHICH SIDE SHOULD BE COMPUTED FIRST.
CALLED WITH THE GLOBAL CSTMNT POINTING TO THE STATEMENT NODE.
THIS ROUTINE IS NOT CALLED RECURSIVELY.
***************************************************************************)%
BEGIN
OWN CMPLX1:CMPLX2;
OWN PEXPRNODE ARG1NODE;
OWN PEXPRNODE LHNODE;
OWN PEXPRNODE RHNODE;
IF .FLGREG<PROGTYP> EQL FNPROG
THEN
FNVLCH1(); !KEEP A CT OF ASSIGNMENTS OF THE FN VAL THAT DIRECTLY
! PRECEDE RETURN STMNTS
RHNODE_.CSTMNT[RHEXP];
LHNODE_.CSTMNT[LHEXP];
IF .CSTMNT[MEMCMPFLG] !IF THIS ASSIGNMENT WILL BE PERFORMED TO MEMORY
AND .RHNODE[OPRCLS] NEQ SPECOP ! AND THE OPERATION IS ARITHMETIC OR BOOLEAN
%4517% AND .LHNODE[OPR1] NEQ CHARFNFL ! NOT CHAR ASMNT
THEN
BEGIN
ORDERMEMCMP(); !ORDER THE ARGS UNDER RHS SO THAT THE ARG THAT MATCHES LHS IS ARG2
ARG1NODE_.RHNODE[ARG1PTR]; !GET PTR TO ARG NOT IDENTICAL TO LHS
%2335% ! If that arg is the integer constant one and the
%2335% ! operation is integer add (or sub) then perform this
%2335% ! op to both rather than to memory (so that can
%2335% ! peephole AOS and SOS).
%2335%
%2335% IF .ARG1NODE[OPERATOR] EQL INTCONST
%2335% THEN IF .ARG1NODE[CONST2] EQL 1
%2335% THEN IF .RHNODE[OPERATOR] EQL INTADD
%2335% THEN RHNODE[OPTOBOTHFLG] = 1;
END;
IF .CSTMNT[A1VALFLG]
THEN
%(***IF LHS IS A SIMPLE VARIABLE, SET UP PTR TO THE SYMBOL TABLE ENTRY***)%
BEGIN
RESNAME_.CSTMNT[LHEXP];
CMPLX1_0;
END
ELSE
%(***IF LHS REQUIRES EVALUATION (IE IS AN ARRAY REFERENCE), DETERMINE NUMBER OF
REGS NEEDED FOR THAT CALC***)%
BEGIN
TREEPTR_.CSTMNT[LHEXP];
CMPLX1_SETCOMPLEXITY();
RESNAME_.LHNODE[ARG1PTR];
END;
%(***DETERMINE THE NUMBER OF REGS NECESSARY FOR EVALUATION OF RHS***)%
IF NOT .CSTMNT[A2VALFLG]
THEN
BEGIN
TREEPTR_.CSTMNT[RHEXP];
CMPLX2_SETCOMPLEXITY();
END;
%(***IF RIGHT HAND SIDE IS A VARIABLE OR A CONSTANT, STILL NEED ONE REG TO LOAD THE VAL INTO***)%
IF .RHNODE[OPRCLS] EQL DATAOPR
THEN
BEGIN
CMPLX2_1;
%(***IF RHNODE IS A CONSTANT, DETERMINE WHETHER IT IS
AN IMMED CONSTANT AND IF NOT ALLOCATE CORE FOR IT***)%
IF .RHNODE[OPR1] EQL CONSTFL
THEN
PRCNSTARG(.CSTMNT,.RHNODE,FALSE);
%(**IF RHS COULD HAVE BEEN LEFT IN A REG EARLIER, DO SO**)%
SAVREGCONTAINING(.RHNODE);
%(**IF THE VAR ON THE RHS IS NEEDED LATER, WILL BE ABLE TO USE
IT FROM THE REG USED FOR THIS ASMNT**)%
ADDREGCANDATE(.RHNODE,.CSTMNT);
END;
%(***IF THE RHS IS DOUBLE-PREC, NEED TWICE AS MANY REGS AS HAVE COMPUTED***)%
IF .RHNODE[DBLFLG] THEN CMPLX2_2*.CMPLX2;
%(***SET FIELD IN THE ASSIGNMENT-STMNT NODE TO INDICATE THE NUMBER OF REGS
NECESSARY TO EVAL THE STMNT EXCLUSIVE OF COMMON SUBEXPRS***)%
CSTMNT[SRCCMPLX]_
(IF .CMPLX1 GTR .CMPLX2
THEN .CMPLX1
ELSE
IF .CMPLX2 GTR .CMPLX1
THEN .CMPLX2
ELSE .CMPLX1+1 );
%(***PERFORM COMPLEXITY ANALYSIS FOR EACH COMMON SUBEXPRESSION UNDER
THIS NODE*******)%
STCMCSB();
%(**IF THE LHS VAR IS NEEDED LATER, IT CAN BE USED DIRECTLY FROM THE REG
USED FOR THIS ASMNT***)%
IF .CSTMNT[A1VALFLG] THEN ADDREGCANDATE(.LHNODE,.CSTMNT);
END; ! of STCMASMNT
GLOBAL ROUTINE STCMAGO=
%(***************************************************************************
ROUTINE TO COMPUTE THE COMPLEXITY OF AN ASSIGNED GOTO
***************************************************************************)%
BEGIN
%(***COMPUTE COMPLEXITY OF THE ASSIGNED VAL (MAY BE AN ARRAY-REF***)%
TREEPTR_.CSTMNT[AGOTOLBL];
IF .TREEPTR[OPRCLS] EQL DATAOPR
THEN
CSTMNT[SRCCMPLX]_0
ELSE
CSTMNT[SRCCMPLX]_SETCOMPLEXITY();
%(***FIND COMPLEXITY OF ANY COMMON SUBEXPRS***)%
STCMCSB();
END; ! of STCMAGO
GLOBAL ROUTINE STCMCGO=
%(***************************************************************************
ROUTINE TO COMPUTE COMPLEXITY OF A COMPUTED GOTO
***************************************************************************)%
BEGIN
%(***CALCULATE THE COMPLEXITY OF THE EXPRESSION TO BE COMPUTED***)%
TREEPTR_.CSTMNT[CGOTOLBL];
IF .TREEPTR[OPRCLS] EQL DATAOPR
THEN
BEGIN
IF .TREEPTR[OPR1] EQL CONSTFL THEN ALOCONST(.TREEPTR);
CSTMNT[SRCCMPLX]_0
END
ELSE
CSTMNT[SRCCMPLX]_SETCOMPLEXITY();
%(***FIND COMPLEXITY OF ANY COMMON SUBEXPRS***)%
STCMCSB();
END; ! of STCMCGO
GLOBAL ROUTINE STCMSTOP=
%(***************************************************************************
ROUTINE TO PERFORM THE COMPLEXITY FOR STOP AND PAUSE.
THE ARG FOR STOP/PAUSE CAN ONLY BE A VARIABLE OR A CONSTANT OR
LITERAL (CANNOT BE AN EXPRESSION).
MUST ALLOCATE THE CONSTANT OR LITERAL IF THERE IS ONE.
***************************************************************************)%
BEGIN
OWN PEXPRNODE STOPEXPR;
IF (STOPEXPR_.CSTMNT[STOPIDENT]) NEQ 0
THEN
BEGIN
IF .STOPEXPR[OPR1] EQL CONSTFL
THEN ALOCONST(.STOPEXPR);
END;
CSTMNT[SRCCMPLX]_0;
END; ! of STCMSTOP
GLOBAL ROUTINE STCMLIF=
%(***************************************************************************
ROUTINE TO PERFORM THE COMPLEXITY PASS FOR A LOGICAL IF.
DETERMINES THE NUMBER OF REGS NECESSARY FOR COMPUTATION OF
THE LOGICAL EXPRESSION AND FOR THE SUBSTATEMENT AND FOR ANY COMMON SUBEXPRS.
SETS THE COMPLEXITY OF THE STATEMENT TO THE MAXIMUM OF THESE.
CALLED WITH THE GLOBAL CSTMNT POINTING TO THE STATEMENT TO BE PROCESSED.
THIS ROUTINE IS NEVER CALLED RECURSIVELY (SINCE IT IS ILLEGAL TO EMBED
A LOGICAL IF INSIDE ANOTHER)
***************************************************************************)%
BEGIN
LOCAL CEXPRPAIRMODE; !VALUE OF "PAIRMODE" FOR THE CONDITIONAL EXPR
! (TRUE IFF THE COND USES ANY REG PAIRS)
LOCAL CEXPRFNREF; !VALUE OF "FNREF" FOR THE CONDITIONAL EXPR (TRUE IFF
! THERE ARE ANY FN CALLS IN THE CEXPR)
OWN PEXPRNODE CONDEXPR;
OWN BASE SAVSTMNT; !SAVE PTR TO THIS STMNT
%(***PERFORM COMPLEXITY ANALYSIS ON THE CONDITIONAL EXPR***)%
CONDEXPR_.CSTMNT[LIFEXPR];
TREEPTR_.CONDEXPR;
%(****FOR RELATIONALS AND CONTROL-TYPE BOOLEANS, NEED NEVER COMPUTE A VALUE***)%
IF .CONDEXPR[VALTYPE] EQL CONTROL
THEN
BEGIN
IF .CONDEXPR[OPRCLS] EQL BOOLEAN
THEN
CSTMNT[SRCCMPLX]_CMPLBL()
ELSE
IF .CONDEXPR[OPRCLS] EQL RELATIONAL
THEN
CSTMNT[SRCCMPLX]_CMPLREL()
ELSE
CGERR()
END
%(***FOR EXPRESSIONS WHICH DO NOT HAVE VALTYPE CONTROL, WILL COMPUTE A VAL AND TEST IT***)%
ELSE
BEGIN
%(***IF CONDEXPR IS A CONSTANT, THIS STMNT WILL HAVE BEEN FOLDED AWAY IN
P2SKEL IF P2SKEL IS USED; IF P2SKEL IS NOT USED, A CONSTANT
CONDEXPR IS ALLOCATED TO CORE****)%
IF .CONDEXPR[OPR1] EQL CONSTFL THEN ALOCONST(.TREEPTR);
CSTMNT[SRCCMPLX]_SETCOMPLEXITY();
END;
CEXPRPAIRMODE_.PAIRMODE; !SAVE KNOWLEDGE OF WHETHER THE COND EXPR USED ANY REG PAIRS
CEXPRFNREF_.FNREF; !SAVE KNOWLEDGE OF WHETHER THE COND EXPR HAD ANY FN CALLS
%(***COMPUTE THE COMPLEXITY OF THE SUBSTATEMNT***)%
SAVSTMNT_.CSTMNT; !SAVE PTR TO THIS STMNT
CSTMNT_.CSTMNT[LIFSTATE];
CMSTMN();
%(**THE IF STATEMENT REQUIRES AT LEAST AS MANY REGS AS ARE NECESSARY FOR
COMPUTATION OF THE SUBSTATEMENT***)%
IF .SAVSTMNT[SRCCMPLX] LSS .CSTMNT[SRCCMPLX]
THEN
SAVSTMNT[SRCCMPLX]_.CSTMNT[SRCCMPLX];
CSTMNT_.SAVSTMNT; !RESTORE VAL OF CSTMNT
%(***PERFORM COMPLEXITY ANALYSIS FOR COMMON SUBEXPRS***)%
STCMCSB();
PAIRMODE_.PAIRMODE OR .CEXPRPAIRMODE; !THE IF REQUIRES A REG PAIR IF EITHER THE COND EXPR
! OR THE SUBSTMNT REQUIRES ONE
FNREF_.FNREF OR .CEXPRFNREF; !THE IF STMNT CONTAINS A FN REF IF EITHER THE
! COND EXPR OR THE SUBSTMNT DOES
END; ! of STCMLIF
GLOBAL ROUTINE STCMAIF=
%(***************************************************************************
ROUTINE TO PERFORM THE COMPLEXITY PASS FOR AN ARITHMETIC IF.
DETERMINES THE NUMBER OF REGS NECESSARY FOR COMPUTATION OF THE
ARITHMETIC EXPRESSION AND FOR ANY COMMON SUBEXPRESSIONS.
SETS THE COMPLEXITY OF THE STATEMENT TO THE MAX OF THESE.
CALLED WITH THE GLOBAL CSTMNT POINTING TO THE STATEMENT FOR
WHICH ANALYSIS IS TO BE PERFORMED.
***************************************************************************)%
BEGIN
%(***PERFORM COMPLEXITY ANALYSIS OF THE ARITH EXPR***)%
TREEPTR_.CSTMNT[AIFEXPR];
%(***IF THE ARITH EXPR IS A VARIABLE, WILL STILL USE A REG TO HOLD THE VAL***)%
IF .TREEPTR[OPRCLS] EQL DATAOPR
THEN
BEGIN
SAVREGCONTAINING(.TREEPTR); !IF BB ALLOCATOR CAN LEAVE THIS VAR IN A
! REG, HAVE IT DO SO
%(***IF CONDEXPR IS A CONSTANT, THIS STMNT WILL HAVE BEEN FOLDED AWAY IN
P2SKEL IF IT WAS USED; IF P2SKEL NOT USED, A CONSTANT CONDEXPR
IS ALLOCATED TO CORE****)%
IF .TREEPTR[OPR1] EQL CONSTFL THEN ALOCONST(.TREEPTR);
CSTMNT[SRCCMPLX]_1
END
ELSE
CSTMNT[SRCCMPLX]_SETCOMPLEXITY();
%(***PERFORM COMPLEXITY ANALYSIS FOR ANY COMMON SUBEXPRSSIONS***)%
IF .CSTMNT[SRCCOMNSUB] NEQ 0
THEN STCMCSB();
END; ! of STCMAIF
GLOBAL ROUTINE SCMASSI=
%(***************************************************************************
PERFORM COMPLEXITY ANALYSIS FOR AN ASSIGN STMNT.
***************************************************************************)%
BEGIN
TREEPTR_.CSTMNT[ASISYM];
%(***IF VAR ASSIGNED TO IS AN ARRAYREF, PERFORM COMPLEXITY ANALYSIS ON IT***)%
IF .TREEPTR[OPRCLS] EQL ARRAYREF
THEN
BEGIN
CSTMNT[SRCCMPLX]_CMPLXARRAY();
IF .CSTMNT[SRCCMPLX] EQL 0 THEN CSTMNT[SRCCMPLX]_1;
END
ELSE
CSTMNT[SRCCMPLX]_1;
END; ! of SCMASSI
GLOBAL ROUTINE STCMOPEN=
%(***************************************************************************
TO PERFORM COMPLEXITY PASS FOR AN OPEN STATEMENT.
MUST ALLOCATE ALL CONSTANTS THAT OCCUR UNDER THIS STMNT.
***************************************************************************)%
BEGIN
REGISTER PEXPRNODE ARGVAL; !PTR TO SYMBOL OR CONSTANT TABLE ENTRY
! FOR THE VALUE TO BE PASSED TO FOROTS
! FOR A GIVEN ARG
REGISTER OPENLIST ARVALLST; !LIST OF ARGS UNDER THIS OPEN STMNT
OWN CMPLXMAX; !MAXIMUM COMPLEXITY OF THE ARGS
ARVALLST_.CSTMNT[OPLST];
CMPLXMAX_0;
%(***WALK THRU THE LIST OF ARGS - FOR ANY ARG THAT IS A CONSTANT OR A LITERAL
ALLOCATE CORE FOR THAT CONSTANT/LITERAL***)%
INCR I FROM 0 TO (.CSTMNT[OPSIZ]-1)
DO
BEGIN
%2401% IF (ARGVAL = .ARVALLST[.I,OPENLPTR]) NEQ 0
%2401% THEN
%2401% BEGIN ! Specifier has a value
%2401% ! See if we have a substring which can be
%2401% ! replaced with a .Dnnnn compile time constant
%2401% ! descriptor.
%2401%
%2401% ARVALLST[.I,OPENLPTR] = ARGVAL = DOTDCHECK(.ARGVAL);
IF .ARGVAL[OPRCLS] EQL DATAOPR !VAL A VAR OR CONST
THEN
! Allocate core for a constant
(IF .ARGVAL[OPR1] EQL CONSTFL THEN ALOCONST(.ARGVAL))
ELSE !VAL AN EXPRESSION (OR ARRAYREF)
BEGIN
REGISTER CMPL1;
! Perform "complexity" pass over this
! expression. If its complexity is
! greater than the maximum, change the
! maximum.
TREEPTR_.ARGVAL;
IF (CMPL1_SETCOMPLEXITY()) GTR .CMPLXMAX
THEN CMPLXMAX_.CMPL1;
END;
%2401% END; ! Specifier has a value
END;
CSTMNT[SRCCMPLX]_.CMPLXMAX;
END; ! of STCMOPEN
GLOBAL ROUTINE CMPDECENC=
%(***************************************************************************
TO PERFORM COMPLEXITY PASS FOR AN ENCODE OR DECODE STMNT.
THE ENCODE VAR MAY BE AN ARRAY REF THAT NEEDS TO HAVE AN ADDRESS CALC
PERFORMED.
***************************************************************************)%
BEGIN
OWN CMPL1;
OWN PEXPRNODE ENCVAR;
OWN PEXPRNODE ENCCT;
ENCVAR_.CSTMNT[IOVAR]; !ENCODE/DECODE VARIABLE
ENCCT_.CSTMNT[IOCNT]; !CHAR CT
%(***IF CHAR CT IS AN EXPRESSION, PERFORM COMPLEXITY ANALYSIS FOR ITS
CALCULATION***)%
IF .ENCCT[OPRCLS] NEQ DATAOPR
THEN
BEGIN
TREEPTR_.ENCCT;
SETCOMPLEXITY()
END
%2317% ELSE IF .ENCCT[OPR1] EQL CONSTFL ! Is it a constant?
%2317% THEN ALOCONST(.ENCCT); ! Yes, allocate it to memory
%(***IF ENCODE/DECODE VARIABLE IS AN ARRAY REF (RATHER THAN A SYMBOL TABLE
ENTRY FOR AN ARRAY NAME) - PERFORM COMPLEXITY PASS ON ADDRESS CALCULATION***)%
IF .ENCVAR[OPRCLS] EQL ARRAYREF
THEN
BEGIN
TREEPTR_.ENCVAR;
CMPL1_CMPLXARRAY()
END
ELSE
IF .ENCVAR[OPRCLS] EQL DATAOPR
THEN CMPL1_0
ELSE CGERR();
CMPLIOLST(); !PERFORM COMPLEXITY ANALYSIS ON THE IOLIST
! LEAVE THE STMNT COMPLEXITY FIELD SET TO THE NUMBER
! OF REGS NECESSARY FOR COMP OF THE IOLIST
%(***IF THE ADDR CALC FOR THE ENCODE VAR REQUIRES MORE REGS THAN CALC
OF THE IOLIST DOES, ADJUST THE COMPLEXITY FIELD OF THE STMNT***)%
IF .CMPL1 GTR .CSTMNT[SRCCMPLX]
THEN CSTMNT[SRCCMPLX]_.CMPL1;
END; ! of CMPDECENC
GLOBAL ROUTINE STCMCSB=
%(***************************************************************************
ROUTINE TO PERFORM COMPLEXITY ANALYSIS FOR EACH COMMON SUBEXPR UNDER THE NODE
POINTED TO BY CSTMNT.
LEAVES THE COMPLEXITY FIELD OF THE STATEMENT SET TO THE MAX OF ITS
INITIAL VAL AND THE MAX COMPLEXITY OF ANY COMMON SUB
***************************************************************************)%
BEGIN
OWN CMPLX1;
REGISTER PEXPRNODE CCMNSUB;
CCMNSUB_.CSTMNT[SRCCOMNSUB];
UNTIL .CCMNSUB EQL 0
DO
BEGIN
IF .CCMNSUB[A2VALFLG] !IF THIS CSB IS A SINGLE VARIABLE
THEN
BEGIN
SAVREGCONTAINING(.CCMNSUB[ARG2PTR]); !IF THE CSB COULD HAVE BEEN
! LEFT IN A REG BY A PREV STMNT, DO LEAVE IT
ADDREGCANDATE(.CCMNSUB[ARG2PTR],.CCMNSUB); !IF THIS VAR SHOULD BE NEEDED LATER
! WILL BE ABLE TO USE IT FROM THE
! REG WHERE THIS STMNT LEFT IT
CCMNSUB[COMPLEXITY]_0;
END
ELSE !IF THE CSB IS AN EXPRESSION
BEGIN
TREEPTR_.CCMNSUB[ARG2PTR];
CMPLX1_SETCOMPLEXITY();
IF .CMPLX1 GTR .CSTMNT[SRCCMPLX]
THEN CSTMNT[SRCCMPLX]_.CMPLX1;
CCMNSUB[COMPLEXITY]_.CMPLX1;
END;
CCMNSUB_.CCMNSUB[CLINK];
END;
END; ! of STCMCSB
GLOBAL ROUTINE ALCASMNT=
%(***************************************************************************
ROUTINE TO PERFORM REGISTER ALLOCATION FOR AN ASSIGNMENT STATEMENT.
DETECTS OPERATONS OF THE FORM:
A=A+B+C+...
A=A*B*C....
TO BE OPERATIONS TO MEMORY.
CALLED WITH THE GLOBAL CSTMNT POINTING TO THE STATEMENT NODE FOR
WHICH ALLOCATION IS TO BE PERFORMED.
THIS ROUTINE IS NEVER CALLED RECURSIVELY.
***************************************************************************)%
BEGIN
OWN PEXPRNODE ARGNODE:LHNODE:RHNODE;
OWN RA,RB;
OWN PEXPRNODE SUBNODE;
OWN RSV;
%4517% LOCAL BASE LHARG1;
%4517% LOCAL BSYRG1,FRGCT1;
%(***TO SET THE REG FOR COMPUTATION OF THE STATEMENT TO THE SAME REG
INTO WHICH THE RIGHT-HAND SIDE WAS COMPUTED***)%
MACRO SETREGTORH=
BEGIN
CSTMNT[ASMNTREG]_.RHNODE[TARGTAC];
CSTMNT[A2SAMEFLG]_1;
END$;
ROUTINE USEAFREEREG=
%(*****ROUTINE TO GET A LEGAL REG FOR COMPUTATION OF THE ASSIGNMENT AND
SET THE REG-TO-BE-USED TO THAT REG*****)%
BEGIN
RA_REGTOUSE(.CSTMNT,.RHNODE,.LHNODE,.RA,.STBSYR);
CSTMNT[ASMNTREG]_.RA; !SET THE REG TO BE USED FOR THE
! ASSIGNMENT TO RA
REGCLOBB(.RA); !MUST ASSUME THAT PREVIOUS CONTENTS OF
! RA ARE CLOBBERED. CLEAR BASIC BLOCK ALLOC
! TABLE ENTRIES FOR RA
IF .RHNODE[DBLFLG] !IF THE VAL BEING ASSIGNED USES 2 WDS
THEN !MUST ALSO ASSUME THAT THE REG AFTER
REGCLOBB(.RA+1); ! RA IS CLOBBERED
END; ! of USEAFREEREG
ROUTINE SETREGFORA2VAL=
%(***ROUTINE TO SET THE "REG FOR COMP" OF THE STMNT WHEN THE RIGHT HAND SIDE IS
A VARIABLE OR REGCONTENTS (IE WHEN A2VALFLG IS SET)***)%
BEGIN
IF .RHNODE[OPRCLS] EQL REGCONTENTS
THEN
%(***IF RHS IS A VAR WHICH LIVES IN A REG, WILL USUALLY WANT TO SET
REG-FOR-COMP OF STMNT TO THAT REG***)%
BEGIN
%(***HAVE THE EXCEPTION THAT IF THE RHS IS AN AOBJN WORD
FOR A LOOP CONTROL, WANT TO USE ONLY THE RIGHT HALF.
THIS IS A PROBLEM IFF EITHER A2NEGFLG OR A2NOTFLG IS SET,
IN WHICH AN EXTRA REG WILL BE NEEDED.
*******)%
IF .CSTMNT[A2IMMEDFLG] AND
(.CSTMNT[A1NEGFLG] OR .CSTMNT[A1NOTFLG]
OR .CSTMNT[A2NEGFLG] OR .CSTMNT[A2NOTFLG])
THEN
USEAFREEREG()
ELSE
SETREGTORH
END
ELSE
IF (RB_REGCONTAINING(.RHNODE)) GEQ 0 !IF THE RIGHT HAND SIDE WAS LEFT IN
! A REG BY AN EARLIER STMNT IN THIS BASIC BLOCK
AND .CSTMNT[A2NGNTFLGS] EQL 0 !AND THE RHS WILL NOT BE PICKED UP
! BY A MOVN
THEN
BEGIN
CSTMNT[ASMNTREG]_.RB; !USE THAT REG FOR THE ASSIGNMENT
CSTMNT[A2SAMEFLG]_1; !NEED NOT RELOAD THE REG
CSTMNT[A2IMMEDFLG]_0; !IF THE RHS WAS PREVIOUSLY AN IMMED CONST, WOULD
! HAVE HAD THIS FLAG SET. MUST BE CAREFUL
! TO TURN IT OFF BECAUSE THE ONLY PLACE THAT
! WE CAN HAVE "A2SAMEFLG" AND "A2IMMEDFLG"
! BOTH SET IS FOR RHS AN AOBJN REG
REGCLOBB(.RB); !DELETE THE PREVIOUS ENTRY IN THE "REGSTATE"
! TABLE FOR RB (SINCE WE CAN ONLY REMEMBER
! A MAX OF 2 VARS PER REG)
END
ELSE
%(***IF RHS IS A VARIABLE WHICH DOES NOT LIVE IN A REG, SET REG
FOR COMP OF STMNT TO RA****)%
USEAFREEREG()
END; ! of SETREGFORA2VAL
FNVALCHK(); !IF LHS OF THIS STMNT IS THE FN ENTRY NAME (IE IS THE VAL TO BE RETURNED)
! AND THE NEXT STMNT IS A RETURN, SUBSTITUTE A REGCONTENTS 0 FOR THE LHS
RHNODE_.CSTMNT[RHEXP];
LHNODE_.CSTMNT[LHEXP];
%(****PERFORM REGISTER ALLOCATION FOR THE COMMON SUBEXPRS UNDER THIS STMNT.****)%
DBLMODE_FALSE;
ALCCMNSB();
%4517% IF .LHNODE[OPR1] EQL CHARFNFL
%4517% THEN
%4517% BEGIN ! 1-character assignment
%4517%
%4517% RA=AFREEREG(.STBSYR,.CSTMNT[SRCSAVREGFLG],0);
%4517%
%4517% IF .LHNODE[A1VALFLG]
%4517% AND (.CSTMNT[A2VALFLG] OR .RHNODE[A1VALFLG])
%4517% THEN
%4517% BEGIN !LH = variable, RH = constant or variable
%4517%
%4517% SETTAC(.LHNODE,.RA); !LHNODE[TARGTAC] = .RA; REGCLOBB(.RA)
%4517%
%4522% IF NOT .LHNODE[INCRFLG] ! unincremented bp - use IDPB
%4522% THEN ! and need a second reg to move bp of RHS into
%4522% BEGIN
%4522% RA=AFREEREG(CLRBIT(.STBSYR,.RA),.CSTMNT[SRCSAVREGFLG],0);
%4522% REGCLOBB(.RA);
%4522% END;
%4517%
%4517% CSTMNT[ASMNTREG] = .RA;
%4517%
%4517% IF NOT .CSTMNT[A2VALFLG]
%4517% THEN
%4517% BEGIN
%4517% RHNODE[TARGTAC] = .RA;
%4517% RHNODE[INREGFLG] = 1;
%4517% END;
%4522% END
%4517% ELSE ! don't have (LH = variable, RH = constant or variable)
%4517% BEGIN
%4517% TREEPTR = .RHNODE;
%4517%
%4517% ! allocate regs for RHNODE
%4517%
%4517% IF .STRGCT LSS .LHNODE[COMPLEXITY]
%4517% OR .STRGCT LSS .RHNODE[COMPLEXITY]
%4517% THEN ! there are not enough regs for both LHS and RHS
%4517% BEGIN
%4517% ALCINTMP(NXTTMP(1),.STBSYR,.STRGCT);
%4517% END
%4517% ELSE
%4517% BEGIN
%4517% ALCINREG(.RA,.STBSYR,.STRGCT); !alloc reg for RHNODE
%4517% STBSYR = CLRBIT(.STBSYR,.RHNODE[TARGTAC]);
%4517% STRGCT = .STRGCT - 1;
%4517% RA=AFREEREG(.STBSYR,.CSTMNT[SRCSAVREGFLG],0);
%4517% END;
%4517%
%4517% !Character reg alloc routines expect regs in double
%4517% !mode. We did not have to do this for the RHS because
%4517% !it has an ICHAR over it and ALCILF converts the regs
%4517% !to double mode
%4517%
%4517% BSYRG1 = DPBSYREGS(.STBSYR);
%4517% FRGCT1 = ONESCOUNT(.BSYRG1);
%4517%
%4517% ! allocate regs for LHNODE
%4517%
%4517% IF .LHNODE[A1VALFLG]
%4517% THEN ! LH = variable
%4517% BEGIN
%4517% SETTAC(.LHNODE,.RA); !LHNODE[TARGTAC] = .RA; REGCLOBB(.RA)
%4517% END
%4517% ELSE ! LH is not variable
%4517% BEGIN
%4517% TREEPTR = LHARG1 = .LHNODE[ARG1PTR];
%4517% ALCINREG(.RA,.BSYRG1,.FRGCT1);
%4517% RA = LHNODE[TARGTAC] = .LHARG1[TARGTAC];
%4517% END;
%4517%
%4517% ! choose ASMNTREG
%4517%
%4517% IF .CSTMNT[A2VALFLG]
%4517% THEN !RHS is a constant
%4517% BEGIN
%4517% IF .LHNODE[A1VALFLG] ! LHS is a variable
%4517% THEN CSTMNT[ASMNTREG] = .LHNODE[TARGTAC]
%4517% ELSE
%4517% BEGIN ! LHS is not a variable
%4517% CSTMNT[ASMNTREG] = RA = AFREEREG(CLRBIT(.BSYRG1,.RA),.CSTMNT[SRCSAVREGFLG],0);
%4517% REGCLOBB(.RA);
%4517% END;
%4517% END
%4517% ELSE !RHS is not a constant
%4517% CSTMNT[ASMNTREG] = .RHNODE[TARGTAC];
%4517% END;
%4517% LHNODE = .LHNODE[ARG1PTR]; !Get whats under CHAR node
%4517% IF .LHNODE[OPRCLS] EQL SUBSTRING! could be substring?
%4517% THEN LHNODE = .LHNODE[ARG4PTR]; !get arrayref or variable
%4517% IF .LHNODE[OPRCLS] EQL ARRAYREF ! could be arrayref?
%4517% THEN LHNODE = .LHNODE[ARG1PTR]; !get variable
%4517% ! value of this variable gets clobbered
%4517% VARCLOBB(.LHNODE); ! with this assignment
%4517% RETURN;
%4517% END; ! 1-character assignment
%(***IF THIS STATEMENT IS DOUBLE-PREC, ADJUST SET OF BUSY REGS SO
THAT ONLY EVEN REGS WILL BE ALLOCATED****)%
IF .RHNODE[DBLFLG]
THEN
BEGIN
STBSYR_DPBSYREGS(.STBSYR);
STRGCT_ONESCOUNT(.STBSYR);
DBLMODE_TRUE;
END
ELSE DBLMODE_FALSE;
%(****IF THE LEFT-HAND SIDE OF THE ASSIGNMENT IS A VARIABLE THAT WAS ALLOCATED
TO LIVE IN A REGISTER, WILL PROCESS THE RIGHT-HAND SIDE IN A SPECIAL
MANNER*****)%
IF .LHNODE[OPRCLS] EQL REGCONTENTS
THEN
BEGIN
IF .CSTMNT[MEMCMPFLG]
THEN
BEGIN
CSTMNT[MEMCMPFLG]_0; !IF IN P2SKEL HAD DECIDED TO PERFORM THIS
! OP TO MEMORY - UNDO THAT DECISION
RHNODE[MEMCMPFLG]_0;
CSTMNT[OPTOBOTHFLG]_0; ! (ALSO UNDO DECISION TO DO OP "TO BOTH")
RHNODE[OPTOBOTHFLG]_0;
END;
IF LHINREGALC() THEN RETURN;
%[1161]% REGCLOBB(.LHNODE[TARGTAC]) ! REGISTER WILL BE TRASHED
END;
%(***IF THE RIGHT-HAND SIDE IS TO BE COMPUTED DIRECTLY TO MEMORY*****)%
IF .CSTMNT[MEMCMPFLG]
THEN
BEGIN
ALCMEMCMP();
RETURN;
END;
RA_AFREEREG(.STBSYR,.CSTMNT[SRCSAVREGFLG],.LHNODE[DBLFLG]);
%(***IF RIGHT HAND SIDE IS AN EXPRESSION WHOSE VAL MUST BE NEGATED BY AN EXTRA MOVN
(IE IT IS NOT A DATA ITEM OR ARRAYREF THAT WOULD HAVE TO BE PICKED UP ANYWAY)
OR IF LEFT HAND SIDE IS AN ARRAYREF (AND HENCE THERE IS NO VALUE IN
LEAVING ITS VAL IN A REG FOR FUTURE USES) AND THE RHS IS A SIMPLE
VAR (AND HENCE ITS VAL MIGHT BE USEFUL IN A REG)
SHOULD DO THE NEGATE AS A PART OF THE STORE OPERATION
HENCE IN THESE CASES SHOULD PUT NEG (AND NOT) FLAGS OVER LEFT
RATHER THAN RIGHT HAND SIDE***)%
IF (.RHNODE[OPRCLS] NEQ DATAOPR AND .RHNODE[OPRCLS] NEQ ARRAYREF)
OR
( NOT .CSTMNT[A1VALFLG]
AND .CSTMNT[A2VALFLG] !AND RHS IS A SIMPLE VAR
! (NB FOR A(I)=-A(I)
! WANT TO CREATE THE PEEPHOLE
! MOVN, MOVEM)
AND NOT (
%1413% IF (.RHNODE[OPERATOR] EQL INTCONST)
%1413% THEN .RHNODE[CONST2] EQL 1
%1413% ELSE FALSE
) !AND RHS IS NOT INTEGER 1
! (BECAUSE WE WANT TO GET THE
! MOVNI 1, MOVEM PEEPHOLE)
)
THEN
BEGIN
CSTMNT[A1NEGFLG]_.CSTMNT[A2NEGFLG]; !(A1NEGFLG WOULD NOT HAVE PREVIOUSLY BEEN SET)
CSTMNT[A1NOTFLG]_.CSTMNT[A2NOTFLG];
CSTMNT[A2NEGFLG]_0;
CSTMNT[A2NOTFLG]_0;
END;
%(***IF LEFT HAND SIDE OF STATEMENT IS A SIMPLE VARIABLE, PERFORM REGISTER
ALLOCATION FOR THE RIGHT HAND SIDE****)%
IF .CSTMNT[A1VALFLG]
THEN
BEGIN
IF .CSTMNT[A2VALFLG]
THEN
%(***IF RIGHT-HAND SIDE IS ALSO A SIMPLE VARIABLE***)%
SETREGFORA2VAL()
ELSE
BEGIN
TREEPTR_.RHNODE;
%(***IF THERE ARE NO REFERENCES TO THE LHS WITHIN THE EXPRESSION
ON THE RHS AND THE RHS IS NOT AN ARRAYREF,
AND THE NEG AND NOT FLAGS IN THE STATEMENT ARE BOTH 0,
ALLOCATE THE RHS TO BE COMPUTED TO THE
VARIABLE ON THE LHS*******)%
IF NOT .RHNODE[RESRFFLG] AND (NOT .RHNODE[OPRCLS] EQL ARRAYREF)
!IF LHS OF ASSIGNMENT STMNT IS A LOGICAL VARIABLE,
! AND IT IS IN COMMON OR EQUIVALENCED, THEN IT COULD
! BE NEEDED FOR EVALUATION OF RHS, SO PREVENT EARLY
! INITIALIZATION OF LHS TO -1
AND NOT(.LHNODE[VALTYPE] EQL LOGICAL
AND (.LHNODE[IDATTRIBUT(INEQV)] OR
.LHNODE[IDATTRIBUT(INCOM)]))
AND (NOT .LHNODE[OPRCLS] EQL REGCONTENTS)
AND (.CSTMNT[A2NGNTFLGS] EQL 0)
AND (.CSTMNT[A1NGNTFLGS] EQL 0)
THEN
BEGIN
ALCINTMP(.LHNODE,.STBSYR,.STRGCT);
IF .RHNODE[TARGTMEM] EQL .LHNODE
THEN
%(***IF COULD COMPUTE RHS DIRECTLY TO LHS***)%
BEGIN
CSTMNT[MEMCMPFLG]_1;
VARCLOBB(.LHNODE); !THE VAL OF THE VAR ON LHS HAS BEEN
! MODIFIED, CLEAR
! ANY BB ALLOC ENTRIES THAT REFER
! TO THAT VAR
IF .CSTMNT[SRCSAVREGFLG] !IF VAL OF LHS VAR IS USEFUL TO LEAVE
! IN A REG
AND .RHNODE[STOREFLG] !AND RHS WAS COMPUTED INTO A REG
! AND THEN STORED INTO LHS VAR
THEN
SAVEREG(.RHNODE[TARGTAC], !REMEMBER THAT LHS VAR
.LHNODE,0,.CSTMNT[SRCSONNXTUSE]); !IS IN THAT REG
RETURN;
END;
END
ELSE
%(***OTHERWISE, ALLOCATE THE RHS TO BE COMPUTED TO THE REG RA***)%
ALCINREG(.RA,.STBSYR,.STRGCT);
%(***DETERMINE REG FOR COMPUTATION OF THE STMNT***)%
IF .CSTMNT[ALCRETREGFLG]
THEN
%(***IF REG FOR COMPUTATION OF STMNT HAS ALREADY BEEN DETERMINED TO
BE THE FN-RETURN REG****)%
BEGIN END
ELSE
IF .RHNODE[INREGFLG]
THEN
%(***IF RHS IS COMPUTED INTO A REG, USE THAT REG AS REG FOR COMP FOR STMNT***)%
SETREGTORH
ELSE
%(***OTHERWISE USE SOME FREE REG***)%
USEAFREEREG()
END;
VARCLOBB(.LHNODE); !THE VAL OF THE VAR ON THE LHS HAS BEEN MODIFIED
! CLEAR ANY BB ALLOC ENTRIES THAT REFER TO IT
IF .CSTMNT[SRCSAVREGFLG] !IF VAL OF EITHER VAR ON LHS OR RHS IS OF FUTURE USE
! TO HAVE IN A REG
AND .CSTMNT[A1NGNTFLGS] EQL 0 !AND VAL WILL NOT BE STORED WITH "MOVNM"
AND NOT(.CSTMNT[A2IMMEDFLG] AND .CSTMNT[A2SAMEFLG]) !AND VAL WILL NOT BE STORED
! WITH "HRRZM" (DUE TO RHS BEING
! RIGHT HALF OF AOBJN WD)
THEN
SAVEREG(.CSTMNT[ASMNTREG], !REMEMBER THAT REG USED CONTAINS
.LHNODE, ! VAL OF VAR ON LHS
(IF .RHNODE[OPRCLS] EQL DATAOPR !AND IF RHS IS A VAR
AND .CSTMNT[A2NGNTFLGS] EQL 0 ! AND WAS NOT PICKED UP WITH "MOVN"
AND NOT (.CSTMNT[A1NEGFLG] AND
.LHNODE[VALTYPE] EQL DOUBLPREC) !AND DONT HAVE TO NEGATE A DP VAL (THERE IS NO MOVNM FOR DP)
THEN .RHNODE ! IT ALSO CONTAINS VAL OF VAR ON RHS
ELSE 0),
.CSTMNT[SRCSONNXTUSE]); ! AND THE NEXT USE OF THAT VAR WAS
! POINTED TO BY THE ASSIGNMNT STMNT
RETURN
END;
%(***IF LEFT-HAND SIDE IS NOT A SIMPLE VARIABLE, IT MUST BE AN ARRAY****)%
IF .LHNODE[OPRCLS] NEQ ARRAYREF
THEN CGERR();
%(****IF RIGHT HAND SIDE IS A SIMPLE VARIABLE, PERFORM REGISTER ALLOCATION FOR
LEFT HAND SIDE*******)%
IF .CSTMNT[A2VALFLG]
THEN
BEGIN
TREEPTR_.LHNODE;
ALCARRAY(.STBSYR,.STRGCT);
%(***GET REG FOR COMP FOR STMNT- DO NOT USE THE REG IN WHICH THE
INDEX INTO THE ARRAY WAS LEFT***)%
IF .LHNODE[TARGXF] NEQ 0
THEN
BEGIN
STBSYR_CLRBIT(.STBSYR,.LHNODE[TARGXF] );
IF .LHNODE[DBLFLG] !IF A 2 WD VAL IS TO BE STORED
THEN ! THEN IF THE INDEX WAS IN AN ODD REG, MUST NOT
STBSYR_CLRBIT(.STBSYR,.LHNODE[TARGXF]-1) !USE THE PRECEEDING EVEN
! REG (IF INDEX IN AN EVEN REG, THEN PRECEEDING REG
! IS ALREADY OUT OF THE SET BECAUSE IT IS ODD)
END;
RA_AFREEREG(.STBSYR,.CSTMNT[SRCSAVREGFLG],.LHNODE[DBLFLG]);
%(***DECIDE WHICH REG TO COMPUTE THE STMNT IN (GIVEN THAT A2VALFLG WAS SET)***)%
SETREGFORA2VAL();
VARCLOBB(.LHNODE); !IF THE ARRAY ON LHS IS IN COMMON OR EQV MUST
! ASSUME THAT VARS IN COMMON/EQV ARE CLOBBERED
IF .CSTMNT[SRCSAVREGFLG] !IF VAR ON RHS IS USEFUL TO LEAVE IN A REG
AND .CSTMNT[A2NGNTFLGS] EQL 0 ! AND WAS NOT PICKED UP WITH "MOVN"
AND .RHNODE[OPRCLS] EQL DATAOPR ! AND WAS NOT REPLACED BY A "REGCONTENTS"
AND NOT (.CSTMNT[A1NEGFLG] AND
.LHNODE[VALTYPE] EQL DOUBLPREC) !AND DONT HAVE TO NEGATE A DP VAL (THERE IS NO MOVNM FOR DP)
THEN SAVEREG(.CSTMNT[ASMNTREG], !REMEMBER TAHT REG USED FOR ASSIGNMNET
.RHNODE,0,.CSTMNT[SRCSONNXTUSE]); ! CONTAINS VAR ON RHS
RETURN;
END;
%(***IF COMPUTATION OF THE RHS WILL CLOBBER ALL REGISTERS AVAILABLE, THEN
SHOULD ALWAYS COMPUTE RHS BEFORE COMPUTING LHS, SO THAT
DO NOT NEED TO LEAVE PTR TO LHS IN A TEMPORARY***)%
IF .RHNODE[COMPLEXITY] GEQ .STRGCT
THEN CSTMNT[RVRSFLG]_1;
%(***IF RIGHT HAND SIDE IS COMPUTED BEFORE ADDRESS CALC FOR LEFT HAND SIDE****)%
IF .CSTMNT[RVRSFLG]
THEN
BEGIN
IF .LHNODE[COMPLEXITY] LSS .STRGCT
THEN
%(***IF ADDRESS CALCULATION CAN BE PERFORMED WITHOUT CLOBBERING
THE REG IN WHICH RIGHT-HAND-SIDE VAL IS LEFT***)%
BEGIN
TREEPTR_.RHNODE;
ALCINREG(.RA,.STBSYR,.STRGCT);
%(***DETERMINE WHICH (IF ANY) REG MUST BE SAVED WHILE COMPUTING
THE LHS BECAUSE IT HOLDS EITHER THE VAL OR A PTR TO THE
VAL OF THE RIGHT-HAND-SIDE***)%
RSV_RGTOSAVE(.RHNODE);
IF .RSV NEQ -1
THEN
BEGIN
%(***IF SOME REG MUST BE SAVED, ADJUST SET OF BUSY REGS***)%
STBSYR_CLRBIT(.STBSYR,.RSV);
STRGCT_.STRGCT-1;
END;
TREEPTR_.LHNODE;
ALCARRAY(.STBSYR,.STRGCT);
IF .RHNODE[INREGFLG]
THEN
SETREGTORH
ELSE
USEAFREEREG()
END
ELSE
BEGIN
TREEPTR_.RHNODE;
%1274% ! Get 1 or 2 word temp based on DBLFLG
%1274% IF .TREEPTR[DBLFLG]
%1274% THEN ALCINTMP(NXTTMP(2),.STBSYR,.STRGCT)
%1274% ELSE ALCINTMP(NXTTMP(1),.STBSYR,.STRGCT);
TREEPTR_.LHNODE;
ALCARRAY(.STBSYR,.STRGCT);
USEAFREEREG()
END;
END
ELSE
%(****IF ADDRESS CALC FOR LEFT-HAND SIDE IS PERFORMED BEFORE RIGHT-HAND SIDE IS COMPUTED***)%
BEGIN
%(***IF LH'S SUBSCRIPT IS A VARIABLE (LEAF) AND THE RH
CONTAINS SOME FUNCTION CALLS, THEN WE MUST CLEAR
THE MEMORY OF AC 1, SO ALCARRAY WON'T TRY TO
LEAVE THE SUBSCRIPT IN AC 1 IF ITS ALREADY
THERE (ALCARRAY NEVER LEAVES IT IN AC 0)***)%
IF .LHNODE[A2VALFLG] AND .RHNODE[FNCALLSFLG]
THEN REGCLOBB(1);
%(***CAN ASSUME THAT THE COMPUTATION OF RHS WILL NOT CLOBBER
THE PTR TO LHS****)%
%(***PERFORM REG ALLOC FOR COMPUTATION OF THE ADDRESS OF THE LHS***)%
TREEPTR_.LHNODE;
ALCARRAY(.STBSYR,.STRGCT);
%(***IF PTR TO LEFT-HAND-SIDE IS LEFT IN A REG, DO NOT USE THAT REG IN
COMPUTATION OF RIGHT-HAND-SIDE***)%
IF .LHNODE[TARGXF] NEQ 0
THEN
BEGIN
STBSYR_CLRBIT(.STBSYR,.LHNODE[TARGXF]);
IF .LHNODE[DBLFLG] !IF A 2 WD VAL IS TO BE STORED
THEN ! THEN IF THE INDEX WAS IN AN ODD REG, MUST NOT
STBSYR_CLRBIT(.STBSYR,.LHNODE[TARGXF]-1); !USE THE PRECEEDING EVEN
! REG (IF INDEX IN AN EVEN REG, THEN PRECEEDING REG
! IS ALREADY OUT OF THE SET BECAUSE IT IS ODD)
STRGCT_.STRGCT-1;
END;
%(***PERFORM REGISTER ALLOC FOR THE COMPUTATION OF THE RHS***)%
RA_AFREEREG(.STBSYR,FALSE,.LHNODE[DBLFLG]);
TREEPTR_.RHNODE;
ALCINREG(.RA,.STBSYR,.STRGCT);
IF .RHNODE[INREGFLG]
THEN
SETREGTORH
ELSE
USEAFREEREG()
END;
VARCLOBB(.LHNODE); !ASSUME VAL OF LHS IS CLOBBERED
END; ! of ALCASMNT
GLOBAL ROUTINE ALCMEMCMP=
%(***************************************************************************
ROUTINE TO PERFORM REGISTER ALLOCATION FOR AN ASSIGNMENT STMNT TO BE
PERFORMED DIRECTLY TO MEMORY. IT IS ASSUMED THAT IF THE
OPERATION HAS 2 ARGS (IE IS EITHER A BOOLEAN OR ARITHMETIC) THEN ARG2 UNDER
THE RIGHT HAND SIDE IS EQUAL TO THE LEFT HAND SIDE.
CALLED WITH THE GLOBAL CSTMNT POINTING TO THE ASSIGNMENT STMNT.
***************************************************************************)%
BEGIN
OWN PEXPRNODE RHNODE:LHNODE:ARG1NODE:ARG2NODE;
OWN RA,RB;
RHNODE_.CSTMNT[RHEXP];
LHNODE_.CSTMNT[LHEXP];
ARG1NODE_.RHNODE[ARG1PTR];
ARG2NODE_.RHNODE[ARG2PTR];
RA_AFREEREG(.STBSYR,.CSTMNT[SRCSAVREGFLG],.LHNODE[DBLFLG]);
IF CLOBBNX(.RHNODE) !IF THIS OPERATION CLOBBERS THE REG AFTER THE
! REG ON WHICH IT IS PERFORMED (IE INTEGER DIVIDE)
AND .RHNODE[OPTOBOTHFLG] ! AND WE WILL BE GENERATING AN OP-TO-BOTH
! (RATHER THAN TO MEMORY - SINCE OPS TO MEM DONT CLOBBER THAT REG)
THEN
RA_GETRGPAIR(.RA,.STBSYR); !GET A REG TO USE THAT DOES NOT HAVE A USEFUL VAL
! IN THE REG FOLLOWING
%(***FOR P2PL1MUL,SQUARE, AND CUBE - THE ARG THAT IS EQL TO THE LEFT HAND
SIDE IS ARG1 (AND THIS IS THE ONLY ARG). HENCE DONT HAVE TO
WORRY ABOUT ALLOCATING THE OTHER ARG***)%
IF .RHNODE[OPRCLS] EQL SPECOP
THEN
BEGIN
RA_RGTOU1(.RHNODE,.RHNODE[ARG1PTR],.RA,.STBSYR);
SETTAC(.RHNODE,.RA)
END
%(***FOR ARITHMETIC AND BOOLEAN OPERATORS***********)%
ELSE
BEGIN
%(***FOR ARITH OPS, CANNOT HAVE NEG ON ARG2. REMOVE A2NEGFLG BY
A+(-B)=A-B, A*(-B)=-A*B, A/(-B)=(-A)/B
SINCE REMOVING NEG FROM ARG2 MAY CHANGE "A1NEGFLG" MUST DO IT BEFORE
DECIDE WHETHER CAN USE ARG1 DIRECTLY FROM A GIVEN REG.***)%
IF .RHNODE[A2NEGFLG] AND .RHNODE[OPRCLS] EQL ARITHMETIC
THEN
BEGIN
IF ADDORSUB(RHNODE) !MAKE ADD INTO SUB, SUB INTO ADD
THEN CMPLSP(RHNODE)
ELSE IF MULORDIV(RHNODE) !FOR MUL, DIV
THEN RHNODE[A1NEGFLG]_NOT.RHNODE[A1NEGFLG] !REVERSE THE NEG ON ARG1
ELSE CGERR(); !OPS TO MEM CANNOT BE EXPONEN
RHNODE[A2NEGFLG]_0;
END;
%(****PERFORM REGISTER ALLOCATION FOR ARG1 UNDER THE RIGHT HAND SIDE****)%
IF .RHNODE[A1VALFLG]
THEN
BEGIN
%(***IF ARG1 IS A REGCONTENTS NODE THEN
1. IF ONLY WANT TO USE THE RIGHT HALF OF TH REG
THEN MUST MOVE IT INTO RA
2. IF THE OPERATION CLOBBERS THE REG USED
THEN MUST MOVE IT TO RA
3. OTHERWISE, USE THAT REGISTER AS REGFORCOMP
FOR RHNODE
********)%
IF .ARG1NODE[OPRCLS] EQL REGCONTENTS AND NOT .RHNODE[A1IMMEDFLG]
AND NOT .RHNODE[A1NEGFLG] AND NOT .RHNODE[A1NOTFLG]
!(DOUBLE-PREC AND COMPLEX OPS TO MEMORY CLOBBER THE REG)
AND NOT .RHNODE[DBLFLG]
THEN
BEGIN
RHNODE[TARGTAC]_.ARG1NODE[TARGTAC];
RHNODE[A1SAMEFLG]_1;
END
ELSE
! If arg1 was put in a register earlier in this
! basic block, then use the register that it is
! already in!
IF (RB_REGCONTAINING(.ARG1NODE)) GEQ 0
THEN
BEGIN
IF .RHNODE[A1NGNTFLGS] NEQ 0 !IF ARG1 MUST BE NEGATED/COMPLEMENTED
AND NOT BITSET (.STBSYR,.RB) ! AND WE CANNOT CLOBBER RB
THEN ! MUST NOT USE RB
SETTAC(.RHNODE,.RA) !USE RA
ELSE
BEGIN
SETTAC(.RHNODE,.RB); !USE THAT REG FOR THIS OP TO MEMORY
RHNODE[A1SAMEFLG]_1; !DONT RELOAD THE REG
%2000% ! If we're using a memory location
%2000% ! for arg1, we don't need an immed
%2000% ! instruction.
%2000% RHNODE[A1IMMEDFLG] = 0;
END
END
%(***IF ARG1 IS A SCALAR, USE RA***)%
ELSE
SETTAC(.RHNODE,.RA);
IF .RHNODE[SAVREGFLG] !IF VAL OF ARG1 WILL BE USEFUL TO HAVE IN A REG LATER
AND .ARG1NODE[OPRCLS] EQL DATAOPR
AND NOT .RHNODE[DBLFLG] ! AND THE OPERATION IS NOT DP OR COMPLEX (WHICH
! OPS CLOBBER THE REG USED FOR THE OP TO MEMORY)
AND NOT .RHNODE[OPTOBOTHFLG] !AND WE HAVE NOT ALREADY DECIDED
! TO PERFORM THE OPERATION TO BOTH
! TEST FOR NOT ON PARENT NODE TOO!
AND NOT .RHNODE[A1NOTFLG]
AND NOT .RHNODE[A1NEGFLG] !AND ARG1 WAS NOT PICKED UP BY "MOVN"
THEN SAVEREG(.RHNODE[TARGTAC], !REMEMBER THAT THE REG USED
.ARG1NODE,0,.RHNODE[SONNXTUSE]); !CONTAINS VAL OF ARG1
END
ELSE
BEGIN
TREEPTR_.RHNODE[ARG1PTR];
ALCINREG(.RA,.STBSYR,.STRGCT);
IF .RHNODE[ALCRETREGFLG]
THEN
%(***IF WE DECIDED ON THE COMPLEXITY-PASS TO USE THE FN-RETURN REGISTER
FOR COMPUTATION OF RHNODE*****)%
BEGIN END
ELSE
IF .ARG1NODE[INREGFLG] AND NOT .ARG1NODE[ALCRETREGFLG]
THEN
%(***IF THE LEFT-ARGUMENT OF RHNODE HAD ITS VAL LEFT IN A REG****)%
BEGIN
RHNODE[TARGTAC]_.ARG1NODE[TARGTAC];
RHNODE[A1SAMEFLG]_1;
END
ELSE
%(***OTHERWISE USE RA TO COMPUTE RHNODE****)%
BEGIN
RA_REGTOUSE(.RHNODE,.RHNODE[ARG1PTR],.RHNODE[ARG2PTR],.RA,.STBSYR);
SETTAC(.RHNODE,.RA)
END
END;
END;
%(***IF THIS OPERATION IS MOST OPTIMALLY PERFORMED FROM A REG
THAT WE CANNOT CLOBBER, THEN WE CANNOT DO IT "TO BOTH"***)%
IF .RHNODE[OPTOBOTHFLG]
THEN
BEGIN
IF NOT BITSET(.STBSYR,.RHNODE[TARGTAC]) !IF THE REG USED CANNOT BE CLOBBERED
OR
(CLOBBNX(.RHNODE) !OR IF THIS OPERATION WILL CLOBBER
! THE REG FOLLOWING THE REG USED
AND NOT BITSET(.STBSYR,.RHNODE[TARGTAC]+1) ! AND THAT REG CANNOT BE CLOBBERED
)
THEN
(CSTMNT[OPTOBOTHFLG]_0;RHNODE[OPTOBOTHFLG]_0); !TURN OFF FLAGS FOR
! "PERFORM OP TO BOTH"
END;
%(***IF THE ELEMENT ON THE LHS (WHICH IS ALSO ARG2 UNDER THE RHS) IS
AN ARRAY REF, PERFORM ALLOC FOR THOSE 2 NODES***)%
IF NOT .CSTMNT[A1VALFLG]
THEN
BEGIN
OWN BSYRG1;
%2072% LOCAL STRCT1, ! Copy of the statement reg count
%2072% RESERVE; ! Reserved register
RA_.RHNODE[TARGTAC];
BSYRG1_CLRBIT(.STBSYR,.RA); !WHEN COMPUTING THE SS DO NOT USE
%2072% ! The number of registers used for the operation to
%2072% ! memory.
%2072% STRCT1 = .STRGCT-1;
%2072% ! We have "A = B op A". "A" is an an operation to
%2072% ! memory. Make sure that "A" and "B" don't use the
%2072% ! same register in calculations. This would result in
%2072% ! trashy code, since the register would be clobbered.
%2072% ! Mark the register in ARG1NODE as being used so that
%2072% ! we won't try to use it again in ARG2NODE.
%2072% RESERVE = RGTOSAVE(.ARG1NODE); ! ARG1NODE's register
%2072% IF .RESERVE NEQ -1
%2072% THEN
%2072% BEGIN ! Register is given to ARG1NODE
%2072%
%2072% BSYRG1 = CLRBIT(.BSYRG1,.RESERVE); ! Zap register
%2072% STRCT1 = .STRCT1-1 ! Decr count
%2072% END;
TREEPTR_.LHNODE;
IF .TREEPTR[OPRCLS] NEQ ARRAYREF THEN CGERR();
%2072% ALCARRAY(.BSYRG1,.STRCT1); ! Allocate the array reference
TREEPTR_(IF .RHNODE[OPRCLS] EQL SPECOP THEN .RHNODE[ARG1PTR] ELSE .RHNODE[ARG2PTR]);
IF .TREEPTR[OPRCLS] NEQ ARRAYREF THEN CGERR();
ALCARRAY(.BSYRG1,.STRGCT-1);
%(***THE FIRST COMPUTATION TO PERFORM SHOULD ALWAYS BE
THAT OF ARG1 UNDER THE RIGHT-HAND SIDE***)%
CSTMNT[RVRSFLG]_1;
RHNODE[RVRSFLG]_0;
END;
RHNODE[A2SAMEFLG]_1; !WILL COMPUTE INTO THE LOC CONTAING ARG2
RHNODE[MEMCMPFLG]_1;
VARCLOBB(.LHNODE); !THE VAL OF THE VAR ON THE LHS OF THIS ASSIGNMENT STMNT
! HAS NOW BEEN MODIFIED. MUST CLEAR ANY BB ALLOC
! TABLE ENTRIES THAT REFER TO THAT VAR
IF .CSTMNT[SRCSAVREGFLG] !IF THE LHS OF THIS ASSIGNMENT WILL BE
! USEFUL TO HAVE IN A REG LATER
AND .CSTMNT[OPTOBOTHFLG] ! AND THIS OPERATION IS PERFORMED "TO BOTH"
THEN SAVEREG(.RHNODE[TARGTAC], !THEN REMEMBER THAT THE REG USED FOR THIS OP
.LHNODE,0,.CSTMNT[SRCSONNXTUSE]); ! CONTAINS THE VAL OF THE VAR ON THE LHS
END; ! of ALCMEMCMP
ROUTINE ORDERMEMCMP=
%(***************************************************************************
ROUTINE TO ORDER ARGS OF AN ARITH OR BOOLEAN OP TO MEMORY SO THAT
ARG2 IS IDENTICAL TO THE LHS OF THE ASSIGNMENT STMNT
BE PERFORMED TO MEMORY.
***************************************************************************)%
BEGIN
OWN PEXPRNODE RHNODE:LHNODE:ARG1NODE:ARG2NODE;
ROUTINE ARREQLLH(NODE)=
%(***TO DETERMINE IF 'NODE' IS AN ARRAYREF THAT IS IDENTICAL TO AN ARRAYREF
ON THE LEFT-HAND-SIDE OF THIS ASSIGNMENT STMNT***)%
BEGIN
MAP PEXPRNODE NODE;
IF .NODE[ARGWD] EQL .LHNODE[ARGWD] !IF ARRAY NAME AND VARIABLE PART
! OF SS EXPR ARE IDENTICAL
THEN
RETURN (.NODE[TARGET] EQL .LHNODE[TARGET]
%2463% AND .NODE[OPR1] EQL .LHNODE[OPR1])
ELSE RETURN FALSE
END;
RHNODE_.CSTMNT[RHEXP];
LHNODE_.CSTMNT[LHEXP];
ARG1NODE_.RHNODE[ARG1PTR];
ARG2NODE_.RHNODE[ARG2PTR];
%(***MUST BE SURE THAT THE ARG UNDER RHNODE WHICH IS EQUAL TO THE LEFT-HAND SIDE
IS THE 2ND ARG (ARGS MAY HAVE BEEN REVERSED SOMETIME SINCE P2SKEL)***)%
IF .CSTMNT[A1VALFLG]
THEN
BEGIN
IF .ARG2NODE NEQ .LHNODE
THEN
BEGIN
IF .ARG1NODE NEQ .LHNODE THEN CGERR();
IF NOT EXCHARGS(.RHNODE) THEN CGERR();
ARG1NODE_.RHNODE[ARG1PTR];
ARG2NODE_.RHNODE[ARG2PTR];
END
END
ELSE
%(***FOR THE LEFT HAND SIDE AN ARRAYREF***)%
IF .LHNODE[OPRCLS] EQL ARRAYREF
THEN
BEGIN
IF NOT ARREQLLH(.ARG2NODE)
THEN
%(***IF ARG2 IS NOT EQUAL TO LHS***)%
BEGIN
%(***IF NEITHER ARG UNDER RHNODE WAS EQL TO LHNODE, SHOULD
NOT HAVE CALLED THIS ROUTINE***)%
IF NOT ARREQLLH(.ARG1NODE) THEN CGERR();
%(***IF ARG1 AND ARG2 CANNOT BE SWAPPED, THEN COULD NEVER
HAVE HAD THEM REVERSED EARLIER(IN P2SKEL WHEN DETECTED
THIS COMP TO MEMORY) - HENCE HAVE A COMPILER BUG***)%
IF NOT EXCHARGS(.RHNODE) THEN CGERR();
%(***HAVE NOW SWITCHED THE ARGS (EXCHARGS DOES THIS)***)%
ARG1NODE_.RHNODE[ARG1PTR];
ARG2NODE_.RHNODE[ARG2PTR];
END
END;
END; ! of ORDERMEMCMP
GLOBAL ROUTINE ALCASSI=
%(***************************************************************************
ROUTINE TO PERFORM REGISTER ALLOCATION FOR AN ASSIGN STATEMENT.
IF VAR ASSIGNED TO IS AN ARRAYREF, MUST PERFORM ALLOC FOR IT.
THE "ASSIGN" OPERATION IS ALWAYS PERFORMED IN REGISTER 1.
***************************************************************************)%
BEGIN
TREEPTR_.CSTMNT[ASISYM];
IF .TREEPTR[OPRCLS] EQL ARRAYREF
THEN
ALCARRAY(.STBSYR,.STRGCT);
REGCLOBB(1); !THE CONTENTS OF REG 1 WILL BE CLOBBERED BY EVAL
! OF THIS STMNT. CLEAR BB ALLOC TABLE ENTRY FOR REG 1
VARCLOBB(.CSTMNT[ASISYM]); !THE VARIABLE ASSIGNED HAS HAD ITS VAL MODIFIED.
! CLEAR ANY BB ALLOC ENTRIES THAT REFER TO THAT VAR
END; ! of ALCASSI
GLOBAL ROUTINE ALCCALL=
%(***************************************************************************
ROUTINE TO PERFORM REGISTER ALLOCATION FOR A CALL STMNT.
***************************************************************************)%
BEGIN
REGISTER PEXPRNODE SYMPTR; !PTR TO SYMBOL TABLE ENTRY FOR THE
! SUBROUTINE NAME
ALCCMNSB(); !PERFORM ALLOCATION FOR ANY COMMON SUBS
IF .CSTMNT[CALLIST] NEQ 0
THEN
BEGIN
TREEPTR_.CSTMNT[CALLIST];
ALCFNARGS(.STBSYR,.STRGCT,FALSE);
END;
%(**THE SUBROUTINE CALLED CAN POTENTIALLY CLOBBER ALL THE REGS,
(UNLESS IT'S A LIBRARY SUBROUTINE SUCH AS "ADJ1.")
HENCE IF THIS IS A FN IT WILL HAVE TO SAVE/RESTORE THEM ALL**)%
SYMPTR_.CSTMNT[CALSYM]; !SYM TABLE ENTRY FOR ROUTINE NAME
%2302% ! If the routine is not a library routine, or if the routine
%2302% ! is a library routine which smashes ACs (i.e., IDCLOBB is
%2302% ! set), then mark registers 2-15 (octal) as being clobbered.
%2302%
%2302% IF NOT .SYMPTR[IDLIBFNFLG] OR .SYMPTR[IDCLOBB]
%2302% THEN CLOBBREGS = .CLOBBREGS OR #177760000000;
END; ! of ALCCALL
GLOBAL ROUTINE ALCAGO=
%(***************************************************************************
ROUTINE TO PERFORM REGISTER ALLOCATION FOR AN ASSIGNED GOTO
(NOTE THAT THE ASSIGNED VAL MAY BE AN ARRAYREF THAT REQUIRES CALCULATION)
THE ACTUAL TESTING OF THE VAL WILL ALWAYS BE PERFORMED IN REG 1.
CALLED WITH THE GLOBALS
CSTMNT - PTR TO THE STMNT
STBSYR - HAS A BIT SET FOR EACH REG AVAILABLE FOR USE IN COMPUTING
THIS STMNT
STRGCT - CT OF REGS AVAILABLE FOR USE IN COMPUTING THIS STMNT
***************************************************************************)%
BEGIN
%(***PERFORM REGISTER ALLOCATION FOR ANY COMMON SUBEXPRS UNDER THIS STATEMENT***)%
ALCCMNSB();
%(***PERFORM REG ALLOC FOR ACCESSING THE ASSIGNED VAR***)%
TREEPTR_.CSTMNT[AGOTOLBL];
IF .TREEPTR[OPRCLS] NEQ DATAOPR
THEN
ALCINREG(AFREEREG(.STBSYR,FALSE,FALSE),.STBSYR,.STRGCT);
REGCLOBB(1); !THE CONTENTS OF REG 1 ARE CLOBBERED BY EVAL OF THIS
! STMNT. CLEAR BB ALLOC ENTRIES FOR REG 1
END; ! of ALCAGO
GLOBAL ROUTINE ALCCGO=
%(***************************************************************************
ROUTINE TO PERFORM REGISTER ALLOCATION FOR A COMPUTED GOTO.
PERFORMS REGISTER-ALLOCATION FOR THE COMPUTATION OF THE COMPUTED
EXPRESSION. THAT VAL WILL ALWAYS BE MOVED TO REG #1 (AS PART OF A SKIP
OPERATION THAT TESTS ITS RANGE) FOR EXCUTION OF THE GOTO
CALLED WITH THE GLOBALS
CSTMNT - PTR TO THE STMNT
STBSYR - HAS A BIT SET FOR EACH REG AVAILABLE FOR USE IN COMPUTING
THIS STMNT
STRGCT - CT OF REGS AVAILABLE FOR USE IN COMPUTING THIS STMNT
***************************************************************************)%
BEGIN
%(***PERFORM REGISTER ALLOCATION FOR ANY COMMON SUBEXPRS UNDER THIS STATEMENT***)%
ALCCMNSB();
%(***PERFORM REGISTER ALLOCATION FOR COMPUTATION OF THE COMPUTED EXPR***)%
TREEPTR_.CSTMNT[CGOTOLBL];
IF .TREEPTR[OPRCLS] NEQ DATAOPR
THEN
ALCINREG(AFREEREG(.STBSYR,FALSE,FALSE),.STBSYR,.STRGCT);
REGCLOBB(1); !THE CONTENTS OF REG 1 ARE CLOBBERED BY EVAL OF THIS
! STMNT. CLEAR BB ALLOC ENTRIES FOR REG 1
END; ! of ALCCGO
GLOBAL ROUTINE ALCLIF=
%(***************************************************************************
ROUTINE TO PERFORM REGISTER ALLOCATION FOR A LOGICAL IF STATEMNT.
CALLED WITH THE GLOBALS
CSTMNT - PTR TO THE STMNT
STBSYR - HAS A BIT SET FOR EACH REG AVAILABLE FOR USE IN COMPUTING
THIS STMNT
STRGCT - CT OF REGS AVAILABLE FOR USE IN COMPUTING THIS STMNT
***************************************************************************)%
BEGIN
OWN PEXPRNODE CONDEXPR;
OWN BASE SAVSTMNT;
OWN SAVBSYR,SAVRCT;
SAVBSYR_.STBSYR;
SAVRCT_.STRGCT;
CONDEXPR_.CSTMNT[LIFEXPR];
%(***IF THIS STATEMENT IS DOUBLE-PREC, ADJUST SET OF BUSY REGS SO
THAT ONLY EVEN REGS WILL BE ALLOCATED****)%
IF .CONDEXPR[DBLFLG]
THEN
BEGIN
STBSYR_DPBSYREGS(.STBSYR);
STRGCT_ONESCOUNT(.STBSYR);
DBLMODE_TRUE;
END
ELSE
DBLMODE_FALSE;
%(***PERFORM REGISTER ALLOCATION FOR ANY COMMON SUBEXPRS UNDER THIS STMNT***)%
ALCCMNSB();
%(***PERFORM REGISTER ALLOCATION FOR THE CONDITIONAL EXPRESSION***)%
TREEPTR_.CONDEXPR;
%(***IF THE EXPRESSION IS OF TYPE CONTROL, NEED NEVER COMPUTE A VALUE FOR IT***)%
IF .CONDEXPR[VALTYPE] EQL CONTROL
THEN
BEGIN
IF .CONDEXPR[OPRCLS] EQL RELATIONAL !FOR A RELATIONAL
THEN ALCRL1(.STBSYR,.STRGCT)
ELSE
IF .CONDEXPR[OPRCLS] EQL BOOLEAN !FOR A BOOLEAN
THEN
BEGIN
NOBBREGSLOAD_TRUE; !CANNOT ASSUME THAT ALL CODE FOR A CONTROL
! BOOLEAN WILL BE EXECUTED - SO SET FLAG
! TO MAKE NO ASSUMPTIONS ABOUT REGS BEING LOADED
ALCCNT(.STBSYR,.STRGCT);
NOBBREGSLOAD_FALSE; !CLEAR FLAG
END
ELSE CGERR(); !A CONTROL-TYPE EXPR MUST BE BOOLEAN OR RELATIONAL
END
%(***OTHERWISE WILL HAVE TO COMPUTE THE VAL AND TEST IT***)%
ELSE
BEGIN
IF .CONDEXPR[OPRCLS] EQL BOOLEAN !IF THE CONDITIONAL EXPR IS A BOOLEAN
THEN
BEGIN
%(***WHEN BOOLEANS IN WHICH ARG1 IS A MASK AND ARG2 IS OF TYPE CONTROL
ARE USED IN A LOGICAL IF - THE CODE GENERATED WILL TEST THE
THE VAL OF THE MASK AND NOT EXECUTE THE CONTROL PART
IF ITS NOT NECESSARY
*****)%
OWN PEXPRNODE ARG2NODE;
ARG2NODE_.CONDEXPR[ARG2PTR];
IF .ARG2NODE[VALTYPE] EQL CONTROL !AND THE 1ST TERM OF THE BOOLEAN
! IS A MASK AND THE 2ND IS OF TYPE CONTROL
THEN
NOBBREGSLOAD_TRUE !DONT MAKE ASSUMPTION THAT ALL
! CODE FOR THIS BOOLEAN IS ALWAYS EXECUTED
END;
ALCINREG(AFREEREG(.STBSYR,FALSE,FALSE),.STBSYR,.STRGCT);
END;
%(***PERFORM REGISTER ALLOCATION FOR THE SUBSTATEMENT****)%
SAVSTMNT_.CSTMNT;
STBSYR_.SAVBSYR;
STRGCT_.SAVRCT;
CSTMNT_.CSTMNT[LIFSTATE];
NOBBREGSLOAD_TRUE; !DO NOT ASSUME THAT ANY REGS INITIALIZED BY EVALUATION
! OF THE SUBSTATEMENT CAN BE USED LATER (SINCE THE SUBSTATEMENT
! IS NOT ALWAYS EVALUATED)
ALCSTMN(); !PERFORM ALLOCATION FOR EVALUATION OF THE SUBSTATEMENT
NOBBREGSLOAD_FALSE; !RESET FLAG SO THAT WILL ONCE AGAIN ASSUME THAT
! CODE IS EXECUTED (IF THIS BASIC BLOCK IS EXECUTED)
CSTMNT_.SAVSTMNT;
END; ! of ALCLIF
GLOBAL ROUTINE ALCAIF=
%(***************************************************************************
ROUTINE TO PERFORM REGISTER ALLOCATION FOR AN ARITHMETIC IF.
CALLED WITH THE GLOBALS
CSTMNT - PTR TO THE STATEMENT
STBSYR - HAS A BIT SET FOR EACH REG AVAILABLE FOR USE
IN COMPUTING THIS STMNT
STRGCT - CT OF REGS AVAILABLE
***************************************************************************)%
BEGIN
OWN RA,RB;
TREEPTR_.CSTMNT[AIFEXPR];
%(*****IF THE VALUE IS DOUBLE-WD, ADJUST THE SET OF REGS SO THAT ONLY EVEN
REGS WILL BE ALLOCATED*****)%
IF .TREEPTR[DBLFLG]
THEN
BEGIN
STBSYR_DPBSYREGS(.STBSYR);
STRGCT_ONESCOUNT(.STBSYR);
DBLMODE_TRUE;
END
ELSE
DBLMODE_FALSE;
%(***PERFORM REGISTER ALLOCATION FOR ANY COMMON SUBEXPRS UNDER THIS STMNT***)%
IF .CSTMNT[SRCCOMNSUB] NEQ 0 THEN ALCCMNSB();
%(***PERFORM REGISTER ALLOCATION FOR THE COMPUTATION OF THE ARITHMETIC EXPRESSION***)%
TREEPTR_.CSTMNT[AIFEXPR];
RA_AFREEREG(.STBSYR,FALSE,.TREEPTR[DBLFLG]);
ALCINREG(.RA,.STBSYR,.STRGCT);
%(***DECIDE WHAT REG TO USE WHEN TESTING THE VALUE OF THE EXPR***)%
TREEPTR_.CSTMNT[AIFEXPR];
IF .TREEPTR[INREGFLG]
THEN
BEGIN
CSTMNT[AIFREG]_.TREEPTR[TARGTAC];
CSTMNT[A1SAMEFLG]_1;
END
ELSE
IF (RB_REGCONTAINING(.CSTMNT[AIFEXPR])) GEQ 0 !IF VAR TO BE TESTED WAS LEFT IN A REG
THEN
BEGIN
CSTMNT[AIFREG]_.RB; !USE THAT REG
CSTMNT[A1SAMEFLG]_1; !DONT RELOAD THE REG
END
ELSE
BEGIN
%(**PICK A REG TO LOAD THE VAL TO BE TESTED - SINCE THE REG
GETS LOADED WITH A SKIP INSTR, DO NOT ALLOW REG 0 TO BE USED**)%
RA_RGTOU1(.CSTMNT,.TREEPTR,.RA,CLRBIT(.STBSYR,REG0));
CSTMNT[AIFREG]_.RA;
REGCLOBB(.CSTMNT[AIFREG]); !THE PREVIOUS CONTENTS OF THE
! REG ASSIGNED WILL BE CLOBBERED.
! CLEAR BB ALLOC ENTRIES FOR THAT REG
END;
END; ! of ALCAIF
GLOBAL ROUTINE ALCDECENC=
%(***************************************************************************
Routine to perform register allocation for ENCODE/DECODE statements.
***************************************************************************)%
BEGIN
OWN RA;
OWN PEXPRNODE ENCVAR;
OWN PEXPRNODE ENCCT; !EXPRESSION FOR CHAR CT
ENCVAR_.CSTMNT[IOVAR];
ENCCT_.CSTMNT[IOCNT];
%(***IF THE CHARACTER CT IS AN EXPRESSION, PERFORM REGISTER ALLOC FOR
ITS CALCULATION***)%
IF .ENCCT[OPRCLS] NEQ DATAOPR
THEN
BEGIN
TREEPTR_.ENCCT;
ALCINREG(AFREEREG(.STBSYR,FALSE,FALSE),.STBSYR,.STRGCT);
%(***IF SOME REGISTER MUST BE PRESERVED IN ORDER TO PRESERVE THE
VAL OF THE COUNT, DONT WANT TO USE THAT REG IN CALCULATING
THE ARRAY ADDRESS***)%
IF (RA_RGTOSAVE(.ENCCT)) NEQ -1
THEN (STBSYR_CLRBIT(.STBSYR,.RA); STRGCT_.STRGCT-1);
END;
! If the ENCODE-array is an "ARRAYREF" node (ie includes an
! offset within the array), perform register allocation for the
! address calculation
IF .ENCVAR[OPRCLS] EQL ARRAYREF
THEN
BEGIN ! Allocate array ref
TREEPTR_.ENCVAR;
%1642% ! Call ALCINREG to decide which routine we really want
%1642% ! to allocate this. We pass 0 for the register since we
%1642% ! don't really want this put into a register and the
%1642% ! routines called for an array ref in ALCINREG do not
%1642% ! use the register value.
%1642% ALCINREG(0,.STBSYR,.STRGCT);
END;
ALCIOLST(); !PERFORM REG ALLOC FOR THE IOLIST
! FOR ENCODE STMNTS MUST ASSUME THAT THE ARRAY BEING ENCODED
! INTO (AND ANY VARS POTENTIALLY EQUIVALENCED TO IT) HAS IT
! CONTENTS MODIFIED.
IF .CSTMNT[SRCID] EQL ENCOID THEN VARCLOBB(.ENCVAR);
END; ! of ALCDECENC
GLOBAL ROUTINE ALCOPEN=
BEGIN
!***************************************************************
! Performs register allocation for an OPEN, CLOSE, or INQUIRE
! statement for the calculation of arguments that are
! expressions. Global INPFLAG is TRUE for INQUIRE and indicates
! that the arguments are modified.
!***************************************************************
REGISTER OPENLIST ARVALLST;
ARVALLST = .CSTMNT[OPLST]; ! List of arguments under the statement
! Walk thru the list of arguments, perform register allocation
! for the calculation of any arg that is not a variable or const
%2572% INCR I FROM 0 TO .CSTMNT[OPSIZ] - 1 DO
BEGIN
! Expression node for the val of the Ith arg
TREEPTR = .ARVALLST[.I,OPENLPTR];
%2201% IF .TREEPTR NEQ 0
%2201% THEN
%2201% BEGIN ! Not DIALOG or READONLY
IF .TREEPTR[OPRCLS] NEQ DATAOPR
THEN
BEGIN
! Be sure to handle array for ASSOCIATE VARIABLE
! correctly here so that the address is set up rather
! than the value in the array element
IF .TREEPTR[OPRCLS] NEQ ARRAYREF
%1700% THEN ALCTMP() ! Allocate a 1 or 2 word .Q temp
ELSE IF .ARVALLST[.I,OPENLCODE] EQL OPNCASSOCIATE
OR .INPFLAG
THEN ARVALLST[.I,OPENLPTR] = ALCTARY(.STBSYR,.STRGCT)
! Allocate array address to temp
ELSE ARVALLST[.I,OPENLPTR] = ALCTVARR(.STBSYR,.STRGCT);
! Allocate variable to temp
END;
%2201% ! INQUIRE clobbers its arguments
%2201% IF .INPFLAG THEN VARCLOBB(.TREEPTR);
END;
END;
END; ! of ALCOPEN
GLOBAL ROUTINE ALCCMNSB=
%(***************************************************************************
ROUTINE TO PERFORM REGISTER ALLOCATION FOR ALL COMMON SUBEXPRS UNDER
THE STATEMENT "CSTMNT".
DEPENDING ON THE NUMBER OF REGS NECESSARY TO COMPUTE THE STATEMENT
AND THE NUMBER OF REGS AVAILABLE (WHICH IS INDICATED BY THE GLOBAL "STRGCT",
LEAVES AS MANY COMMON SUBEXPRS AS POSSIBLE IN REGISTERS.
***************************************************************************)%
BEGIN
OWN RA,RB;
OWN PEXPRNODE CCMNSUB:ARGNODE;
OWN BASE CCSTMNT; ! SAVE CSTMNT
OWN BSYRG1,REGCT1;
OWN REGSNEEDED; !NUMBER OF REGISTERS NEEDED (EXCEPT FOR COMMON SUBEXPRS)
! FOR COMPUTATION OF THIS STMNT
OWN PAIRSNEEDED; !FOR STMNTS THAT REQUIRE REG PAIRS, MAX NUMBER OF PAIRS NEEDED
OWN FREERGPAIRS; !NUMBER OF REG PAIRS FREE
CCMNSUB_.CSTMNT[SRCCOMNSUB];
CCSTMNT_.CSTMNT; ! SAVE CSTMNT FOR ALC TO 0 CHECK
REGSNEEDED_.CSTMNT[SRCCMPLX]; !NUMBER OF REGS NEEDED FOR THIS STMNT
PAIRSNEEDED_(.CSTMNT[SRCCMPLX]+1)/2; !MAX NUMBER OF PAIRS NEEDED
%(**WALK THRU ALL COMMON SUBS ON THIS STMNT***)%
UNTIL .CCMNSUB EQL 0
DO
BEGIN
ARGNODE_.CCMNSUB[ARG2PTR];
TREEPTR_.ARGNODE;
%(***IF THIS COMMON SUBEXPR IS DOUBLE-PREC AND THE STATEMENT IS NOT,
THEN MUST ADJUST THE SET OF AVAILABLE REGS TO INCLUDE ONLY EVEN REGS***)%
IF .ARGNODE[DBLFLG] AND NOT .DBLMODE
THEN
BEGIN
BSYRG1_DPBSYREGS(.STBSYR);
REGCT1_ONESCOUNT(.BSYRG1);
END
ELSE
BEGIN
BSYRG1_.STBSYR;
REGCT1_.STRGCT;
END;
%(***IF THIS COMMON SUB WILL BE USED AS A SS, DONT USE REG 0 FOR IT**)%
IF .CCMNSUB[CSSSFLG]
THEN
BEGIN
IF BITSET(.BSYRG1,0) THEN
(REGCT1_.REGCT1-1; BSYRG1_CLRBIT(.BSYRG1,0))
END;
%(***DETERMINE HOW MANY REG PAIRS ARE NOW AVAILABLE**)%
FREERGPAIRS_
IF .DBLMODE OR .ARGNODE[DBLFLG] !IF BSYRG1 IS ALREADY IN TERMS OF PAIRS
THEN .REGCT1
ELSE FREEPAIRS(.STBSYR);
%(***IF THERE ARE ENOUGH REGISTERS FREE SO THAT THIS THIS EXPRESSION
CAN BE LEFT IN A REG WHILE CALCULATING THE WHOLE STATEMENT,
LEAVE THIS EXPR IN A REG.
OTHERWISE LEAVE IT IN A TEMPORARY.
********)%
IF (NOT .PAIRMODE !WHEN THIS STMNT NEEDS NO ADJACENT PAIRS
AND .STRGCT GTR .REGSNEEDED+1) !NUMBER OF REGS LEFT SHOULD BE
! GREATER THAN 1 MORE THAN NUMBER NEEDED
OR
(.FREERGPAIRS GTR .PAIRSNEEDED+1) !IF STMNT WILL NEED PAIRS, SHOULD
! HAVE AT LEAST 1 EXTRA PAIR BEFORE RISK
! USING UP A PAIR
OR
(.CCMNSUB[CSSSFLG] !IF THIS CSB IS USED AS A SUBSCRIPT
AND .FREERGPAIRS GTR 2) !THEN PUT IT IN A REG AS LONG AS
! 2 PAIRS CAN BE LEFT
THEN
BEGIN
RA_AFREEREG(.BSYRG1,.CCMNSUB[SAVREGFLG],.CCMNSUB[DBLFLG]);
IF NOT .CCMNSUB[A2VALFLG]
THEN
ALCINREG(.RA,.BSYRG1,.REGCT1);
%(***IF THE COMMON SUB WAS COMPUTED INTO A REG WHERE IT CAN
BE LEFT - LEAVE IT THERE***)%
IF .ARGNODE[INREGFLG] AND NOT .ARGNODE[ALCRETREGFLG]
!IF THE COMMON SUB IS THE RIGHT HALF OF AN AOBJN WD
! AND IS USED IN A CONTEXT THAT REQUIRES A FULL WD,
! CANNOT USE THE AOBJN REG
AND NOT (.CCMNSUB[A2IMMEDFLG] AND .CCMNSUB[CSFULLWDFLG])
THEN
BEGIN
CCMNSUB[TARGTAC]_.ARGNODE[TARGTAC];
CCMNSUB[TARGADDR]_.CCMNSUB[TARGTAC];
CCMNSUB[A2SAMEFLG]_1;
END
ELSE
IF (RB_REGCONTAINING(.ARGNODE)) GEQ 0 !IF ARG IS A VAR WHOSE VAL WAS LEFT IN A REG
AND ! IF IT'S AN ASSIGNMENT STATEMENT
(IF .CCSTMNT[SRCID] EQL ASGNID AND .CCSTMNT[OPRCLS] EQL STATEMENT
THEN ! IF THE LEFT HALF IS A REGCONTENTS
BEGIN ! NODE TO 0
LOCAL PEXPRNODE T1;
T1_.CCSTMNT[LHEXP];
IF .T1[OPRCLS] EQL REGCONTENTS AND .RB EQL 0
THEN FALSE ! WE CAN'T USE ZERO
ELSE TRUE ! ANYTHING BUT 0
END
ELSE TRUE)
AND NOT ((.RB EQL RETREG ! THIS IS NOT 0
OR .RB EQL (RETREG+1)) ! OR 1
AND .CSTMNT[FNCALLSFLG]) ! WHEN THERE IS A FUNCTION CALL
! UNDER THIS NODE
AND .CCMNSUB[A2NGNTFLGS] EQL 0 ! AND ARG NEED NOT BE NEGATED
AND NOT(.RB EQL 0 AND .CCMNSUB[CSSSFLG]) !AND DO NOT HAVE A VAR WHICH WILL
! BE USED AS A SS IN REG 0
THEN
BEGIN
CCMNSUB[TARGTAC]_.RB; !THEN USE THAT REG
CCMNSUB[TARGADDR]_.RB;
CCMNSUB[A2SAMEFLG]_1; !DONT RELOAD THE REG
END
ELSE
BEGIN
RA_RGTOU1(.CCMNSUB,.ARGNODE,.RA,.BSYRG1);
SETTARGINREG(.CCMNSUB,.RA)
END;
CCMNSUB[INREGFLG]_1;
RA_.CCMNSUB[TARGTAC];
%(***REMOVE THE REG HOLDING THIS COMMON SUB FROM THE REG POOL***)%
STBSYR_CLRBIT(.STBSYR,.RA);
STRGCT_.STRGCT-1;
%(***IF THE COMMON SUB IS DOUBLE-WD, REMOVE THE REG HOLDING THE RIGHT HALF
FROM THE REG POOL***)%
IF .ARGNODE[DBLFLG]
THEN
BEGIN
STBSYR_CLRBIT(.STBSYR,.RA+1);
STRGCT_.STRGCT-1;
END;
IF .ARGNODE[OPRCLS] EQL DATAOPR !IF THE COMMON SUB IS A VAR
AND .CCMNSUB[SAVREGFLG] ! WHICH WILL BE USEFUL IN A REG IN A LATER STMNT
AND .CCMNSUB[A2NGNTFLGS] EQL 0 ! AND WAS NOT PICKED UP WITH "MOVN"
THEN SAVEREG(.CCMNSUB[TARGTAC], !REMEMBER THAT THIS REG
.ARGNODE, ! CONTAINS THE VAL OF THAT VAR
0,.CCMNSUB[SONNXTUSE]);
END
ELSE
%(***IF CANNOT SPARE A REG TO LEAVE THIS COMMON SUBEXPR IN****)%
BEGIN
IF .CCMNSUB[A2VALFLG]
THEN
BEGIN
%(***IF THIS ARG IS THE RIGHT HALF OF AN AONJN WD
AND WE WILL NEED THE WHOLE THING, MUST LOAD AND STORE IT***)%
IF .CCMNSUB[A2IMMEDFLG] AND .CCMNSUB[CSFULLWDFLG]
THEN
BEGIN
! Choose a register for the common sub
CCMNSUB[TARGTAC] = RA = AFREEREG(.BSYRG1,.CCMNSUB[SAVREGFLG],FALSE);
! The register's previous contents
! are clobbered.
REGCLOBB(.RA);
! Get 1 word .Qnnnn temporary
%1274% CCMNSUB[TARGADDR] = NXTTMP(1);
! Set flag to store AC into .Qnnnn var
%1753% CCMNSUB[STOREFLG] = 1;
END
ELSE
%(***IF THE COMMON SUB IS A REGCONTENTS THAT CAN BE USED, USE IT**)%
IF .ARGNODE[OPRCLS] EQL REGCONTENTS
THEN
BEGIN
CCMNSUB[TARGET]_.ARGNODE[TARGET];
CCMNSUB[A2SAMEFLG]_1;
END
ELSE
BEGIN
CCMNSUB[TARGET]_.ARGNODE;
CCMNSUB[A2SAMEFLG]_1;
END
END
ELSE
BEGIN
%1274% ! Get 1 or 2 word temp based on DBLFLG
%1274% IF .TREEPTR[DBLFLG]
%1274% THEN ALCINTMP(NXTTMP(2),.BSYRG1,.REGCT1)
%1274% ELSE ALCINTMP(NXTTMP(1),.BSYRG1,.REGCT1);
CCMNSUB[TARGET]_.ARGNODE[TARGET];
CCMNSUB[A2SAMEFLG]_1;
END;
END;
CCMNSUB_.CCMNSUB[CLINK];
END;
END; ! of ALCCMNSB
GLOBAL ROUTINE ALCIOLST=
%(***************************************************************************
ROUTINE TO PERFORM REGISTER ALLOCATION FOR AN IOLIST.
CALLED WITH THE GLOBAL CSTMNT POINTING TO THE STATEMENT FOR
WHICH AN IOLIST IS TO BE PROCESSED.
CALLED WITH THE GLOBALS STBSYR AND STRGCT INDICATING WHICH REGS
ARE AVAILABLE FOR USE.
***************************************************************************)%
BEGIN
LOCAL BASE IOLELEM;
LOCAL SAVSTMNT,SAVBSYR,SAVRGCT;
%2047% LOCAL SAVEPAIRMODE;
%(***GET PTR TO 1ST ELEM ON IOLIST TO BE PROCESSED***)%
IOLELEM_.CSTMNT[IOLIST];
%(****SAVE PTR TO CURRENT STATEMENT (IF THERE ARE DO-STMNTS ON THE IOLIST
WILL CLOBBER CSTMNT,STBSYR,STRGCT)*****)%
SAVSTMNT_.CSTMNT;
SAVBSYR_.STBSYR;
SAVRGCT_.STRGCT;
%(*****WALK THRU THE ELEMENTS ON THE IOLIST******)%
UNTIL .IOLELEM EQL 0
DO
BEGIN
IF .IOLELEM[OPRCLS] EQL STATEMENT
THEN
BEGIN
CSTMNT_.IOLELEM;
%2047% SAVEPAIRMODE = .PAIRMODE;
ALCSTMN();
%2047% PAIRMODE = .SAVEPAIRMODE;
%(**IF THIS STMNT IS A DO STMNT, MUST TERMINATE THE PREVIOUS BASIC BLOCK
(SINCE SOME VAR MIGHT BE CLOBBERED LATER IN THE LIST AND ON
LOOPING BACK MIGHT MAKE A FALSE ASSUMPTION ABOUT ITS VAL
BEING IN A REG)
***)%
%2364% ! CSTMNT and IOLELEM both point to the current
%2364% ! statement under the I/O list. Call
%2364% ! ENDSMZTRIP (which looks at CSTMNT) to see if
%2364% ! this statement ends a MAYBEZTRIP DO-loop.
%2364% ! If so, mark all registers as being
%2364% ! clobbered.
%2364%
%2364% IF ENDSMZTRIP()
%2364% THEN CLRRGSTATE()
%2364% ELSE IF .IOLELEM[SRCID] EQL DOID
THEN
BEGIN
CLRRGSTATE(); !MUST DELETE ALL ASSUMPTIONS ABOUT
! THE CONTENTS OF REGISTERS
IF .IOLELEM[SAVREGFLG] !IF THE DO INDEX WILL BE USEFUL
! LATER, REMEMBER WHAT REG ITS IN
THEN SAVEREG(.IOLELEM[DOIREG],
.IOLELEM[DOSYM],0,.IOLELEM[SRCSONNXTUSE],
FALSE);
END;
END
ELSE
IF .IOLELEM[OPRCLS] EQL IOLSCLS
THEN
BEGIN
CASE .IOLELEM[OPERSP] OF SET
%(***FOR A DATACALL NODE - PERFORM REG ALLOC FOR THE
EXPRESSION UNDER THIS NODE*****)%
BEGIN
TREEPTR_.IOLELEM[DCALLELEM];
IF .TREEPTR[OPRCLS] NEQ DATAOPR
THEN
BEGIN
LOCAL STBSY1,STRG1;
IF .TREEPTR[DBLFLG] THEN
BEGIN
STBSY1_DPBSYREGS(.STBSYR);
STRG1_ONESCOUNT(.STBSY1);
END ELSE
BEGIN
STBSY1_.STBSYR;
STRG1_.STRGCT;
END;
ALCINREG(AFREEREG(.STBSY1,FALSE,.TREEPTR[DBLFLG]),.STBSY1,.STRG1);
%1220% ! Put fn calls out into a temp.
%1220% TREEPTR_.IOLELEM[DCALLELEM];
%1220% IF .TREEPTR[ALCRETREGFLG] THEN
%1220% BEGIN
%1274% ! Get 1 or 2 word temp based on DBLFLG
%2065% ! DBLFLG - except for character
%2065% ! functions
%2065% IF .TREEPTR[VALTYPE] NEQ CHARACTER
%2065% THEN
%1274% TREEPTR[TARGTMEM] =
%1274% IF .TREEPTR[DBLFLG]
%1274% THEN NXTTMP(2)
%1274% ELSE NXTTMP(1);
%2065% ! Don't store control or character
%2065% ! results
%1220% IF .TREEPTR[VALTYPE] NEQ CONTROL
%2065% THEN IF .TREEPTR[VALTYPE] NEQ CHARACTER
%2065% THEN TREEPTR[STOREFLG]_1;
%1220% TREEPTR[TARGTAC]_RETREG;
%1220% TREEPTR[INREGFLG]_0
%1220% END
END;
IF .INPFLAG !IF INPUT IS BEING PERFORMED
THEN VARCLOBB(.IOLELEM[DCALLELEM]) !THE VAL OF THE VAR WILL BE
! CLOBBERED, HENCE MUST FORGET ASSUMPTIONS
! ABOUT THAT VAR BEING IN SOME REG
END;
%(***FOR AN SLISTCALL NODE - PERFORM REG ALLOC FOR THE OPERATION
TO CALCULATE THE NUMBER OF ELEMS IN THE ARRAY (IF ARRAY
HAS VARIABLE BOUNDS)****)%
BEGIN
TREEPTR_.IOLELEM[SCALLCT];
IF .TREEPTR[OPRCLS] NEQ DATAOPR
THEN
ALCINREG(AFREEREG(.STBSYR,FALSE,.TREEPTR[DBLFLG]),.STBSYR,.STRGCT);
IF .INPFLAG !IF INPUT IS BEING PERFORMED
THEN VARCLOBB(.IOLELEM[SCALLELEM]); !MUST ASSUME THAT ELEMENTS OF THE
! ARRAY AND ALL VARS EQUIVALENCED TO THEM
! ARE CLOBBERED
END;
%(***FOR AN IOLSTCALL NODE***************)%
ALCIOCALL(.IOLELEM);
%(****FOR AN E1LISTCALL NODE - OPTIMIZED CODE ONLY***)%
BEGIN
LOCAL BASE SAVCSTMNT;
SAVCSTMNT_.CSTMNT;
CSTMNT_.IOLELEM;
ALCCMNSB();
CSTMNT_.SAVCSTMNT;
ALCE1LIST(.IOLELEM,.STBSYR,.STRGCT);
!**;[1220], ALCIOLST, DCE, 2-Jun-81
%[1220]% CSTMNT_.SAVCSTMNT;
END;
%(***FOR AN E2LISTCALL NODE - OPTIMIZED CODE ONLY***)%
BEGIN
LOCAL BASE SAVCSTMNT;
SAVCSTMNT_.CSTMNT;
CSTMNT_.IOLELEM;
ALCCMNSB();
CSTMNT_.SAVCSTMNT;
ALCE2LIST(.IOLELEM,.STBSYR,.STRGCT)
END
TES;
END;
%(***RESTORE STBSYR,STRGCT FOR THE NEXT ELEM ON IOLIST***)%
STBSYR_.SAVBSYR;
STRGCT_.SAVRGCT;
%(***GO ON TO NEXT ELEMENT****)%
IOLELEM_.IOLELEM[CLINK];
END;
CSTMNT_.SAVSTMNT;
END; ! of ALCIOLST
GLOBAL ROUTINE ALCIOCALL(IOLSNODE)=
%(***************************************************************************
TO PERFORM REGISTER ALLOCATION FOR AN IOLSTCALL NODE.
THE ARG IOLSNODE PTS TO AN IOLSTCALL NODE.
FOR IOLIST ELEMENTS THAT REQUIRE COMPUTATION, LEAVE AS MANY
AS POSSIBLE IN THE REGS IN WHICH THEY WERE COMPUTED (RATHER THAN
STORING THEM IN TEMPORARIES). ALSO LEAVE AS MANY ARRAY OFFSETS
AS POSSIBLE IN REGISTERS.
***************************************************************************)%
BEGIN
MAP BASE IOLSNODE;
MAP PEXPRNODE TREEPTR;
OWN BASE IOLELEM;
OWN REGSREQ;
OWN FREGCT,BSYREGS; !REGISTERS AVAILABLE FOR USE AT THE CURRENT PT IN
! THE IOLIST (AS EARLY ELEMS GET LEFT IN REGS,
! THESE VARIABLES ARE ADJUSTED SO THAT LATER ELEMS
! WONT CLOBBER THOSE REGS)
OWN FRGCT1,BSYRG1; !FOR A DATACALL NODE - THESE ARE ADJUSTED TO ACCOUNT
! FOR A DOUBLE PRECISION EXPRESSION
OWN RA;
OWN PEXPRNODE ARGNODE;
OWN SAVSTMNT;
%2047% REGISTER FREERGPAIRS; ! Number of free register pairs
%(***SAVE VAL OF THE GLOBAL CSTMNT***)%
SAVSTMNT_.CSTMNT;
%(***PERFORM REGISTER ALLOCATION FOR ANY COMMON SUBEXPRS ON THIS IOLST***)%
CSTMNT_.IOLSNODE;
ALCCMNSB();
%(***GET NUMBER OF REGS REQUIRED FOR REST OF THIS IOLSTCALL***)%
REGSREQ_.IOLSNODE[SRCCMPLX];
BSYREGS_.STBSYR;
FREGCT_.STRGCT;
%(***WALK THRU ELEMENTS ON THIS IOLSTCALL***)%
IOLELEM_.IOLSNODE[IOLSTPTR];
UNTIL .IOLELEM EQL 0
DO
BEGIN
CASE .IOLELEM[OPERSP] OF SET
%(***FOR A DATACALL NODE****)%
BEGIN
TREEPTR_.IOLELEM[DCALLELEM];
ARGNODE_.TREEPTR;
IF .ARGNODE[OPRCLS] NEQ DATAOPR ! IF NEED TO CALCULATE
! DO NOT NEED TO GET A NEW REGISTER IF THIS ELEMENT IS A REGCONTENTS NODE
THEN IF .ARGNODE[OPRCLS] NEQ REGCONTENTS
![764] NO REGISTER IS NEEDED FOR AN IMMEDIATE ARRAY REFERENCE
%[764]% THEN IF NOT (.ARGNODE[OPRCLS] EQL ARRAYREF AND
%[764]% .ARGNODE[ARG2PTR] EQL 0)
THEN ! THE VALUE OF THIS ITEM
BEGIN ! THEN ALLOCATE THE REGS
%(***IF THIS ELEMENT IS DOUBLE-PREC - MUST ADJUST SET OF FREE REGS***)%
IF .ARGNODE[DBLFLG]
THEN
%2047% BEGIN ! Double
%2047%
%2047% BSYRG1 = DPBSYREGS(.BSYREGS);
%2047% FREERGPAIRS = FRGCT1 = ONESCOUNT(.BSYRG1);
%2047%
%2047% END ! Double
%2047% ELSE
%2047% BEGIN ! Non-double
%2047%
%2047% BSYRG1 = .BSYREGS;
%2047% FRGCT1 = .FREGCT;
%2047% FREERGPAIRS = FREEPAIRS(.BSYREGS);
%2047%
%2047% END; ! Non-double
%(***IF THERE ARE ENOUGH REGS TO LEAVE ALL FURTHER ARGS IN REGS***)%
![1142] Since the complexity count is only 6 bits worth, the field may
![1142] overflow for a complicated IOLISTCALL node, and the number of
![1142] registers required may appear as 0, or the correct number modulo 64.
![1142] Check for these cases, and leave two free registers so that the temp
![1142] allocator can still succeed with array refs.
%2047% IF .REGSREQ GTR 0
%2047% AND .REGSREQ LSS .FREGCT-1
%2047% AND (NOT .PAIRMODE
%2047% ! Need one pair left over
%2047% OR .FREERGPAIRS GTR 1)
THEN
BEGIN
ALCINREG(AFREEREG(.BSYRG1,FALSE,.TREEPTR[DBLFLG]),.BSYRG1,.FRGCT1);
%(***IF THIS ARG WAS LEFT IN A REG, MUST TAKE THAT REG
OUT OF THE SET OF REGS AVAILABLE FOR USE FOR
LATER ELEMENTS****)%
%1220% ! If value left in fn return reg, must use a temp instead.
%1220% IF .ARGNODE[ALCRETREGFLG] THEN
%1220% BEGIN
%1274% ! Get 1 or 2 word temp based on DBLFLG
%1274% ARGNODE[TARGTMEM] =
%1274% IF .ARGNODE[DBLFLG]
%1274% THEN NXTTMP(2)
%1274% ELSE NXTTMP(1);
%1404% IF .ARGNODE[VALTYPE] NEQ CONTROL
THEN ARGNODE[STOREFLG]_1;
%1220% ARGNODE[TARGTAC]_RETREG;
%1220% ARGNODE[INREGFLG]_0
%1220% END;
RA_RGTOSAVE(.ARGNODE);
IF .RA NEQ -1
THEN
BEGIN
BSYREGS_CLRBIT(.BSYREGS,.RA);
%(***IF THIS ARG WAS DOUBLE-PREC MUST ALSO
REMOVE THE REG AFTER RA FROM THE SET***)%
IF .ARGNODE[DBLFLG]
THEN
BEGIN
BSYREGS_CLRBIT(.BSYREGS,.RA+1);
FREGCT_.FREGCT-2;
REGSREQ_.REGSREQ-2;
END
ELSE
BEGIN
FREGCT_.FREGCT-1;
REGSREQ_.REGSREQ-1;
END;
END;
END
%(***IF THERE ARE NOT ENOUGH REGS, THEN IF THIS ELEM IS COMPUTED,
LEAVE IT IN A TEMP***)%
ELSE
BEGIN
IF .TREEPTR[OPRCLS] EQL ARRAYREF
THEN
%(***FOR AN ARRAYREF - IF THE SS IS ALREADY IN A REG, CAN PASS
FOROTS ARG IN THE FORM "ADDR(R)"
OTHERWISE, MUST MATERIALIZE THE ADDRESS REFERENCED***)%
BEGIN
IF .TREEPTR[A2VALFLG] AND NOT .TREEPTR[A2NEGFLG]
%2023% AND .TREEPTR[VALTYPE] NEQ CHARACTER
THEN
BEGIN
OWN PEXPRNODE SSNODE;
SSNODE_.TREEPTR[ARG2PTR];
IF (.SSNODE[OPRCLS] EQL REGCONTENTS) OR
(.SSNODE[OPRCLS] EQL CMNSUB
AND .SSNODE[INREGFLG])
THEN
BEGIN
%(***SET THE "INDEX" FIELD TO
BE USED TO REFERENCE THE ELEMENT
TO THE REG THAT HOLDS THE SS***)%
TREEPTR[TARGXF]_.SSNODE[TARGTAC];
TREEPTR[A2SAMEFLG]_1
END
ELSE IOLELEM[DCALLELEM]_ALCTARY(.BSYRG1,.FRGCT1)
END
ELSE
IOLELEM[DCALLELEM]_ALCTARY(.BSYRG1,.FRGCT1)
END
ELSE
%1274% ! Get 1 or 2 word temp based on DBLFLG
%1274% IF .TREEPTR[DBLFLG]
%1274% THEN ALCINTMP(NXTTMP(2),.BSYRG1,.FRGCT1)
%1274% ELSE ALCINTMP(NXTTMP(1),.BSYRG1,.FRGCT1);
%(***IF AN ARG THAT MIGHT HAVE BEEN LEFT IN A REG WAS
LEFT IN A TEMP, CAN REDUCE THE NUMBER OF FUTURE REGS
REQUIRED BY 1***)%
IF .TREEPTR[OPRCLS] NEQ DATAOPR AND .TREEPTR[OPRCLS] NEQ CMNSUB
THEN
BEGIN
IF .TREEPTR[COMPLEXITY] NEQ 0
THEN
BEGIN
%(***FOR DOUBLE-WD VAL HAVE 2 EXTRA REGS**)%
IF .TREEPTR[DBLFLG]
THEN REGSREQ_.REGSREQ-2
ELSE REGSREQ_.REGSREQ-1;
END
END;
END;
END; ! OF IF NEQ DATAOPR
%2363% ! If input is being performed, we must assume
%2363% ! the variable is clobbered. Note that this
%2363% ! includes a COMMON/EQUIVALENCE check.
%2363%
%2363% IF .INPFLAG
%2363% THEN VARCLOBB(.IOLELEM[DCALLELEM]);
END;
%(***FOR AN SLISTCALL NODE***)%
BEGIN
TREEPTR_.IOLELEM[SCALLCT];
IF .TREEPTR[OPRCLS] NEQ DATAOPR
THEN
%(***DONT BOTHER TO TRY TO LEAVE THIS IN A REG***)%
%1274% ! Get 1 or 2 word temp based on DBLFLG
%1274% IF .TREEPTR[DBLFLG]
%1274% THEN ALCINTMP(NXTTMP(2),.BSYREGS,.FREGCT)
%1274% ELSE ALCINTMP(NXTTMP(1),.BSYREGS,.FREGCT);
%2363% ! If input is being performed, we must assume
%2363% ! the array is clobbered. Note that this
%2363% ! includes a COMMON/EQUIVALENCE check.
%2363%
%2363% IF .INPFLAG
%2363% THEN VARCLOBB(.IOLELEM[SCALLELEM]);
END;
%(***AN IOLSTCALL WITHIN AN IOLSTCALL IS ILLEGAL***)%
BEGIN
END;
%(***FOR AN E1LISTCALL NODE - OPTIMIZED CODE ONLY***)%
ALCE1LIST(.IOLELEM,.BSYREGS,.FREGCT);
%(***FOR AN E2LISTCALL NODE - OPTIMIZED CODE ONLY***)%
ALCE2LIST(.IOLELEM,.BSYREGS,.FREGCT)
TES;
%(***GO ON TO NEXT ELEMENT***)%
IOLELEM_.IOLELEM[CLINK];
END;
%(***RETSORE CSTMNT***)%
CSTMNT_.SAVSTMNT;
END; ! of ALCIOCALL
GLOBAL ROUTINE ALCE1LIST(IOLELEM,BSYREGS,FREGCT)=
%(**********************************************************************
PERFORM REGISTER ALLOCATION FOR AN E1LISTCALL NODE
STORE THE RESULTS OF ALL CALCULATIONS REQUIRED BY
ELEMENTS IN THE E1LISTCALL NODE IN TEMPORARIES
**********************************************************************)%
BEGIN
MAP BASE IOLELEM;
MAP PEXPRNODE TREEPTR;
LOCAL BASE IOARRAY;
%2363% LOCAL BSYRG1; ! Adjusted set of free regs
%2363% LOCAL FRGCT1; ! Adjusted count of free regs
%(***ALLOCATE THE COUNT EXPRESSION***)%
TREEPTR_.IOLELEM[ECNTPTR];
IF .TREEPTR[OPRCLS] EQL ARRAYREF !REF TO AN ARRAY ELEM
THEN IOLELEM[ECNTPTR]_ALCTVARR(.BSYREGS,.FREGCT) !LINK A STORECLS NODE INTO THE TREE
ELSE
IF .TREEPTR[OPRCLS] NEQ DATAOPR
%1274% THEN ! Get 1 or 2 word temp based on DBLFLG
%1274% IF .TREEPTR[DBLFLG]
%1274% THEN ALCINTMP(NXTTMP(2),.BSYREGS,.FREGCT)
%1274% ELSE ALCINTMP(NXTTMP(1),.BSYREGS,.FREGCT);
%(***ALLOCATE THE INCREMENT EXPRESSION***)%
TREEPTR_.IOLELEM[E1INCR];
IF .TREEPTR[OPRCLS] EQL ARRAYREF
THEN IOLELEM[E1INCR]_ALCTVARR(.BSYREGS,.FREGCT)
ELSE
IF .TREEPTR[OPRCLS] NEQ DATAOPR
%1274% THEN ! Get 1 or 2 word temp based on DBLFLG
%1274% IF .TREEPTR[DBLFLG]
%1274% THEN ALCINTMP(NXTTMP(2),.BSYREGS,.FREGCT)
%1274% ELSE ALCINTMP(NXTTMP(1),.BSYREGS,.FREGCT);
%(***ALLOCATE THE ARRAY REFERENCES***)%
IOARRAY_.IOLELEM[ELSTPTR];
WHILE .IOARRAY NEQ 0
%2363% DO
%2363% BEGIN ! For each element
%2363%
%2363% TREEPTR = .IOARRAY[E2ARREFPTR];
%2363%
%2363% ! We don't need to do register allocation if this
%2363% ! element is a DATAOPR, a REGCONTENTS node, or an
%2363% ! ARRAYREF with no subscript expression.
%2363%
%2363% IF .TREEPTR[OPRCLS] NEQ DATAOPR
%2363% THEN IF .TREEPTR[OPRCLS] NEQ REGCONTENTS
%2363% THEN IF NOT (.TREEPTR[OPRCLS] EQL ARRAYREF AND
%2363% .TREEPTR[ARG2PTR] EQL 0)
%2363% THEN
%2363% BEGIN ! Do register allocation
%2363%
%2363% ! Determine the set of free registers
%2363%
%2363% IF .TREEPTR[DBLFLG]
%2363% THEN
%2363% BEGIN ! Double
%2363%
%2363% BSYRG1 = DPBSYREGS(.BSYREGS);
%2363% FRGCT1 = ONESCOUNT(.BSYRG1);
%2363%
%2363% END ! Double
%2363% ELSE
%2363% BEGIN ! Non-double
%2363%
%2363% BSYRG1 = .BSYREGS;
%2363% FRGCT1 = .FREGCT;
%2363%
%2363% END; ! Non-double
%2363%
%2363% ! For an ARRAYREF, we must materialize the
%2363% ! address referenced. For a non-ARRAYREF, use
%2363% ! a 1 or 2 word temp based on DBLFLG.
%2363%
%2363% IF .TREEPTR[OPRCLS] EQL ARRAYREF
%2363% THEN IOARRAY[E2ARREFPTR] = ALCTARY(.BSYRG1,.FRGCT1)
%2363% ELSE IF .TREEPTR[DBLFLG]
%2363% THEN ALCINTMP(NXTTMP(2),.BSYRG1,.FRGCT1)
%2363% ELSE ALCINTMP(NXTTMP(1),.BSYRG1,.FRGCT1);
%2363%
%2363% END; ! Do register allocation
%2363%
%2363% ! If input is being performed, we must assume the
%2363% ! variable is clobbered. Note that this includes a
%2363% ! COMMON/EQUIVALENCE check.
%2363%
%2363% IF .INPFLAG
%2363% THEN VARCLOBB(.IOARRAY[E2ARREFPTR]);
%2363%
%2363% IOARRAY = .IOARRAY[CLINK]; ! Move to next element
%2363%
%2363% END; ! For each element
%(***ALLOCATE THE ASSIGNMENT STATEMENT(S) TO LOOP VARIABLE***)%
%1663% ALCASCHAIN( .IOLELEM[ELPFVLCHAIN], .BSYREGS, .FREGCT );
END; ! of ALCE1LIST
GLOBAL ROUTINE ALCE2LIST(IOLELEM,BSYREGS,FREGCT)=
%(**********************************************************************
PERFORM REGISTER ALLOCATION FOR AN E2LISTCALL NODE
STORE THE RESULTS OF ALL CALCULATIONS REQUIRED BY
ELEMENTS IN THE E2LISTCALL NODE IN TEMPORARIES
**********************************************************************)%
BEGIN
MAP BASE IOLELEM;
MAP PEXPRNODE TREEPTR;
LOCAL BASE IOARRAY;
%2363% LOCAL BSYRG1; ! Adjusted set of free regs
%2363% LOCAL FRGCT1; ! Adjusted count of free regs
%(***ALLOCATE THE COUNT EXPRESSION***)%
TREEPTR_.IOLELEM[ECNTPTR]; !ALLOCATE EXPRESSION
IF .TREEPTR[OPRCLS] EQL ARRAYREF !REF TO AN ARRAY ELEM
THEN IOLELEM[ECNTPTR]_ALCTVARR(.BSYREGS,.FREGCT) !LINK A STORECLS NODE INTO THE TREE
ELSE
IF .TREEPTR[OPRCLS] NEQ DATAOPR
%1274% THEN ! Get 1 or 2 word temp based on DBLFLG
%1274% IF .TREEPTR[DBLFLG]
%1274% THEN ALCINTMP(NXTTMP(2),.BSYREGS,.FREGCT)
%1274% ELSE ALCINTMP(NXTTMP(1),.BSYREGS,.FREGCT);
%(***ALLOCATE THE INCREMENT EXPRESSIONS***)%
IOARRAY_.IOLELEM[ELSTPTR]; !LOCATE LIST
WHILE .IOARRAY NEQ 0 DO
BEGIN
TREEPTR_.IOARRAY[E2INCR]; !ALLOCATE EXPRESSION
IF .TREEPTR[OPRCLS] EQL ARRAYREF
THEN IOARRAY[E2INCR]_ALCTVARR(.BSYREGS,.FREGCT)
ELSE
IF .TREEPTR[OPRCLS] NEQ DATAOPR
%1274% THEN ! Get 1 or 2 word temp based on DBLFLG
%1274% IF .TREEPTR[DBLFLG]
%1274% THEN ALCINTMP(NXTTMP(2),.BSYREGS,.FREGCT)
%1274% ELSE ALCINTMP(NXTTMP(1),.BSYREGS,.FREGCT);
IOARRAY_.IOARRAY[CLINK]
END;
%(***ALLOCATE THE ARRAYREF COMPUTATIONS***)%
IOARRAY_.IOLELEM[ELSTPTR]; !LOCATE LIST
WHILE .IOARRAY NEQ 0
%2363% DO
%2363% BEGIN ! For each element
%2363%
%2363% TREEPTR = .IOARRAY[E2ARREFPTR];
%2363%
%2363% ! We don't need to do register allocation if this
%2363% ! element is a DATAOPR, a REGCONTENTS node, or an
%2363% ! ARRAYREF with no subscript expression.
%2363%
%2363% IF .TREEPTR[OPRCLS] NEQ DATAOPR
%2363% THEN IF .TREEPTR[OPRCLS] NEQ REGCONTENTS
%2363% THEN IF NOT (.TREEPTR[OPRCLS] EQL ARRAYREF AND
%2363% .TREEPTR[ARG2PTR] EQL 0)
%2363% THEN
%2363% BEGIN ! Do register allocation
%2363%
%2363% ! Determine the set of free registers
%2363%
%2363% IF .TREEPTR[DBLFLG]
%2363% THEN
%2363% BEGIN ! Double
%2363%
%2363% BSYRG1 = DPBSYREGS(.BSYREGS);
%2363% FRGCT1 = ONESCOUNT(.BSYRG1);
%2363%
%2363% END ! Double
%2363% ELSE
%2363% BEGIN ! Non-double
%2363%
%2363% BSYRG1 = .BSYREGS;
%2363% FRGCT1 = .FREGCT;
%2363%
%2363% END; ! Non-double
%2363%
%2363% ! For an ARRAYREF, we must materialize the
%2363% ! address referenced. For a non-ARRAYREF, use
%2363% ! a 1 or 2 word temp based on DBLFLG.
%2363%
%2363% IF .TREEPTR[OPRCLS] EQL ARRAYREF
%2363% THEN IOARRAY[E2ARREFPTR] = ALCTARY(.BSYRG1,.FRGCT1)
%2363% ELSE IF .TREEPTR[DBLFLG]
%2363% THEN ALCINTMP(NXTTMP(2),.BSYRG1,.FRGCT1)
%2363% ELSE ALCINTMP(NXTTMP(1),.BSYRG1,.FRGCT1);
%2363%
%2363% END; ! Do register allocation
%2363%
%2363% ! If input is being performed, we must assume the
%2363% ! variable is clobbered. Note that this includes a
%2363% ! COMMON/EQUIVALENCE check.
%2363%
%2363% IF .INPFLAG
%2363% THEN VARCLOBB(.IOARRAY[E2ARREFPTR]);
%2363%
%2363% IOARRAY = .IOARRAY[CLINK]; ! Move to next element
%2363%
%2363% END; ! For each element
%(***ALLOCATE THE ASSIGNMENT STATEMENT(S) TO LOOP VARIABLE***)%
%1663% ALCASCHAIN( .IOLELEM[ELPFVLCHAIN], .BSYREGS, .FREGCT );
END; ! of ALCE2LIST
GLOBAL ROUTINE ALCASCHAIN( FIRSTMN, BSYREGS, FREGCT ) =
%(*****
Routine to perform register allocation for a chain of
assignment statements embedded within another statement.
Called for the assignment statements that set the final value
of an implied DO loop index when that DO has been folded into
an E1LIST or an E2LIST by the optimizer. Called by
ALCE1LIST and ALCE2LIST.
FIRSTMN points to the first assignment statement in the chain
to be allocated. BSYREGS and FREGCT indicate the AC's that
can be used.
[1663] New routine.
******)%
BEGIN ! ALCASCHAIN
LOCAL SAVSTBSYR;
LOCAL SAVSTRGCT;
SAVSTBSYR = .STBSYR; ! Save "statement busy regs"
SAVSTRGCT = .STRGCT;
CSTMNT = .FIRSTMN; ! Set up CSTMNT to point to the first
! assignment statement in the chain
%[1220]% WHILE .CSTMNT NEQ 0 DO
%[1220]% BEGIN
! Set up globals that indicate AC's that can
! be used to evaluate the assignment stmt
STBSYR = .BSYREGS;
STRGCT = .FREGCT;
%[1220]% ALCASMNT();
%[1220]% CSTMNT_.CSTMNT[CLINK]
%[1220]% END;
STBSYR = .SAVSTBSYR; ! Restore STBSYR, STRGCT
STRGCT = .SAVSTRGCT;
END; !ALCASCHAIN
GLOBAL ROUTINE LHINREGALC=
%(*****
ROUTINE TO PERFORM REGISTER ALLOCATION FOR AN ASSIGNMENT STATEMENT
WHEN THE LEFT-HAND-SIDE IS ALLOCATED TO A REGISTER.
THIS ROUTINE ATTEMPTS TO COMPUTE THE VALUE OF THE RIGHT-HAND-SIDE
INTO THAT REGISTER. IT IS ABLE TO DO SO IF EITHER:
1. THERE IS NO REFERENCE TO THE LHS VARIABLE IN THE
RHS EXPRESSION
2. THERE IS A REFERENCE TO THE LHS VARIABLE AT A DEPTH OF
1 OR 2 WITHIN THE RHS EXPRESSION.
RETURNS TRUE IF SUCCEEDED, FALSE IF FAILED (IN WHICH CASE REGISTER
ALLOCATION FOR THIS EXPRESSION MUST STILL BE PERFORMED)
*****)%
BEGIN
REGISTER PEXPRNODE RHNODE;
OWN PEXPRNODE LHNODE;
OWN RA;
OWN PEXPRNODE ARG1NODE;
REGISTER PEXPRNODE ARG2NODE;
%(***LOCAL ROUTINE TO SET REG FOR COMPUTATION OF RIGHT HAND EXPR EQUAL TO
REG TO WHICH LHS VARIABLE WAS ALLOCATED*****)%
ROUTINE SETRHRGTOLH=
BEGIN
RHNODE[TARGTAC]_.LHNODE[TARGTAC];
%[625]% RHNODE[INREGFLG]_1;
CSTMNT[ASMNTREG]_.LHNODE[TARGTAC];
![721] SINCE WE ARE USING THE REGISTER, INVALIDATE ANY PREVIOUS USE
%[721]% REGCLOBB(.CSTMNT[ASMNTREG]);
CSTMNT[A1SAMEFLG]_1;
CSTMNT[A2SAMEFLG]_1;
END; ! of SETRHRGTOLH
%(***LOCAL ROUTINE TO SPECIFY THAT THE COMPUTATION OF THE VALUE OF THE NODE
"PNODE" BE PERFORMED IN THE REGISTER USED FOR LHS WHEN ARG1
UNDER "PNODE" IS EQUAL TO LHS
CAN BE CALLED FOR PNODE OF OPRCLS:
ARITHMETIC,BOOLEAN,SPECOP
****)%
ROUTINE CMPNODINLH(PNODE)=
BEGIN
MAP PEXPRNODE PNODE;
PNODE[A1SAMEFLG]_1;
PNODE[TARGTAC]_.LHNODE[TARGTAC];
%[625]% PNODE[INREGFLG]_1;
%(****PERFORM REG ALLOC FOR ARG2 UNDER PNODE***)%
IF NOT .PNODE[A2VALFLG] AND .PNODE[OPRCLS] NEQ SPECOP
THEN
BEGIN
TREEPTR_.PNODE[ARG2PTR];
ALCINREG(AFREEREG(.STBSYR,FALSE,.TREEPTR[DBLFLG]),.STBSYR,.STRGCT);
END;
END; ! of CMPNODINLH
ROUTINE CMPRHINLH=
%(***LOCAL ROUTINE TO ALLOCATE THE COMPUTATION OF RHNODE TO BE
PERFORMED IN THE REGISTER ALLOCATED TO LHS, WHEN THE FIRST
ARG UNDER THE FIRST ARG OF RHNODE IS KNOWN TO BE EQUAL TO
THE VARIABLE ON THE LHS
****)%
BEGIN
%(***IF THE COMPUTATION OF ARG2 UNDER RHS INCLUDES A REFERENCE
TO THE VARIABLE FROM THE LHS, MUST COMPUTE ARG2 BEFORE
COMPUTE ARG1 (SINCE THE COMPUTATION OF ARG1 WILL
CLOBBER THE REG THAT HOLDS THAT VAR)
***)%
IF .ARG2NODE[RESRFFLG] AND NOT .RHNODE[RVRSFLG]
THEN
BEGIN
RHNODE[RVRSFLG]_1;
%(**IF ON COMPLEXITY PASS WE ALLOCATED ARG2 TO BE COMPUTED
INTO FN-RETURN REG, AND THE COMPUTATION OF ARG1 WILL
CLOBBER FN-RETURN REG, THEN WE MUST UNDO THAT ALLOCATION***)%
IF .ARG2NODE[ALCRETREGFLG] AND .ARG1NODE[FNCALLSFLG]
THEN
BEGIN
ARG2NODE[ALCRETREGFLG]_0;
ARG2NODE[INREGFLG]_0;
ARG2NODE[A1SAMEFLG]_0;
ARG2NODE[A2SAMEFLG]_0;
END
END;
%(***PERFORM REGISTER ALLOCATION FOR THE COMPUTATION OF ARG2 UNDER RHNODE
(WE KNOW THAT THE VAL OF ARG1 WILL BE LEFT IN THE REG IN WHICH LHS
IS ALLOCATED)
****)%
IF NOT .RHNODE[A2VALFLG] AND .RHNODE[OPRCLS] NEQ SPECOP
THEN
BEGIN
TREEPTR_.ARG2NODE;
ALCINREG(AFREEREG(.STBSYR,FALSE,.TREEPTR[DBLFLG]),.STBSYR,.STRGCT);
%(***IF ARG2 IS COMPUTED BEFORE ARG1, THEN MUST NOT USE
THE REG IN WHICH VAL OF ARG2 WAS LEFT IN COMPUTING ARG1**)%
IF .RHNODE[RVRSFLG]
THEN
BEGIN
OWN RB;
IF (RB_RGTOSAVE(.ARG2NODE)) NEQ -1 !IF SOME REG MUST BE PRESERVED
! TO PRESERVE VAL OF ARG2
THEN
BEGIN
STBSYR_CLRBIT(.STBSYR,.RB); !TAKE THAT REG OUT OF SET AVAILABL
%(***IF THAT REG IS THE REG TO WHICH LHS WAS
ALLOCATED, ARE IN AN IMPOSSIBLE SITUATION.
THIS SHOULD NEVER OCCUR***)%
IF .RB EQL .LHNODE[TARGTAC] THEN CGERR();
END;
END;
END;
%(***PERFORM ALLOCATION OF ARG1 UNDER RHNODE, COMPUTING ITS VAL INTO
THE REG USED FOR LHS***)%
CMPNODINLH(.ARG1NODE);
RHNODE[TARGTAC]_.ARG1NODE[TARGTAC];
RHNODE[A1SAMEFLG]_1;
SETRHRGTOLH(); !SET FIELDS OF CSTMNT TO INDICATE THAT RHNODE WAS
! COMPUTED INTO THE REG FOR LHNODE
END; ! of CMPRHINLH
ROUTINE ALCTORETREG=
%(*********************
ROUTINE TO ALLOCATE THE RIGHT HAND SIDE WHEN IT HAS BEEN DETERMINED
THAT IT CAN BE COMPUTED INTO THE FN RETURN REG, AND THE LHS
IS ALSO A REGCONTENTS FOR THE FN RETURN REG
***********************)%
BEGIN
TREEPTR_.RHNODE;
ALCINREG(AFREEREG(.STBSYR,FALSE,.RHNODE[DBLFLG]),.STBSYR,.STRGCT);
CSTMNT[ASMNTREG]_RETREG; !USE RETREG FOR THE ASSIGNMNET
CSTMNT[A1SAMEFLG]_1;
CSTMNT[A2SAMEFLG]_1;
RETURN TRUE
END; ! of ALCTORETREG
ROUTINE MUSTSAVLHREG(ANODE)=
%(***************
TESTS WHETHER THE VALUE OF ANODE WILL BE INACCESSIBLE IF THE
REGISTER THAT HOLDS THE VARIABLE ON THE LHS HAS BEEN CLOBBERED.
THIS IS TRUE ONLY IF ANODE IS AN ARRAYREF THAT WILL HAVE THE
LHS VAR AS ITS SUBSCRIPT OR FOR DUMMY TYPE CONVERSION NODES
THAT HAVE THE LHS VAR UNDER THEM
******************)%
BEGIN
MAP PEXPRNODE ANODE;
IF .ANODE EQL .LHNODE THEN RETURN TRUE !TO REF THE LHS VAR ITSELF,
! THE VAL MUST BE PRESERVED
ELSE
IF .ANODE[OPRCLS] EQL ARRAYREF !FOR AN ARRAYREF, IF THE INDEX
THEN RETURN MUSTSAVLHREG(.ANODE[ARG2PTR]) ! IS A NODE THAT REQUIRES THE LHS TO
! BE PRESERVED
ELSE
IF .ANODE[OPRCLS] EQL TYPECNV
THEN
BEGIN
%(***IF THE ARG UNDER A DUMMY TYPE-CNV NODE REQUIRES THE REG TO
BE PRESERVED, THEN THE TYPE-CNVNODE DOES ALSO***)%
IF NOCNV(ANODE) THEN RETURN MUSTSAVLHREG(.ANODE[ARG2PTR])
ELSE RETURN FALSE
END
ELSE RETURN FALSE
END; ! of MUSTSAVLHREG
%[1067]% ROUTINE NOCMSBINR1=
![1067] %(***********************
![1067] ROUTINE TO TEST IF A COMMON SUBEXPRESSION HAS BEEN ALLOCATED
![1067] IN REGISTER 1. RETURN TRUE IF NONE IN REG 1
![1067] ************************)%
%[1067]% BEGIN
%[1067]% REGISTER T1;
%[1067]% MAP PEXPRNODE T1;
%[1067]% T1_.CSTMNT[SRCCOMNSUB];
%[1067]% IF .T1 NEQ 0 THEN
%[1067]% DO IF .T1[TARGADDR] EQL RETREG+1 THEN RETURN FALSE
%[1067]% ELSE T1_.T1[CLINK]
%[1067]% WHILE .T1 NEQ 0;
%[1067]% RETURN TRUE
%[1067]% END; ! of NOCMSBINR1
LHNODE_.CSTMNT[LHEXP];
%(***IF RHS IS A SCALAR, SIMPLY SET TARGET TO REG ALLOCATED FOR LHS***)%
IF .CSTMNT[A2VALFLG]
THEN
BEGIN
CSTMNT[ASMNTREG]_.LHNODE[TARGTAC];
CSTMNT[A1SAMEFLG]_1;
IF .CSTMNT[RHEXP] EQL .LHNODE
OR REGCONTAINING(.CSTMNT[RHEXP]) EQL .LHNODE[TARGTAC] !IF THE VAR ON RHS WAS ALREADY IN THE DESIRED REG
THEN
CSTMNT[A2SAMEFLG]_1
ELSE REGCLOBB(.CSTMNT[ASMNTREG]); !IF LEFT SOME VAR IN LHS REG WHILE
! COMPUTING RHS, THAT VAR IS NOW NO LONGER THERE
RETURN TRUE;
END;
RA_.LHNODE[TARGTAC];
RHNODE_.CSTMNT[RHEXP];
%(***IF THE LHS IS THE FN-RETURN REG AND THE RHS HAS ALREADY BEEN DETERMINED
TO BE EVALUATED TO IT, THEN JUST DO
REST OF ALLOCATION FOR RHS EXPRESSION***)%
IF .RA EQL RETREG AND .RHNODE[ALCRETREGFLG] AND .RHNODE[TARGTAC] EQL RETREG AND .RHNODE[INREGFLG]
THEN RETURN ALCTORETREG();
%(***IF RHS IS AN ARRAY-REF - LOAD THE VAL INTO THE DESIRED REG***)%
IF .RHNODE[OPRCLS] EQL ARRAYREF
THEN
BEGIN
TREEPTR_.RHNODE;
ALCARRAY(.STBSYR,.STRGCT);
CSTMNT[ASMNTREG]_.LHNODE[TARGTAC];
CSTMNT[A1SAMEFLG]_1;
REGCLOBB(.CSTMNT[ASMNTREG]);
RETURN TRUE;
END;
%(***IF THERE IS NO REFERENCE TO THE VARIABLE ON THE LHS IN THE
EXPRESSION ON THE RHS, SIMPLY ALLOCATE THE EXPRESSION TO BE
COMPUTED INTO THE REG USED FOR THE VARIABLE IF POSSIBLE
****)%
IF NOT .RHNODE[RESRFFLG]
AND NOT (.RA EQL RETREG AND .RHNODE[FNCALLSFLG]) !IF LHS IS FN RETURN REG
! AND HAVE FNCALLS ON RHS
THEN
BEGIN
OWN STBSYR1; !SET OF REGS AVAILABLE FOR USE IN COMPUTING THE
! THE VAL OF THE RHS
%(***FOR COMPUTING THE RHS OF THIS STMNT, CAN USE THE REG TO WHICH
THE LHS WAS ALLOCATED (SINCE THE LHS VARIABLE DOES NOT OCCUR
IN THE RHS EXPRESSION)***)%
STBSYR1_SETBIT(.STBSYR,.RA);
![1067] %(**WHEN TARGETTING TO REG 0 (FN RET REG) ALLOW REG 1 TO BE
![1067] USED IF THERE ARE NO COMMON SUBEXPRS ON STMNT WHICH USE IT
![1723] AND ARE NOT ALREADY IN DOUBLE WORD MODE**)%
%[1067]% IF .RA EQL RETREG AND NOCMSBINR1()
%[1723]% AND NOT .DBLMODE
THEN STBSYR1_SETBIT(.STBSYR1,RETREG+1);
TREEPTR_.RHNODE;
ALCINREG(.RA,.STBSYR1,ONESCOUNT(.STBSYR1));
CSTMNT[ASMNTREG]_.LHNODE[TARGTAC];
CSTMNT[A1SAMEFLG]_1;
IF .RHNODE[TARGTAC] EQL .CSTMNT[ASMNTREG] AND .RHNODE [INREGFLG]
THEN
CSTMNT[A2SAMEFLG]_1
ELSE REGCLOBB(.CSTMNT[ASMNTREG]); !IF LEFT SOME VAR IN LHS REG WHILE
! COMPUTING RHS, THAT VAR IS NOW NO LONGER THERE
RETURN TRUE;
END;
%(***IF RHS CONTAINS A REFERENCE TO LHS VAR AND IS A SPECIAL OPERATOR
(P2MUL OR P2DIV), CHECK FOR ARG1 OF THAT OPERATOR EQUAL
TO THE LHS - IF IT IS, PERFORM THE OPERATION IN THE REG
ALLOCATED TO LHS - OTHERWISE GIVE UP
****)%
IF .RHNODE[OPRCLS] EQL SPECOP
THEN
BEGIN
! MUST NOT CLOBBER LHS REG IF P2PL1OP OR EXPCIOP NOT A POWER OF 2
IF .RHNODE [OPERSP] EQL P2PL1OP OR
(.RHNODE [OPERSP] EQL EXPCIOP AND
NOT POWOF2 (.RHNODE [ARG2PTR]))
THEN RETURN FALSE;
IF .RHNODE[ARG1PTR] EQL .LHNODE
THEN
BEGIN
SETRHRGTOLH();
RHNODE[A1SAMEFLG]_1;
RETURN TRUE;
END
ELSE
RETURN FALSE;
END;
%(***IF RHS CONTAINS A REFERENCE TO LHS VAR AND IS A RELATIONAL,
FUNCTION CALL, TYPE-CONVERSION, OR NEG/NOT - DON'T BOTHER
****)%
IF .RHNODE[OPRCLS] NEQ ARITHMETIC AND .RHNODE[OPRCLS] NEQ BOOLEAN
THEN
RETURN FALSE;
%(********WHEN THE LHS IS THE FN RETURN REG AND THE RHS IS AN ARITH OR BOOLEAN
EXPRESSION THAT CONTAINS FUNCTION CALLS BUT WAS NOT ALLOCATED TO THE FN RETURN
REG ALREADY, CHECK FOR RHS OF THE FORM:
<EXPR> OP <FN-CALL>
OR <EXPR> OP <EXPR ALLOCATED TO FN RETURN REG>
AND REVERSE THE 2 OPERATORS IF CAN DO SO
*********)%
IF .RA EQL RETREG
THEN
BEGIN
ARG1NODE_.RHNODE[ARG1PTR];
ARG2NODE_.RHNODE[ARG2PTR];
IF .ARG2NODE[ALCRETREGFLG] !IF ARG2 WAS ALLOCATED TO FN RETURN REG
AND .ARG2NODE[INREGFLG] AND .ARG2NODE[TARGTAC] EQL RETREG
AND COMMUTATIVE(RHNODE) !AND THE RHS EXPRESSION IS COMMUTATIVE
AND NOT .ARG1NODE[FNCALLSFLG] !AND ARG1 DOES NOT INCLUDE FN CALLS
THEN
BEGIN
EXCHARGS(.RHNODE); !LET ARG1 BE THE ARG COMPUTED INTO FN RETURN REG
RHNODE[RVRSFLG]_0; !ALWAYS COMPUTE THAT ARG FIRST
RHNODE[ALCRETREGFLG]_1; !COMPUTE THE RHS IN THE FN RET REG
RHNODE[TARGTAC]_RETREG;
RHNODE[INREGFLG]_1;
RHNODE[A1SAMEFLG]_1; !ARG1 OF RHS WONT HAVE TO BE LOADED INTO THE REG
RETURN ALCTORETREG()
END
ELSE RETURN FALSE; !IF LHS IS FN RETURN REG, RHS CONTAINS FN CALLS
! AND NEITHER RHS, NOR ARG2 UNDER RHS WAS ALLOCATED TO FN
! RET REG, GIVE UP ON OPTIMALITY
END;
%(*******WHEN RHS EXPRESSION IS ARITHMETIC OR BOOLEAN AND CONTAINS
A REFERENCE TO LHS VAR***)%
! CONSIDER CASES LIKE:
! I=I/J
! I=(I+K)/J
! I=J+(I/K)
! AND OTHER ASSOCIATED PROBLEMS!
! THESE ALL DEPEND UPON THE REG AFTER THE ONE
! IN WHICH THE LHS IS LIVING GETTING OVERWRITTEN BY
! SOME OPERATION PERFORMED DIRECTLY IN THE REG FOR LHS.
IF CLOBBNX(.RHNODE) THEN RETURN FALSE;
%(***IF ARG1 IS EQUAL TO LHS VAR, SIMPLY PERFORM OP IN LHS REG***)%
IF .RHNODE[ARG1PTR] EQL .LHNODE
THEN
BEGIN
SETRHRGTOLH();
CMPNODINLH(.RHNODE);
RETURN TRUE;
END;
%(***IF ARG2 IS EQUAL TO LHS VAR. ATTEMPT TO SWAP THE ARGS.
IF CAN DO SO, THE PERFORM OP IN LHS REG***)%
IF .RHNODE[ARG2PTR] EQL .LHNODE
THEN
BEGIN
IF COMMUTATIVE(RHNODE)
THEN
BEGIN
SWAPARGS(RHNODE);
SETRHRGTOLH();
CMPNODINLH(.RHNODE);
RETURN TRUE;
END
ELSE
RETURN FALSE
END;
%(***SEARCH DOWN ONE LEVEL ONLY FOR REFERENCES TO LHS.
THUS CAN HANDLE:
A=A+C
A=A+B+C
A=A*B+C*D
BUT NOT:
A=A*B+C*D+E*F
A=A+B+C+D
****)%
ARG1NODE_.RHNODE[ARG1PTR];
ARG2NODE_.RHNODE[ARG2PTR];
%(***IF EITHER OF THE ARGS WILL BE IMPOSSIBLE TO REFERENCE IF THE
OTHER ARG IS COMPUTED INTO THE REG HOLDING THE LHS VAR,
THEN GIVE UP. (EG I=I*J+K(I) CANNOT BE COMPUTED BY COMPUTING
I*J IN THE REG FOR I)
*****)%
IF .ARG1NODE[RESRFFLG] AND .ARG2NODE[RESRFFLG] AND .RHNODE[OPRCLS] NEQ SPECOP
THEN
BEGIN
IF MUSTSAVLHREG(.ARG1NODE) OR MUSTSAVLHREG(.ARG2NODE)
THEN RETURN FALSE
END;
IF .ARG1NODE[OPRCLS] EQL ARITHMETIC OR .ARG1NODE[OPRCLS] EQL BOOLEAN OR .ARG1NODE[OPRCLS] EQL SPECOP
THEN
BEGIN
IF .ARG1NODE[ARG1PTR] EQL .LHNODE
THEN
BEGIN
%1757% ! The SPECOP's P2PL1 (power of 2 plus 1) and
%1757% ! EXPCIOP (raise to an integer power), must not
%1757% ! use the same register as the LHS for the
%1757% ! computation.
%1757% IF .ARG1NODE[OPRCLS] EQL SPECOP
%1757% THEN IF .ARG1NODE[OPERSP] EQL P2PL1OP OR
%1757% .ARG1NODE[OPERSP] EQL EXPCIOP
%1757% THEN RETURN FALSE;
IF CLOBBNX(.ARG1NODE) THEN RETURN FALSE;
CMPRHINLH();
RETURN TRUE;
END
ELSE
IF .ARG1NODE[ARG2PTR] EQL .LHNODE
THEN
BEGIN
IF COMMUTATIVE(ARG1NODE)
THEN
BEGIN
SWAPARGS(ARG1NODE);
CMPRHINLH();
RETURN TRUE;
END;
END;
END;
%2041% IF COMMUTATIVE(RHNODE)
%2041% THEN IF .ARG2NODE[OPRCLS] EQL ARITHMETIC
%2041% OR .ARG2NODE[OPRCLS] EQL BOOLEAN
%2041% OR .ARG2NODE[OPRCLS] EQL SPECOP
THEN
BEGIN
IF .ARG2NODE[ARG1PTR] EQL .LHNODE
THEN
BEGIN
IF CLOBBNX(.ARG2NODE) THEN RETURN FALSE;
SWAPARGS(RHNODE);
RHNODE[RVRSFLG]_NOT .RHNODE[RVRSFLG]; !WHEN EXCHANGE ARG1 AND ARG2
! COMPUTE THEM IN THE ORDER
! ORIGINALLY DETERMINED
ARG1NODE_.RHNODE[ARG1PTR];
ARG2NODE_.RHNODE[ARG2PTR];
CMPRHINLH();
RETURN TRUE;
END
ELSE
IF .ARG2NODE[ARG2PTR] EQL .LHNODE
THEN
BEGIN
IF COMMUTATIVE(ARG2NODE)
THEN
BEGIN
SWAPARGS(ARG2NODE);
SWAPARGS(RHNODE);
RHNODE[RVRSFLG]_NOT .RHNODE[RVRSFLG]; !WHEN EXCHANGE ARG1 AND ARG2
! COMPUTE THEM IN THE ORDER
! ORIGINALLY DETERMINED
ARG1NODE_.RHNODE[ARG1PTR];
ARG2NODE_.RHNODE[ARG2PTR];
CMPRHINLH();
RETURN TRUE;
END
END
END;
RETURN FALSE;
END; ! of LHINREGALC
END
ELUDOM