Trailing-Edge
-
PDP-10 Archives
-
BB-D480F-SB_FORTRAN10_V10
-
regal2.bli
There are 26 other files named regal2.bli in the archive. Click here to see a list.
!COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1972, 1985
!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/MD/DCE/SJW/JNG/EGM/EDS/TFV/RVM/CDM/TJK
MODULE REGAL2(SREG=#17,VREG=#15,FREG=#16,DREGS=4,RESERVE(0,1,2,3)) =
BEGIN
GLOBAL BIND REGALV = #10^24 + 0^18 + #2402; ! Version Date: 19-Jun-84
%(
***** Begin Revision History *****
114 ----- ----- DONT ALLOW REGISTER 0 TO BE THE REG TO WHICH AN ARRAY
SUBSCRIPT IS TARGETED
115 ----- ----- IN "ALCA", IF ARG1 WAS LEFT IN SOME REGISTER
(AS INDICATED BY "REGCONTAINING") - DO NOT
USE THAT REG IF A1NEGFLG OR A1NOTFLG IS SET
IN THIS EXPRESSION NODE (BECAUSE CAN THEN
HAVE SAME,NEG,AND IMMED FLAGS ALL SET)
116 ----- ----- IN "ALCTPCNV", FOR A DUMMY TYPE CONVERSION NODE,
WHEN THE SON OF THE TYPE CONVERSION IS DEALLOCATED
FROM THE FN RETURN REG, MUST TURN OFF
"A2SAMEFLG" IN THE SON AS WELL AS "A1SAMEFLG"
117 ----- ----- LIBRARY FUNCTIONS DO NOT CLOBBER EITHER
COMMON OR EQUIVALENCED VARAIBLES
118 ----- ----- EXPCIOP MUST SAVE COMPUTED ARGUMENT IN
A REGISTER UNLESS POWER IS A POWER OF 2
119 ----- ----- ADD ROUTINE "ALCTVARR" TO ALLOCATE AN ARRAY ELEM
TO HAVE ITS VALUE STORED IN A TEMP (TO BE
CALLED FOR OPEN STMNTS,UNIT NUMBERS,RECORD NUMBERS)
120 ----- ----- ADD ROUTINE "CLOBBNX" TO TEST WHETHER AN OPERATION
CLOBBERS THE REG FOLLOWING THE REG BEING OPERATED ON.
THIS ROUTINE REPLACES THE MACRO "CLBNXREG",
WHICH WAS INCORRECT IN THAT DIVISION OF VARIABLES
OF TYPES LOGICAL AND INDEX WERE NOT BEING DETECTED
121 ----- ----- CHANGE ALL CALLS TO THE MACRO "CLBNXREG" INTO
CALLS TO THE ROUTINE "CLOBBNX" (MUST ADD A DOT)
122 ----- ----- ADD CODE TO "ALCA" TO ALLOCATE THE ARGS UNDER
THE IN LINE FN "CMPLX" IN SINGLE WD MODE
(BUG IN CEXPO)
123 ----- ----- REMOVE ALL REFERENCES TO SQROP,CUBOP,P4OP
124 ----- ----- CHANGE REFS TO THE MACRO "POWEROF2"
TO "POWOF2"
125 ----- ----- FIX BUG IN ALCARGS, MISSING DOT IN FRONT OF FREGCT
IN A CALL TO ALCINREG
126 ----- ----- FIX ANOTHER BUG IN THE SAME BLOCK OF ALCARGS
AS EDIT 125; DO NOT CLRBIT(.BSYRG1,.RA) IF RA
IS THE ONLY REG IN BSYRG1
127 237 ----- IN ALCARGS, IF HAVE A1VALFLG, IF RA IS THE ONLY
REG IN BSYREGS - DONT TRY TO GET ANOTHER REG
TO TARGET ARG2 TO (ARG2 MAY NOT REALLY NEED A
REG AT ALL - EG IF ITS A FN CALL)
128 250 15356 IN ALCARGS, IF ALCRETREGFLG IS ON, DON'T ALLOCATE
ANOTHER REGISTER (DON'T NEED IT, AND MAY NOT HAVE
IT.
129 267 ----- IN 250, IF WE HAVE A RELATIONAL, DON'T SKIP ALLOCATION
130 274 16050 ALCINREG FUNCTION CALLS IN RIGHT ORDER AND INTO A
FREE REGISTER
131 302 16181 DON'T SAVE REGS FOR ALL CASES OF CONTROL TYPE BOOLEANS
132 304 16441 CHECK DOUBLE TO SINGLE CONVERSION NODES FOR CLOBBERRING AC+1
133 326 17086 FIX TARGETING FOR AND/OR NODE INVOLVING FUNCTION CALL,
(DCE)
134 341 17770 FIX REGISTER TARGETING FOR EXPONENTIATION, (DCE)
135 373 18242 DON'T CALL AFREEREG WITH BSYRG1=0, (DCE)
136 377 18476 FIX REG ALLOCATION FOR COS(X)*A(I), (DCE)
***** Begin Version 5 *****
137 412 ----- FIX REGTOUSE SO DOUBLE ARRAY REF LOADED INTO
SUBSCRIPT REG PAIR UNLESS FOR KA10
138 432 19037 FIX REGISTER ALLOCATION FOR TYPE CONVERSION
NODES ABOVE ARRAY REFERENCES (ET AL), (DCE)
139 441 19231 FIX REGISTER ALLOCATION FOR A DOUBLE PRECISION
ARRAYREF IN A FUNCTION CALL PARAMETER LIST, (DCE)
140 457 19805 TRY HARDER TO NOT ASK FOR A REGISTER UNLESS WE
REALLY NEED ONE (MORE TO EDIT 250)., (DCE)
141 504 ----- FIX EDIT 412 TO KNOW THAT COMPLEX NUMBERS ARE
FETCHED WITH TWO MOVN'S, NOT A DMOVN., (JNG)
142 545 22096 STORE FUNCTION VALUE IN REALLY FREE REG, (DCE)
143 550 21824 FIX TEMP ALLOCATION FOR KA WITH BIG EXPRESSION, (DCE)
144 552 21826 RESET ARGNODE PTR TO GIVE BETTER CODE, (DCE)
145 554 22324 NOT FLAG CAUSES PROBLEMS ON AND, OR NODES, (DCE)
***** Begin Version 5A *****
146 600 22990 REWRITE TO MAKE BETTER USE OF STACK, (DCE)
***** Begin Version 5B *****
147 672 25725 FIX BUG WITH NOT FLAG ON CONSTANT ARRAY REF, (DCE)
148 757 29149 ADD THE ROUTINE STORAC (BY SRM) WHICH FORCES THE RESULT
OF A NODE OUT OF AN AC INTO A TEMP, AND USE THAT
ROUTINE IF ALCARGS GIVES AWAY THE LAST FREE REGISTER
PAIR WHEN IT REALLY NEEDS IT., (EGM)
***** Begin Version 6 *****
149 1064 EDS 28-Apr-81 Q20-01483
Dont set A1SAMEFLG when allocating register for a REGCONTENTS
node in ALCTVBOOL, this allows CGVBOOL to store ARG1.
***** Begin Version 6A *****
153 1145 EGM 4-Dec-81 10-31836
Make sure setting MEMCMP for an expression node also turns off
INREGFLG and ALCRETREGFLG. Also make make sure A1SAMEFLG is off
in the parent node if the MEMCMP node is ARG1PTR (really not
in any AC).
***** Begin Version 7 *****
150 1253 CKS 11-Apr-81
Add ALCCHARRAY to do register allocation for character arrayref nodes.
Same as ALCARRAY but assume the index register will be clobbered by
the node. Store the register in TARGTAC not TARGXF. Allocate a 2-word
.Q temp for the result descriptor.
151 1274 TFV 20-Oct-81 ------
Fix calls to NXTTMP. It's argument is now the number of words
of .Qnnnn variable to allocate.
152 1422 TFV 12-Nov-81 ------
Modify ALCFNCALL to handle character functions. They do not use AC0,
and AC1 for their result. Instead the first argument is a pointer to
the descriptor for the result. Modify ALCFNARGS so it does not try
to allocate character functions into .Qnnnn variables.
154 1431 CKS 4-Dec-81
Add ALCSUBSTR to do register allocation for substring nodes
155 1475 RVM 8-Feb-82
Give an internal compiler error if ALCTVARR is called on a character
array reference. Character array ref's never need a STORECLS node
inserted above them as they all ready are in a temp. Make ALCCHARRAY
a global routine, as it handles character array refs.
1474 TFV 15-Mar-82
Add ALLCONCAT to do register allocation for character
concatenation expressions. Modify ALCINREG and ALCINTMP to
handle concatentations by calling ALLCONCAT. For CONCTF nodes,
ALLCONCAT builds a compile-time-constant descriptor for the
result and allocates .Q space for the result. it then calls
ALCFNARGS to process its arguments.
1533 TFV 14-May-82
Write FINDMARK, GENMARK, and MARKIOLSCLS for CONCTV nodes.
FINDMARK looks at the parent node of the dynamic concatenation
for the argument list for the calls to CHMRK./CHUNW. If none
exists, GENMARK is called to create one. GENMARK creates the
argument list and allocates a one word .Qnnnn variable as the
single argument. MARKIOLSCLS is called for IOLSCLS nodes to set
the IOLDYNFLG to indicate that the IOLST. call needs to generate
CHMRK./CHUNW. calls.
1553 CKS 7-Jun-82
Bug in ALCSUBSTR: if substring upper bound is a function call,
ALCSUBSTR can decide to do substring length in register 0. If
substring is of an arrayref, it can then decide that register 0
is a handy register to do an ADJBP in. You can't do ADJBP in
register 0. In this case, pick an arbitrary free register.
1561 CKS 15-Jun-82
Modify ALCCHARRAY somewhat so it can be called by ALCINTMP. Pass it
a .Q temp to evaluate the char array ref into, instead of having it
allocate a .Q temp itself. Change ALCINTMP to pass TA down to
ALCCHARRAY. ALCINREG'd arrayrefs continue to allocate a new .Q temp,
but the NXTTMP is done by ALCINREG instead of ALCCHARRAY. ALCCHARRAY
should NOT be a global routine; make it local again and fix the
legitimate callers. Now char arrayrefs can be handled by ALCINREG,
ALCINTMP, ALCTVARR, and ALCTARY.
1567 CDM 24-Jun-82
Register allocation for new inlines CHAR, ICHAR, LEN.
1644 CDM 13-Oct-82
Correction of assignment into TARGADDR for type convert nodes that
do not generate any code.
1664 CKS 8-Nov-82
Wrong variable use in ALCSUBSTR -- use RBP instead of RLEN.
***** Begin Version 10 *****
2201 TFV 30-Mar-83
Add INQUIRE to FINDMARK in case FILE= is a dynamic concatentation.
2244 CDM 13-Dec-83
Eliminate AOBJN DO loop register indexes into large arrays
(arrays in .LARG.) during code generation. Create a new
STORECLS node, STRHAOBJN to copy the right hand half of the
AOBJN register into another register. Otherwise, the negative
left half of the AOBJN register will appear to be an invalid
section number. This is to catch the cases that the skeleton
optimizer (edit 2243) can not.
2376 TJK 18-Jun-84
Rewrite MARKIOLSCLS to handle E1 and E2 lists. Also
restructure, add companion routine MARKSUP, and have it set
IOLDYNFLG on all IOLSCLS nodes with a dynamic CONCATENATION
directly beneath them or directly beneath some lower-level
IOLSCLS node. Formerly only the top-level IOLSCLS node was
being marked.
2402 TJK 19-Jun-84
Add STORECLS case to ALCINTMP for STRHAOBJN nodes.
***** End V10 Development *****
***** End Revision History *****
)%
SWITCHES NOLIST;
REQUIRE FIRST.BLI;
REQUIRE TABLES.BLI;
SWITCHES LIST;
! The below is for putting through RUNOFF to get a PLM file.
!++
!.LITERAL
!--
FORWARD
ALCINREG(3),
ALCREL(3),
ALCRL1(2),
ALCA(3),
GETRGPR(2),
ALCLIBFN(3),
ALCARGS(3),
ALCVBOOL(3),
ALCCNB(3),
ALCCNT(2),
RGTOSAVE(1),
ALCNARG(2),
%1474% ALLCONCAT(3), ! Register allocation for concatenations
%1533% FINDMARK, ! Find the argument list for CHMRK./CHUNW. calls
%1533% GENMARK, ! Create the argument list for CHMRK./CHUNW. calls
%1533% MARKIOLSCLS(1), ! Mark the IOLSCLS node so it generates CHMRK./CHUNW.
! calls
%2376% MARKSUP(2), ! Companion routine to MARKIOLSCLS
ALCFNCALL(2),
ALCFNARGS(2),
ALCARRAY(2),
ALCCHARRAY(3),
ALCTPCNV(3),
ALCNEGNOT(3),
ALCSPECOP(3),
ALCSUBSTR(3),
ALCILF(3),
ALCINTMP(3),
ALCTVBOOL(3),
ALCTA(3),
USEARGREG(4),
ALCTARY(2),
ALCTVARR(2),
REGTOUSE(5),
RGTOU1(4),
SETTARGINREG(2),
SETTAC(2),
CLOBBNX(1),
STORAC;
EXTERNAL
AFREEREG, ! Routine is called whenever a free register is
! needed. If possible it selects a register that
! is not of future use within this basic block
! if not, it selects the register whose next use
! is furthest in the future
ALOCONST, ! Routine to turn on CNTOBEALCFLG
BLOCKBSYREGS, ! Bit pattern in which 0's indicate registers
! that the basic block allocator would like to
! preserve (1's are registers it doesnt care
! about)
C1H,
C1L,
CGERR,
CLOBBCOMEQV, ! Routine to assume that all COMMON or EQUIVALENCEd
! variables have been clobbered
CORMAN, ! Routine to allocate memory
DNEGCNST,
EXCHARGS,
FATLERR,
FREEPAIRS, ! Routine to determine the number of free
! even-odd register pairs indicated by a bit
! pattern in which a 0 represents a busy reg, 1
! represents a free register
GBSYREGS,
ISN,
MAKPR1,
MAKEPR,
%1474% NEWDVAR, ! Routine to generate a .Dnnnn compile-time-constant
%1474% ! character descriptor
NEWENTRY, ! Routine to generate an expression node
NOBBREGSLOAD, ! Global flag indicating that code for the nodes
! being processed will not always be executed
! and hence that the basic block allocator
! cannot asume the registers will have the right
! values
NXTTMP, ! Routine to allocate a .Qnnnn variable
PAIRMODE, ! Global flag indicating that the statement
! being processed requires some register pairs
REGCLOBB, ! Routine is called whenever an allocation is
! performed which will cause the contents of a
! register to be clobbered (if that register
! might have contained the value of some
! variable) it deletes any assumptions about the
! contents of the register
REGCONTAINING, ! Routine to determine whether given variable
! was left in a register by a previous statement
! and if so to return that register (if not
! returns -1)
RESNAME,
SAVEREG, ! Routine to remember that a given variable is
! in a given register
TBLSEARCH,
PEXPRNODE TREEPTR,
VARCLOBB; ! Routine is called whenever the value of a
! variable is modified (or might be modified).
! it deletes any assumptions about registers
! containing the value of that variable
!***************************************************************
! Local register allocation module. Includes two passes over an
! expression tree. On the complexity walk (i.e. the routine
! SETCOMPLEXITY and all the routines it calls), the nodes are
! rearranged to reduce the number of registers necessary to
! compute them, and the minimum number of regs necessary is
! saved in each node. At this time constants that can be used
! in immediate mode are recognized and space is allocated for
! all others. The constant part of an array address calculation
! is also added in to the instruction address at this time. The
! second walk (the routines ALCINREG and ALCINTMP) allocates
! registers and/or temporaries for each binary/unary operation
! to be performed - targeting the value of an expression to a
! particular register or temporary. The global TREEPTR is used
! in both these walks to point to the node of the expression
! tree being processed.
!***************************************************************
GLOBAL ROUTINE ALCINREG(RA,BSYREGS,FREGCT)=
%(***************************************************************************
PERFORM REGISTER ALLOCATION FOR SUBNODES OF THE NODE POINTED TO BY
THE GLOBAL "TREEPTR" SUCH THAT THE VALUE OF THAT NODE
WILL BE LEFT IN THE REG "RA"
THIS ROUTINE IS ONLY CALLED WHEN THE COMPLEXITY OF THE
NODE TO BE PROCESSED IS KNOWN TO BE LESS THAN THE NUMBER
OF REGISTERS AVAILABLE TO PROCESS IT
THE ARG "BSYREGS" HAS BITS 0-15 REPRESENTING THE 16 ACS
THE BIT FOR A GIVEN AC IS 1 IF THAT IS AVAILABLE FOR USE
***************************************************************************)%
BEGIN
LOCAL PEXPRNODE CNODE;
CASE .TREEPTR[OPRCLS] OF SET
%(****FOR A BOOLEAN OPERATOR***************)%
ALCVBOOL(.RA,.BSYREGS,.FREGCT);
%(****FOR A DATA REFERENCE - SHOULD ONLY GET HERE IN CERTAIN RARE CASES*******)%
BEGIN END;
%(****FOR RELATIONALS***************************************)%
ALCREL(.RA,.BSYREGS,.FREGCT);
%(*****FOR FUNCTION CALLS********************************)%
BEGIN
CNODE_.TREEPTR; ! SAVE ORIGINAL NODE
ALCFNCALL(.BSYREGS,.FREGCT); ! ALLOCATE DOWN
%1422% ! Character functions do not leave their result in a register
%1422% ! The first argument is the descriptor for the result
%1422% IF NOT .CNODE[ALCRETREGFLG] AND .CNODE[VALTYPE] NEQ CHARACTER
THEN
%(***IF CANNOT LEAVE THE VALUE SITTING IN RETREG (BECAUSE IT WILL
BE CLOBBERED BEFORE IT IS USED)***)%
BEGIN
! MUST NOT CONFLICT WITH A REG ALREADY USED IN BSYREGS TOO
IF NOT BITSET (.BLOCKBSYREGS AND .BSYREGS,.RA) ! IF NEED IT LATER
THEN
RA_AFREEREG(.BSYREGS,FALSE,.CNODE[DBLFLG]);
CNODE[STOREFLG]_1;
SETTARGINREG(.CNODE,.RA);
END;
END;
%(*****FOR ARITHMETIC EXPRESSIONS************************)%
ALCA(.RA,.BSYREGS,.FREGCT);
%(*****FOR TYPE CONVERSION******************************)%
ALCTPCNV(.RA,.BSYREGS,.FREGCT,FALSE);
%(*****FOR ARRAY REFERENCE**********)%
%1561% IF .TREEPTR[VALTYPE] NEQ CHARACTER
THEN ALCARRAY(.BSYREGS,.FREGCT)
%1561% ELSE ALCCHARRAY(NXTTMP(2),.BSYREGS,.FREGCT);
%(*****FOR COMMON SUBEXPRESSION*****)%
%(******SHOULD NOT WALK DOWN OVER THEM (ONLY GET HERE AT ALL IN RARE CASES)***)%
BEGIN END;
%(*****FOR NEG/NOT****************)%
ALCNEGNOT(.RA,.BSYREGS,.FREGCT);
%(*****FOR SPECIAL-CASE OPS INTRODUCED BY PHASE 2 SKELETON****)%
ALCSPECOP(.RA,.BSYREGS,.FREGCT);
CGERR(); !FIELD-REF, NOT IN RELEASE 1
%2244% BEGIN ! STORECLS
%2244%
%2244% ! Only STRHAOBJN may be walked at this point. All other
%2244% ! STORECLS nodes are created in the register allocation
%2244% ! walk and should not be here.
%2244%
%2244% IF .TREEPTR[OPERSP] EQL STRHAOBJN
%2244% THEN TREEPTR[TARGTAC] = TREEPTR[TARGADDR] = ! Get free reg
%2244% AFREEREG(.BSYREGS, FALSE, FALSE)
%2244% ELSE CGERR(); ! Internal Compiler Error
%2244%
%2244%
%2244% END; ! STORECLS
BEGIN END; !REGCONTENTS: SHOULD RARELY WALK DOWN HERE
CGERR(); !LABOP: SHOULD NEVER WALK DOWN ON ONE
CGERR(); !STATEMENT: SHOULD NOT OCCUR UNDER
! AN EXPRESSION
CGERR(); !IOLSCLS: SHOULD NOT OCCUR
%(****FOR AN IN-LINE-FN*****)%
ALCILF(.RA,.BSYREGS,.FREGCT);
%1431% %(****FOR SUBSTRING****)%
%1431% ALCSUBSTR(NXTTMP(2),.BSYREGS,.FREGCT);
%1474% %(****FOR CONCATENATION****)%
%1474% ALLCONCAT(NXTTMP(2), .BSYREGS, .FREGCT);
TES;
END; ! of ALCINREG
GLOBAL ROUTINE ALCREL(RA,BSYREGS,FREGCT)=
%(***************************************************************************
PERFORM REGISTER ALLOCATION FOR RELATIONALS
***************************************************************************)%
BEGIN
OWN PEXPRNODE ARGNODE;
LOCAL ADJREGCT;
ARGNODE_.TREEPTR[ARG1PTR];
%(***IF THE ARGS OF THIS REL ARE DOUBLE-WD (AND HENCE WE ARE GOING DOWN
FROM PROCESSING SINGLE-WD OPERATIONS TO PROCESSING DOUBLE-WD OPS)
WE MUST ADJUST THE COUNT OF AVAILABLE REGS BEFORE DETERMINING WHETHER
TO LEAVE THE VAL OF THE REL IN A REG***)%
IF .ARGNODE[DBLFLG]
THEN
BEGIN
OWN BSYRG1;
BSYRG1_DPBSYREGS(.BSYREGS);
ADJREGCT_ONESCOUNT(.BSYRG1);
END
ELSE ADJREGCT_.BSYREGS;
IF .TREEPTR[COMPLEXITY] LEQ .ADJREGCT
THEN
BEGIN
%(***COMPUTE THE VAL OF THE REL(TRUE OR FALSE) INTO THE REG RA***)%
SETTARGINREG(.TREEPTR,.RA);
%(***PERFORM REG ALLOCATION FOR THE COMPARISON***)%
ALCRL1(CLRBIT(.BSYREGS,.RA),.FREGCT-1)
END
ELSE
BEGIN
%(***COMPUTE THE VAL OF THE REL INTO A TEMPORARY***)%
%1274% TREEPTR[TARGTMEM] = NXTTMP(1); ! Get 1 word temp
%(***PERFORM REG ALLOCATION FOR THE COMPARISON***)%
ALCRL1(.BSYREGS,.FREGCT)
END;
END; ! of ALCREL
GLOBAL ROUTINE ALCRL1(BSYREGS,FREGCT)=
%(***************************************************************************
PERFORM REGISTER ALLOCATION FOR THE COMPARISON OPERATION OF A RELATIONAL
(BUT NOT FOR THE STORING OF THE VALUE OF THE RELATIONAL).
THIS ROUTINE IS CALLED BOTH FOR RELATIONALS USED ONLY FOR
CONTROL PURPOSES AND FOR RELATIONALS WHOSE VALUES ARE COMPUTED.
CALLED WITH THE ARGS
BSYREGS - HAS BIT SET FOR EACH REGISTER AVAILABLE FOR USE
BITS 0-15 REPRESENT THE 16 REGS
FREGCT - NUMBER OF REGISTERS AVAILABLE
CALLED WITH THE GLOBAL TREEPTR POINTING TO THE RELATIONAL NODE TO
BE ALLOCATED.
***************************************************************************)%
BEGIN
LOCAL RA;
LOCAL RGFORCM;
LOCAL PEXPRNODE ARG1NODE:ARG2NODE;
REGISTER PEXPRNODE CNODE;
CNODE_.TREEPTR;
ARG1NODE_.CNODE[ARG1PTR];
ARG2NODE_.CNODE[ARG2PTR];
%(***IF THE ARGS UNDER THIS RELATIONAL ARE DOUBLE-WORD, MUST ADJUST THE
SET OF AVAILABLE REGISTERS TO INCLUDE ONLY EVEN REGISTERS***)%
IF .ARG1NODE[DBLFLG]
THEN
BEGIN
BSYREGS_DPBSYREGS(.BSYREGS);
FREGCT_ONESCOUNT(.BSYREGS);
CNODE[COMPLEXITY]_.CNODE[COMPLEXITY]^(-1) + 1; !CHANGE COMPLEXITY OF THE
! RELAT TO BE IN TERMS OF PAIRS
END;
RGFORCM_AFREEREG(.BSYREGS,.CNODE[SAVREGFLG],.ARG1NODE[DBLFLG]);
%(****PERFORM REGISTER ALLOCATION FOR THE 2 ARGS, TO GET THE FIRST ONE
INTO THE 'REGFORCM' ("REGISTER FOR COMPARISON") IF POSSIBLE.*****)%
IF NOT (.CNODE[A1VALFLG] AND .CNODE[A2VALFLG])
THEN
ALCARGS(.RGFORCM,.BSYREGS,.FREGCT);
%(****IF POSSIBLE, DO THE COMPARISON IN WHATEVER REGISTER ARG1 WAS COMPUTED
INTO************)%
IF NOT .CNODE[ALCRETREGFLG] !IF HAVE NOT ALREADY DECIDED TO DO THE COMPAR IN FN-RET REG
THEN
BEGIN
%(***TEST WHETHER ARG1 WAS COMPUTED INTO A REG THAT CAN BE USED
FOR THE COMPARISON****)%
IF .ARG1NODE[OPRCLS] NEQ DATAOPR !ARG1 NOT A SYMBOL TAB ENTRY
AND .ARG1NODE[INREGFLG] !ARG1 WAS LEFT IN A REG
AND NOT .ARG1NODE[ALCRETREGFLG] ! OTHER THAN THE FN-RETURN REG
AND NOT .CNODE[A1IMMEDFLG] !ARG1 NOT RIGHT HALF OF AOBJN VAR
AND NOT (.CNODE[A1NEGFLG] AND .CNODE[A1VALFLG]) !ARG1 NOT A REGCONTENTS
! THAT HAS TO BE NEGATED WHEN
! PICKED UP
THEN
BEGIN
%(***IF CAN USE THE REG USED FOR COMPUTATION OF ARG1 FOR THE COMPAR**)%
CNODE[TARGAUX]_.ARG1NODE[TARGTAC];
CNODE[A1SAMEFLG]_1;
END
ELSE
%(***TEST WHETHER ARG1 IS A VARIABLE OR CONST WHOSE VAL WAS LEFT IN
A REG BY THE COMPUTATION OF A PREVIOUS STMNT**)%
IF (RA_REGCONTAINING(.ARG1NODE)) GEQ 0 !IF VAL OF ARG1 WAS LEFT IN A REG
AND .CNODE[A1NGNTFLGS] EQL 0 ! AND WE DONT NEED TO NEGATE
! OR COMPLEMENT IT
THEN
BEGIN
CNODE[TARGAUX]_.RA; !USE THE REG CONTAINING ARG1 FOR THE COMPAR
CNODE[A1SAMEFLG]_1; !DONT RELOAD THE REG
END
ELSE
%(***IF ARG1 IS NOT IN A REG THAT CAN BE USED FOR THE COMPAR, USE
SOME FREE REG****)%
BEGIN
RGFORCM_REGTOUSE(.CNODE,.ARG1NODE,.ARG2NODE,.RGFORCM,.BSYREGS);
CNODE[TARGAUX]_.RGFORCM;
REGCLOBB(.RGFORCM); !THE PREVIOUS CONTENTS OF THE REG USED
! WILL BE CLOBBERED. ADJUST BASIC-BLOCK
! REG ALLOC TABLE FOR THIS
IF .ARG1NODE[DBLFLG] !IF THE VAL BEING LOADED IS DOUBLE-WD
THEN ! THE CONTENTS OF THE NEXT
REGCLOBB(.RGFORCM+1); ! REG WILL ALSO BE CLOBBERED
END;
END; !END OF BLOCK TO DECIDE ON REG FOR COMPAR IF FN-RETURN REG NOT USED
IF .CNODE[SAVREGFLG] !IF IT WILL BE USEFUL LATER TO HAVE ARG1
! LEFT IN A REG
THEN
BEGIN
ARG1NODE_.CNODE[ARG1PTR];
IF .ARG1NODE[OPRCLS] EQL DATAOPR !BE SURE THAT ARG1 IS STILL A VAR
! (IT MIGHT NOW BE A REGCONTENTS)
AND .CNODE[A1NGNTFLGS] EQL 0 !AND ARG1 WAS NOT PICKED UP BY "MOVN"
THEN SAVEREG(.CNODE[TARGAUX], !REMEMBER THAT REG USED FOR COMPAR
.ARG1NODE,0,.CNODE[SONNXTUSE]); ! CONTAINS VAR ARG1
END;
END; ! of ALCRL1
GLOBAL ROUTINE ALCA(RA,BSYREGS,FREGCT)=
%(***************************************************************************
PERFORM REGISTER ALLOCATION FOR A BINARY NODE POINTED TO
BY THE GLOBAL TREEPTR
CALLED WITH THE ARGS
RA - REGISTER INTO WHICH THE 1ST ARG TO BE "COMPUTED
INTO THE RESULT" SHOULD BE MOVED
BSYREGS - BITS 0-15 OF THIS WD REPRESENT THE 16 REGS,
A BIT IS 1 IFF THE CORRESP REG IS AVAIL FOR USE
FREGCT - NUMBER OF FREE REGISTERS AVAILABLE
***************************************************************************)%
BEGIN
REGISTER
PEXPRNODE CNODE,
T;
OWN
PEXPRNODE ARG1NODE,
RB, ! REG IN WHICH VAL OF SON WAS LEFT
TEMPFLG; ! TO GET BETTER CODE
CNODE_.TREEPTR;
! IF THIS OPERATION CLOBBERS THE REGISTER FOLLOWING THE ONE ON
! WHICH IT IS PERFORMED, MUST BE SURE TO NOT
! PERFORM IT ON A REG PRECEEDING A REG WHOSE VAL MUST BE PRESERVED
IF CLOBBNX(.CNODE) THEN RA = GETRGPR(.RA,.BSYREGS);
IF USEFNCALL(CNODE) AND (.CNODE[ARG1PTR] EQL .CNODE[ARG2PTR])
! IF THIS OPERATION IS ONE WHICH WILL BE PERFORMED BY A LIBRARY FN,
! AND THE 2 ARGS ARE IDENTICAL, THEN THE 2ND ARG
! MUST BE COMPUTED INTO A MEMORY LOC.
! IF SO, GO PERFORM THE REGISTER ALLICATION FOR THE ARGS OF THIS NODE.
THEN ALCLIBFN(.RA,.BSYREGS,.FREGCT)
ELSE IF NOT ( .TREEPTR[A1VALFLG] AND .TREEPTR[A2VALFLG])
! UNLESS BOTH ARGS ARE VARIABLES OR COMMON SUBEXPRESSIONS, GO
! PERFORM REGISTER ALLOCATION FOR THEM, COMPUTING ARG1 INTO RA
! IF POSSIBLE
THEN IF .TREEPTR[OPERATOR] EQL CMPLXFNOP !FOR IN LINE CMPLX FN
THEN
BEGIN ! ALLOCATE ARGS IN SINGLE WORD MODE
T_SPBSYREGS(.BSYREGS);
ALCARGS(.RA,.T,ONESCOUNT(.T));
END !ALLOCATE ARGS IN SINGLE WORD MODE
ELSE ALCARGS(.RA,.BSYREGS,.FREGCT); !OTHERWISE NORMAL
![1145] If ARG1 is being computed only to memory, cannot also
![1145] be in the same AC to be used for this node.
%[1145]% ARG1NODE_.CNODE[ARG1PTR];
%[1145]% IF .ARG1NODE[MEMCMPFLG] AND NOT .ARG1NODE[OPTOBOTHFLG]
%[1145]% THEN CNODE[A1SAMEFLG]_0;
%(***IF HAVE ALREADY DETERMINED THAT CNODE SHOULD BE COMPUTED IN THE FN-RETURN REG,
ARE DONE WITH CNODE*****)%
IF .CNODE[ALCRETREGFLG] THEN RETURN;
%[1145]%
%(***IF ARG1 WAS LEFT IN A REG THAT CAN BE USED FOR THE COMPUTATION OF CNODE,
WE WANT TO USE THAT REG.
*******)%
TEMPFLG_ (NOT .CNODE[A1VALFLG]) AND (.ARG1NODE[INREGFLG]) AND (NOT .ARG1NODE[ALCRETREGFLG]);
RB_IF .TEMPFLG THEN .ARG1NODE[TARGTAC]
ELSE REGCONTAINING(.ARG1NODE);
IF .RB GEQ 0 !IF ARG1 STILL IN A REG...
THEN
IF(CLOBBNX(.CNODE) AND (NOT NXREGFREE(.BSYREGS,.RB)))
THEN RB_-1 !NEXT REG WOULD BE CLOBBERED, SO GET OUT
ELSE
IF NOT BITSET(.BSYREGS,.RB)
THEN RB_-1 !CANNOT USE RB FOR CNODE, SO GET OUT
ELSE
IF (.TEMPFLG OR (.CNODE[A1NGNTFLGS] EQL 0))
THEN !ALL IS OK!
BEGIN
RA_.RB; !THIS IS THE REG WE WANT
CNODE[A1SAMEFLG]_1;
END
ELSE RB_-1;
! IF REGISTER FOR ARG1 IS NO GOOD FOR CNODE, GET ANOTHER REGISTER.
IF .RB LSS 0
THEN RA_REGTOUSE(.CNODE,.ARG1NODE,.CNODE[ARG2PTR],.RA,.BSYREGS);
%(****SET UP THE TARGET FIELD OF CNODE***)%
SETTARGINREG(.CNODE,.RA);
END; ! of ALCA
GLOBAL ROUTINE GETRGPR(RA,BSYREGS)=
%(***************************************************************************
ROUTINE TO RETURN THE NEXT AVAILABLE REGISTER SUCH THAT THE REGISTER FOLLOWIN
THAT REGISTER IS ALSO AVAILABLE.
USED FOR REGISTER ALLOCATION FOR OPERATIONS SUCH AS INTEGER DIVIDE,
FIX, AND FLOAT WHICH CLOBBER THE REGISTER FOLLOWING THE REGISTER IN WHICH
THE OPERATION IS PERFORMED.
CALLED WITH THE ARG "RA" SET TO THE REG TO TRY FIRST, THE ARG "BSYREGS"
SET TO INDICATE WHICH REGS ARE FREE
***************************************************************************)%
BEGIN
IF BITSET(.BSYREGS,.RA+1) !IF THE REG AFTER RA IS FREE, USE RA
THEN RETURN .RA
ELSE
RETURN AFREEREG(DPBSYREGS(.BSYREGS),FALSE,TRUE) !OTHERWISE GET AN EVEN-ODD REGISTER PAIR
END; ! of GETRGPR
GLOBAL ROUTINE ALCLIBFN(RA,BSYREGS,FREGCT)=
%(****************************************************************************
TO PERFORM REGISTER ALLOCATION FOR THE ARGS OF AN ARITHMETIC OPERATION THAT IS PERFORMED
BY A LIBRARY FUNCTION. (THESE INCLUDE EXPONENTIATION).
FOR SUCH OPERATIONS THE SECOND ARGUMENT SHOULD NEVER BE LEFT IN A
REGISTER.
CALLED WITH THE GLOBAL TREEPTR POINTING TO THE ARITHMETIC NODE WHOSE ARGS
ARE TO BE PROCESSED.
****************************************************************************)%
BEGIN
LOCAL PEXPRNODE CNODE:ARG2NODE;
CNODE_.TREEPTR;
ARG2NODE_.CNODE[ARG2PTR];
%(***IF ARG2 IS A COMMON SUBEXPRESSION THAT WAS LEFT IN A REGISTER,
IT MUST BE STORED IN A TEMPORARY BEFORE CALLING THE FUNCTION.
****)%
IF .CNODE[A2VALFLG]
THEN
BEGIN
IF .ARG2NODE[OPRCLS] EQL CMNSUB
THEN
BEGIN
IF .ARG2NODE[INREGFLG] AND NOT .ARG2NODE[STOREFLG]
THEN
BEGIN
ARG2NODE[STOREFLG]_1;
%1274% ! Get 1 or 2 word temp based on DBLFLG
%1274% ARG2NODE[TARGTMEM] =
%1274% IF .ARG2NODE[DBLFLG]
%1274% THEN NXTTMP(2)
%1274% ELSE NXTTMP(1);
END
END
END
%(***IF ARG2 IS AN EXPRESSION WHICH MUST BE EVALUATED, EVALUATE IT INTO A TEMPORARY.
ALWAYS EVALUATE ARG2 BEFORE ARG1****)%
ELSE
BEGIN
CNODE[RVRSFLG]_1;
TREEPTR_.ARG2NODE;
%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);
END;
%(***PERFORM REGISTER ALLOCATION TO GET ARG1 INTO RA***)%
IF NOT .CNODE[A1VALFLG]
THEN
BEGIN
TREEPTR_.CNODE[ARG1PTR];
ALCINREG(.RA,.BSYREGS,.FREGCT);
END;
END; ! of ALCLIBFN
GLOBAL ROUTINE ALCARGS(RA,BSYREGS,FREGCT)=
%(***************************************************************************
PERFORM REGISTER ALLOCATION FOR THE 2 ARGS OF A BINARY NODE POINTED TO
BY THE GLOBAL "TREEPTR".
CALLED WITH THE ARGS
RA - REGISTER INTO WHICH THE 1ST ARG TO BE "COMPUTED
INTO THE RESULT" SHOULD BE MOVED
BSYREGS - BITS 0-15 OF THIS WD REPRESENT THE 16 REGS,
A BIT IS 1 IFF THE CORRESP REG IS AVAIL FOR USE
FREGCT - NUMBER OF FREE REGISTERS AVAILABLE
***************************************************************************)%
BEGIN
OWN BSYRG1,FRGCT1;
REGISTER PEXPRNODE CNODE:ARG1NODE:ARG2NODE;
LOCAL RB;
OWN RSV; !REG THAT MUST BE PRESERVED BECAUSE IT HOLDS THE
! VAL OF THE ARG THAT WAS COMPUTED FIRST
OWN FREERGPAIRS; !NUMBER OF FREE REGISTER PAIRS
OWN PEXPRNODE ARGCOMP1ST; !ARG WHOSE VAL IS COMPUTED 1ST
OWN PEXPRNODE ARGCOMP2ND; !ARG WHOSE VAL IS COMPUTED 2ND
OWN PAIRPROBLEM; !LOCAL FLAG INDICATING THAT MAY RUN OUT OF ADJACENT
! REG PAIRS WHILE COMPUTING THE SUBNODE THAT
! IS COMPUTED 2ND - HENCE MUST ALLOC THE 1ST SUBNODE
! TO RESIDE IN A TEMPORARY
CNODE_.TREEPTR;
ARG1NODE_.CNODE[ARG1PTR];
ARG2NODE_.CNODE[ARG2PTR];
IF .CNODE[A2VALFLG]
THEN
%(***IF ARG2 NEEDS NO EVALUATION, SIMPLY EVAL ARG1 INTO RA***)%
BEGIN
TREEPTR_.ARG1NODE;
ALCINREG(.RA,.BSYREGS,.FREGCT);
RETURN;
END;
IF .CNODE[A1VALFLG]
THEN
%(***IF ARG1 NEEDS NO EVALUATION, EVALUATE ARG2 INTO ANY REG EXCEPT RA (OR INTO A TMP)***)%
BEGIN
TREEPTR_.ARG2NODE;
IF .CNODE[COMPLEXITY] LEQ .FREGCT
THEN
BEGIN
IF .FREGCT EQL 1 !IF RA IS THE ONLY AC LEFT IN BSYREGS
!(WHICH MAY HAPPEN IF ARG2 DOESNT REALLY NEED AN AC-
!EG IF ITS A FN CALL, AN ARRAY REF WITH CONSTANT SS, ETC)
THEN !DONT TRY TO GET ANOTHER AC FOR ARG2
ALCINREG(.RA,.BSYREGS,.FREGCT)
ELSE
%[757]% BEGIN
%[757]% ALCINREG(AFREEREG(CLRBIT(.BSYREGS,.RA),FALSE,.ARG2NODE[DBLFLG]),.BSYREGS,.FREGCT);
%[757]%
%[757]% %(***** NOW IF THIS NODE PERFORMS AN OPERATION WHICH CLOBBERS
THE NEXT REGISTER AFTER THE CURRENT ONE, AND THERE IS
ONLY ONE REGISTER PAIR LEFT, AND THE SON HAS USED ONE OF
THE REGS IN THAT PAIR, MOVE THE SON TO A TEMP *****)%
%[757]% IF CLOBBNX(.CNODE)
%[757]% THEN
%[757]% IF FREEPAIRS(.BSYREGS) EQL 1
%[757]% THEN
%[757]% IF .ARG2NODE[INREGFLG]
%[757]% THEN
%[757]% IF .ARG2NODE[TARGTAC] EQL .RA OR
%[757]% .ARG2NODE[TARGTAC] EQL .RA+1
%[757]% THEN
%[757]% CNODE[ARG2PTR] _ STORAC(.ARG2NODE,.BSYREGS)
%[757]% END
END
%1274% ELSE IF .TREEPTR[DBLFLG] ! Get 1 or 2 word temp based on DBLFLG
%1274% THEN ALCINTMP(NXTTMP(2),.BSYREGS,.FREGCT)
%1274% ELSE ALCINTMP(NXTTMP(1),.BSYREGS,.FREGCT);
RETURN;
END;
%(***IF ARG1 IS LEFT IN THE FN-RETURN REGISTER AND THE PARENT NODE IS NOT (PRESUMABLY
BECAUSE THERE IS ANOTHER FN CALL THAT WOULD CLOBBER IT) THEN
IF ARG2 IS NOT LEFT IN THE FN RETURN REG AND IT IS POSSIBLE TO
EXCHANGE THE 2 ARGS, DO SO***)%
IF .ARG1NODE[ALCRETREGFLG] AND (NOT .ARG2NODE[ALCRETREGFLG]) AND (NOT .CNODE[ALCRETREGFLG])
THEN
BEGIN
IF EXCHARGS(.CNODE)
THEN
BEGIN
%(***IF HAVE EXCHANGED THE ARGS, MUST COMPLEMENT THE BIT THAT
INDICATES WHICH TO EVALUATE FIRST***)%
CNODE[RVRSFLG]_NOT .CNODE[RVRSFLG];
%(***MUST RESET THE LOCAL VARS ARG1NODE AND ARG2NODE***)%
ARG1NODE_.CNODE[ARG1PTR];
ARG2NODE_.CNODE[ARG2PTR];
END
END;
%(****IF THE STATEMENT BEING PROCESSED INCLUDES SUBEXPRESSIONS THAT
REQUIRE REG PAIRS, AND WE ARE NOT PRESENTLY ALLOCATING IN DP MODE (IE
IN MODE WHERE "FREGCT" INDICATES NUMBER OF PAIRS AVAILABLE) - MUST
TAKE PRECAUTIONS NOT TO RUN OUT OF PAIRS
******)%
IF .PAIRMODE AND NOT .ARG1NODE[DBLFLG] !(FOR RELATIONALS, CNODE WILL NOT HAVE "DBLFLG"
! EVEN THOUGH THE ARGS ARE DP AND WE ARE NOW IN DP MODE
! HENCE WE MUST LOOK AT DBLFLG ON THE ARG TO SEE IF IN DP MODE)
THEN
BEGIN
FREERGPAIRS_FREEPAIRS(.BSYREGS); !NUMBER OF PAIRS LEFT
IF .CNODE[RVRSFLG] !IF ARG2 IS COMPUTED BEFORE ARG1
THEN (ARGCOMP1ST_.ARG2NODE; ARGCOMP2ND_.ARG1NODE)
ELSE (ARGCOMP1ST_.ARG1NODE; ARGCOMP2ND_.ARG2NODE);
IF .ARGCOMP2ND[COMPLEXITY] GEQ 2 !IF THE ARG THAT WILL BE EVALUATED 2ND
! REQUIRES 2 OR MORE REGS TO EVALUATE
! MUST ASSUME THAT IT NEEDS A PAIR
AND .FREERGPAIRS LSS 2 ! AND IF THERE ARE NOT 2 PAIRS LEFT
AND NOT .ARGCOMP1ST[ALCRETREGFLG] !AND THE ARG COMPUTED 1ST WONT
! BE LEFT IN THE FN-RET REG
THEN PAIRPROBLEM_TRUE !MUST TAKE SPECIAL ACTION TO ASSURE THAT
! A REG FROM THE LAST PAIR IS NOT USED TO HOLD THE 1ST ARG
! WHILE THE 2ND ARG IS BEING COMPUTED
ELSE PAIRPROBLEM_FALSE
END
ELSE
PAIRPROBLEM_FALSE;
!FORGET WHAT LIVES IN REGS 0 AND 1 IF A FUNCTION
! CALL OCCURS ON THE SIDE OF THE TREE TO BE
! ALLOCATED LAST. THIS HELPS TO GET GOOD CODE
! FOR COS(X)*A(I) WHERE I IS IN 0 OR 1
IF .CNODE[FNCALLSFLG] AND
(IF .CNODE[RVRSFLG] THEN .ARG1NODE[FNCALLSFLG]
ELSE .ARG2NODE[FNCALLSFLG])
THEN BEGIN REGCLOBB(0); REGCLOBB(1) END;
%(****IF BOTH SUBNODES REQUIRE COMPUTATION, PERFORM REGISTER ALLOCATION FOR THE
2 COMPUTATIONS.
IF THE FIRST SUBNODE COMPUTED HAS ITS VAL (OR A PTR
TO IT VAL) LEFT IN A REGISTER, THEN THAT
REGISTER CANNOT BE USED IN COMPUTATION OF THE OTHER SUBNODE.
(NOTE THAT EVEN IF A SUBNODE HAS BEEN DESIGNATED AS COMPUTED INTO "FN
RETURN REG", MUST STILL DO ALLOCATION FOR SOME OF ITS SUBNODES)
*************)%
IF .CNODE[COMPLEXITY] LEQ .FREGCT AND NOT .PAIRPROBLEM
THEN
%(*****IF VAL OF THIS NODE CAN BE COMPUTED ENTIRELY IN REGS****)%
BEGIN
IF .CNODE[RVRSFLG]
THEN
%(***IF 2ND ARG IS EVALUATED BEFORE 1ST***)%
BEGIN
%(***IN COMPUTING ARG2 - DO NOT WANT TO LEAVE THEVAL OF ARG2
IN RA IF CAN AVOID IT, SINCE WILL WANT TO COMPUTE
THE 1ST ARG INTO RA SO THAT CAN THEN COMPUTE THE
PARENT THERE***)%
BSYRG1_CLRBIT(.BSYREGS,.RA);
!IF THIS WAS THE LAST AVAILABLE REGISTER, THEN
! USE IT ANYWAY. THIS PREVENTS A CALL TO AFREEREG
! WITH BSYRG1=0 WHICH CAN NOT BE HANDLED!
IF .BSYRG1 EQL 0 THEN BSYRG1_.BSYREGS;
%(***ALSO, IF ARG1 IS AN OPERATION THAT CLOBBERS THE REG
FOLLOWING THE REG USED, THEN IF POSSIBLE DONT
USE THE REG AFTER RA***)%
IF CLOBBNX(.ARG1NODE)
THEN
BEGIN
IF .FREGCT GTR 2
THEN BSYRG1_CLRBIT(.BSYRG1,.RA+1);
END;
%(***NOW ALLOCATE A REGISTER FOR ARG2 TO BE COMPUTED
INTO - MUST BE CAREFUL NOT TO ASK FOR A REG
UNLESS WE REALLY NEED ONE, SINCE THERE MIGHT
NOT BE ANY LEFT. THEREFORE, DON'T ALLOCATE
A REGISTER IF ARG2 IS GOING INTO THE FUNCTION
RETURN REGISTER, OR IF THE COMPLEXITY OF ARG2
IS ZERO***)%
IF (.ARG2NODE[ALCRETREGFLG] AND
.ARG2NODE[OPRCLS] NEQ RELATIONAL)
OR (.ARG2NODE[COMPLEXITY] EQL 0)
THEN %DON'T NEED A REG, SO USE RA%
RB_.RA
ELSE %GO GET A NEW REGISTER%
RB_AFREEREG(.BSYRG1,FALSE,.ARG2NODE[DBLFLG]);
%(***PERFORM REGISTER ALLOC FOR COMPUTATION OF ARG2- TO LEAVE
THE RESULT IN RB (WHERE RB NEQ RA)***)%
TREEPTR_.ARG2NODE;
ALCINREG(.RB,.BSYREGS,.FREGCT);
%(***IN THE COMPUTATION OF ARG1, CANNOT USE THE REG WHICH
MUST BE PRESERVED TO PRESERVE THE VAL OF ARG2***)%
RSV_RGTOSAVE(.ARG2NODE);
IF .RSV NEQ -1
THEN
%(***IF SOME REG MUST BE PRESERVED TO PRESERVE THE VAL OF ARG2,
TAKE THAT REG OUT OF THE SET OF AVAILABLE REGS***)%
(BSYREGS_CLRBIT(.BSYREGS,.RSV); FREGCT_.FREGCT-1);
%(***WHEN COMPUTING ARG1, CANNOT USE THE REG THAT WE
NEED TO SAVE TO PRESERVE THE VALUE OF ARG2.
IF WE'RE ABOUT TO, GO GET ANOTHER REGISTER
TO USE, AFTER FIRST MAKIING SURE THAT WE
REALLY NEED IT (MIGHT BE LOW ON REGS)***)%
IF %WE'RE ABOUT TO USE RSV% (.RA EQL .RSV)
AND NOT %THIS COMPUTATION CAN DO WITHOUT A REG%
((.ARG1NODE[ALCRETREGFLG] AND
.ARG1NODE[OPRCLS] NEQ RELATIONAL)
OR .ARG1NODE[COMPLEXITY] EQL 0)
THEN %ALLOCATE A DIFFERENT REGISTER%
RA_AFREEREG(.BSYREGS,FALSE,.ARG1NODE[DBLFLG]);
%(***PERFORM REGISTER ALLOCATION FOR ARG1***)%
TREEPTR_.ARG1NODE;
ALCINREG(.RA,.BSYREGS,.FREGCT);
END
ELSE
%(****IF 1ST ARG IS EVALUATED BEFORE 2ND****)%
BEGIN
TREEPTR_.ARG1NODE;
ALCINREG(.RA,.BSYREGS,.FREGCT);
%(***DETERMINE WHICH (IF ANY) REG MUST BE SAVED WHILE COMPUTING
ARG2 BECAUSE IT HOLDS EITHER THE VAL OR A PTR TO THE
VAL OF ARG1****)%
RSV_RGTOSAVE(.ARG1NODE);
IF .RSV NEQ -1
THEN
BEGIN
BSYRG1_CLRBIT(.BSYREGS,.RSV);
FRGCT1_.FREGCT-1;
END
ELSE
BEGIN
BSYRG1_.BSYREGS;
FRGCT1_.FREGCT;
END;
TREEPTR_.ARG2NODE;
RB_CLRBIT(.BSYRG1,.RA); !PREFER NOT TO USE RA
! TO HOLD ARG2 - SINCE THEN WONT BE
! ABLE TO USE IT FOR THE PARENT
IF .RB EQL 0 !HOWEVER IF IT WAS THE ONLY REG AVAILABLE
THEN RB_.BSYRG1; ! THEN MUST USE IT
%(***ALLOCATE A REG AS TARGET OF ARG2'S CALCULATION,
AFTER USUAL CHECKS TO MAKE SURE WE REALLY
NEED IT***)%
IF (.ARG2NODE[ALCRETREGFLG] AND
.ARG2NODE[OPRCLS] NEQ RELATIONAL)
OR (.ARG2NODE[COMPLEXITY] EQL 0)
THEN %USE THE OLD REG%
RB_.RA
ELSE
RB_AFREEREG(.RB,FALSE,.ARG2NODE[DBLFLG]);
ALCINREG(.RB,.BSYRG1,.FRGCT1);
END;
END
ELSE
%(*****IF VAL OF THIS NODE CANNOT BE COMPUTED ENTIRELY IN REGS****)%
BEGIN
IF .CNODE[RVRSFLG]
THEN
%(***IF ARG2 IS EVALUATED BEFORE ARG1***)%
BEGIN
TREEPTR_.ARG2NODE;
%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);
TREEPTR_.ARG1NODE;
ALCINREG(.RA,.BSYREGS,.FREGCT);
END
ELSE
%(***IF ARG1 IS EVALUATED BEFORE ARG2***)%
BEGIN
TREEPTR_.ARG1NODE;
IF .ARG2NODE[COMPLEXITY] GTR (.FREGCT-1)
OR .PAIRPROBLEM
THEN
%(***IF WILL NEED TO USE RA IN COMPUTING ARG2***)%
BEGIN
%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);
TREEPTR_.ARG2NODE;
IF .ARG2NODE[COMPLEXITY] EQL .FREGCT
THEN
ALCINREG(AFREEREG(CLRBIT(.BSYREGS,.RA),FALSE,.ARG2NODE[DBLFLG]),.BSYREGS,.FREGCT)
%1274% ELSE IF .TREEPTR[DBLFLG] ! Get 1 or 2 word temp based on DBLFLG
%1274% THEN ALCINTMP(NXTTMP(2),.BSYREGS,.FREGCT)
%1274% ELSE ALCINTMP(NXTTMP(1),.BSYREGS,.FREGCT);
END
ELSE
%(***IF CAN COMPUTE ARG2 WITHOUT CLOBBERRING RA***)%
BEGIN
ALCINREG(.RA,.BSYREGS,.FREGCT);
%(***DETERMINE WHICH (IF ANY) REG MUST BE SAVED WHILE COMPUTING
ARG2 BECAUSE IT HOLDS EITHER THE VAL OR A PTR TO THE
VAL OF ARG1****)%
RSV_RGTOSAVE(.ARG1NODE);
IF .RSV NEQ -1
THEN
BEGIN
BSYRG1_CLRBIT(.BSYREGS,.RSV);
FRGCT1_.FREGCT-1;
END
ELSE
BEGIN
BSYRG1_.BSYREGS;
FRGCT1_.FREGCT;
END;
TREEPTR_.ARG2NODE;
ALCINREG(AFREEREG(CLRBIT(.BSYRG1,.RA),FALSE,.ARG2NODE[DBLFLG]),.BSYRG1,.FRGCT1);
END;
END;
END;
END; ! of ALCARGS
GLOBAL ROUTINE ALCVBOOL(RA,BSYREGS,FREGCT)=
%(***************************************************************************
TO PERFORM REGISTER ALLOCATION TO COMPUTE THE VALUE OF A BOOLEAN.
***************************************************************************)%
BEGIN
OWN PEXPRNODE ARG2NODE;
LOCAL PEXPRNODE CNODE:ARG1NODE;
LOCAL RV; !REG INTO WHICH THE VAL OF THE BOOLEAN
! WILL BE CALCULATED.
%(****EQV AND XOR ARE HANDLED LIKE ARITHMETICS***)%
IF .TREEPTR[BOOLCLS] NEQ ANDORCLS
THEN ALCA(.RA,.BSYREGS,.FREGCT)
ELSE
%(***IF THIS EXPRESSION HAS VALTYPE "CONTROL" (BOTH ARGS ARE RELATIONALS
OR BOOLEANS OF TYPE CONTROL), WILL ONLY COMPUTE A VAL FOR THE
TOP LEVEL BOOLEAN NODE*****)%
IF .TREEPTR[VALTYPE] EQL CONTROL
THEN ALCCNB(.RA,.BSYREGS,.FREGCT)
ELSE
%(***IF ONE OF THE ARGS UNDER THIS NODE HAS TYPE CONTROL AND THE OTHER DOES NOT,
THEN ARG2 WILL BE THE CONTROL ARG (COMPLEXITY HAS SET THIS UP)
IF NEITHER ARG HAS TYPE CONTROL, WILL HANDLE LIKE ARITHMETIC*****)%
IF ( ARG2NODE_.TREEPTR[ARG2PTR]; .ARG2NODE[VALTYPE] NEQ CONTROL)
THEN ALCA(.RA,.BSYREGS,.FREGCT)
ELSE
%(****IF ARG1 IS A MASK (IE A NON-CONTROL EXPRESSION) AND ARG2 IS A CONTROL EXPR*****)%
%(***IF HAVE ALREADY DETERMINED THAT VAL IS TO BE COMPUTED TO FN-RET-REG, THEN
SIMPLY ALLOCATE THE 2 ARGS****)%
IF .TREEPTR[ALCRETREGFLG] THEN ALCARGS(.RA,.BSYREGS,.FREGCT)
ELSE
%(****IF CANNOT COMPUTE THE WHOLE EXPRESSION ENTIRELY IN REGS, COMPUTE THE VAL
OF THE BOOLEAN IN A TEMPORARY****)%
%1274% IF .TREEPTR[COMPLEXITY] GTR .FREGCT THEN ALCTVBOOL(NXTTMP(1),.BSYREGS,.FREGCT) ! Get 1 word temp
ELSE
%(***FOR A BOOLEAN WHERE ARG2 IS OF TYPE CONTROL, ARG1 IS A MASK.
WILL COMPUTE ARG1 FIRST AND THEN USE THE REG CONTAINING ARG1 AS
THE REG FOR THE VAL OF THE BOOLEAN*****)%
BEGIN
CNODE_.TREEPTR;
ARG1NODE_.TREEPTR[ARG1PTR];
%(***IF ARG1 IS A LEAF OR A COMMON SUBEXPR, GET A REG FOR COMP
OF PARENT****)%
IF .CNODE[A1VALFLG] THEN
BEGIN
IF (RV_REGCONTAINING(.ARG1NODE)) GEQ 0 !IF ARG1 WAS LEFT IN A REG BY A PREV STMNT
AND .CNODE[A1NGNTFLGS] EQL 0
THEN
BEGIN
IF BITSET(.BSYREGS,.RV) !IF ITS OK TO CLOBBER RV WHILE
! PROCESSING THIS STMNT
THEN CNODE[A1SAMEFLG]_1 !DONT RELOAD IT
ELSE
RV_REGTOUSE(.CNODE,.ARG1NODE,.CNODE[ARG2PTR],.RA,.BSYREGS)
END
ELSE
RV_REGTOUSE(.CNODE,.ARG1NODE,.CNODE[ARG2PTR],.RA,.BSYREGS)
END
%(***OTHERWISE, USE THE REG INTO WHICH ARG1 WAS COMPUTED***)%
ELSE
BEGIN
TREEPTR_.ARG1NODE;
ALCINREG(.RA,.BSYREGS,.FREGCT);
IF .ARG1NODE[INREGFLG] AND NOT .ARG1NODE[ALCRETREGFLG]
THEN
BEGIN
RV_.ARG1NODE[TARGTAC];
CNODE[A1SAMEFLG]_1;
END
ELSE RV_REGTOUSE(.CNODE,.ARG1NODE,.CNODE[ARG2PTR],.RA,.BSYREGS);
END;
%(***PERFORM ALLOCATION FOR THE CONTROL ARG
DO NOT USE REG THAT HOLDS VAL OF PARENT IN COMP OF ARG***)%
TREEPTR_.CNODE[ARG2PTR];
ALCNARG(CLRBIT(.BSYREGS,.RV),.FREGCT-1);
SETTARGINREG(.CNODE,.RV);
END;
END; ! of ALCVBOOL
GLOBAL ROUTINE ALCCNB(RA,BSYREGS,FREGCT)=
%(***************************************************************************
PERFORM REGISTER ALLOCATION FOR A CONTROL-TYPE BOOLEAN
***************************************************************************)%
BEGIN
LOCAL SAVNOBBREGS; !TO SAVE THE VAL THAT "NOBBREGSLOAD" HAD ON ENTERING THIS ROUTINE
SAVNOBBREGS_.NOBBREGSLOAD;
NOBBREGSLOAD_TRUE; !SET FLAG TO TELL BB ALLOC THAT CODE NOT ALWAYS EXECUTED
IF .TREEPTR[ALCRETREGFLG]
THEN
BEGIN
ALCCNT(.BSYREGS,.FREGCT);
RETURN;
END;
IF .TREEPTR[COMPLEXITY] LEQ .FREGCT
THEN
%(***IF VAL CAN BE COMPUTED IN A REG***)%
BEGIN
SETTARGINREG(.TREEPTR,.RA);
ALCCNT(CLRBIT(.BSYREGS,.RA),.FREGCT-1)
END
ELSE
%(***IF NUMBER OF REGS NECESSARY TO COMPUTE VAL OF THIS NODE IS GREATER THAN NO AVAILABLE*)%
BEGIN
%1274% TREEPTR[TARGTMEM] = NXTTMP(1); ! Get 1 word temp
ALCCNT(.BSYREGS,.FREGCT);
END;
NOBBREGSLOAD_.SAVNOBBREGS; !RESTORE FLAG FOR CODE NOT ALWAYS EXECUTED
! TO ITS STATE UPON ENTRY TO THIS ROUTINE
END; ! of ALCCNB
GLOBAL ROUTINE ALCCNT(BSYREGS,FREGCT)=
%(***************************************************************************
ROUTINE TO PERFORM REGISTER ALLOCATION FOR A CONTROL-TYPE
BOOLEAN.
THE VALUES OF SUBNODES OF SUCH A NODE ARE NEVER ACTUALLY COMPUTED.
CALLED WITH THE GLOBAL "TREEPTR" POINTING TO THE NODE TO BE
PROCESSED, WITH THE ARG "BSYREGS" INDICATING WHICH REGS ARE
AVAILABLE.
***************************************************************************)%
BEGIN
LOCAL PEXPRNODE CNODE;
CNODE_.TREEPTR;
%(*********FOR THE 1ST ARG****************************)%
TREEPTR_.CNODE[ARG1PTR];
ALCNARG(.BSYREGS,.FREGCT);
%(*********FOR THE 2ND ARG************************)%
TREEPTR_.CNODE[ARG2PTR];
ALCNARG(.BSYREGS,.FREGCT);
END; ! of ALCCNT
GLOBAL ROUTINE RGTOSAVE(CNODE)=
%(***************************************************************************
ROUTINE TO DETERMINE WHICH REGISTER MUST BE PRESERVED SO THAT THE
VAL CORRESPONDING TO A GIVEN EXPRESSION NODE WILL BE PRESERVED.
IF THE EXPRESSION NODE IS AN ARRAYREF, THEN NEED TO PRESERVE THE REG
HOLDING AN INDEX INTO THE ARRAY, OTHERWISE MAY NEED TO PRESERVE
A REG HOLDING THE VALUE OF AN EXPRESSION.
THIS ROUTINE RETURNS THE REG TO BE PRESERVED (FOR A DOUBLE-PREC
NODE IT RETURNS THE EVEN REG OF THE EVEN-ODD PAIR TO BE PRESERVED),
-1 IF NO REG NEEDS TO BE PRESERVED.
***************************************************************************)%
BEGIN
MAP PEXPRNODE CNODE;
OWN SVAC;
IF .CNODE[OPRCLS] EQL DATAOPR OR .CNODE[OPRCLS] EQL CMNSUB
THEN
RETURN -1;
%(***IF THE VAL WAS LEFT IN THE FN RETURN REG, THEN HAVE NO
REGS FROM THE USUAL POOL TO PRESERVE***)%
IF .CNODE[ALCRETREGFLG] THEN RETURN -1;
!WE NEED TO CONSIDER THE CASE OF A TYPE CONVERSION
! NODE ABOVE AN ARRAY REFERENCE WHEN THE TYPE CONVERSION
! NODE ACQUIRES A TARGXF VALUE - TREAT IT JUST LIKE AN
! ARRAY REFERENCE NODE, AND RESTRUCTURE THIS ROUTINE.
! THE THREE CASES BELOW ARE:
! 1. WE HAVE A REAL TARGET (IN TARGTAC)
! 2. NO REGISTER IN USE AT ALL
! 3. TARGXF FIELD IN USE (ARRAY REF, TYPE CONVERSION,
! AND POSSIBLY OTHERS)
IF .CNODE[INREGFLG]
THEN RETURN .CNODE[TARGTAC]
ELSE IF .CNODE[TARGXF] EQL 0
THEN RETURN -1
ELSE
BEGIN
SVAC_.CNODE[TARGXF];
IF .CNODE[DBLFLG] !IF THE ARRAYREF WAS DOUBLE-PREC
THEN ! WILL NEED TO PRESERVE THE EVEN-ODD PAIR
SVAC_(.SVAC/2)*2; ! IF THE INDEX IS IN AN ODD REG
! (INSERTED 11-5-73 TO FIX BUG IN BB0402.FTP
! WITH -R*DP(I) WHEN R HAD BEEN
! LEFT IN A REG )
RETURN .SVAC
END
END; ! of RGTOSAVE
GLOBAL ROUTINE ALCNARG(BSYREGS,FREGCT)=
%(***************************************************************************
ROUTINE TO PERFORM REGISTER ALLOCATION FOR ONE OF THE ARGS OF
A CONTROL-TYPE BOOLEAN.
SUCH AN ARG CAN ONLY BE EITHER A RELATIONAL OR ANOTHER CONTROL-TYPE
BOOLEAN (BY DEFINITION).
THE VALUE OF SUCH AN ARG WILL NEVER BE EXPLICITLY COMPUTED, HENCE
"LOC OF VALUE" FIELD WILL ALWAYS BE LEFT EMPTY
***************************************************************************)%
BEGIN
LOCAL SAVNOBBREGS; ! SAVE NOBBREGSLOAD
IF .TREEPTR[OPRCLS] EQL RELATIONAL
THEN
%(*****IF THIS ARG IS A RELATIONAL******************)%
%(***PERFORM REGISTER ALLOCATION FOR THE COMPARISON***)%
ALCRL1(.BSYREGS,.FREGCT)
ELSE
IF .TREEPTR[OPRCLS] EQL BOOLEAN
THEN
%(*****IF THIS ARG IS A BOOLEAN************)%
BEGIN
SAVNOBBREGS_.NOBBREGSLOAD; ! SAVE CURRENT FLAG
NOBBREGSLOAD_TRUE; ! DON'T REMEMBER VALUES WHICH
! MAY NOT GET CALCULATED
ALCCNT(.BSYREGS,.FREGCT);
NOBBREGSLOAD_.SAVNOBBREGS;
END
ELSE
%(*****AN ARG OF A CONTROL-TYPE BOOLEAN CAN ONLY BE A RELATIONAL
OR A CONTROL-TYPE BOOLEAN (BY DEFINITION) *****)%
CGERR(6);
END; ! of ALCNARG
GLOBAL ROUTINE ALLCONCAT(TA,BSYREGS,FREGCT)=
BEGIN
!***************************************************************
! Perform register allocation for a character concatenation
! expression. They are function calls; the first argument is
! the descriptor for the result. The result is allocated in .Q
! space (CONCTF and CONCTM) or at run-time (CONCTV). The
! descriptor for the result is either a compile-time-constant
! descriptor (CONCTF) or a two word .Qnnnn variable (CONCTM and
! CONCTV). CONCTV nodes call FINDMARK to allocate an argument
! list for the calls to CHMRK./CHUNW.; the single argument is a
! one word .Qnnnn variable.
!***************************************************************
%1474% ! Written by TFV on 18-Feb-82
BIND GENLEN = TRUE; ! Generate both byte pointer and length for
! a .Dnnnn compile-time-constant character
! descriptor
REGISTER
ARGUMENTLIST ARGLIST,
PEXPRNODE CNODE, ! Pointer to the concatenation node
BASE DVAR, ! Pointer to the .Dnnnn variable for
! the result
BASE LEN; ! Length of the result
LOCAL
PEXPRNODE TYPCNODE; ! Type convert node for .Qnnnn variable
! for result of CONCTM and CONCTV nodes
CNODE = .TREEPTR;
IF .CNODE[OPERSP] EQL CONCTF OR .CNODE[OPERSP] EQL CONCTM
THEN
BEGIN ! Fixed or maximum length result
LEN = .CNODE[ARG1PTR]; ! Constant table entry for the
! length of the result
LEN = .LEN[CONST2]; ! Get the actual length
! Generate a compile-time-constant descriptor for the
! result.
DVAR = NEWDVAR(GENLEN);
! Allocate space for the result using a .Qnnnn variable
DVAR[IDADDR] = NXTTMP(CHWORDLEN(.LEN));
DVAR[IDCHLEN] = .LEN; ! Fill in the length
END; ! Fixed or maximum length result
! Fill in the first argument and the TARGADDR field with the
! pointer to the descriptor for the result.
ARGLIST = .CNODE[ARG2PTR]; ! Pointer to the argument list
IF .CNODE[OPERSP] EQL CONCTF
THEN
BEGIN ! Fixed length
! Use the .Dnnnn variable for the descriptor for the
! result
CNODE[TARGADDR] = ARGLIST[1,ARGNPTR] = .DVAR;
END ! Fixed length result
ELSE IF .CNODE[OPERSP] EQL CONCTM
THEN
BEGIN ! Known maximum length result
! Save the maximum length descriptor for the result in
! ARG1PTR of the node
CNODE[ARG1PTR] = .DVAR;
! Allocate a dummy type convert node for the first
! argument which is a two word .Qnnnn for the descriptor
! for the result. The .Dnnnn variable will be copied
! into it at run time.
NAME = EXPTAB; ! make an expression node
TYPCNODE = NEWENTRY();
TYPCNODE[OPRCLS] = TYPECNV; ! Type convert
TYPCNODE[OPERSP] = FROMCHAR; ! From CHARACTER
TYPCNODE[VALTYPE] = CHARACTER; ! To CHARACTER
TYPCNODE[NOCNVFLG] = TRUE; ! No actual conversion is done
TYPCNODE[ARG2PTR] = .TA; ! Pointer to .Qnnnn variable
TYPCNODE[A2VALFLG] = TRUE; ! It's a DATAOPR
TYPCNODE[TARGADDR] = .TA; ! The argument is the .Q var
! The argument list points to the type convert node
ARGLIST[1,ARGNPTR] = .TYPCNODE;
CNODE[TARGADDR] = .TA;
END ! Known maximum length result
ELSE IF .CNODE[OPERSP] EQL CONCTV
THEN
BEGIN ! Dynamic length result
! Allocate a dummy type convert node for the first
! argument which is a two word .Qnnnn for the descriptor
! for the result. The descriptor is generated at run
! time by a call to CONCD. whic calls CHALC%.
NAME = EXPTAB; ! make an expression node
TYPCNODE = NEWENTRY();
TYPCNODE[OPRCLS] = TYPECNV; ! Type convert
TYPCNODE[OPERSP] = FROMCHAR; ! From CHARACTER
TYPCNODE[VALTYPE] = CHARACTER; ! To CHARACTER
TYPCNODE[NOCNVFLG] = TRUE; ! No actual conversion is done
TYPCNODE[ARG2PTR] = .TA; ! Pointer to .Qnnnn variable
TYPCNODE[A2VALFLG] = TRUE; ! It's a DATAOPR
TYPCNODE[TARGADDR] = .TA; ! The argument is the .Q var
! The argument list points to the type convert node
ARGLIST[1,ARGNPTR] = .TYPCNODE;
CNODE[TARGADDR] = .TA;
FINDMARK(); ! Find or create the argument list for
! the calls to CHMRK./CHUNW.
END ! Dynamic length
ELSE CGERR();
ARGLIST[1,AVALFLG] = 1; ! Set the DATAOPR flag
! Allocate the arguments
TREEPTR = .ARGLIST;
ALCFNARGS(.BSYREGS, .FREGCT, .CNODE[DBLFLG]);
REGCLOBB(0); ! AC0 is clobbered
REGCLOBB(1); ! AC1 is clobbered
END; ! of ALLCONCAT
ROUTINE FINDMARK=
BEGIN
!***************************************************************
! Find or create the argument list for calls to CHMRK./CHUNW.
! for CONCTV nodes. TREEPTR points to the CONCTV node. The
! parent pointer is either a statement (CALL or I/O), a FNCALL
! node or an IOLSCLS node. GENMARK is called to create the
! argument list.
!***************************************************************
%1533% ! Written by TFV on 14-May-82
REGISTER
ARGUMENTLIST ARGL, ! Pointer to an argument list
BASE PNODE; ! Parent node
MAP
BASE TREEPTR; ! CONCTV node
PNODE = .TREEPTR[PARENT]; ! Get pointer to parent
IF .PNODE EQL 0 THEN CGERR(); ! Error if no parent
IF .PNODE[OPRCLS] EQL STATEMENT
THEN
BEGIN ! CALL or I/O statement
IF .PNODE[SRCID] EQL CALLID
THEN
BEGIN
ARGL = .PNODE[CALLIST]; ! Get the argument list
IF .ARGL[ARGMARK] EQL 0
THEN ARGL[ARGMARK] = GENMARK(); ! Create mark
END
ELSE IF (.PNODE[SRCID] GEQ READID AND
.PNODE[SRCID] LEQ REREDID) OR
.PNODE[SRCID] EQL CLOSID OR
.PNODE[SRCID] EQL OPENID OR
%2201% .PNODE[SRCID] EQL INQUID
THEN
BEGIN ! READ/WRITE, ENCODE/DECODE, REREAD, CLOSE/OPEN/INQUIRE
IF .PNODE[IOMARK] EQL 0
THEN PNODE[IOMARK] = GENMARK(); ! Create mark
END ! READ/WRITE, ENCODE/DECODE, REREAD, CLOSE/OPEN/INQUIRE
ELSE CGERR(); ! Unknown context is an error
END ! CALL or I/O statement
ELSE IF .PNODE[OPRCLS] EQL FNCALL
THEN
BEGIN ! Function call
ARGL = .PNODE[ARG2PTR]; ! Pointer to argument list
IF .ARGL[ARGMARK] EQL 0
THEN ARGL[ARGMARK] = GENMARK(); ! Create mark
END ! Function call
ELSE IF .PNODE[OPRCLS] EQL IOLSCLS
THEN
BEGIN ! IOLST. call
! Find the IOLSLCS node used for the IOLST. call and set
! the flag for dynamic concatenations under this node
MARKIOLSCLS(.PNODE);
PNODE = .PNODE[IOLSTATEMENT]; ! Pointer to the I/O statement
! If the I/O statement has END, ERR or IOSTAT specified,
! we need a mark to unwind all the dynamic
! concatenations under it if we get a run-time error.
IF .PNODE[IOEND] NEQ 0 OR
.PNODE[IOERR] NEQ 0 OR
.PNODE[IOIOSTAT] NEQ 0
THEN IF .PNODE[IOMARK] EQL 0
THEN PNODE[IOMARK] = GENMARK(); ! Create mark
! Now the mark for the IOLST. call
IF .PNODE[IOLMARK] EQL 0
THEN PNODE[IOLMARK] = GENMARK(); ! Create mark
END ! IOLST. call
ELSE CGERR(); ! Unknown context is an error
END; ! of FINDMARK
ROUTINE GENMARK=
BEGIN
!***************************************************************
! Generate the argument list for calls to CHMRK./CHUNW. The
! single argument is a one word .Qnnnn variable to hold the
! mark.
!***************************************************************
%1533% ! Written by TFV on 14-May-82
REGISTER
ARGUMENTLIST ARGLST; ! The argument list
NAME<LEFT> = ARGLSTSIZE(1); ! Setup size of node for CORMAN
ARGLST = CORMAN(); ! Create the node
ARGLST[ARGCOUNT] = 1; ! It has one argument
! Create a one word .Qnnnn variable
ARGLST[1,ARGNPTR] = NXTTMP(1);
ARGLST[1,AVALFLG] = 1; ! It's a DATAOPR
RETURN .ARGLST;
END; ! of GENMARK
GLOBAL ROUTINE MARKIOLSCLS(CNODE) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine is passed a pointer to an IOLSCLS node (CNODE)
! which is the parent of a dynamic concatenation (i.e., a CONCTV
! node). It sets the IOLDYNFLG flag on each IOLSCLS node which
! is an ancestor of CNODE, including CNODE itself. The flag in
! the top-level IOLSCLS node is tested during code generation to
! determnine if CHMRK./CHUNW. calls should be generated for the
! IOLST. call.
!
! This routine merely walks the I/O list of the top-level
! statement containing CNODE, and calls MARKSUP to do the real
! work (after filtering out STATEMENT nodes).
!
! FORMAL PARAMETERS:
!
! CNODE Pointer to an IOLSCLS node which is the parent
! of a dynamic concatenation (i.e., a CONCTV
! node).
!
! IMPLICIT INPUTS:
!
! None
!
! IMPLICIT OUTPUTS:
!
! None
!
! ROUTINE VALUE:
!
! None
!
! SIDE EFFECTS:
!
! None
!
!--
![2376] Rewritten
BEGIN
MAP BASE CNODE; ! IOLSCLS node with a CONCTV child
REGISTER BASE IOLNODE; ! Current I/O list element
IOLNODE = .CNODE[IOLSTATEMENT]; ! Top level I/O statement
IOLNODE = .IOLNODE[IOLIST]; ! First I/O list element
WHILE .IOLNODE NEQ 0
DO
BEGIN ! For each I/O list element
IF .IOLNODE[OPRCLS] EQL IOLSCLS ! Ignore statements
THEN IF MARKSUP(.IOLNODE,.CNODE) ! Walk this node
THEN RETURN; ! Done, found it
IOLNODE = .IOLNODE[CLINK]; ! Try next one
END; ! For each I/O list element
CGERR(); ! Didn't find the IOLSCLS node
END; ! of MARKIOLSCLS
ROUTINE MARKSUP(ELEMENT,CNODE) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine is passed CNODE, a pointer to an IOLSCLS node
! which is the parent of a dynamic concatenation (i.e., a CONCTV
! node), and ELEMENT, a pointer to an IOLSCLS node which may
! contain CNODE.
!
! If ELEMENT is not equal to CNODE, and is not an ancestor of
! CNODE, it does nothing and returns FALSE.
!
! If ELEMENT is equal to CNODE, or is an ancestor of CNODE, it
! sets the IOLDYNFLG flag on each IOLSCLS node which is an
! ancestor of CNODE between CNODE to ELEMENT, including CNODE
! and ELEMENT. It then returns TRUE.
!
! The flag in the top-level IOLSCLS node is tested during code
! generation to determnine if CHMRK./CHUNW. calls should be
! generated for the IOLST. call.
!
! FORMAL PARAMETERS:
!
! ELEMENT Pointer to an IOLSCLS node which may contain
! CNODE.
!
! CNODE Pointer to an IOLSCLS node which is the parent
! of a dynamic concatenation (i.e., a CONCTV
! node).
!
! IMPLICIT INPUTS:
!
! None
!
! IMPLICIT OUTPUTS:
!
! None
!
! ROUTINE VALUE:
!
! FALSE if ELEMENT is not equal to CNODE, and is not
! an ancestor of CNODE.
!
! TRUE if ELEMENT is equal to CNODE, or is an
! ancestor of CNODE.
!
! SIDE EFFECTS:
!
! None
!
!--
![2376] New
BEGIN
MAP BASE ELEMENT; ! IOLSCLS node which may contain CNODE
MAP BASE CNODE; ! IOLSCLS node with a CONCTV child
REGISTER BASE SUBNODE; ! Current child IOLSCLS node
IF .ELEMENT EQL .CNODE
THEN
BEGIN ! We found it
ELEMENT[IOLDYNFLG] = TRUE; ! Set flag for CHMRK./CHUNW.
RETURN TRUE; ! Done, indicate success
END; ! We found it
IF .ELEMENT[OPERSP] EQL IOLSTCALL
THEN SUBNODE = .ELEMENT[IOLSTPTR] ! Look at nested IOLSCLS nodes
ELSE IF .ELEMENT[OPERSP] EQL E1LISTCALL
OR .ELEMENT[OPERSP] EQL E2LISTCALL
THEN SUBNODE = .ELEMENT[ELSTPTR] ! Look at nested IOLSCLS nodes
ELSE RETURN FALSE; ! No nested IOLSCLS nodes, indicate failure
WHILE .SUBNODE NEQ 0
DO
BEGIN ! For each IOLSCLS node
IF MARKSUP(.SUBNODE,.CNODE) ! Walk this node
THEN
BEGIN ! It was found under this node
ELEMENT[IOLDYNFLG] = TRUE; ! Set flag
RETURN TRUE; ! Done, found it
END; ! It was found under this node
SUBNODE = .SUBNODE[CLINK]; ! Try next one
END; ! For each IOLSCLS node
END; ! of MARKSUP
GLOBAL ROUTINE ALCFNCALL(BSYREGS,FREGCT)=
%(***************************************************************************
ROUTINE TO PERFORM REGISTER ALLOCATION FOR A FUNCTION CALL.
CALLED WITH "TREEPTR" POINTING TO THE FUNCTION CALL NODE
***************************************************************************)%
BEGIN
REGISTER PEXPRNODE CNODE; ! Pointer to the FNCALL expression node
REGISTER ARGUMENTLIST ARGLST; ! Pointer to the argument list
%1422% REGISTER BASE DPTR; ! Pointer to the .Dnnnn variable used
%1422% ! for the descriptor for the result of
%1422% ! character functions. It is the first
%1422% ! argument in the argument list.
CNODE = .TREEPTR;
ARGLST = TREEPTR = .CNODE[ARG2PTR];
! Evaluate all arguments into temporaries or variables
ALCFNARGS(.BSYREGS,.FREGCT,.CNODE[DBLFLG]);
REGCLOBB(0); ! AC0 is always clobbered
REGCLOBB(1); ! AC1 is clobbered by Double precision and complex
! results
%1422% ! Character function results are not returned in AC0, AC1. The
%1422% ! first argument is the descriptor for the result. The descriptor
%1422% ! points to a .Qnnnn variable which holds the actual data.
%1422% IF .CNODE[VALTYPE] EQL CHARACTER
%1422% THEN
%1422% BEGIN ! Character function
%1422% ! The target address is the descriptor in the first argument
%1422% CNODE[TARGADDR] = DPTR = .ARGLST[1,ARGNPTR];
%1422% ! Generate a .Qnnnn variable to hold the result
%1422% DPTR[IDADDR] = NXTTMP(CHWORDLEN(.DPTR[IDCHLEN]));
%1422% END; ! Character function
! For a non-library function, assume that the values of all variables
! that are arguments are clobbered.
IF .CNODE[OPERSP] NEQ LIBARY
THEN
BEGIN
CLOBBCOMEQV(); ! Must assume that all variables in COMMON or
! EQUIVALENCE are clobbered
! Walk down the argument list and clobber the variables
IF .ARGLST NEQ 0
THEN INCR CT FROM 1 TO .ARGLST[ARGCOUNT]
DO VARCLOBB(.ARGLST[.CT,ARGNPTR]);
END;
END; ! of ALCFNCALL
GLOBAL ROUTINE ALCFNARGS(BSYREGS,FREGCT,PARDBLFLG)=
BEGIN
!***************************************************************
! Perform register/temporary allocation for all arguments of a
! function call. PARDBLFLG is true iff the function call node
! had a double word VALTYPE (if the parent was a subroutine,
! PARDBLFLG is always false). All arguments must be
! materialized before the function is called. The global
! TREEPTR points to the argument list
!***************************************************************
LOCAL
ARGUMENTLIST ARGLST,
FRGCT1,
BSYRG1;
! Return if no arguments
IF .TREEPTR EQL 0 THEN RETURN;
! Get a local pointer to the argument list (TREEPTR will be
! clobberred during the walk
ARGLST = .TREEPTR;
INCR CT FROM 1 TO .ARGLST[ARGCOUNT] BY 1
DO
BEGIN ! Walk down the argument list
! Get pointer to expression node for this arg
TREEPTR = .ARGLST[.CT,ARGNPTR];
IF .TREEPTR[DBLFLG] AND NOT .PARDBLFLG
! If this argument involves a double precision or
! complex computation, and we are not already allocating
! in double word mode, must convert set of available
! registers
THEN BSYRG1 = DPBSYREGS(.BSYREGS)
ELSE IF .PARDBLFLG AND NOT .TREEPTR[DBLFLG]
! If we are operating in double word mode and this
! argument is single word, convert set of available
! registers
THEN BSYRG1 = SPBSYREGS(.BSYREGS)
ELSE BSYRG1 = .BSYREGS;
! Setup count of registers free in BSYRG1
FRGCT1 = ONESCOUNT(.BSYRG1);
IF .TREEPTR[OPRCLS] EQL CMNSUB
THEN
BEGIN ! The value of a common sub must be stored in a temp
IF .TREEPTR[INREGFLG] AND NOT .TREEPTR[STOREFLG]
THEN
BEGIN
TREEPTR[STOREFLG] = 1;
%1274% ! Get 1 or 2 word temp based on DBLFLG
%1274% TREEPTR[TARGTMEM] =
%1274% IF .TREEPTR[DBLFLG]
%1274% THEN NXTTMP(2)
%1274% ELSE NXTTMP(1);
END
END ! The value of a common sub must be stored in a temp
ELSE IF .ARGLST[.CT,AVALFLG]
THEN BEGIN END
ELSE IF .TREEPTR[OPRCLS] EQL ARRAYREF
THEN
BEGIN ! For an arrayref, get pointer to element into a tmp
! If subscripts are all constants, can simply
! put pointer to element into argument list.
! Otherwise, insert a store address node under
! the argument pointer above the arrayref
IF .TREEPTR[ARG2PTR] NEQ 0
THEN ARGLST[.CT,ARGNPTR] = ALCTARY(.BSYRG1,.FRGCT1)
END
%1274% ELSE IF .TREEPTR[DBLFLG]
%1422% ! Perform register/temporary allocation for this
%1422% ! argument. Get its value into a one or two
%1422% ! word temporary based on DBLFLG
%1274% THEN ALCINTMP(NXTTMP(2),.BSYRG1,.FRGCT1)
%1274% ELSE ALCINTMP(NXTTMP(1),.BSYRG1,.FRGCT1);
END; ! Walk down the argument list
END; ! of ALCFNARGS
GLOBAL ROUTINE ALCARRAY(BSYREGS,FREGCT)=
%(***************************************************************************
PERFORM REGISTER ALLOCATION FOR AN ARRAY REFERENCE
FOR A FORMAL PARAM, THE ADDRESS WILL BE COMPUTED ENTIRELY INTO SOME REG
FOR OTHER ARRAYS, THE OFFSET WILL BE COMPUTED INTO SOME REG AND
THE BASE WILL BE RETRIEVED FROM THE SYMBOL TABLE BY THE OUTPUT MODULE
CALLED WITH THE GLOBAL TREEPTR POINTING TO THE EXPRESSION NODE
FOR THE ARRAY REFFERENCE
RA IS A REGISTER TO USE TO HALD THE OFFSET IF ONE IS NEEDED
***************************************************************************)%
BEGIN
REGISTER PEXPRNODE CNODE:ADDRNODE;
LOCAL RA; !REG TO USE TO HOLD INDEX
OWN RB;
LOCAL FRGCT1,BSYRG1;
ROUTINE USESOMEREG(RA,BSYREGS)=
%(************
ROUTINE TO PICK A REG FROM BSYREGS TO USE TO HOLD THE INDEX
AND SET UP FIELDS INDICATING THAT THAT REG IS TO BE USED
**************)%
BEGIN
RA_RGTOU1(.CNODE,.ADDRNODE,.RA,CLRBIT(.BSYREGS,0)); !PICK A REG TO USE
CNODE[TARGXF]_.RA; !SET "INDEX" FIELD IN NODE TO INDICATE THE
! REG TO INDEX OFF OF
REGCLOBB(.RA); !MUST ASSUME THAT THE PREVIOUS CONTENTS OF THE
! REG USED ARE NOW CLOBBERED
END; ! of USESOMEREG
CNODE_.TREEPTR;
%1561% IF .TREEPTR[VALTYPE] EQL CHARACTER THEN CGERR();
ADDRNODE_.CNODE[ARG2PTR]; !2ND ARG UNDER AN ARRAYREF NODE IS
! A PTR TO THE ADDRESS CALC TO BE PERFORMED
%(***IF THE SS CALC IS ENTIRELY A CONSTANT (WHICH HAS ALREADY BEEN FOLDED INTO THE
TARGET WD) - SIMPLY RETURN****)%
IF .ADDRNODE EQL 0 THEN RETURN;
%(***IF THIS ARRAY HAS DOUBLE-WD ENTRIES, THEN TO PERFORM THE ADDRESS ARITHMETIC WILL
GO DOWN FROM DOUBLE-WD COMPUTATIONS TO SINGLE-WD COMPUTATIONS****)%
IF .TREEPTR[DBLFLG]
THEN
BEGIN
%(***ADJUST SET OF AVAILABLE REGS TO ONCE AGAIN INCLUDE ODD REGS
(EXCEPT FOR THOSE ODD REGS HOLDING THE 2ND HALF OF A DP VAL)***)%
BSYRG1_SPBSYREGS(.BSYREGS);
FRGCT1_ONESCOUNT(.BSYRG1);
END
ELSE
BEGIN
BSYRG1_.BSYREGS;
FRGCT1_.FREGCT;
END;
RA_AFREEREG(CLRBIT(.BSYRG1,0),.CNODE[SAVREGFLG],FALSE); !GET A REG TO USE TO
! HOLD THE VAR PART OF THE ADDRESS (AND
! BE INDEXED FROM)
%(***PERFORM REGISTER ALLOCATION FOR THE ADDRESS CALCULATION***)%
IF NOT .CNODE[A2VALFLG]
THEN
BEGIN
TREEPTR_.CNODE[ARG2PTR];
ALCINREG(.RA,.BSYRG1,.FRGCT1);
END;
%(***DETERMINE WHICH REG TO USE AS AN INDEX**************)%
IF .ADDRNODE[OPRCLS] EQL DATAOPR !IF ADDRESS IS A SIMPLE VARIABLE
THEN
BEGIN
IF (RB_REGCONTAINING(.ADDRNODE)) GTR 0 !IF VAR WAS LEFT IN A
! REG OTHER THAN 0 BY A PREVIOUS STMNT
AND .CNODE[A2NGNTFLGS] EQL 0 !AND NEED NOT BE NEGATED OR COMPLEMENTED
THEN
BEGIN
CNODE[TARGXF]_.RB; !THEN USE THAT REG
CNODE[A2SAMEFLG]_1 ! AND DONT RELOAD IT
END
ELSE
USESOMEREG(.RA,.BSYREGS); !OTHERWISE LOAD THE INDEX INTO SOME REG
IF .CNODE[SAVREGFLG] !IF THE VAR WILL BE USEFUL TO HAVE IN REG
! IN SOME FURTURE STMNT
AND .CNODE[A2NGNTFLGS] EQL 0 ! AND WAS NOT PICKED UP BY "MOVN"
THEN SAVEREG(.CNODE[TARGXF], !REMEMBER THAT THE REG USED AS INDEX
.ADDRNODE,0,.CNODE[TARGXF]); !CONTAINS THAT VAR
END
ELSE
%(***IF HAVE ALREADY DETERMINED THAT THE INDEX SHOULD BE LEFT IN THE FN-RET
REG, (IF SOME REG OTHER THAN 0 IS USED FOR FN-RET) THEN DONT
CHANGE IT***)%
IF .CNODE[ALCRETREGFLG]
THEN BEGIN END
ELSE
%(***IF THE VARIABLE PART OF THE ADDR WAS CALCULATED INTO A
REG OTHER THAN 0 AND OTHER THAN THE FN-RET REG, USE THAT REG
AS THE INDEX***)%
IF .ADDRNODE[INREGFLG] AND (.ADDRNODE[TARGTAC] NEQ 0) AND ( NOT .ADDRNODE[ALCRETREGFLG])
AND NOT (.CNODE[A2VALFLG] AND .CNODE[A2NGNTFLGS] NEQ 0) !IF ADDR WAS A COMMON SUB OR A REGCONTENTS
! CANNOT USE THE REG IF VAL IN IT MUST
! BE NEGATED OR COMPLEMENTED
THEN
BEGIN
CNODE[TARGXF]_.ADDRNODE[TARGTAC]; !USE THE REG CONTAINING FOR THE ADDRESS
CNODE[A2SAMEFLG]_1; !DONT RELOAD THE REG
END
%(***OTHERWISE, PICK A REG TO USE***)%
ELSE
USESOMEREG(.RA,.BSYREGS);
END; ! of ALCARRAY
ROUTINE ALCCHARRAY(TA,BSYREGS,FREGCT)= ! [1253] New
! Register allocation for character ARRAYREF node
BEGIN
REGISTER PEXPRNODE CNODE:ADDRNODE;
LOCAL RA:RB;
CNODE _ .TREEPTR; ! CNODE points to arrayref node
ADDRNODE _ .CNODE[ARG2PTR]; ! ARG2 points to subscript expression
IF .ADDRNODE EQL 0 THEN CGERR(); ! If subscript expr was folded into
! TARGET field or someplace, somebody
! is confused
BSYREGS _ SPBSYREGS(.BSYREGS); ! Character nodes have DBLFLG set so
FREGCT _ ONESCOUNT(.BSYREGS); ! caller has set BSYREGS to double word
! mode. Set it back to single words.
RA _ AFREEREG(CLRBIT(.BSYREGS,0),FALSE,FALSE);
! Get a reg for the subscript expression
IF NOT .CNODE[A2VALFLG] ! Perform register allocation for the
THEN ! subscript expression
BEGIN
TREEPTR _ .CNODE[ARG2PTR];
ALCINREG(.RA,.BSYREGS,.FREGCT);
END;
! Pick a register to use for the ADJBP
IF .ADDRNODE[OPRCLS] EQL DATAOPR ! If subscript is a simple variable
THEN
IF .ADDRNODE[A2NGNTFLGS] NEQ 0 ! If it must be negated or complemented
THEN RB _ -1 ! we have to generate a MOVN or SETCM
! anyway so there's no advantage to
! doing it from a register
ELSE RB _ REGCONTAINING(.ADDRNODE) ! If the variable is in a register,
! use it
ELSE ! If subscript is not a DATAOPR
IF .ADDRNODE[INREGFLG] AND NOT (.CNODE[A2VALFLG] AND .CNODE[A2NGNTFLGS] NEQ 0)
! If it made it into a register and
! isn't a REGCONTENTS or COMNSUB which
! must be negated or complemented
THEN
RB _ .ADDRNODE[TARGTAC] ! Use the reg containing the expression
ELSE
RB _ -1; ! Otherwise pick some other register
IF .RB GTR 0 ! If we found a nonzero register
THEN IF NOT BITSET(.BSYREGS,.RB) ! check if we are allowed to clobber it
THEN RB _ -1; ! No, must allocate some different register
IF .RB GTR 0 ! If we found a good register
THEN
BEGIN
RA _ .RB; ! Use the one we found
CNODE[A2SAMEFLG] _ 1;
END
ELSE ! Otherwise use any free register
RA _ RGTOU1(.CNODE,.ADDRNODE,.RA,CLRBIT(.BSYREGS,0)); ! (except 0)
REGCLOBB(.RA); ! Register will be clobbered by ADJBP
CNODE[TARGTAC] _ .RA; ! Set target AC in arrayref node
! Assign 2-word temp for the result descriptor
%1561% CNODE[TARGADDR] = .TA;
END; ! ALCCHARRAY
GLOBAL ROUTINE ALCTPCNV(RT,BSYREGS,FREGCT,TMPFLG)=
%(***************************************************************************
PERFORM REGISTER ALLOCATION FOR A TYPE CONVERSION NODE.
THIS ROUTINE IS USED BOTH FOR ALLOCATING RESULT TO A REG AND FOR
ALLOCATING IT TO A TEMPORARY.
THE FLAG "TMPFLG" IS TRUE IF RESULT IS TO BE ALLOCATED TO A
TEMP. THE ARG RT IS A REG IF ALLOCATING TOA REG, A TEMP IF
ALLOCATING TO A TEMP.
IF ARE GOING FROM DOUBLE-WD COMPUTATIONS DOWN TO SINGLE WD
COMPUTATIONS, ODD REGISTERS CAN NOW BE ASSIGNED (EXCEPT OF
COURSE FOR THOSE WHOSE PRECEEDING EVEN REG WAS ASSIGNED TO SOME
DOUBLE-WD RESULT).
IF ARE GOING FROM SINGLE-WD COMPUTATIONS DOWN TO DOUBLE-WD
COMPUTATIONS (ONLY OCCURS WHEN EXPLICITLY INVOKED BY PROGRAM),
ODD REGISTERS CAN NO LONGER BE ASSIGNED, NOR CAN EVEN REGS WHICH
ARE FOLLOWED BY AN ODD REG THAT IS IN USE.
IN THIS ROUTINE, WE USE THE LOCALS BSYRG1 AND FRGCT1 TO INDICATE
WHICH REGISTERS ARE AVAILABLE FOR USE IN THE COMPUTATION OF THE
ARG UNDER THE TYPE-CONVERSION NODE. THE ARGS BSYREGS AND FREGCT
INDICATE WHICH REGS ARE AVAILABLE FOR THE COMPUTATION OF THIS
TYPE-CONVERSION NODE ITSELF.
THE LOCAL RA INDICATES THE REG TO BE USED FOR COMPUTATION OF THE
TYPE-CONVERSION, CALLED WITH THE GLOBAL TREEPTR POINTING TO THE
TYPE CONVERSION NODE.
***************************************************************************)%
BEGIN
LOCAL RA,RB; !REG TO BE USED
LOCAL ARGREG; !REG IN WHICH THE ARG WAS COMPUTED
LOCAL PEXPRNODE ARGNODE;
REGISTER PEXPRNODE CNODE;
LOCAL BSYRG1;
LOCAL FRGCT1;
CNODE_.TREEPTR;
ARGNODE_.CNODE[ARG2PTR];
%(***INIT SET OF AVAILABLE REGS TO THOSE THAT WERE AVAILABLE ABOVE THIS NODE***)%
BSYRG1_.BSYREGS;
%(***IF CONVERSION IS FROM DOUBLE-WD TO SINGLE-WD AND HENCE ARE GOING
DOWN FROM SINGLE-WD COMPUTATIONS TO DOUBLE-WD COMPUTATIONS****)%
IF .CNODE[SDBLFLG] AND NOT .CNODE[DBLFLG]
THEN
%(**ADJUST SET OF AVAILABLE REGISTERS TO INCLUDE ONLY EVEN REGS***)%
BSYRG1_DPBSYREGS(.BSYRG1);
%(***IF CONVERSION IS FROM SINGLE-WD TO DOUBLE-WD AND ARE HENCE
GOING DOWN FROM DOUBLE-WD COMPUTATIONS TO SINGLE-WD COMPUTATIONS****)%
IF NOT .CNODE[SDBLFLG] AND .CNODE[DBLFLG]
THEN
%(***ADJUST SET OF AVAILABLE REGS TO INCLUDE ODD REGS AGAIN (EXCEPT
FOR THOSE ODD REGS CONTAININD THE 2ND HALF OF A DP VAL TO BE SAVED)***)%
BSYRG1_SPBSYREGS(.BSYRG1);
%(***DETERMINE NUMBER OF REGS NOW AVAILABLE FOR USE***)%
FRGCT1_ONESCOUNT(.BSYRG1);
%(***SET RA TO INDICATE THE REG IN WHICH THE COMPUTATION
OF THE TYPE CONVERSION WILL TAKE
PLACE (IF ARE ALLOCATING TO A REG IT WILL BE THAT REG IF POSSIBLE) ***)%
IF .TMPFLG
THEN
RA_AFREEREG(.BSYREGS AND .BSYRG1,FALSE,.CNODE[SDBLFLG] OR .CNODE[DBLFLG]) !IF ARE ALLOCATING TO A TMP, USE THE
! FIRST REG THAT IS LEGAL FOR BOTH THE
! OLD AND NEW VALUE TYPES
ELSE
IF BITSET(.BSYRG1,.RT) !IF THE SPECIFIED DESTIN REG FOR
! THE PARENT IS ALSO LEGAL FOR THE OLD
! VALUE-TYPE, THEN USE THAT REG
THEN
RA_.RT
ELSE
RA_AFREEREG(.BSYREGS AND .BSYRG1,FALSE,.CNODE[SDBLFLG] OR .CNODE[DBLFLG]); !OTHERWISE USE THE 1ST REG
! THAT IS LEGAL FOR BOTH THE OLD AND NEW
! VALTYPES
%(****PERFORM REGISTER ALLOCATION FOR NODES BELOW THIS NODE***)%
TREEPTR_.ARGNODE;
%(****IF NO ACTUAL CODE NEEDS TO BE GENERATED FOR THIS TYPE-CONVERSION (IE THE
TYPE-CONVERSION NODE IS PRESENT ONLY TO KEEP TRACK OF THE WAY IN WHICH
THE VALUE CORRESPONDING TO THE NODES BELOW IS TO BE USED),
THEN THE "CONVERTED" VALUE SHOULD BE ACCESSED IN THE SAME
WAY AS THE UNCONVERTED VALUE
********)%
IF NOCNV(CNODE)
THEN
BEGIN ! No conversion
IF .CNODE[A2VALFLG]
THEN
BEGIN
! If subnode is a scalar variable, the address
! for the "converted" variable is identical to
! the address of the original var
IF .ARGNODE[OPRCLS] EQL DATAOPR
%1644% THEN CNODE[TARGADDR] _ .ARGNODE
! If subnode is a common subexpr, the
! "converted" value is accessed in the same way
! as the original value
ELSE CNODE[TARGET] _ .ARGNODE[TARGET];
END
%(***IF THE VALUE OF THE ARG MUST BE COMPUTED, PERFORM REGISTER ALLOCATION FOR
THAT COMPUTATION. THE ADDRESS CORRESPONDING TO THE "CONVERTED"
VALUE IS IDENTICAL TO THE ADDRESS CORRESPONDING TO THE UNCONVERTED ONE***)%
ELSE
BEGIN
IF .TMPFLG
THEN
ALCINTMP(.RT,.BSYRG1,.FRGCT1)
ELSE
BEGIN
%(***IF THE ARGNODE WAS ALLOCATED TO THE FN RETURN REG,
AND WE THEN FOUND THAT THAT REG WOULD BE CLOBBERED
BEFORE THE RESULT WAS USED (AND HENCE DEALLOCATED THE
CONVERTED VAL FROM THE RETREG), DEALLOCATE
THE ARGNODE FROM THE RETREG ALSO***)%
IF NOT .CNODE[ALCRETREGFLG] AND .ARGNODE[ALCRETREGFLG]
THEN
BEGIN
ARGNODE[A1SAMEFLG]_0;
ARGNODE[A2SAMEFLG]_0;
ARGNODE[ALCRETREGFLG]_0;
ARGNODE[INREGFLG]_0;
END;
ALCINREG(.RA,.BSYRG1,.FRGCT1);
END;
!ALCINTMP MAY HAVE INSERTED A STORE CLASS NODE BETWEEN
! A TYPE CONVERSION AND AN ARRAYREF NODE - IN THIS CASE,
! ARGNODE NEEDS TO BE UPDATED TO PREVENT A MOVE-MOVEM
! PAIR FROM AND TO THE SAME LOCATION!
ARGNODE_.CNODE[ARG2PTR];
CNODE[TARGET]_.ARGNODE[TARGET];
END;
END ! No conversion
%(****IF CODE MUST BE GENERATED TO PERFORM THE CONVERSION, THEN THE "UNCONVERTED"
VALUE WILL HAVE TO BE LOADED INTO A REG TO CONVERT IT****)%
ELSE
BEGIN ! Conversion needed
%(***IF ARG REQUIRES COMPUTATION, COMPUTE IT INTO RA IF POSSIBLE****)%
IF NOT .CNODE[A2VALFLG]
THEN
BEGIN
ALCINREG(.RA,.BSYRG1,.FRGCT1);
%(***IF POSSIBLE, USE THE REG IN WHICH ARG WAS LEFT AS THE
REG FOR COMPUTATION OF THE TYPE-CONVERSION***)%
IF (.ARGNODE[INREGFLG]) AND (NOT .ARGNODE[ALCRETREGFLG])
THEN
RA_.ARGNODE[TARGTAC];
END;
%(***IF HAVE PREVIOUSLY ALLOCATED THE TYPE-CONVERSION TO BE DONE IN
THE FN-RETURN REG, ARE DONE******)%
IF NOT .CNODE[ALCRETREGFLG]
THEN
BEGIN
%(**IF ARG IS A VAR WHOSE VAL WAS LEFT IN A REG BY A PREVIOUS STMNT, USE
THAT REG IF POSSIBLE**)%
IF (RB_REGCONTAINING(.ARGNODE)) GEQ 0 !IF ARG WAS LEFT IN A REG
THEN
BEGIN
IF BITSET(.BSYRG1 AND .BSYREGS, .RB) !IF THIS REG IS LEGAL FOR
! THE PRECISION OF BOTH THE
! SOURCE AND RESULT TYPES
THEN
BEGIN
SETTAC(.CNODE,.RB); !USE RB FOR THE TYPE CONV
CNODE[A2SAMEFLG]_1; !DONT RELOAD THE REG
END
ELSE
BEGIN
RA_RGTOU1(.CNODE,.ARGNODE,.RA,(.BSYREGS AND .BSYRG1)); !USE SOME OTHER FREE RG
SETTAC(.CNODE,.RA)
END
END
ELSE
BEGIN
%(***SET REG FOR COMPUTATION OF THE TYPE-CONVERSION TO RA IF
RA IS LEGAL TO USE, OTHERWISE TO SOME OTHER LEGAL REG***)%
RA_RGTOU1(.CNODE,.ARGNODE,.RA,(.BSYREGS AND .BSYRG1));
SETTAC(.CNODE,.RA);
%(***IF THE TYPE CONVERSION IS BEING COMPUTED IN THE SAME REG AS ITS ARG***)%
IF (.CNODE[TARGTAC] EQL .ARGNODE[TARGTAC]) AND .ARGNODE[INREGFLG]
THEN CNODE[A2SAMEFLG]_1;
END;
%(***IF ARE ALLOCATING TO A TEMPORARY, SET "STOREFLG" TO INDICATE
THAT THE VAL COMPUTED MUST BE STORED; SET LOC FOR VAL TO THE TMP****)%
IF .TMPFLG
THEN
BEGIN
CNODE[TARGTMEM]_.RT;
CNODE[STOREFLG]_1;
END
%(***IF ARE ALLOCATING TO A REG, SET MEMREF FIELD TO INDICATE THAT
THAT IS THE LOC OF THE VAL****)%
ELSE
BEGIN
CNODE[TARGADDR]_.CNODE[TARGTAC];
CNODE[INREGFLG]_1;
END;
END;
END; ! Conversion needed
END; ! of ALCTPCNV
GLOBAL ROUTINE ALCNEGNOT(RA,BSYREGS,FREGCT)=
%(***************************************************************************
TO PERFORM REG ALLOC FOR A NEG/NOT NODE
***************************************************************************)%
BEGIN
LOCAL PEXPRNODE CNODE:ARGNODE;
LOCAL RB;
CNODE_.TREEPTR;
ARGNODE_.TREEPTR[ARG2PTR];
IF .CNODE[A2VALFLG]
THEN
BEGIN
RA_RGTOU1(.CNODE,.ARGNODE,.RA,.BSYREGS);
SETTARGINREG(.CNODE,.RA);
END
ELSE
BEGIN
TREEPTR_.CNODE[ARG2PTR];
ALCINREG(.RA,.BSYREGS,.FREGCT);
%(***DECIDE WHAT REG TO COMPUTE THE NEG/NOT IN***)%
IF .CNODE[ALCRETREGFLG]
%(***IF HAVE ALREADY DECIDED TO COMPUTE THE NEG/NOT IN THE FN-RET REG
DONT CHANGE IT***)%
THEN BEGIN END
ELSE
%(***IF THE ARG WAS LEFT IN A REG OTHER THAN THE FN-RET REG, USE THAT REG***)%
IF .ARGNODE[INREGFLG] AND NOT .ARGNODE[ALCRETREGFLG]
THEN
BEGIN
CNODE[TARGET]_.ARGNODE[TARGET];
CNODE[A2SAMEFLG]_1;
END
ELSE
IF (RB_REGCONTAINING(.ARGNODE)) GEQ 0 !IF ARG IS A VAR WHOSE VAL WAS LEFT
! IN A REG BY ANOTHER STMNT
THEN
BEGIN
IF BITSET(.BSYREGS,.RB) !IF IT'S LEGAL TO CLOBBER THAT REG
! IN THIS STMNT
THEN
BEGIN
CNODE[TARGTAC]_.RB; !USE THAT REG
CNODE[A2SAMEFLG]_1; !DONT RELOAD THE REG
END
ELSE
BEGIN !OTHERWISE, USE SOME FREE REG
RA_RGTOU1(.CNODE,.ARGNODE,.RA,.BSYREGS);
SETTARGINREG(.CNODE,.RA)
END
END
ELSE
BEGIN
RA_RGTOU1(.CNODE,.ARGNODE,.RA,.BSYREGS);
SETTARGINREG(.CNODE,.RA)
END
END
END; ! of ALCNEGNOT
GLOBAL ROUTINE ALCSPECOP(RA,BSYREGS,FREGCT)=
%(***************************************************************************
PERFORM REGISTER ALLOCATION FOR THE SPECIAL OPERATIONS INTRODUCED
BY PHASE 2 SKELETON.
FOR P2MUL (POWER OF 2 MULTIPLY),P2DIV, AND EXPCIOP WHEN THE POWER IS A POWER OF 2
ALLOCATE ARG TO BE COMPUTED INTO REG TO BE USED FOR FINAL RESULT.
FOR P2PL1MUL ("POWER OF 2 PLUS 1" MULTIPLY)
AND EXPCIOP FOR POWER OTHER THEN A POWER OF 2
ALLOCATE ARG TO BE COMPUTED INTO
SOME OTHER REG.
CALLED WITH THE ARGS
RA - REG INTO WHICH SHOULD ATTEMPT TO COMPUTE RESULT
BSYREGS - INDICATES WHICH REGS ARE AVAILABLE
FREGCT - CT OF AVAILABLE REGS
CALLED WITH THE GLOBAL TREEPTR POINTING TO THE EXPRESSION NODE
FOR WHICH ALLOCATION IS TO BE PERFORMED
***************************************************************************)%
BEGIN
LOCAL PEXPRNODE CNODE:ARGNODE;
LOCAL RB;
CNODE_.TREEPTR;
ARGNODE_.CNODE[ARG1PTR];
IF .CNODE[A1VALFLG] !IF ARG REQUIRES NO COMPUTATION
THEN
BEGIN
IF (RB_REGCONTAINING(.ARGNODE)) GEQ 0 !IF ARG IS A VAR WHOSE VAL WAS LEFT IN A REG
THEN
BEGIN
IF BITSET(.BSYREGS,.RB) !IF ITS OK TO CLOBBER THAT REG
THEN
BEGIN
SETTARGINREG(.CNODE,.RB); !USE THAT REG
CNODE[A1SAMEFLG]_1; !DONT RELOAD THE REG
END
ELSE !OTHERWISE USE RA TO COMPUTE THE OP
SETTARGINREG(.CNODE,.RA)
END
ELSE !OTHERWISE USE RA TO COMPUTE THE OP
SETTARGINREG(.CNODE,.RA)
END
ELSE
%(***IF ARG MUST BE CALCULATED, PERFORM REGISTER ALLOCATION FOR THAT CALCULATION***)%
BEGIN
TREEPTR_.ARGNODE;
IF .CNODE[OPERSP] EQL P2PL1OP
OR
(.CNODE[OPERSP] EQL EXPCIOP AND NOT POWOF2(.CNODE[ARG2PTR]) )
THEN
%(***FOR MULTIPLICATION BY POWER OF 2 PLUS 1 OR TO RAISE A VAL TO POWER
THAT IS NOT A POWER OF 2***)%
BEGIN
REGISTER BSYRG1;
IF .FREGCT GTR 1 !IF HAVE MORE FREE REGS THAN JUST "RA"
THEN ! THEN DONT COMPUTE THE ARG INTO RA
BEGIN
RB_AFREEREG(CLRBIT(.BSYREGS,.RA),FALSE,.ARGNODE[DBLFLG]);
ALCINREG(.RB,.BSYREGS,.FREGCT);
END
ELSE ALCINREG(.RA,.BSYREGS,.FREGCT);
%(***PICK OUT A REG TO USE FOR COMP OF VAL OF PARENT***)%
IF (RB_RGTOSAVE(.ARGNODE)) GEQ 0 !IF SOME REG MUST BE SAVED TO
! REFERENCE THE VAL OF THE ARG
THEN BSYRG1_CLRBIT(.BSYREGS,.RB) !CANNOT USE THAT REG TO COMPUTE
! THE PARENT
ELSE BSYRG1_.BSYREGS;
RA_RGTOU1(.CNODE,.ARGNODE,.RA,.BSYRG1);
SETTARGINREG(.CNODE,.RA)
END
ELSE
%(***FOR P2MUL,P2DIV, OR EXPCIOP WHEN THE POWER IS
A POWER OF 2(AND HENCE A COPY OF THE ARG IS NOT NEEDED)**)%
BEGIN
ALCINREG(.RA,.BSYREGS,.FREGCT);
%(***IF HAVE ALREADY DECIDED TO COMPUTE THE P2MUL IN THE FN-RET
REG, DONT CHANGE IT***)%
IF .CNODE[ALCRETREGFLG]
THEN BEGIN END
ELSE
%(***WANT TO COMPUTE VAL OF PARENT IN SAME REG AS ARG WAS
COMPUTED IN IF POSSIBLE***)%
IF .ARGNODE[INREGFLG] AND NOT .ARGNODE[ALCRETREGFLG]
THEN
BEGIN
CNODE[TARGET]_.ARGNODE[TARGET];
CNODE[A1SAMEFLG]_1;
END
ELSE
BEGIN
RA_RGTOU1(.CNODE,.ARGNODE,.RA,.BSYREGS);
SETTARGINREG(.CNODE,.RA)
END;
END
END
END; ! of ALCSPECOP
GLOBAL ROUTINE ALCSUBSTR(TA,BSYREGS,FREGCT)= ! [1431] New
!Perform register allocation for a character substring node.
!
!This routine always allocates the result (which is a character descriptor) to
!a temp, which is pointed to by argument TA.
!
!Assigns 2 registers to be used by the calculation. One is used to compute the
!length of the substring, the other is used to compute the byte pointer. They
!may be the same AC.
!
!If the substring is of an array reference, the substring node and the arrayref
!node are treated as a single unit. We are in effect dealing with a substring
!node with 3 expressions under it: the upper bound, the lower bound-1, and the
!subscript.
!
!Since substrings are always valtype CHARACTER, and CHARACTER has DBLFLG set in
!its valtype, the arguments BSYREGS and FREGCT are in double mode. (Ie, they
!give info about pairs of registers, not single registers.) All subnodes of a
!substring node are of type integer. So we unconditionally convert BSYREGS and
!FREGCT to single mode in this routine.
!
!Called with the global TREEPTR pointing to the substring node.
BEGIN
LOCAL PEXPRNODE CNODE:LNODE:UNODE:ANODE:SNODE;
LOCAL BSYRG1,FRGCT1;
LOCAL RL,RU,RLEN,RBP,RSUB;
CNODE = .TREEPTR; ! CNODE points to the substring node
UNODE = .CNODE[ARG1PTR]; ! UNODE points to the upper bound
LNODE = .CNODE[ARG2PTR]; ! LNODE points to the lower bound - 1
ANODE = .CNODE[ARG4PTR]; ! ANODE points to the ARRAYREF/DATAOPR
SNODE = .ANODE[ARG2PTR]; ! if ANODE is an ARRAYREF, SNODE points
! to the subscript expression
BSYREGS = SPBSYREGS(.BSYREGS); ! Convert to single mode
FREGCT = ONESCOUNT(.BSYREGS);
! Allocate L node to a register or a temp. Use a register if possible,
! but if we do not have enough free registers to do that, we must
! evaluate the L node into a .Q temp.
IF .FREGCT LSS .LNODE[COMPLEXITY] ! Enough regs for L node?
OR .FREGCT LEQ .UNODE[COMPLEXITY] ! and U node?
OR .FREGCT LEQ (IF .ANODE[OPRCLS] EQL ARRAYREF ! and S node?
THEN .SNODE[COMPLEXITY]
ELSE 0)
THEN
BEGIN ! allocate L node to a temp
IF NOT .CNODE[A2VALFLG]
THEN
BEGIN
TREEPTR = .CNODE[ARG2PTR];
ALCINTMP(NXTTMP(1),.BSYREGS,.FREGCT);
END
END ! allocate L node to a temp
ELSE
BEGIN ! allocate L node to a register
RL = AFREEREG(CLRBIT(.BSYREGS,0),FALSE,FALSE);
! Pick any nonzero free register to
! target the L node to
IF NOT .CNODE[A2VALFLG]
THEN
BEGIN
TREEPTR = .CNODE[ARG2PTR];
ALCINREG(.RL,.BSYREGS,.FREGCT);
END;
END; ! allocate L node to a register
RL = RGTOSAVE(.LNODE); ! Set RL to the register that the L
! node was evaluated into, or any other
! register which must not be clobbered
! while we want to keep the L node
! around
IF .RL GEQ 0 ! Set BSYRG1 and FRGCT1 to be the free
THEN ! regs except for RL
BEGIN
BSYRG1 = CLRBIT(.BSYREGS,.RL);
FRGCT1 = .FREGCT - 1;
END
ELSE
BEGIN
BSYRG1 = .BSYREGS;
FRGCT1 = .FREGCT;
END;
! Allocate U node to a register
RU = AFREEREG(.BSYRG1,FALSE,FALSE);
! Pick any free reg except RL to
! target the U node to
IF NOT .CNODE[A1VALFLG]
THEN
BEGIN
TREEPTR = .CNODE[ARG1PTR];
ALCINREG(.RU,.BSYRG1,.FRGCT1);
END;
! Pick a register (RLEN) to use for the substring length calculation.
! If possible, use the same register that the U node landed in.
IF .UNODE[OPRCLS] EQL DATAOPR
THEN IF .CNODE[A1NGNTFLGS] NEQ 0
THEN RLEN = -1
ELSE RLEN = REGCONTAINING(.UNODE)
ELSE IF .UNODE[INREGFLG] AND NOT
(.CNODE[A1VALFLG] AND .CNODE[A1NGNTFLGS] NEQ 0)
THEN RLEN = .UNODE[TARGTAC]
ELSE RLEN = -1;
IF NOT .UNODE[ALCRETREGFLG] ! If U node is in return reg, fine,
! leave it there
THEN IF .RLEN GEQ 0 ! If it's in some other register
THEN IF NOT BITSET(.BSYRG1,.RLEN) ! which cannot be clobbered
THEN RLEN = -1; ! we must try again
! Now RLEN is a good register if there is one, or -1 if there isn't.
! If there isn't, call REGTOUSE to choose some clobberable AC.
IF .RLEN LSS 0
THEN RLEN = REGTOUSE (.CNODE, .UNODE, .LNODE, .RU, .BSYRG1)
ELSE CNODE[A1SAMEFLG] = 1;
CNODE[TARGTAC] = .RLEN; ! Store AC in substring node
REGCLOBB(.RLEN); ! The length calculation will clobber
! the AC.
! Now do subscript if there is an arrayref under the substring node
IF .ANODE[OPRCLS] EQL ARRAYREF
THEN
BEGIN ! arrayref
! Allocate the subscript expression to a register. RLEN is
! known to be free and clobberable, so we will use it unless
! there is a better choice.
IF NOT .ANODE[A2VALFLG]
THEN
BEGIN
TREEPTR = .SNODE;
ALCINREG(.RLEN,.BSYRG1,.FRGCT1);
END;
! Pick a register (RSUB) to use for the subscript calculation
IF .SNODE[OPRCLS] EQL DATAOPR
THEN IF .ANODE[A2NGNTFLGS] NEQ 0
THEN RSUB = -1
ELSE RSUB = REGCONTAINING(.SNODE)
ELSE IF .SNODE[INREGFLG] AND NOT
(.ANODE[A2VALFLG] AND .ANODE[A2NGNTFLGS] NEQ 0)
THEN RSUB = .SNODE[TARGTAC]
ELSE RSUB = -1;
! If RSUB is zero, forget it. We are going to do an ADJBP in
! this AC. If it is not clobberable, forget it.
IF .RSUB GTR 0
THEN IF NOT BITSET(.BSYREGS,.RSUB)
THEN RSUB = -1;
! If we found a good AC above, use it and set SAMEFLG so code
! generation knows not to generate a MOVE. Otherwise use RLEN.
IF .RSUB LEQ 0
THEN RSUB = .RLEN ! (RLEN is not constrained to be ~=0)
ELSE ANODE[A2SAMEFLG] = 1;
%1553% ! RSUB will be used to do an ADJBP, so if we have decided that
%1553% ! register 0 is the best bet so far, we must reconsider. Pick
%1553% ! any free register except RL.
%1553% IF .RSUB EQL 0
%1553% THEN RSUB = AFREEREG(CLRBIT(.BSYRG1,0),FALSE,FALSE);
ANODE[TARGTAC] = .RSUB; ! Store AC in substring node
REGCLOBB(.RSUB); ! The ADJBP will clobber this AC.
END; ! arrayref
! Pick a register (RBP) to user for the ADJBP. If possible, use the
! same register that the L node landed in.
IF .LNODE[OPRCLS] EQL DATAOPR
THEN IF .LNODE[A2NGNTFLGS] NEQ 0
THEN RBP = -1
ELSE RBP = REGCONTAINING(.LNODE)
ELSE IF .LNODE[INREGFLG] AND NOT
(.CNODE[A2VALFLG] AND .CNODE[A2NGNTFLGS] NEQ 0)
THEN RBP = .LNODE[TARGTAC]
ELSE RBP = -1;
%1664% IF .RBP GTR 0 ! If L node made it into a nonzero
THEN ! register, check if the register
IF NOT BITSET(.BSYREGS,.RBP)! can be clobbered
THEN RBP = -1; ! If not, must try again
! Now RBP is a good register if there is one, or -1 if there isn't.
! If there isn't, we can use any free register except 0.
IF .RBP LEQ 0
THEN RBP = AFREEREG (CLRBIT(.BSYREGS,0),FALSE,FALSE)
ELSE CNODE[A2SAMEFLG] = 1;
CNODE[TARGAUX] = .RBP; ! Store AC in substring node
REGCLOBB(.RBP); ! The ADJBP will clobber this AC.
! Store address of descriptor for result.
CNODE[TARGADDR] = .TA
END; ! ALCSUBSTR
GLOBAL ROUTINE ALCILF(RA,BSYREGS,FREGCT)=
%(***************************************************************************
To perform register for an in-line-function node. For all
except ABS, IABS, and character fns use ALCA. RVRSFLG is never
set in this node.
***************************************************************************)%
BEGIN
%1567% REGISTER
PEXPRNODE CNODE, ! Function node
PEXPRNODE ARG1NODE; ! ARG1PTR of CNODE
LOCAL
%1567% PEXPRNODE ARG2NODE, ! ARG2PTR of CNODE
%1567% BSYRG1, ! Changed BSYREGS
%1567% BASE DPTR, ! Pointer to .Dnnn variable
RB; ! Another register
%1567% CNODE = .TREEPTR; ! Save value of TREEPTR
%1567% ARG1NODE = .CNODE[ARG1PTR];
%1567% ARG2NODE = .CNODE[ARG2PTR];
%1567% IF .ARG1NODE[VALTYPE] EQL CHARACTER
%1567% THEN
%1567% BEGIN ! Character argument (LEN, ICHAR)
%1567%
%1567% IF .CNODE[VALTYPE] EQL CHARACTER
%1567% THEN CGERR(); ! Can't handle character to character yet
%1567%
%1567% TREEPTR = .ARG1NODE; ! Point to the arg
%1567%
%1567% ! Alocate to a temp. (Only register pairs should be
%1567% ! used for char arg)
%1567% BSYRG1 = DPBSYREGS(.BSYREGS);
%1567% ALCINTMP(NXTTMP(2), .BSYRG1, ONESCOUNT(.BSYRG1));
%1567%
%1567% ! Decide on the register to use for the result
%1567%
%1567% RA = RGTOU1(.CNODE, .ARG1NODE, .RA, .BSYREGS);
%1567% SETTARGINREG(.CNODE, .RA);
%1567%
%1567% RETURN; ! Done
%1567%
%1567% END; ! Character argument
%1567% IF .CNODE[VALTYPE] EQL CHARACTER
%1567% THEN
%1567% BEGIN ! Character function (CHAR)
%1567%
%1567% TREEPTR = .ARG1NODE;
%1567%
%1567% ! Allocate argument. (Can use every register for
%1567% ! numeric argument)
%1567% BSYRG1 = SPBSYREGS(.BSYREGS);
%1567% ALCINREG(.RA, .BSYRG1, ONESCOUNT(.BSYRG1));
%1567% RB = .ARG1NODE[TARGTAC]; ! Reg to be used
%1567%
%1567% ! Need two regs. Check if we can use the register
%1567% ! allocated for the argument and the one after it.
%1567% IF .ARG1NODE[INREGFLG] AND BITSET(.BSYREGS,.RB)
%1567% THEN
%1567% BEGIN ! Use the arg's register
%1567%
%1567% CNODE[A1SAMEFLG] = 1;
%1567% END
%1567% ELSE
%1567% BEGIN ! Get a different register
%1567%
%1567% CNODE[A1SAMEFLG] = 0;
%1567% RB = RGTOU1(.CNODE,.ARG1NODE, .RA, .BSYREGS);
%1567% REGCLOBB(.RB);
%1567% END;
%1567%
%1567% CNODE[INREGFLG] = 0; ! Result in memory
%1567%
%1567% CNODE[TARGTAC] = .RB; ! Set register to use
%1567% REGCLOBB(.RB+1); ! Clobber the next one
%1567%
%1567% ! Set up TARGADDR field to the .Dnnn variable and
%1567% ! allocate the .Qnnn variable actually needed for the
%1567% ! storage.
%1567%
%1567% CNODE[TARGADDR] = .ARG2NODE;
%1567% ARG2NODE[IDADDR] = NXTTMP(1); ! Need a 1 word .Qnnn
%1567%
%1567% RETURN; ! Done
%1567%
%1567% END; ! Character function
IF .TREEPTR[OPERSP] EQL ABSFN
THEN
BEGIN
CNODE_.TREEPTR;
IF NOT .CNODE[A1VALFLG] !IF ARG MUST BE COMPUTED
THEN
BEGIN
TREEPTR_.ARG1NODE;
ALCINREG(.RA,.BSYREGS,.FREGCT);
%(***IF HAVE DETERMINED (IN COMPLEXITY PASS) THAT SHOULD LEAVE
VALUE OF THIS NODE IN THE FN-RET REG, DONT CHANGE IT***)%
IF .CNODE[ALCRETREGFLG]
THEN BEGIN END
ELSE
%(***IF ARG1 WAS LEFT IN A REG OTHER THAN FN-RET REG
COMPUTE CNODE IN THAT REG***)%
IF .ARG1NODE[INREGFLG] AND NOT .ARG1NODE[ALCRETREGFLG]
THEN
BEGIN
CNODE[TARGTAC]_.ARG1NODE[TARGTAC];
CNODE[TARGADDR]_.ARG1NODE[TARGTAC];
CNODE[INREGFLG]_1;
CNODE[A1SAMEFLG]_1;
END
ELSE
BEGIN
RA_RGTOU1(.CNODE,.ARG1NODE,.RA,.BSYREGS);
SETTARGINREG(.CNODE,.RA)
END;
END
ELSE !IF ARG IS A VAR,COMMON SUB, OR REGCONTENTS
BEGIN
RA_RGTOU1(.CNODE,.ARG1NODE,.RA,.BSYREGS);
SETTARGINREG(.CNODE,.RA)
END;
%1567% RETURN; !Done
END; ! ABS
! Any other function
ALCA(.RA,.BSYREGS,.FREGCT);
END; ! of ALCILF
GLOBAL ROUTINE ALCINTMP(TA,BSYREGS,FREGCT)=
BEGIN
!*****************************************************************
%1422% ! Perform register or temporary allocation for subnodes of the
%1422% ! node pointed to by the global TREEPTR such that the value of
%1422% ! that node will be left in a temporary which is usually TA. If
%1422% ! TREEPTR is a character function the value is left in the temp
%1422% ! whose descriptor is the first argument instead of in TA.
%1422% ! The other arguments for this routine are:
%1422% ! BSYREGS has bits 0-15 representing the 16 ACS.
%1422% ! The bit for a given AC is 1 if that AC is
%1422% ! available for use.
%1422% ! FREGCT number of regs available for use
!*****************************************************************
LOCAL
RB,
PEXPRNODE CNODE,
PEXPRNODE ARGNODE,
SAVNOBBREGS;
CNODE_.TREEPTR;
CASE .TREEPTR[OPRCLS] OF SET
%(****FOR A BOOLEAN OPERATOR***************)%
BEGIN
%(***EQV AND XOR ARE TREATED LIKE ARITH***)%
IF .TREEPTR[BOOLCLS] NEQ ANDORCLS
THEN
ALCTA(.TA,.BSYREGS,.FREGCT)
ELSE
%(***FOR CONTROL-TYPE BOOLEANS, ALLOCATE VAL TO TA. ALLOC
THE CONTROL PART IN SAME WAY AS DO WHEN VAL GOES TO REG***)%
IF .TREEPTR[VALTYPE] EQL CONTROL
THEN
BEGIN
SAVNOBBREGS_.NOBBREGSLOAD; ! SAVE CURRENT ONE
NOBBREGSLOAD_TRUE; ! DON'T SAVE REGS WHICH
! MAY NOT GET LOADED
ALCCNT(.BSYREGS,.FREGCT);
CNODE[TARGTMEM]_.TA;
NOBBREGSLOAD_.SAVNOBBREGS;
END
ELSE
BEGIN
ARGNODE_.TREEPTR[ARG2PTR];
%(***IF THE 2ND ARG IS NOT OF TYPE CONTROL, THEN NEITHER ARG IS.
TREAT LIKE ARITHMETIC. ***)%
IF .ARGNODE[VALTYPE] NEQ CONTROL
THEN ALCTA(.TA,.BSYREGS,.FREGCT)
%(***IF 1ST ARG IS A MASK, 2ND ARG OF TYPE CONTROL***)%
ELSE ALCTVBOOL(.TA,.BSYREGS,.FREGCT);
END;
END;
%(****FOR A DATA REFERENCE - SHOULD RARELY GET HERE*****)%
BEGIN END;
%(****FOR RELATIONALS***************************************)%
BEGIN
%(****PERFORM REGISTER ALLOCATION FOR THE COMPARISON****)%
ALCRL1(.BSYREGS,.FREGCT);
CNODE[TARGTMEM]_.TA;
END;
%(*****FOR FUNCTION CALLS********************************)%
BEGIN
%1422% ! Character function calls do not return results in AC0, AC1.
%1422% ! Their first argument is the descriptor for the result.
%1422% IF .TREEPTR[VALTYPE] NEQ CHARACTER
%1422% THEN
%1422% BEGIN
TREEPTR[TARGTMEM]_.TA;
TREEPTR[STOREFLG]_1;
TREEPTR[TARGTAC]_RETREG;
TREEPTR[INREGFLG]_0;
%1422% END;
ALCFNCALL(.BSYREGS,.FREGCT);
END;
%(*****FOR ARITHMETIC EXPRESSIONS************************)%
ALCTA(.TA,.BSYREGS,.FREGCT);
%(*****FOR TYPE CONVERSION******************************)%
BEGIN
CNODE_.TREEPTR;
ALCTPCNV(.TA,.BSYREGS,.FREGCT,TRUE);
%(***IF THE VAL COULD BE ALLOCATED DIRECTLY TO A TMP, STORE IT IN TA***)%
IF .CNODE[INREGFLG]
THEN
BEGIN
CNODE[INREGFLG]_0;
CNODE[STOREFLG]_1;
CNODE[TARGTMEM]_.TA;
END;
END;
%(******FOR AN ARRAY REFERENCE*******************)%
%(********MUST INSERT A "STORE" NODE ABOVE THE ARRYAREF NODE, TO HOLD THE
ADDRESS TA - SINCE THE TARGTMEM FIELD OF THE ARRAYREF NODE MUST
HOLD THE ARRAY OFFSET**********)%
BEGIN
OWN PEXPRNODE PARNODE:STORENODE;
%1561% IF .TREEPTR[VALTYPE] EQL CHARACTER
%1561% THEN RETURN ALCCHARRAY(.TA,.BSYREGS,.FREGCT);
PARNODE_.TREEPTR[PARENT];
%(***IN THE CASE WHERE THE ARRAY IS DOUBLE-WD (IE DP OR COMPLEX) AND THERE
IS ONLY ONE REG PAIR LEFT WE WONT HAVE ENOUGH REGS
TO HAVE THE INDEX IN A REG AND PICK UP THE 2 WDS OF THE ARRAY ELEMENT.
(SINCE WE CANNOT PICK UP A DOUBLE-WD VAL INTO THE SAME REG USED FOR INDEXING)
IN THIS CASE, SAVE A PTR TO THE ELEMENT INSTEAD.
*********)%
IF .TREEPTR[DBLFLG] AND (.TREEPTR[ARG2PTR] NEQ 0) AND .FREGCT LSS 2
THEN
BEGIN
(IF .PARNODE[ARG1PTR] EQL .TREEPTR THEN PARNODE[ARG1PTR] ELSE PARNODE[ARG2PTR])_
ALCTARY(.BSYREGS,.FREGCT)
END
ELSE
%(***OTHERWISE, STORE THE VALUE OF THE ARRAY ELEMENT IN THE TEMP**)%
BEGIN
STORENODE_MAKPR1(.PARNODE,STORECLS,STARVAL,.TREEPTR[VALTYPE],0,.TREEPTR);
STORENODE[TARGTMEM]_.TA;
(IF .PARNODE[ARG1PTR] EQL .TREEPTR THEN PARNODE[ARG1PTR]
ELSE PARNODE[ARG2PTR]) _ .STORENODE;
ALCARRAY(.BSYREGS,.FREGCT);
SETTAC(.STORENODE,
RGTOU1(.STORENODE,.STORENODE[ARG2PTR],
AFREEREG(.BSYREGS,FALSE,FALSE),.BSYREGS));
END
END;
%(*****FOR COMMON SUBEXPRS - DONT WALK DOWN ON THEM***)%
BEGIN END;
%(****FOR NEG/NOT***************************************)%
BEGIN
ARGNODE_.CNODE[ARG2PTR];
RB_AFREEREG(.BSYREGS,FALSE,.ARGNODE[DBLFLG]);
%(***IF ARG UNDER THIS NODE IS COMPUTED INTO A REG, USE THAT REG,
OTHERWISE USE RB******)%
IF .CNODE[A2VALFLG]
THEN
%(***FOR ARG A VARIABLE OR COMMON-SUBEXPR***)%
SETTAC(.CNODE,.RB)
ELSE
BEGIN
TREEPTR_.ARGNODE;
ALCINREG(.RB,.BSYREGS,.FREGCT);
IF .ARGNODE[INREGFLG]
THEN
BEGIN
CNODE[TARGTAC]_.ARGNODE[TARGTAC];
CNODE[A2SAMEFLG]_1;
END
ELSE
BEGIN
RB_RGTOU1(.CNODE,.ARGNODE,.RB,.BSYREGS);
SETTAC(.CNODE,.RB)
END
END;
%(***STORE THE VALUE INTO THE TMP*************)%
CNODE[INREGFLG]_0;
CNODE[TARGTMEM]_.TA;
CNODE[STOREFLG]_1;
END;
%(***FOR SPECIAL OPS -
P2MUL,P2DIV,SQUARE,CUBE,... - COMPUTE THE VALUE IN A REG, THEN STORE***)%
BEGIN
ALCINREG(AFREEREG(.BSYREGS,FALSE,.TREEPTR[DBLFLG]),.BSYREGS,.FREGCT);
CNODE[INREGFLG]_0;
CNODE[TARGTMEM]_.TA;
CNODE[STOREFLG]_1;
END;
CGERR(); !FIELD-REF, NOT IN RELEASE 1
%2402% !STORECLS
%2402% BEGIN
%2402% IF .CNODE[OPERSP] NEQ STRHAOBJN THEN CGERR();
%2402% SETTAC(.CNODE,AFREEREG(.BSYREGS,FALSE,FALSE));
%2402% CNODE[INREGFLG] = 0;
%2402% CNODE[TARGTMEM] = .TA;
%2402% CNODE[STOREFLG] = 1;
%2402% END;
BEGIN END; !REGCONTENTS: SHOULD RARELY WALK DOWN HERE
CGERR(); !LABOP: SHOULD NEVER WALK DOWN ON ONE
CGERR(); !STATEMENT: SHOULD NOT OCCUR UNDER
! AN EXPRESSION
CGERR(); !IOLSCLS: SHOULD NOT OCCUR
%(****For an in-line-fn: Compute the val in a reg, then store*****)%
BEGIN ! In-line
ALCILF(AFREEREG(.BSYREGS,FALSE,.TREEPTR[DBLFLG]),
.BSYREGS, .FREGCT);
%1567% ! If the return value to the function was left in an ac,
%1567% ! then put it into memory.
%1567%
%1567% IF .CNODE[INREGFLG]
%1567% THEN
%1567% BEGIN
CNODE[INREGFLG]_0;
CNODE[TARGTMEM]_.TA;
CNODE[STOREFLG]_1;
%1567% END;
END; ! In-line
%1431% %(****FOR SUBSTRING****)%
%1431% ALCSUBSTR(.TA,.BSYREGS,.FREGCT);
%1474% %(****FOR CONCATENATION***)%
%1474% ALLCONCAT(.TA, .BSYREGS, .FREGCT);
TES;
END; ! of ALCINTMP
GLOBAL ROUTINE ALCTVBOOL(TA,BSYREGS,FREGCT)=
%(***************************************************************************
ROUTINE TO PERFORM REGISTER ALOCATION FOR AN "AND" OR "OR" NODE WHOSE VALUE IS TO BE
COMPUTED INTO THE MEMORY LOCATION "TA", AND WHICH IS KNOWN TO HAVE ARG2
OF TYPE CONTROL, AND ARG1 NOT OF TYPE CONTROL.
THE VALUE OF ARG1 WILL BE COMPUTED AND STORED INTO TA, THEN ARG2 WILL BE EVALUATED
AND IN THE CASE OF "AND", 0 WILL BE STORED INTO TA IF ARG2 IS FALSE,
IN THE CASE OF "OR", 1 WILL BE STORED IF ARG2 IS TRUE
TREEPTR POINTS TO THE PARENT NODE.
***************************************************************************)%
BEGIN
LOCAL PEXPRNODE CNODE:ARG1NODE;
LABEL ALLARG1;
LOCAL RA;
%(***DEFINE MACRO TO USE SOME LEGAL REGISTER***)%
MACRO USESOMEREG=
BEGIN
RA_RGTOU1(.CNODE,.ARG1NODE,AFREEREG(.BSYREGS,FALSE,FALSE),.BSYREGS);
SETTAC(.CNODE,.RA);
END$;
%(***DEFINE MACRO TO USE THE REG INTO WHICH ARG1 WAS COMPUTED (AND THEN
STORE VAL INTO TA)***)%
MACRO USEA1REG=
BEGIN
CNODE[TARGTAC]_.ARG1NODE[TARGTAC];
CNODE[A1SAMEFLG]_1;
END$;
CNODE_.TREEPTR;
ARG1NODE_.TREEPTR[ARG1PTR];
%(***PERFORM REG ALLOC FOR ARG1******)%
IF .CNODE[A1VALFLG]
THEN
BEGIN
%(***IF ARG IS A COMMON SUBEXPR OR REGCONTENTS, WILL JUST STORE IT INTO TA)%
IF .ARG1NODE[INREGFLG]
THEN
%[1064]% CNODE[TARGTAC]_.ARG1NODE[TARGTAC]
%(***IF ARG IS IN MEMORY, WILL LOAD IT AND STORE IT INTO TA***)%
ELSE
USESOMEREG
END
ELSE
ALLARG1:BEGIN
TREEPTR_.ARG1NODE;
!IF THE AND NODE (OR NODE) HAS A1NOTFLG SET, MUST BE
! VERY CAREFUL ABOUT TARGETING BOTH ARG1NODE AND CNODE
! SO THAT ARG1NODE GOES TO A REG WHILE CNODE GOES TO MEMORY
IF .CNODE[A1NOTFLG]
THEN
BEGIN
RA_AFREEREG(.BSYREGS,FALSE,FALSE);
ALCINREG(.RA,.BSYREGS,.FREGCT);
!IF THE PRECEDING CALL TO ALCINREG DOES NOT REALLY ALLOCATE
! THE REGISTER THAT WAS EXPECTED, THEN WE NEED TO CALL
! SETTAC TO SET TARGET IN CNODE.
![672] IF THE PRECEDING CALL TO ALCINREG DOES NOT REALLY ALLOCATE
![672] THE REGISTER THAT WAS EXPECTED, THEN WE NEED TO CALL
![672] SETTAC TO SET TARGET IN CNODE.
%[672]% IF .ARG1NODE[INREGFLG] THEN
%[672]% CNODE[A1SAMEFLG]_0
%[672]% ELSE USESOMEREG;
LEAVE ALLARG1
END;
ALCINTMP(.TA,.BSYREGS,.FREGCT);
IF .ARG1NODE[TARGTMEM] EQL .TA
%(***IF ARG1 WAS COMPUTED INTO TA, WILL NOT NEED TO LOAD IT***)%
THEN CNODE[A1SAMEFLG]_1
ELSE
%(**IF ARG1 WAS LEFT IN A REG, WILL STORE IT IN TA; IF NOT LOAD
IT INTO A REG AND STORE IT INTO TA***)%
IF .ARG1NODE[INREGFLG]
THEN
USEA1REG
ELSE
USESOMEREG
END;
CNODE[TARGTMEM]_.TA;
!IF THE COMPLEXITY PASS ALLOCATED THIS NODE TO BE COMPUTED
! IN FUNCTION RETURN REGISTER, UNDO THAT DECISION
IF .CNODE[ALCRETREGFLG] THEN
BEGIN
CNODE[ALCRETREGFLG]_0;
CNODE[INREGFLG]_0
END;
%(***PERFORM ALLOCATION FOR THE CONTROL-TYPE ARG***)%
TREEPTR_.CNODE[ARG2PTR];
ALCNARG(.BSYREGS,.FREGCT);
END; ! of ALCTVBOOL
ROUTINE USEARGREG(RA,BSYREGS,CNODE,ARG1NODE)=
BEGIN
!***************************************************************
! Set the register for computation of CNODE to the register into
! which ARG1NODE was computed if possible.
!***************************************************************
MAP
PEXPRNODE CNODE,
PEXPRNODE ARG1NODE;
! IF THIS NODE WAS ALREADY ALLOCATED TO FN RET REG, DO NOT CHANGE IT
IF .CNODE[ALCRETREGFLG] THEN RETURN;
! IF CAN USE THE REG CONTAINING ARG1, DO SO
IF .ARG1NODE[INREGFLG] AND NOT .ARG1NODE[ALCRETREGFLG]
THEN RA_.ARG1NODE[TARGTAC];
! USE RA IF ITS LEGAL FOR THIS OPERATION, IF NOT USE SOME
! OTHER LEGAL REG
RA_REGTOUSE(.CNODE,.CNODE[ARG1PTR],.CNODE[ARG2PTR],.RA,.BSYREGS);
SETTAC(.CNODE,.RA);
! IF WERE ABLE TO USE THE REG IN WHICH ARG1 WAS LEFT, SET A1SAMEFLG
IF (.CNODE[TARGTAC] EQL .ARG1NODE[TARGTAC]) AND .ARG1NODE[INREGFLG]
THEN CNODE[A1SAMEFLG]_1;
END; ! of USEARGREG
GLOBAL ROUTINE ALCTA(TA,BSYREGS,FREGCT)=
%(***************************************************************************
PERFORM REGISTER/TEMPORARY ALLOCATION FOR A BINARY NODE POINTED TO
BY THE GLOBAL TREEPTR
THE OPERATOR ON THIS NODE IS ARITHMETIC OR BOOLEAN AND IS ALWAYS
ONE THAT CAN BE PERFORMED TO MEMORY, ***EXCEPT*** FOR KI10 DOUBLE-WD OPERATIONS
CALLED WITH THE ARGS
TA - TEMPORARY INTO WHICH THE RESULT SHOULD BE COMPUTED
BSYREGS - BITS 0-15 OF THIS WD REPRESENT THE 16 REGS,
A BIT IS 1 IFF THE CORRESP REG IS AVAIL FOR USE
***************************************************************************)%
BEGIN
REGISTER PEXPRNODE CNODE;
REGISTER PEXPRNODE ARG1NODE;
LOCAL PEXPRNODE ARG2NODE;
LOCAL RA; !REGISTER TO BE USED IN THE
!COMPUTATION OF THE VAL OF THIS NODE
OWN CMPLX1,CMPLX2; !NUMBER OF REGS NECESSARY TO
! EVALUATE ARG1, ARG2
ROUTINE USESOMEREG(BSYREGS)=
%(******************************
LOCAL ROUTINE TO USE SOME LEGAL REGISTER.
DETERMINE REG TO USE AND THEN SET TARGET AC TO THAT REG
********************************)%
BEGIN
OWN RA;
%(***IF FN-RET REG WAS ALREADY ASSIGNED, DONT DO ANYTHING***)%
IF .CNODE[ALCRETREGFLG]
THEN BEGIN END
ELSE
BEGIN
%(***GET A REG THAT CAN BE USED***)%
RA_REGTOUSE(.CNODE,.ARG1NODE,.CNODE[ARG2PTR],
AFREEREG(.BSYREGS,FALSE,.CNODE[DBLFLG]),.BSYREGS);
%(***SET REG FOR COMP OF CNODE TO RA***)%
SETTAC(.CNODE,.RA);
END
END; ! of USESOMEREG
CNODE_.TREEPTR;
RA_AFREEREG(.BSYREGS,FALSE,.CNODE[DBLFLG]);
%(****IF THE VALUE OF THIS NODE CAN BE COMPUTED IN THE NUMBER OF REGS AVAILABLE, DO
SO AND THEN STORE THE VALUE INTO TA
ALSO - FOR DOUBLE WD OPS ON THE KI10, COMPUTE AND THEN STORE****)%
IF .CNODE[COMPLEXITY] LEQ .FREGCT
OR (.CNODE[VALTYPE] EQL DOUBLPREC)
OR (.CNODE[OPERSP] EQL EXPONOP)
THEN
BEGIN
ALCA(.RA,.BSYREGS,.FREGCT);
CNODE[INREGFLG]_0;
CNODE[STOREFLG]_1;
CNODE[TARGTMEM]_.TA;
RETURN
END;
ARG1NODE_.CNODE[ARG1PTR];
ARG2NODE_.CNODE[ARG2PTR];
%(****WANT TO PERFORM THE OPERATION ON THIS NODE TO MEMORY - THEREFORE ARG2 SHOULD
BE COMPUTED INTO TA, ARG1 INTO RA. *****)%
%(***IF ARG2 NEEDS NO EVALUATION, SIMPLY EVAL ARG1 INTO RA***)%
%(****THEN COMPUTE VAL OF PARENT IN RA AND STORE IN TA**********)%
IF .CNODE[A2VALFLG]
THEN
BEGIN
TREEPTR_.ARG1NODE;
ALCINREG(.RA,.BSYREGS,.FREGCT);
%(***SET REG FOR COMP OF CNODE TO REG WHERE VAL OF ARG1 WAS LEFT***)%
USEARGREG(.RA,.BSYREGS,.CNODE,.ARG1NODE);
CNODE[STOREFLG]_1;
END
ELSE
%(***IF ARG1 NEEDS NO EVALUATION, EVALUATE ARG2 INTO TA****)%
IF .CNODE[A1VALFLG]
THEN
BEGIN
TREEPTR_.ARG2NODE;
ALCINTMP(.TA,.BSYREGS,.FREGCT);
%(***GET A REG FOR COMP OF THIS NODE***)%
USESOMEREG(.BSYREGS);
END
ELSE
%(****IF BOTH SUBNODES REQUIRE COMPUTATION, PERFORM REGISTER ALLOCATION FOR THE
2 COMPUTATIONS.
IF THE FIRST SUBNODE COMPUTED HAS ITS VAL LEFT IN A REGISTER, THEN THAT
REGISTER CANNOT BE USED IN COMPUTATION OF THE OTHER SUBNODE.
(NOTE THAT EVEN IF A SUBNODE HAS BEEN DESIGNATED AS COMPUTED INTO "FN
RETURN REG", MUST STILL DO ALLOCATION FOR SOME OF ITS SUBNODES)
*************)%
IF .CNODE[RVRSFLG]
THEN
%(****IF ARG2 IS COMPUTED BEFORE ARG1****)%
BEGIN
TREEPTR_.ARG2NODE;
ALCINTMP(.TA,.BSYREGS,.FREGCT);
!THE CALL TO ALCINTMP (ONE LINE UP) MAY CAUSE A STORE
! CLASS NODE TO BE INSERTED BETWEEN CNODE AND ARG2NODE.
! WE NEED TO ADJUST ARG2NODE IN THIS CASE SO THAT THE
! TEST AGAINST ARG2NODE[TARGTMEM] LATER ON WILL SUCCEED
ARG2NODE_.CNODE[ARG2PTR];
TREEPTR_.ARG1NODE;
ALCINREG(.RA,.BSYREGS,.FREGCT);
%(***SET REG FOR COMP OF CNODE TO REG WHERE VAL OF ARG1 WAS LEFT (IF CAN)***)%
USEARGREG(.RA,.BSYREGS,.CNODE,.ARG1NODE);
END
ELSE
%(***IF ARG1 IS EVALUATED BEFORE ARG2***)%
BEGIN
TREEPTR_.ARG1NODE;
IF .ARG2NODE[COMPLEXITY] GTR (.FREGCT-1)
THEN
%(***IF WILL NEED TO USE RA IN COMPUTING ARG2***)%
BEGIN
%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);
TREEPTR_.ARG2NODE;
IF .ARG2NODE[COMPLEXITY] EQL .FREGCT
THEN
BEGIN
ALCINREG(AFREEREG(CLRBIT(.BSYREGS,.RA),FALSE,.ARG2NODE[DBLFLG]),.BSYREGS,.FREGCT);
CNODE[STOREFLG]_1;
END
ELSE
ALCINTMP(.TA,.BSYREGS,.FREGCT);
USESOMEREG(.BSYREGS)
END
ELSE
%(***IF CAN COMPUTE ARG2 WITHOUT CLOBBERRING RA***)%
BEGIN
LOCAL BSYRG1;
ALCINREG(.RA,.BSYREGS,.FREGCT);
%(***IF ARG1 WAS LEFT IN A REG, DO NOT USE THAT REG IN THE COMP OF ARG2**)%
IF .ARG1NODE[INREGFLG]
THEN
BSYRG1_CLRBIT(.BSYREGS,.ARG1NODE[TARGTAC])
ELSE
BSYRG1_.BSYREGS;
TREEPTR_.ARG2NODE;
ALCINREG(AFREEREG(.BSYRG1,FALSE,.ARG2NODE[DBLFLG]),.BSYRG1,ONESCOUNT(.BSYRG1));
%(***SET REG FOR COMP OF CNODE TO REG WHERE VAL OF ARG1 WAS LEFT (IF CAN)***)%
USEARGREG(.RA,.BSYREGS);
CNODE[STOREFLG]_1;
END;
END;
IF .ARG2NODE[TARGTMEM] EQL .TA
THEN
BEGIN
CNODE[A2SAMEFLG]_1;
CNODE[MEMCMPFLG]_1;
%[1145]% CNODE[INREGFLG]_0; ! With just MEMCMP, values cannot
%[1145]% CNODE[ALCRETREGFLG]_0; ! be returned in any register
END;
CNODE[TARGTMEM]_.TA;
RETURN;
END; ! of ALCTA
GLOBAL ROUTINE ALCTARY(BSYREGS,FREGCT)=
%(***************************************************************************
ROUTINE TO ALLOCATE AN ARRAYREF NODE SO THAT THE ADDRESS WILL
BE COMPUTED AND STORED IN A TEMPORARY (WHICH WILL LATER BE USED AS
A PTR).
THIS ROUTINE WILL INTRODUCE A "STARADDR" (OPRCLS=STORECLS, OPERSP=STARADDR)
NODE INTO THE TREE ABOVE THE ARRAYREF NODE, HOWEVER IT WILL NOT ACTUALLY
LINK THE NEW NODE IN UNDER THE PARENT OF THE ARRAYREF. INSTEAD IT WILL
RETURN A PTR TO THE NEW NODE AND THE LINKING MUST BE COMPLETED BY THE
ROUTINE THAT CALLED IT. (THIS IS NECESSARY BECAUSE IN SOME CASES
THE ARRAYREF WAS IN AN ARGUMENT LIST OR AN IOLIST).
THE INDIRECT BIT WILL BE SET IN THE TARGET WORD OF THE STOREADDR
NODE SO THAT REFERENCES TO THIS ELEMENT WILL BE MADE INDIRECT.
***************************************************************************)%
BEGIN
LOCAL PEXPRNODE CNODE:STORENODE;
LOCAL RA; !REG TO USE IN GETTING THE ADDR
CNODE_.TREEPTR;
%1561% ! A char arrayref will be evaluated into a .Q temp; return the .Q temp
%1561%
%1561% IF .CNODE[VALTYPE] EQL CHARACTER ! Character arrayref?
%1561% THEN
%1561% BEGIN ! character
%1561% STORENODE = .TREEPTR; ! Save pointer to arrayref node
%1561% ALCCHARRAY(NXTTMP(2),.BSYREGS,.FREGCT); ! Allocate to .Q temp
%1561% RETURN .STORENODE; ! Return arrayref node
%1561% END; ! character
%(***PERFORM REGISTER ALLOCATION FOR THE ARRAYREF NODE***)%
ALCARRAY(.BSYREGS,.FREGCT);
%(***IF THE ADDRESS IS A COMPILE-TIME CONSTANT (AND HENCE REFERENCING IT DOES
NOT DEPEND ON THE CONTENTS OF SOME REG BEING PRESERVED), NEED NOT DO ANYTHING SPECIAL***)%
IF .CNODE[TARGXF] EQL 0
THEN
RETURN .CNODE;
%(***PUT A "STARADDR" NODE ABOVE THE ARRAYREF NODE***)%
STORENODE_MAKPR1(.CNODE[PARENT],STORECLS,STARADDR,.CNODE[VALTYPE],0,.CNODE);
%(***DETERMINE WHAT REG TO USE TO LOAD THE ADDR - USE THE SAME REG THAT
HOLDS THE PARTIAL ADDR (WITHOUT CONSTANT OFFSET) IF POSSIBLE***)%
RA_.CNODE[TARGXF];
IF NOT BITSET(.BSYREGS,.RA) THEN RA_AFREEREG(.BSYREGS,FALSE,FALSE);
SETTAC(.STORENODE,.RA);
%(***IF THERE IS NO CONSTANT PORTION OF THE ADDRESS TO ADD IN TO THE
VARIABLE PORTION, SET A2SAMEFLG ****)%
IF (.CNODE[TARGADDR] EQL 0) AND (.CNODE[TARGXF] EQL .STORENODE[TARGTAC])
AND (.CNODE[FORMLFLG]) !UNLESS THE ARRAY IS A FORMAL, WILL
! HAVE TO ADD IN THE BASE EVEN IF
! ITS **REALTIVE** ADDRESS IS 0
THEN
STORENODE[A2SAMEFLG]_1;
%(***SET UP TARGET WD OF THE STOREADDR NODE - WILL REFERENCE THIS
ITEM INDIRECT THRU A TEMPORARY THAT HOLDS THE PTR***)%
%1274% STORENODE[TARGADDR] = NXTTMP(1); ! Get 1 word temp
STORENODE[TARGIF]_1;
RETURN .STORENODE;
END; ! of ALCTARY
GLOBAL ROUTINE ALCTVARR(BSYREGS,FREGCT)=
%(***************************************************************************
Allocates an array ref so that the value of the array element
will be stored in a temporary. For a DP or COMPLEX array, this
routine must be called with at least 2 reg (pairs) available,
since the reg indexed off of cannot be loaded into for KA10.
This routine will introduce a "STARVAL" (OPRCLS=STORECLS,
OPERSP=STARVAL) into the tree above the ARRAYREF node, however
it will not link that node in under the parent of the arrayref.
Instead it will return a ptr to the new node and the linking
must be done by the routine that called it. This routine is
called when the arrayref is a unit or record number, or is under
an OPEN/CLOSE. TREEPTR points to the arrayref.
***************************************************************************)%
BEGIN
REGISTER PEXPRNODE STORENODE;
%1561% ! A char arrayref will be evaluated into a .Q temp; return the .Q temp
%1561%
%1561% IF .TREEPTR[VALTYPE] EQL CHARACTER ! Character arrayref?
%1561% THEN
%1561% BEGIN ! character
%1561% STORENODE = .TREEPTR; ! Save pointer to arrayref node
%1561% ALCCHARRAY(NXTTMP(2),.BSYREGS,.FREGCT); ! Allocate to .Q temp
%1561% RETURN .STORENODE; ! Return arrayref node
%1561% END; ! character
STORENODE_MAKPR1(.TREEPTR[PARENT],STORECLS,STARVAL,.TREEPTR[VALTYPE],0,.TREEPTR);
%1274% ! Get 1 or 2 word temp based on DBLFLG
%1274% STORENODE[TARGTMEM] =
%1274% IF .TREEPTR[DBLFLG]
%1274% THEN NXTTMP(2)
%1274% ELSE NXTTMP(1);
ALCARRAY(.BSYREGS,.FREGCT);
SETTAC(.STORENODE,
RGTOU1(.STORENODE,.STORENODE[ARG2PTR],AFREEREG(.BSYREGS,FALSE,FALSE),.BSYREGS));
RETURN .STORENODE
END; ! of ALCTVARR
GLOBAL ROUTINE REGTOUSE(PNODE,ARG1NODE,ARG2NODE,RA,BSYREGS)=
%(***************************************************************************
ROUTINE TO DECIDE WHICH REGISTER TO USE FOR COMPUTATION OF
A BINARY NODE WHEN DO NOT HAVE THE 1ST ARG IN A REG THAT CAN BE USED.
IF POSSIBLE WILL WANT TO USE THE REG RA (BECAUSE IT IS THE REG TO WHICH
THE COMPUTATION WAS "TARGETED") - BUT CANNOT USE RA IF
1.ARG2 WAS LEFT IN RA
2.ARG1 IS A DOUBLE-PRECISION ARRAYREF AND THE INDEX WAS LEFT
IN RA
3.IF THE OPERATION CLOBBERS THE REGISTER AFTER THE ONE IN WHICH
IT IS BEING PERFORMED AND THE REG AFTER RA CONTAINS
A VALUE THAT NEEDS TO BE PRESERVED
WE PREFER TO NOT USE RA IF IT IS IN THE SET OF REGS TO BE PRESERVED
BY THE BB ALLOCATOR.
[1431] RETURNS A PAIR IF PNODE IS TYPE DOUBLE OR COMPLEX, OTHERWISE RETURNS
A SINGLE REGISTER. DOES *NOT* USE DBLFLG SINCE IT ISN'T APPROPRIATE
TO RETURN PAIRS FOR CHARACTER CALCULATIONS. THE ONLY POSSIBILITIES
FOR DBLFLG BEING SET IN A PARENT NODE ARE DOUBLE PRECISION, COMPLEX,
AND CHARACTER. VALTYPE IS CHECKED INSTEAD OF DBLFLG.
***************************************************************************)%
BEGIN
MAP PEXPRNODE PNODE:ARG1NODE:ARG2NODE;
OWN BSYRG1; !SET OF REGS THAT CAN BE
! USED FOR PERFORMING THIS OPERATION
OWN RB;
%1431% OWN DOUBLFLG; ! VALTYPE DOUBLE OR COMPLEX
! (BUT NOT CHARACTER)
%(***WHEN IN DEBUG MODE- CHECK THAT BSYREGS IS NON-ZERO***)%
IF DEBUGFLG
THEN
(IF .BSYREGS EQL 0 THEN CGERR());
BSYRG1_.BSYREGS;
%(***IF ARG1 IS ACCESSED OFF OF AN INDEX REGISTER (IT COULD BE EITHER
AN ARRAYREF NODE OR A TYPE-CONVERSION NODE THAT DOESNT DO ANYTHING),
THEN CAN'T USE THE INDEX REGISTER FOR THE FETCH ON A KA10,
SINCE 2 MOVE-TYPE INSTRUCTIONS ARE GENERATED. THIS ALSO
APPLIES TO A NEGATED COMPLEX FETCH ON A KI OR KL, SINCE
THAT CASE GENERATES TWO CONSECUTIVE MOVN'S. WE WON'T
ALLOW THE AC'S TO BE THE SAME FOR ANY COMPLEX FETCHES,
SINCE NEGFLG'S CAN FLOAT IN LATER (IN FORTG)***)%
IF .ARG1NODE[TARGXF] NEQ 0
THEN
IF.ARG1NODE[VALTYPE] EQL COMPLEX
THEN BSYRG1_CLRBIT(.BSYRG1,.ARG1NODE[TARGXF] );
%(***IF NEED TO PRESERVE SOME REG TO ACCESS THE VAL OF ARG2, MUST NOT USE
THAT REG***)%
IF (RB_RGTOSAVE(.ARG2NODE)) NEQ -1
THEN BSYRG1_CLRBIT(.BSYRG1,.RB);
%(***IF RA IS NOW NOT IN THE SET OF REGS AVAILABLE FOR USE
OR IF IT IS ONE OF THE REGS TO BE PRESERVED FOR THE BB ALLOCATOR, GET A NEW REG
TO USE***)%
IF NOT BITSET(.BSYRG1 AND .BLOCKBSYREGS,.RA) THEN
BEGIN
%1431% DOUBLFLG _ .PNODE[VALTYPE] EQL DOUBLPREC OR .PNODE[VALTYPE] EQL COMPLEX;
%1431% RA_AFREEREG(.BSYRG1,FALSE,.DOUBLFLG);
END;
%(***IF THIS OPERATION CLOBBERS THE NEXT REG AFTER THE ONE USED, CHECK
THAT THE REG AFTER RA IS FREE (NOTE HOWEVER THAT THE REG AFTER
RA DOES NOT HAVE THE SAME RESTRICTIONS ON IT AS RA DOES -HENCE
CAN COMPARE WITH "BSYREGS" RATHER THAN "BSYRG1"***)%
IF CLOBBNX(.PNODE) AND (NOT NXREGFREE(.BSYREGS,.RA))
THEN RA_GETRGPR(.RA,.BSYRG1);
RETURN .RA
END; ! of REGTOUSE
GLOBAL ROUTINE RGTOU1(PNODE,ARGNODE,RA,BSYREGS)=
%(***************************************************************************
ROUTINE TO DECIDE WHICH REGISTER TO USE FOR A UNARY NODE WHEN THE
ARG WAS NOT LEFT IN A REG THAT CAN BE USED FOR COMPUTATION OF THE
PARENT. IF POSSIBLE WANT TO USE THE REG "RA".
IF RA IS IN THE SET OF REGS TO BE PRESERVED FOR THE BB ALLOCATOR,
THEN IF POSSIBLE USE SOME OTHER REG.
[1431] RETURNS A PAIR IF PNODE IS TYPE DOUBLE OR COMPLEX, OTHERWISE RETURNS
A SINGLE REGISTER. DOES *NOT* USE DBLFLG SINCE IT ISN'T APPROPRIATE
TO RETURN PAIRS FOR CHARACTER CALCULATIONS. THE ONLY POSSIBILITIES
FOR DBLFLG BEING SET IN A PARENT NODE ARE DOUBLE PRECISION, COMPLEX,
AND CHARACTER. VALTYPE IS CHECKED INSTEAD OF DBLFLG.
***************************************************************************)%
BEGIN
MAP PEXPRNODE PNODE:ARGNODE;
OWN BSYRG1,RB;
%1431% OWN DOUBLFLG;
%(***WHEN IN DEBUG MODE- CHECK THAT BSYREGS IS NON-ZERO***)%
IF DEBUGFLG
THEN
(IF .BSYREGS EQL 0 THEN CGERR());
%(**FIRST, MUST CHECK THAT RA IS IN THE SET OF REGS INDICATED BY BSYREGS (ALCTPCNV
COUNTS ON THIS BEING DONE HERE)***)%
IF NOT BITSET (.BSYREGS AND .BLOCKBSYREGS,.RA)
THEN
BEGIN
%1431% DOUBLFLG _ .PNODE[VALTYPE] EQL DOUBLPREC OR .PNODE[VALTYPE] EQL COMPLEX;
%1431% RA_AFREEREG(.BSYREGS,.PNODE[SAVREGFLG],.DOUBLFLG);
END;
BSYRG1_.BSYREGS;
%(***IF THE ARG IS ACCESSED BY USING AN INDEX REGISTER AND IT IS DOUBLE-WD
THEN THAT INDEX REG CANNOT BE USED FOR COMPUTATION OF THE PARENT NODE***)%
IF (.ARGNODE[DBLFLG]) AND (.ARGNODE[TARGXF] NEQ 0)
THEN
BEGIN
BSYRG1_CLRBIT(.BSYRG1,(RB_.ARGNODE[TARGXF]));
IF .RA EQL .RB
THEN
BEGIN
IF .BSYRG1 EQL 0 THEN CGERR();
RA_AFREEREG(.BSYRG1,.PNODE[SAVREGFLG],.PNODE[DBLFLG]);
END;
END;
%(***IF THIS OP CLOBBERS THE REG AFTER THE ONE ON WHICH IT IS PERFORMED***)%
IF CLOBBNX(.PNODE) AND NOT NXREGFREE(.BSYREGS,.RA) THEN RA_GETRGPR(.RA,.BSYRG1);
RETURN .RA
END; ! of RGTOU1
GLOBAL ROUTINE SETTARGINREG(CNODE,RA)=
%(***************************************************************************
TO SET THE TARGET OF A NODE TO INDICATE THAT THE VALUE WILL
LIVE IN THE REGISTER "RA"
***************************************************************************)%
BEGIN
MAP PEXPRNODE CNODE;
CNODE[TARGTAC]_.RA; !SET FIELD IN NODE TO INDICATE THAT THIS REG
! SHOULD BE USED FOR THE COMPUTATION OF THE NODE
CNODE[TARGADDR]_.CNODE[TARGTAC]; !SET FIELD INDICATING THAT THE "MEMORY" LOCATION
! FOR THE VAL OF THE NODE IS THE REG THAT
! WAS USED TO COMPUTE THE VAL
CNODE[INREGFLG]_1; !SET FLAG INDICATING VAL IS IN A REG
REGCLOBB(.CNODE[TARGTAC]); !MUST ASSUME THAT THE PREVIOUS CONTENTS OF
! THE REG USED WILL BE CLOBBERED (MUST
! CLEAR ENTRIES FOR THAT REG IN BASIC-BLOCK ALLOC TABLES)
IF CLOBBNX(.CNODE) !IF THIS OPERATION WILL CLOBBER THE REG
OR .CNODE[DBLFLG] ! FOLLOWING RA, MUST ALSO ASSUME THAT
THEN ! THE PREVIOUS CONTENTS OF THAT REG
REGCLOBB(.CNODE[TARGTAC]+1); ! ARE CLOBBERED
END; ! of SETTARGINREG
GLOBAL ROUTINE SETTAC(CNODE,RA)=
%(***************************************************************************
TO SET THE TARGET AC FIELD OF A NODE TO THE REG RA (WHEN
THE "TARGADDR" WILL BE SOME OTHER LOC)
***************************************************************************)%
BEGIN
MAP PEXPRNODE CNODE;
CNODE[TARGTAC]_.RA; !SET FIELD IN NODE TO INDICATE THAT OPERATION
! SHOULD BE CALCULATED IN REG "RA"
REGCLOBB(.RA); !MUST ASSUME THAT THE PREVIOUS CONTENTS OF THAT
! REG WILL BE CLOBBERED BY CALC OF THIS NODE
! CLEAR THE BASIC-BLOCK ALLOCATOR TABLE ENTRIES FOR
! THAT REG
IF CLOBBNX(.CNODE) !IF THE EVAL OF THIS NODE WILL CLOBBER THE REG FOLLOWING RA
OR .CNODE[DBLFLG]
OR ((.CNODE[OPRCLS] EQL TYPECNV) ! CHECK FOR TYPE CONVERSION
AND .CNODE[SDBLFLG]) ! FROM DOUBLE TO SINGLE
THEN ! THEN CLEAR THE BASIC-BLOCK ALLOCATOR TABLE ENTRIES
REGCLOBB(.CNODE[TARGTAC]+1); !FOR THAT REG AS WELL
END; ! of SETTAC
GLOBAL ROUTINE CLOBBNX(NODE)=
%(***************************************************************************
Routine to test whether an operation clobbers the register
following the reg in which it is performed. This test does not
check for double-prec operations - when one is in "double-prec
mode" one simply does not use the odd regs at all node points to
an expression node.
***************************************************************************)%
BEGIN
MAP PEXPRNODE NODE;
(
! For divide of an integer, logical, or index var
(.NODE[OPR1] EQL OPR1C(ARITHMETIC,DIVOP)
AND .NODE[VALTP1] EQL INTEG1)
OR (.NODE[OPR1] EQL MODFNFL) ! Inline function MOD
)
END; ! of CLOBBX
GLOBAL ROUTINE STORAC(CNODE,BSYREGS)=
BEGIN
%(****************************************************************************
ROUTINE TO STORE THE VALUE OF A NODE IN A TEMPORARY IF IT DEPENDS
ON ANY AC (IE IF IT IS IN AN AC OR IF IT REQUIRES AN INDEXED
REFERENCE).
CNODE - THE NODE WHOSE VALUE SHOULD BE STORED
BSYREGS - THE ACS THAT CAN BE USED TO LOAD THE VALUE
IF NECESSARY FOR AN ARRAYREF
THIS ROUTINE RETURNS A POINTER TO THE NODE WHICH SHOULD
REPLACE CNODE IN THE TREE. THIS MAY BE CNODE ITSELF
OR IT MAY BE A STORECLS NODE. NOTE THAT THIS
ROUTINE DOES NOT INSERT THE STORECLS NODE INTO THE TREE.
THE CALLER MUST DO SO.
*****************************************************************************)%
%757% ! Added routine
REGISTER TEMP; ! THE TEMPORARY TO BE USED
REGISTER PEXPRNODE STORENODE; !"STORE CLASS" NODE BEING INSERTED
! IN THE TREE IF NEEDED
MAP PEXPRNODE CNODE;
! IF THE VALUE IS IN AN AC, MARK CNODE TO STORE THE VALUE
IF .CNODE[INREGFLG]
THEN
BEGIN
CNODE[INREGFLG] _ 0; ! TURN OFF FLAG FOR IN AC
CNODE[STOREFLG] _ 1; ! SET FLAG FOR STORE THE VALUE
%1274% ! Get 1 or 2 word temp based on DBLFLG
%1274% CNODE[TARGTMEM] =
%1274% IF .CNODE[DBLFLG]
%1274% THEN NXTTMP(2)
%1274% ELSE NXTTMP(1);
RETURN .CNODE
END
ELSE
! IF THE VALUE MUST BE ACCESSED BY INDEXING, INSERT A STORECLS
! NODE INTO THE TREE TO STORE IT IN A TEMP
IF .CNODE[OPRCLS] EQL ARRAYREF AND .CNODE[TARGXF] NEQ 0
THEN
BEGIN
STORENODE _ MAKPR1( .CNODE[PARENT], STORECLS, STARVAL,
.CNODE[VALTYPE], 0, .CNODE ); !GET STORAGE
! FOR A NODE AND INIT SOME FIELDS
%1274% ! Get 1 or 2 word temp based on DBLFLG
%1274% STORENODE[TARGTMEM] =
%1274% IF .CNODE[DBLFLG]
%1274% THEN NXTTMP(2)
%1274% ELSE NXTTMP(1);
CNODE[PARENT] _ .STORENODE;
SETTAC(.STORENODE,
RGTOU1(.STORENODE,.STORENODE[ARG2PTR],AFREEREG(.BSYREGS,FALSE,FALSE),.BSYREGS));
RETURN .STORENODE
END
ELSE
RETURN .CNODE;
END; ! of STORAC
! The below is for putting through RUNOFF to get a PLM file.
!++
!.END LITERAL
!--
END
ELUDOM