Trailing-Edge
-
PDP-10 Archives
-
BB-D480F-SB_FORTRAN10_V10
-
cmplex.bli
There are 26 other files named cmplex.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/JNG/SJW/DCE/TFV/AHM/CDM/TJK
MODULE CMPLEX(SREG=#17,VREG=#15,FREG=#16,DREGS=4,RESERVE(0,1,2,3))=
BEGIN
GLOBAL BIND CMPLEV = #10^24 + 0^18 + #2466; ! Version Date: 12-Oct-84
%(
***** Begin Revision History *****
115 ----- ----- ADD ROUTINES CMPE1LIST AND CMPE2LIST TO
COMPUTE COMPLEXITY FOR E1LISTCALL AND
E2LISTCALL NODES
116 ----- ----- ALLOCATE CONSTANT ZERO IN E1INCR OR E2INCR
FIELD OF E1LISTCALL OR E2LISTCALL NODES
117 ----- ----- KEEP VALUE OF "PAIRMODE" CORRECTLY INSIDE OF
IOLISTS ("CMPLIOLST" NEEDED MODIFYING)
KEEP VALUE OF "FNREF" INSIDE OF IOLISTS
SET "FNREF" WHEN A FNCALL IS ENCOUNTERED
118 ----- ----- IN A SYMMETRIC BINARY OPERATION WITH TWO
REGISTER ARGUMENTS ONE OF WHICH IS THE
FUNCTION RETURN REGISTER, PERFORM CALCULATIONS
IN THE OTHER REGISTER
119 ----- ----- IMPROVE COMPLEXITY CALCULATION FOR DATACALL,
E1LISTCALL, AND E2LISTCALL NODES
120 ----- ----- SAME FOR FUNCTION AND SUBROUTINE CALLS
121 ----- ----- ADD CMPLEXITY FOR CMPLX IN LINE
122 ----- ----- ALLOW "EXCHARGS" TO BE CALLED FOR IN LINE FNS
123 ----- ----- REMOVE ALL REFERENCES TO SQROP,CUBOP,P4OP
(THEY ARE ALL NOW UNDER EXPCIOP)
124 ----- ----- CHANGE REFS TO THE MACRO "POWEROF2" TO "POWOF2"
125 ----- ----- FIX BUG IN CMPILF; DIM CANNOT HAVE AN IMMED MODE 2ND ARG
126 ----- ----- ?
127 301 16154 SET FNCALLSFLG IN CSTMNT WHEN CHANGING ** TO FUNCTION
CALL, (JNT)
128 344 17768 PROPAGATE FNCALLSFLG TO NEG/NOT NODE EVEN
IF COMPLEXITY OF ARGUMENT IS ZERO., (MD)
129 411 19537 DON'T EXCHANGE ARGS TO MAX OR MIN FUNCTION IF
FIRST ARG IS NEGATIVE., (JNG)
***** Begin Version 5 *****
130 412 ----- IN CMPLA FOR DOUBLE ARRAYREF FOR KA10, PARENT
COMPLEXITY MUST BE AT LEAST 3, (SJW)
131 426 18816 SET FNCALLSFLG FOR STATEMENTS CONTAINING
IMPLICIT FN CALLS SO 0,1, 16 WILL BE SAVED., (JNG)
132 510 ----- DON'T LOOK FOR ALCRETREGFLG IN DATAOPR NODES., (JNG)
***** Begin Version 5A *****
133 622 11020 COMPLEXITY OF COMPLEX ARRAY REF SHOULD BE GTR 2, (DCE)
***** Begin Version 5B *****
134 730 28275 IN LINE FUNCTIONS OF FORM A=MIN(A,EXPR) MAY
DOUBLY ASSIGN A REGISTER., (DCE)
***** Begin Version 6 *****
135 761 TFV 1-Mar-80 -----
Remove KA10FLG and add new /GFLOATING exponential routine
names (GEXP vs DEXP etc.)
139 1127 AHM 22-Sep-81 ------
Change erroneous (and potentially dangerous) use of IDTARGET
to TARGADDR in ARRNARGBLK.
***** Begin Version 7 *****
136 1202 DCE 1-Jul-80 -----
For expressions on output lists, we need to allocate potential
constants in the lists.
137 1211 DCE 29-Apr-81 -----
Do complexity analysis for final loop value assignments (ELISTs).
138 1253 CKS 11-Aug-81
Do complexity for character arrayref nodes. Same as numeric arrayrefs
but don't remove constant term from subscript expression. Also don't
ADDREGCANDIDATE the subscript since it will be destroyed by the ADJBP.
140 1422 TFV 12-Nov-81 ------
Modify CMPLFNCALL for character functions. The first argument on the
argument list is the descriptor for the result. The value is not
returned in AC0, AC1, but they maybe clobbered.
141 1431 CKS 15-Dec-81
Add CMPLXSUBSTR to compute complexity for substring nodes
1474 TFV 15-Mar-82
Add CMPLCONCAT to compute the complexity of concatenation nodes.
Concatenations are function calls. The first argument is the
descriptor for the result. Since it has not yet been set up,
CMPLFNARGS has to be changed to ignore the first argument. This
is done by adding another argument to the call.
1505 AHM 12-Mar-82
Have EXPTOFNCALL set the psect index of symbol table entries
for exponentiation functions to PSCODE in order to relocate
those references by .CODE.
1507 AHM 14-Mar-82
Make CMPLIOLST, CMPIOCALL, CMPE1LIST and CMPE2LIST call
ALOCONST for SLIST/ELIST increments and counts so we can get
rid of immediate I/O list args.
1520 DCE 25-Mar-82
Fix up ELISTS so that constants in I/O lists get allocated,
e. g., (A(I),1234,I=1,10).
1551 AHM 3-Jun-82
Remove edit 1505 from this module because external references
will not have a psect index set in the STE.
1567 CDM 24-JUN-82
Set complexities for inline functions
***** End V7 Development *****
1762 TFV 13-Jun-83 10-33767
Fix CMPLXARRAY to handle the case where the subscript expression
for a complicated arrayref propagates and folds to constant +
constant. Add in both constants to the ADDR field of the
arrayref and zero ARG2PTR. ((THIS IS A DAY 1 BUG.))
1766 CDM 15-Jul-83
Compiler puts constant array ref offset calculations in TARGADDR
whenever possible. TARGADDR is a half word quantity (17 bit
plus 1 bit for sign) which can not store large numbers. Some
large positive numbers may be truncated and appear to be
negative when retrieved, since the retrieved offset is sign
extended. (Also negative numbers can appear to be positive the
same way.) Before storing into TARGADDR, check if the offset
will fit.
2012 CDM 11-Oct-83
Correct edit 1766. Incorrect arguments were passed to AROFCONST.
2052 TJK 16-May-84
CMPLXSUBSTR was incorrectly clearing some flags (specifically,
INREGFLG) when the lower bound (minus 1) was a REGCONTENTS
node. This edit adds a test so that these flags are only
cleared when they really should be.
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.
2336 CDM 6-Apr-84
Fix case not caught for edit 1766 for putting too large a
constant into an ARRAYREF's TARGADDR.
2360 CDM 17-May-84
Fix for edit 2336. CMPLXA was making an add node to add the array's
IDADDR field and the array's address calculation together even if the
pointer to the address calculation is 0 (meaning there isn't any).
This edit simply substitutes the constant IADDR if no calculation
previously exists.
2361 AHM 17-May-84
Fix for edit 2360. Prevents generation of immediate mode
instructions for large constants. A local alias for the
ARRAYREF's ARG2PTR field (ADDRNODE) was not kept up to date
even though later code uses it. Update ADDRNODE with
ARG2PTR's new value.
2362 CDM 23-May-84
Hopefully the final fix for edits 1766/2012/2336/2360/2361.
Flags from deleted nodes (expressions and constants) were not
being propagated properly. These include A*VALFLG, A*IMMEDFLG,
A*NEGFLG, A*NOTFLG.
2401 TJK 19-Jun-84
Add DOTDCHECK, which checks for substrings which can be
converted into .Dnnnn compile time constant descriptors. It
also performs the bounds checking which was formerly done in
P2SKSUBSTR. Make several improvements to the bounds checking.
Add calls to DOTDCHECK in CMPFNARGS, CMPILF, CMPLIOLST,
CMPIOCALL, CMPE1LIST, and CMPE2LIST.
2402 TJK 19-Jun-84
Add FIXAOBJN, a routine which prevents values from being taken
directly from AOBJN registers. Call this routine from
CMPE1LIST and CMPE2LIST. Note that this only catches a few of
the many known cases. Furthermore, it would really be better
if we could eliminate the AOBJN control word completely in
these cases, instead of inserting STRHAOBJN nodes.
2411 CDM 30-Jun-84
Fix CMPLXA so that array address calculations with neg/not flags
involved won't take out constants below the flags to add into
the array's TARGADDR. Also rename local symbol NAME to ARRNAME
to avoid any confusion with global NAME.
2463 AHM 8-Oct-84
When trying to add all sorts of constant offsets into a
numeric ARRAYREF's TARGADDR in AROFCONST, use a constant table
entry for the ones that are too big to fit when the array is
in PSLARGE. Set the OPERSP to ARREFBIG for such ARRAYREFs.
Also, take account of such mutated ARRAYREFs when accessing
TARGADDR in CMPLXARRAY.
2464 AHM 9-Oct-84
Change of heart for edit 2463. Try to create ARREFBIG nodes
for all numeric ARRAYREFs in AROFCONST, not just for large
arrays. Also, be wary of ARREFBIG nodes as well as ARRAYREFs
for arrays in PSLARGE when creating STRHAOBJN nodes.
2466 AHM 12-Oct-84
Yet another patch to subscript optimization in CMPLXARRAY. If
both operands of a topmost plus node are optimized into
TARGADDR, return after SAVSPACEing the plus node. Also,
explicitly set A2VALFLG for the ARRAYREF in CMPLXARRAY in this
situation. These keep SETCOMPLEXITY and CGETVAL
(respectively) from infinitely recursing on a NIL ARG2PTR.
***** 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
SETCOMPLEXITY,
ARRNARGBLK(2),
CMPLA,
CMARGS,
EXPTOFNCALL,
PRCNSTARG(3), ! Process constants
CMPVBOOL,
CMPLBL,
CMPLREL,
%1474% CMPLCONCAT, ! Compute the complexity of a CONCATENATION node
CMPLFNCALL,
CMPFNARGS(3),
CMPTPCNV,
CMPLXARRAY,
%1766% AROFCONST(4), ! Optimize array offset expression if constant
CMPILF,
CMPLXSUBSTR,
CMPLIOLST,
CMPIOCALL(1),
CMPE1LIST(1),
CMPE2LIST(1),
SNGARGPROP(2),
EXCHARGS(1),
%2401% DOTDCHECK(1), ! Tries to create compile time constant .Dnnnn
%2401% ! substring descriptors
%2402% FIXAOBJN(2); ! Eliminates AOBJN fetches
EXTERNAL
ADDREGCANDATE, ! Routine in basic-block register allocator to
! add a variable to the set of variables whose
! values are left in registers by the
! computation of statements in the block
ALOCONST,
C1H,
C1L,
%2244% BASE CDONODE, ! Current DO statement
CGERR,
CLOBBREGS,
CORMAN, ! Routine to get dynamic core
%1211% CMSTMN,
%2401% BASE CSTMNT, ! Pointer to source statement node
DNEGCNST,
%2244% OBJECTCODE DOWDP, ! DO loop status word
%2401% E165, ! Substring bound out of range error
ENTRY, ! Holds name that TBLSEARCH looks for
%2401% FATLERR, ! Error routine
FNREF, ! Global flag for this statement includes a
! function call
GBSYREGS,
MAKEPR,
MAKPR1,
NAME, ! Holds name of which hash table to search
%2401% NEWDVAR, ! Creates .Dnnnn variables
ONEPLIT, ! Points to a constant table entry for the number 1
PAIRMODE, ! Global flag that will be set to true if any
! operations are encountered that require
! register pairs
PROPNEG, ! Routine to propagate a negate (UTIL)
RESNAME,
SAVREGCONTAINING, ! Routine to set flag in the previous
! reference to a variable so that the register
! containing it will be saved (CMPBLO)
SAVSPACE,
SRCHREGCANDATE, ! Routine in basic-block allocator that checks
! whether or a given variable is in the set of
! variables whose values were left in registers
! by the computation of preceeding statements
STBSYR,
STCMCSB,
STRGCT,
TBLSEARCH, ! Searches hash tables
%2401% BASE TREEPTR;
!++
!***************************************************************************
!
! Local register allocation module.
!
! Does two passes over an expression tree;
! 1. Complexity
! 2. Allocation.
!
! The global "TREEPTR" is used in both these walks to point to the
! node of the expression tree being processed.
!
!***************************************************************************
!
! Complexity:
!
! On the "complexity walk", the nodes are rearranged to reduce
! the number of registers necessary to compute them, and the
! minimum number of regs necessary to compute is saved in each
! node.
!
! CMPBLOCK performs complexity on a basic block.
! SETCOMPLEXTIY Compute the complexity of expression nodes.
!
! At this time:
!
! o Constants that can be used "immed mode" (able to fit in
! a half word for use with an immediate instruction) are
! recognized, and space is allocated for all others.
!
! o The constant part of an array address calculation is
! also added in to the instruction address at this time.
!
! o For statements within an inner DO loop whose index will
! live in a register, a REGCONTENTS node is substituted
! for each reference to the loop index. See LPSIXSUB.
!
! Complexity of common subexpressions for statements (in routine
! STCMCSB) must be done after the complexity walk for the
! statement. This is because of the possibitlity of changing the
! common subexpression in the complexity walk for the statement.
!
!***************************************************************************
!
! Allocation:
!
! ALCBLOCK performs register allocation for basic blocks.
! ALCSTMN performs register allocation for statements.
!
! ALCINREG does reg allocation for an expression to leave the
! result in an accumilator.
! ALCINTMP does reg allocation for an expression to leave the
! result in a memory location.
!
! Parameter BSYREGS indicates which register are available for
! use. Each bit represents a register. If bit zero is a one,
! then register zero is free for use.
!
! Registers 0 and 1 are always used for returning function
! values and are never preserved across function calls.
! Register 16 is used to point to argument lists. Rgister 17 is
! the stack pointer.
!
! For double precision and complex expressions, only even
! registers are allcoated. BYREGS is modified so that only
! alternate bits are set.
!
! The flag PAIRMODEFLG on a statement is set during the
! complexity pass if operations that require a register pair is
! required. Global PAIRMODE is set to TRUE to keep at least one
! pair of adjacent accumilators.
!
! For each statement, the allocator first performs register
! allocation for all local common subexpressions, using the
! routine ALCCMNSB. Common subexpessions are left in registers
! whenever possible (this will be done for most statements).
!***************************************************************************
!--
GLOBAL ROUTINE SETCOMPLEXITY=
BEGIN
!++
!***************************************************************************
! Routine to compute the complexity (ie # of regs necessary for
! computation) of expression nodes and store that value into the
! node itself.
!
! o Tries to make arg1 be the argument most likely to be
! computed into a register.
!
! o Sets the flag FNCALLSFLG which indicates that reg 0
! gets clobbered under this node.
!
! o When arg1 of a given node will be computed into
! "RETREG" (ie fn return reg) then if possible assigns
! the parent to be computed into "RETREG"
!
! Called with the global "TREEPTR" pointing to the node to be
! processed returns the value of the complexity of this node.
!
!***************************************************************************
!--
REGISTER PEXPRNODE CNODE:ARGNODE; !PTR TO THE NODE BEING PROCESSED
OWN CMPLX1;
CNODE_.TREEPTR;
IF .CNODE[DBLFLG] !IF THIS NODE IS DP OR COMPLEX
THEN PAIRMODE_TRUE; ! THEN REG PAIRS WILL BE NEEDED
RETURN
BEGIN
CASE .CNODE[OPRCLS] OF SET
%(*******FOR BOOLEAN OPERATIONS*******)%
CNODE[COMPLEXITY]_CMPVBOOL();
%(******FOR DATA ITEMS******************)%
%(*******RETURN 0, BUT DO NOT SET ANYTHING IN THE ENTRY***)%
0;
%(******FOR RELATIONALS*********************)%
%(********NEED 1 MORE REG THAN DO FOR CONTROL-TYPE RELATIONALS****)%
%(*******MUST CHECK FOR DOUBLE-PREC ARGS UNDER THIS SINGLE-WD NODE*****)%
CNODE[COMPLEXITY]_CMPLREL()+1;
%(*******FOR FUNCTION CALLS*****************)%
CNODE[COMPLEXITY]_CMPLFNCALL();
%(*******FOR ARITHMETIC EXPRESSIONS**********)%
BEGIN
CMPLX1_CMPLA();
CNODE[COMPLEXITY]_(IF .CNODE[OPERATOR] EQL INTDIVIDE
THEN (
PAIRMODE_TRUE; !A REG PAIR WILL BE NEEDED
IF .CMPLX1 GTR 2 !AT LEAST 2 REGS
THEN .CMPLX1 !WILL BE NEEDED
ELSE 2)
ELSE .CMPLX1)
END;
%(*******FOR TYPE CONVERSION****************)%
CNODE[COMPLEXITY]_CMPTPCNV();
%(******FOR ARRAY REFERENCE***************)%
%(*******MUST GET THE VALUE OF THE OFFSET INTO A REGISTER - THUS
NEED AS MANY REGS AS NEED TO COMPUTE THAT VAL, OR 1 REG
IF NO COMPUTATION IS NECESSARY*******)%
CNODE[COMPLEXITY]_CMPLXARRAY();
%(*******FOR COMMON SUBEXPRESSION NODE*******)%
%(*********RETURN 0 - DO NOT SET FIELD IN NODE*****)%
0;
%(*******FOR NEG/NOT NODES (THERE SHOULD BE VERY FEW OF THESE THAT COULDNT BE
PROPAGATED OUT*******)%
CNODE[COMPLEXITY]_BEGIN
ARGNODE_.CNODE[ARG2PTR];
IF .ARGNODE[OPR1] EQL CONSTFL !IF ARG IS A CONST
THEN ALOCONST(.ARGNODE); !THIS NODE WILL USUALLY HAVE BEEN
! FOLDED INTO THE CONSTANT, IF NOT
! ALLOCATE CORE FOR THE CONST
TREEPTR_.CNODE[ARG2PTR];
CMPLX1_SETCOMPLEXITY();
IF .CMPLX1 EQL 0
THEN
BEGIN
%(***IF ARG IS EQL TO VAR ON LHS OF ASMNT***)%
IF .ARGNODE EQL .RESNAME
THEN CNODE[RESRFFLG]_1;
%(***IF ARG IS A FUNCTION CALL ***)%
IF .ARGNODE[OPRCLS] NEQ DATAOPR
AND .ARGNODE[OPRCLS] NEQ CMNSUB
THEN SNGARGPROP(.CNODE,.ARGNODE);
%(***IF ARG COULD HAVE BEEN LEFT IN A
REG BY A EARLIER STMNT, DO SO***)%
SAVREGCONTAINING(.ARGNODE);
%(***VAL OF CMPLX IS 1***)%
1
END
ELSE
BEGIN
%(***IF ARG IS COMPUTED INTO FN-RET REG
COMPUTE VAL OF THIS NODE THERE ALSO***)%
SNGARGPROP(.CNODE,.ARGNODE);
.CMPLX1
END
END;
%(*****FOR SPECIAL OPS INTRODUCED BY PHASE 2 SKELETON****)%
%(*******P2MUL,P2DIV, AND EXPCIOP TO A POWER THAT IS A POWER OF TWO TAKE NO EXTRA REGISTERS OVER
THOSE NECESSARY TO GET THE ARG INTO A REG.
P2PL1MUL NEEDS 1 REG IF ARG IS A PROGRAM VARIABLE
OTHERWISE, EITHER 2 REGS OR AS MANY AS ARE
NEEDED TO COMPUTE THE ARG (WHICHEVER IS GREATER)
********)%
CNODE[COMPLEXITY]_
BEGIN
ARGNODE_.CNODE[ARG1PTR];
IF .CNODE[A1VALFLG]
THEN
BEGIN
%(**IF ARG COULD HAVE BEEN LEFT IN A REG BY AN EARLIER STMNT, DO SO**)%
SAVREGCONTAINING(.ARGNODE);
%(***IF ARG IS A CONSTANT, DECIDE WHETHER TO ALLOCATE CORE FOR IT**)%
IF .ARGNODE[OPR1] EQL CONSTFL
THEN PRCNSTARG(.CNODE,.ARGNODE,TRUE)
ELSE
%(***IF ARG IS THE VARIABLE ON THE LHS OF THE ASSIGNMENT
STMNT, SET "RESRFFLG" IN CNODE***)%
IF .ARGNODE EQL .RESNAME THEN CNODE[RESRFFLG]_1;
1
END
ELSE
BEGIN
TREEPTR_.ARGNODE;
CMPLX1_SETCOMPLEXITY();
%(***IF ARG CONTAINED ANY FNCALLS OR ANY REFERENCES TO THE
LHS OF ASMNT, SET FLAGS IN CNODE***)%
IF .ARGNODE[RESRFFLG] THEN CNODE[RESRFFLG]_1;
IF .ARGNODE[FNCALLSFLG] THEN CNODE[FNCALLSFLG]_1;
%(***IF ARG WAS COMPUTED INTO FN-RETURN REG, THEN FOR
P2MUL,P2DIV, AND EXPCIOP TO A POWER OF 2 WANT TO
COMPUTE THE PARENT IN FN-RETURN REG***)%
IF .ARGNODE[ALCRETREGFLG]
THEN
BEGIN
MACRO CMPINRETREG=
BEGIN
CNODE[TARGTAC]_RETREG;
CNODE[INREGFLG]_1;
CNODE[A1SAMEFLG]_1;
CNODE[ALCRETREGFLG]_1;
END$;
CASE .CNODE[OPERSP] OF SET
CMPINRETREG; !P2MUL
CMPINRETREG; !P2DIV
BEGIN END; !P2PL1MUL
CGERR(); !(SQROP HAS BEEN REMOVED)
CGERR(); !CUBOP HAS BEEN REMOVED
CGERR(); !P4OP HAS BEEN REMOVED
BEGIN !EXPCIOP
IF POWOF2(.CNODE[ARG2PTR]) THEN CMPINRETREG;
END;
TES;
END;
%(***IF ARG HAS COMPLEXITY 0, STILL NEED 1 REG***)%
IF .CMPLX1 EQL 0
THEN 1
ELSE
%(***IF ARG HAS COMPLEXITY GEQ 2, THEN NEED SAME NUMBER
OF REGS FOR PARENT AS DO FOR ARG***)%
IF .CMPLX1 GEQ 2
THEN .CMPLX1
ELSE
%(***IF ARG HAS COMPLEXITY 1, THEN FOR P2MUL,P2DIV,
AND EXPCIOP TO A POWER OF 2, NEED ONLY 1 REG.
FOR P2PL1MUL AND EXPCIOP TO A NUMBER OTHER THAN A POWER OF 2
NEED 2 REGS******)%
( CASE .CNODE[OPERSP] OF SET
1; !FOR P2MUL
1; !FOR P2DIV
2; !FOR P2PL1MUL
CGERR(); !FOR SQROP(NO LONGER USED)
CGERR(); !FOR CUBOP(NO LONGER USED)
CGERR(); !FOR P4OP (POWER OF 4)
2; !FOR EXPCIOP
TES )
END
END;
%(****FOR FIELD-REF: NOT IN RELEASE 1**************)%
CGERR();
%2244% BEGIN ! STORECLS
%2244%
%2244% ! The only STORECLS node allowed in the
%2244% ! complexity walk is STRHAOBJN. All others are
%2244% ! created in the register allocation walk and
%2244% ! SHOULD NEVER COME HERE!!
%2244%
%2244% IF .TREEPTR[OPERSP] EQL STRHAOBJN
%2244% THEN 1
%2244% ELSE CGERR(); ! Internal Compiler Error
%2244%
%2244% END; ! STORECLS
%(***FOR REGCONTENTS: COMPLEXITY IS 0*****)%
0;
%(***FOR LABOP: SHOULD NEVER GET HERE*************)%
CGERR();
%(***FOR STATEMENT: SHOULD NEVER GET HERE*****)%
CGERR();
%(***FOR IOLIST ELEMENT: SHOULD NEVER GET HERE*******)%
CGERR();
%(***FOR IN-LINE FUNCTIONS*************************)%
CNODE[COMPLEXITY]_CMPILF();
%1431% %(***FOR SUBSTRING***)%
%1431% CNODE[COMPLEXITY] _ CMPLXSUBSTR();
%1474% ! CONCATENATION
%1474% CNODE[COMPLEXITY] = CMPLCONCAT();
TES
END;
END; ! of SETCOMPLEXITY
GLOBAL ROUTINE ARRNARGBLK(REFPNTR,VLUPNTR)=
%(**********************************************************************
ROUTINE TO DETERMINE IF AN ARRAY REFENCE APPEARING IN
AN ARGBLK IS OF THE FORM A(1) WHERE A IS A FORMAL ARRAY
IF SO, WE WANT TO SUBSTITUTE THE NAME OF THE FORMAL
ARRAY FOR THE ARRAYREFERENCE
CALLED WITH REFPNTR POINTING TO THE REFERENCE
TO THE ARRAY AND VLUPNTR POINTING TO
THE APPRPARIATE VALFLG (REFPNTR AND
VLUPNTR ARE BYTE POINTERS)
**********************************************************************)%
BEGIN
TREEPTR_..REFPNTR; !RESET TREEPTR
IF .TREEPTR[OPRCLS] EQL ARRAYREF THEN
IF .TREEPTR[ARG2PTR] NEQ 0 THEN
IF .TREEPTR[TARGADDR] EQL 0 THEN !1127
BEGIN
LOCAL PEXPRNODE ARROFFSET;
ARROFFSET_.TREEPTR[ARG2PTR];
IF .ARROFFSET[OPR1] EQL FMLVARFL THEN
BEGIN
LOCAL PEXPRNODE ARRNAME;
ARRNAME_.TREEPTR[ARG1PTR];
IF .ARRNAME[OPR1] EQL FMLARRFL THEN
IF .ARRNAME[IDSYMBOL] EQL .ARROFFSET[IDSYMBOL] THEN
BEGIN
SAVSPACE(EXSIZ-1,.TREEPTR);
.REFPNTR_TREEPTR_.ARRNAME; !SUBSTITUE ARRAY NAME
IF .VLUPNTR NEQ 0 THEN .VLUPNTR_1;
RETURN TRUE
END
END
END;
RETURN FALSE
END; ! of ARRNARGBLK
GLOBAL ROUTINE CMPLA=
%(***************************************************************************
ROUTINE TO COMPUTE THE COMPLEXITY OF AN ARITH OR NON-CONTROL
TYPE BOOLEAN
RETURNS THE VAL OF THE COMPLEXITY
ALSO TRIES TO MAKE ARG1 BE THE ARGUMENT MOST LIKELY TO BE COMPUTED INTO
A REGISTER.
ALSO SETS THE FLAGS "FNCALLSFLG", "A1IMMEDFLG", "A2IMMEDFLG".
ALLOCATES CORE FOR CONSTANTS WHICH ARE NOT IMMED-SIZE AND HENCE MUST BE STORED
ALSO, WHEN ARG1 OF A GIVEN NODE WILL BE COMPUTED INTO "RETREG" (IE FN RETURN REG)
THEN IF POSSIBLE ASSIGNS THE PARENT TO BE COMPUTED INTO "RETREG"
CALLED WITH THE GLOBAL "TREEPTR" POINTING TO THE NODE TO BE
PROCESSED
***************************************************************************)%
BEGIN
LOCAL PEXPRNODE CNODE; !PTR TO THE NODE BEING PROCESSED
REGISTER PEXPRNODE ARG1NODE;
REGISTER PEXPRNODE ARG2NODE;
LOCAL CMPLX1,CMPLX2; !COMPLEXITY OF THE ARGS UNDER CNODE
LOCAL RETVAL; ! RETURN VALUE
OWN T1;
OWN AADDR; !BASE ADDRESS FOR THE ARRAY
%(****TO SWAP THE INFO ABOUT THE 2 ARGS WHEN SWAP THE 2 ARGS***)%
MACRO SWPARGDATA =
BEGIN
T1_.CMPLX1;
CMPLX1_.CMPLX2;
CMPLX2_.T1;
ARG1NODE_.CNODE[ARG1PTR];
ARG2NODE_.CNODE[ARG2PTR];
END$;
%(**CHECK WHETHER THIS EXPR WILL BE EVALUATED BY
CALLING A LIBRARY FN(EG IF IT IS COMPLEX MUL,DIV OR A DP OP ON THE KA10)
SET A GLOBAL FLAG INDICATING WHETHER THIS PROGRAM INCLUDES ANY CALLS TO SUCH FNS**)%
IF USEFNCALL(TREEPTR) THEN TREEPTR[FNCALLSFLG]_LIBARITHFLG_TRUE;
%(****WILL TREAT EXPONENTIATION AS A FUNCTION CALL. THEREFORE TRANSFORM
ANY EXPONENTIATION NODES TO FUNCTION-CALL NODES AND CALL THE ROUTIEN TO PERFORM
COMPLEXITY OF A FN-CALL
********)%
IF .TREEPTR[OPR1] EQL EXPONOPF
THEN
BEGIN
EXPTOFNCALL();
RETURN CMPLFNCALL();
END;
CNODE_.TREEPTR;
ARG1NODE_.CNODE[ARG1PTR];
ARG2NODE_.CNODE[ARG2PTR];
%(****FIND COMPLEXITIES OF THE 2 ARGS, IF EITHER ARG IS A CONSTANT PROCESS IT
ALSO PROPAGATE THE FLAGS FNCALLSFLG, AND RESRFFLG UP FROM THE ARGS***)%
CMARGS();
%(***GET COMPLEXITY OF 1ST ARG****)%
CMPLX1_(IF .CNODE[A1VALFLG] THEN 0 ELSE .ARG1NODE[COMPLEXITY]);
%(**GET COMPLEXITY OF 2ND ARG*******)%
CMPLX2_(IF .CNODE[A2VALFLG] THEN 0 ELSE .ARG2NODE[COMPLEXITY]);
%(****WILL ALWAYS WANT ARG1 TO BE COMPUTED INTO A REGISTER, THEREFORE IF EITHER ARG
1. MUST BE IN A TEMPORARY
2. IS A SIMPLE DATA ITEM WHICH REQUIRES NO COMPUTATION
3. IS AN ARRAY REFERENCE WHICH MAY BE PICKED UP WITHOUT COMPUTING
IT INTO A REG
4. IS A COMMON SUBEXPRESSION
LET THAT ARG BE ARG2 IF POSSIBLE
********)%
IF NOT .CNODE[A2VALFLG]
AND NOT .CNODE[MEMCMPFLG] !DO NOT REORDER THE ARGS OF AN OPERATION
! THAT WILL BE PERFORMED TO MEMORY
THEN
BEGIN
IF .CNODE[A1VALFLG]
THEN
%(***IF EITHER ARG IS A DATA ITEM OR COMMON SUBEXPR, THAT ARG SHOULD
ALWAYS BE ARG2 IF POSSIBLE**********)%
BEGIN
IF EXCHARGS(.CNODE)
THEN
%(***IF WERE ABLE TO EXCHANGE ARG1 AND ARG2, THEN EXCHANGE
THE DATA ABOUT THEM AS WELL***)%
SWPARGDATA;
END
ELSE
IF .ARG2NODE[OPRCLS] NEQ ARRAYREF
THEN
%(****WHEN NEITHER ARG IS A SIMPLE DATA ITEM, THEN IF EITHER ARG IS AN
ARRAY REFERENCE, THAT ARG SHOULD BE ARG2 IF POSSIBLE*****)%
BEGIN
IF .ARG1NODE[OPRCLS] EQL ARRAYREF
OR
.CMPLX1 GTR .CMPLX2
THEN
%(***IF NEITHER ARG IS AN ARRAYREF NOR A DATA ITEM,
LET ARG2 BE THE ARG OF GREATER COMPLEXITY***)%
BEGIN
IF EXCHARGS(.CNODE)
THEN SWPARGDATA;
END;
END;
END;
%(***IF 1ST ARG IS NOT A SUBEXPRESSION WHOSE EVALUATION WILL LEAVE A RESULT
IN A REGISTER, THEN TRY TO MAKE 1ST ARG BE A VARIABLE WHOSE VALUE MIGHT
BE LEFT IN A REG FROM EXECUTION OF A PRECEEDING STMNT***)%
IF .ARG1NODE[OPRCLS] EQL DATAOPR !IF ARG1 IS A VAR OR CONST
THEN
BEGIN
IF SAVREGCONTAINING(.ARG1NODE) !IF CAN LEAVE ARG1 IN A REG FROM A
THEN BEGIN END ! PRECEEDING STMNT, DO SO
ELSE !OTHERWISE,
IF .ARG2NODE[RGCANDFLG] !IF ARG2 CAN BE LEFT IN A REG BY
AND NOT .CNODE[MEMCMPFLG]
THEN ! A PRECEEDING STMNT,
BEGIN
IF EXCHARGS(.CNODE) !IF CAN SWAP THE ARGS, DO SO
THEN
BEGIN
SWPARGDATA;
SAVREGCONTAINING(.ARG1NODE); !SAVE THE REG CONTAINING
! THE NEW ARG1
END;
END
END
ELSE
%(***
IF ARG1 IS AN ARRAYREF OR COMMON SUB OR ARG1 RETURNS ITS
VALUE IN THE FUNCTION RETURN REGISTER, CHECK IF ARG2 IS
ALSO A REGISTER AND, IF SO, PERFORM THE
CALCULATION IN THE REGISTER FOR ARG2
***)%
IF .ARG1NODE[OPRCLS] EQL ARRAYREF
OR .ARG1NODE[OPRCLS] EQL CMNSUB
OR
BEGIN !ARG1 RETURNING VALUE IN REGISTER 0?
.ARG1NODE[ALCRETREGFLG] AND
.ARG1NODE[INREGFLG] AND
.ARG1NODE[TARGTAC] EQL RETREG
END
THEN
BEGIN
IF .ARG2NODE[RGCANDFLG] !HENCE IF ARG2 WAS LEFT IN A REG
AND NOT .CNODE[MEMCMPFLG]
THEN ! BY A PRECEEDING STMNT
BEGIN
IF EXCHARGS(.CNODE) !IF CAN SWAP THE ARGS, DO SO
THEN
BEGIN
SWPARGDATA;
SAVREGCONTAINING(.ARG1NODE); !SAVE THE REG CONTAINING
! THE NEW ARG1
END
END
END;
%(***IF ARE COMPUTING TO MEMORY AND THE 1ST ARG IS A SIMPLE VAR OR CONST, THEN THAT
VAR OR CONST CAN BE LEFT IN A REG AFTER THIS STMNT IS EVALUATED**)%
IF .CNODE[MEMCMPFLG] AND .CNODE[A1VALFLG]
THEN ADDREGCANDATE(.ARG1NODE,.CNODE);
IF .CMPLX1 LEQ .CMPLX2
THEN
CNODE[RVRSFLG]_1;
%(***CHECK WHETHER THE VAL OF THE ARG COMPUTED FIRST WILL
BE LEFT IN "RETREG" AND THEN CLOBBERRED BY COMPUTATION
OF THE ARG THAT IS COMPUTED SECOND.
IF SO, UNDO THE ASSIGNMENT OF THAT VAL TO "RETREG"
********)%
IF NOT .CNODE[A1VALFLG] AND NOT .CNODE[A2VALFLG]
THEN
BEGIN
IF .CNODE[RVRSFLG]
THEN
%(***IF ARG2 IS EVALUATED FIRST***)%
BEGIN
IF .ARG2NODE[ALCRETREGFLG] AND .ARG1NODE[FNCALLSFLG]
THEN
BEGIN
ARG2NODE[ALCRETREGFLG]_0;
ARG2NODE[A1SAMEFLG]_0;
ARG2NODE[A2SAMEFLG]_0; !(NOTE THAT ARG-SAME-FLGS
! COULD ONLY BE SET AT THIS
! POINT DUE TO ALCRETREG
ARG2NODE[INREGFLG]_0;
END;
END
ELSE
%(***IF ARG1 IS EVALUATED FIRST***)%
BEGIN
IF .ARG1NODE[ALCRETREGFLG] AND .ARG2NODE[FNCALLSFLG]
THEN
BEGIN
ARG1NODE[ALCRETREGFLG]_0;
ARG1NODE[A1SAMEFLG]_0;
ARG1NODE[A2SAMEFLG]_0;
ARG1NODE[INREGFLG]_0;
END;
END;
END;
%(****IF ARG1 WILL BE COMPUTED INTO "RETREG" (FN RETURN REGISTER) THEN
WOULD LIKE TO COMPUTE PARENT IN RETREG ALSO.*******)%
IF NOT .CNODE[A1VALFLG] AND .ARG1NODE[ALCRETREGFLG]
AND .ARG1NODE[INREGFLG] AND .ARG1NODE[TARGTAC] EQL RETREG !(FOR RELATIONALS, "ALCRETREGFLG"
! INDICATES THAT THE COMPAR IS DONE
! IN RETREG, NOT THAT THE VAL IS LEFT THERE
THEN
%(***IF VAL OF ARG1 WILL BE LEFT IN "RETREG"***)%
BEGIN
IF .CNODE[OPRCLS] EQL RELATIONAL
THEN
CNODE[TARGAUX]_RETREG
ELSE
BEGIN
CNODE[TARGTAC]_RETREG;
CNODE[INREGFLG]_1;
END;
CNODE[ALCRETREGFLG]_1;
CNODE[A1SAMEFLG]_1;
END;
%(***IF CMPLX1 IS STILL 0 (AFTER HAVE ATTEMPTED TO SWAP ARGS), TREAT IT AS
IF IT WERE 1 (SINCE IT MUST BE LOADED INTO A REG TO PERFORM THE OPERATION***)%
IF .CMPLX1 EQL 0 THEN CMPLX1_1;
%(***RETURN THE COMPLEXITY OF CNODE - THIS VALUE IS EQUAL
TO THE MAXIMUM OF THE COMPLEXITY OF ARG1(CMPLX1) AND THE
COMPLEXITY OF ARG2 (CMPLX2), UNLESS THE TWO ARE EQUAL, IN
WHICH CASE IT IS ONE GREATER THAN THE VAL OF THE COMPLEXITY
OF THE 2 ARGS
*********)%
RETVAL _
BEGIN
IF .CMPLX1 EQL .CMPLX2
THEN
.CMPLX1+1
ELSE
BEGIN
IF .CMPLX2 GTR .CMPLX1
THEN
.CMPLX2
ELSE
.CMPLX1
END
END;
%(*** IF ARG1 IS DOUBLE PREC ARRAYREF FOR KA10 AND
ARG2 HAS NON-ZERO COMPLEXITY, THEN PARENT MUST
HAVE AT LEAST COMPLEXITY 3 ***)%
%622% ! COMPLEX ARRAY REF NEEDS 3 REGS ALSO!
%622% IF .ARG1NODE[OPRCLS] EQL ARRAYREF
%622% THEN IF .ARG1NODE[VALTYPE] EQL COMPLEX
%622% THEN IF .CMPLX2 NEQ 0
%622% THEN IF .RETVAL LSS 3
%622% THEN RETVAL _ 3;
RETURN .RETVAL;
END; ! of CMPLA
GLOBAL ROUTINE CMARGS=
%(***************************************************************************
ROUTINE TP PERFORM COMPLEXITY-WALK PROCESSING FOR THE 2 ARGS
UNDER THE NODE POINTED TO BY THE GLOBAL "TREEPTR".
IF EITHER OF THE ARGS HAS "FNCALLSFLG" SET, SETS IT IN THE PARENT.
IF EITHER OF THE ARGS HAS "RESRFFLG" SET, SETS IT IN THE PARENT.
IF EITHER ARG IS A CONSTANT, DECIDES WHETHER TO USE IT IMMEDIATE MODE,
OR ALLOCATE CORE FOR IT
***************************************************************************)%
BEGIN
LOCAL PEXPRNODE ARG1NODE:ARG2NODE:CNODE;
CNODE_.TREEPTR;
ARG1NODE_.CNODE[ARG1PTR];
ARG2NODE_.CNODE[ARG2PTR];
%(*****COMPUTE COMPLEXITY OF 1ST ARG******)%
IF NOT .CNODE[A1VALFLG]
THEN
BEGIN
TREEPTR_.CNODE[ARG1PTR];
SETCOMPLEXITY();
END;
%(*****COMPUTE COMPLEXITY OF 2ND ARG*****)%
IF NOT .CNODE[A2VALFLG]
THEN
BEGIN
TREEPTR_.CNODE[ARG2PTR];
SETCOMPLEXITY();
END;
%(***IF EITHER ARG IS THE VAR INTO WHICH THE RESULT OF THIS ASSIGNMENT IS
TO BE STORED, SET A FLAG IN THE PARENT***)%
IF .ARG1NODE EQL .RESNAME OR .ARG2NODE EQL .RESNAME THEN CNODE[RESRFFLG]_1;
%(***IF EITHER ARG IS A CONSTANT- THEN IF IT IS IMMED SIZE, SET IMMEDFLG,
IF NOT, ALLOCATE CORE FOR IT*****)%
IF .ARG1NODE[OPR1] EQL CONSTFL
THEN
PRCNSTARG(.CNODE,.ARG1NODE,TRUE);
IF .ARG2NODE[OPR1] EQL CONSTFL
THEN
PRCNSTARG(.CNODE,.ARG2NODE,FALSE);
%(***KEEP FLAGS FOR "FNCALL PRESENT SOMEWHERE UNDER THIS NODE"
AND "REF TO RESULT VARIABLE PRESENT SOMEWHER UNDER THIS NODE"*****)%
IF .ARG1NODE[OPRCLS] NEQ DATAOPR
THEN
BEGIN
IF .ARG1NODE[FNCALLSFLG] THEN CNODE[FNCALLSFLG]_1;
IF .ARG1NODE[RESRFFLG] THEN CNODE[RESRFFLG]_1;
END;
IF .ARG2NODE[OPRCLS] NEQ DATAOPR
THEN
BEGIN
IF .ARG2NODE[FNCALLSFLG] THEN CNODE[FNCALLSFLG]_1;
IF .ARG2NODE[RESRFFLG] THEN CNODE[RESRFFLG]_1;
END;
END; ! of CMARGS
GLOBAL ROUTINE EXPTOFNCALL= ![1505] Reformatted by AHM
BEGIN
! Transforms an exponentiation node into a function call node. Called
! with the global TREEPTR pointing to the node to be transformed.
REGISTER
PEXPRNODE FNNMENTRY, ! Points to the function name STE
PEXPRNODE ARG2NODE, ! Points to the RH exponentiation operand
ARGUMENTLIST LST; ! Points to the arg list being created
! Tables of routine names to be called for exponentiation
BIND
IEXPFNTBL= PLIT ( ! INTEGER exponent, non G-floating
SIXBIT 'EXP1.', !INTEGER**INTEGER
SIXBIT 'EXP2.', !REAL**INTEGER
SIXBIT 'DEXP2.', !DOUBLE-PREC**INTEGER
SIXBIT 'CEXP2.' ), !COMPLEX**INTEGER
%761% GIEXPFNTBL= PLIT ( ! INTEGER exponent, G-floating
%761% SIXBIT 'EXP1.', !INTEGER**INTEGER
%761% SIXBIT 'EXP2.', !REAL**INTEGER
%761% SIXBIT 'GEXP2.', !DOUBLE-PREC**INTEGER
%761% SIXBIT 'CEXP2.' ), !COMPLEX**INTEGER
EXPFNTBL=PLIT ( ! Exponent of same type as base, non G-floating
SIXBIT 'EXP1.', !INTEGER**INTEGER
SIXBIT 'EXP3.', !REAL**REAL
SIXBIT 'DEXP3.', !DOUBLE-PREC**DOUBLE-PREC
SIXBIT 'CEXP3.' ), !COMPLEX**COMPLEX
%761% GEXPFNTBL=PLIT ( ! Exponent of same type as base, G-floating
%761% SIXBIT 'EXP1.', !INTEGER**INTEGER
%761% SIXBIT 'EXP3.', !REAL**REAL
%761% SIXBIT 'GEXP3.', !DOUBLE-PREC**DOUBLE-PREC
%761% SIXBIT 'CEXP3.' ); !COMPLEX**COMPLEX
! Get core to hold the arg list
NAME<LEFT> = ARGLSTSIZE(2);
LST = CORMAN();
LST[ARGCOUNT] = 2; ! Say there are 2 arguments
LST[1,ARGNPTR] = .TREEPTR[ARG1PTR]; ! First one was ARG1PTR
LST[2,ARGNPTR] = ARG2NODE = .TREEPTR[ARG2PTR]; ! Second was ARG2PTR
LST[1,AVALFLG] = .TREEPTR[A1VALFLG]; ! Set the valflgs for
LST[2,AVALFLG] = .TREEPTR[A2VALFLG]; ! the 2 args
TREEPTR[OPRCLS] = FNCALL; ! Make the node a FNCALL node
TREEPTR[OPERSP] = LIBARY; ! (A library function)
TREEPTR[ARG2PTR] = .LST; ! Point to the argument list
TREEPTR[EXPFLAGS] = 0; ! Clear lots of flags
! Set ARG1 of the FNCALL to point to the symbol table entry for the
! function name for the function to be used. There are 2 sets of 2
! functions for each of the 4 main value types. One set is for normal
! double precision and the other is for G-floating DP. One function
! in each set is for that valtype raised to an integer power and the
! other is for that valtype raised to a power of the same valtype.
%761% IF .GFLOAT ! G-floating uses GEXP, not DEXP
%761% THEN IF .ARG2NODE[VALTP1] EQL INTEG1
%761% THEN ENTRY[0] = .GIEXPFNTBL[.TREEPTR[VALTP1]]
%761% ELSE ENTRY[0] = .GEXPFNTBL[.TREEPTR[VALTP1]]
%761% ELSE IF .ARG2NODE[VALTP1] EQL INTEG1
%761% THEN ENTRY[0] = .IEXPFNTBL[.TREEPTR[VALTP1]]
%761% ELSE ENTRY[0] = .EXPFNTBL[.TREEPTR[VALTP1]];
NAME = IDTAB; ! Search the symbol table
TREEPTR[ARG1PTR] = FNNMENTRY = TBLSEARCH();
FNNMENTRY[OPERSP] = FNNAME
END; ! of EXPTOFNCALL
GLOBAL ROUTINE PRCNSTARG(PARNODE, CONSTNODE,A1CNSTFLG)=
%(***************************************************************************
TO PROCESS A CONSTANT ARG.
IF IT IS OF IMMED SIZE, SET IMMEDFLG IN THE PARENT.
IF NOT, ALLOCATE CORE FOR IT.
CALLED WITH THE ARGS
PARNODE - PTR TO THE PARENT NODE
CONSTNODE - PTR TO THE CONSTANT TABLE ENTRY FOR THE CONSTANT
A1CNSTFLG - FLAG FOR "THE CONSTANT NODE IS THE 1ST ARG UNDER PARENT"
***************************************************************************)%
BEGIN
MAP PEXPRNODE PARNODE:CONSTNODE;
%(***IF THE CONSTANT IS USED AS THE 2ND ARG OF AN OPERATION WHICH IS PERFORMED
BY MEANS OF A FN-CALL (IE EXPONENTIATION OR DOUBLE-PREC OPS ON KA10), THEN
MUST ALLOCATE CORE FOR THE CONSTANT***)%
IF USEFNCALL(PARNODE) AND NOT .A1CNSTFLG
THEN
ALOCONST(.CONSTNODE)
%(***IF THE CONSTANT IS NOT OF TYPE INTEGER OR TYPE LOGICAL, AND A BOOLEAN
OPERATOR IS BEING APPLIED TO IT, THEN MUST ALLOCATE CORE FOR IT*****)%
ELSE
IF .PARNODE[OPRCLS] EQL BOOLEAN AND .CONSTNODE[VALTP1] NEQ INTEG1
THEN ALOCONST(.CONSTNODE)
%(***IF CONSTANT IS IMMEDIATE SIZE, DO NOT ALLOCATE CORE FOR IT. INSTEAD, SET
IMMEDFLG IN THE PARENT
*****)%
ELSE
IF IMMEDCNST(CONSTNODE)
THEN
BEGIN
(IF .A1CNSTFLG THEN PARNODE[A1IMMEDFLG] ELSE PARNODE[A2IMMEDFLG])_1;
IF .CONSTNODE[CONST2] LSS 0 AND .CONSTNODE[VALTP1] EQL INTEG1
THEN
%(***IF THE CONSTANT IS A NEG INTEGER, USE A POSITIVE NUMBER NEGATED.***)%
BEGIN
IF .PARNODE[OPRCLS] EQL BOOLEAN THEN
%(***FOR BOOLEANS, USE THE 1S COMPLEMENT AND THE 'NOT'
VERSION OF THE INSTRUCTION.*******)%
BEGIN
IF .A1CNSTFLG !TO PICK UP ARG1 WITH"NOT"
THEN
BEGIN
PARNODE[A1NOTFLG]_NOT .PARNODE[A1NOTFLG];
PARNODE[ARG1PTR]_MAKECNST(.CONSTNODE[VALTYPE],0,NOT .CONSTNODE[CONST2]);
END
ELSE !TO OPERATE ON ARG2 WITH "NOT"
BEGIN
PARNODE[A2NOTFLG]_NOT .PARNODE[A2NOTFLG];
PARNODE[ARG2PTR]_
MAKECNST(.CONSTNODE[VALTYPE],0,NOT .CONSTNODE[CONST2]);
END;
END
ELSE
IF .PARNODE[OPRCLS] EQL STATEMENT
THEN
BEGIN
%(***FOR ASSIGNMENT STMNTS, IF RHS IS AN IMMED CONSTANT
WHEN NEGATED, THEN SET A2NEGFLG AND USE THE NEG***)%
IF .PARNODE[SRCID] EQL ASGNID
THEN
BEGIN
PARNODE[A2NEGFLG]_NOT .PARNODE[A2NEGFLG];
PARNODE[RHEXP]_MAKECNST(.CONSTNODE[VALTYPE],0,-.CONSTNODE[CONST2]);
END
ELSE CGERR(); !SHOULD NEVER CALL PRCNSTARG WITH
! ANY STMNT OTHER THAN ASSIGNMENT
END
ELSE
IF .A1CNSTFLG
THEN
BEGIN
PARNODE[A1NEGFLG]_NOT .PARNODE[A1NEGFLG];
PARNODE[ARG1PTR]_MAKECNST(.CONSTNODE[VALTYPE],0,-.CONSTNODE[CONST2]);
END
ELSE
BEGIN
PARNODE[A2NEGFLG]_NOT .PARNODE[A2NEGFLG];
PARNODE[ARG2PTR]_MAKECNST(.CONSTNODE[VALTYPE],0,-.CONSTNODE[CONST2]);
END;
END
END
ELSE
ALOCONST(.CONSTNODE);
END; ! of PRCNSTARG
GLOBAL ROUTINE CMPVBOOL=
%(***************************************************************************
ROUTINE PERFORMS COMPLEXITY WALK FOR A BOOLEAN WHOSE VALUE IS
TO BE COMPUTED.
***************************************************************************)%
BEGIN
LOCAL PEXPRNODE CNODE:ARG1NODE:ARG2NODE;
%(***FOR EQV AND XOR - TREAT SAME AS ARITH****)%
IF .TREEPTR[BOOLCLS] NEQ ANDORCLS THEN CMPLA()
ELSE
%(***IF VALTYPE OF THIS NODE IS "CONTROL" WILL NEED 1 REG TO HOLD THE VAL
IN ADDITION TO THE NUMBER OF REGS NEEDED FOR THE CONTROL BOOLEAN IF
IT WERE USED STRICTLY FOR CONTROL PURPOSES****)%
IF .TREEPTR[VALTYPE] EQL CONTROL
THEN CMPLBL() + 1
ELSE
BEGIN
CNODE_.TREEPTR;
ARG1NODE_.CNODE[ARG1PTR];
ARG2NODE_.CNODE[ARG2PTR];
%(***IF ONE OF THE 2 ARGS HAS VALTYPE CONTROL (AND THE OTHER IS A MASK)
ALWAYS MAKE ARG1 BE THE MASK.
********)%
IF .ARG1NODE[VALTYPE] EQL CONTROL
THEN
BEGIN
EXCHARGS(.CNODE);
ARG1NODE_.CNODE[ARG1PTR];
ARG2NODE_.CNODE[ARG2PTR];
END;
%(***IF ONE ARG IS OF TYPE CONTROL, WILL INIT VAL OF BOOLEAN TO THE
OTHER ARG, THEN EVALUATE THE CONTROL ARG***)%
IF .ARG2NODE[VALTYPE] EQL CONTROL
THEN
BEGIN
%(***PERFORM COMPLEXITY WALK FOR THE 2 ARGS. PROPAGATE
FNCALLSFLG AND RESRFFLG UP FROM THE ARGS TO THE PARENT***)%
CMARGS();
%(***IF ARG1 IS COMPUTED INTO FN-RETURN-REG***)%
IF .ARG1NODE[OPRCLS] NEQ DATAOPR
AND .ARG1NODE[ALCRETREGFLG]
THEN
BEGIN
%(**IF COMP OF ARG2 WILL CLOBBER FN-RET-REG, THEN
MUST STORE ARG1 ELSEWHERE***)%
IF .ARG2NODE[FNCALLSFLG]
THEN
BEGIN
ARG1NODE[ALCRETREGFLG]_0;
ARG1NODE[A1SAMEFLG]_0;
ARG1NODE[INREGFLG]_0;
END
%(***OTHERWISE COMPUTE PARENT IN FN-RET REG***)%
ELSE
BEGIN
CNODE[ALCRETREGFLG]_1;
CNODE[A1SAMEFLG]_1;
CNODE[INREGFLG]_1;
CNODE[TARGTAC]_RETREG;
END;
END;
SAVREGCONTAINING(.ARG1NODE); !IF BB ALLOCATOR CAN LEAVE VAL OF ARG1 IN A REG
! IN SOME PREV STMNT, IT SHOULD DO SO
%(***COMPLEXITY OF CNODE IS MAX OF (1+CMPLX OF ARG2) AND
CMPLX OF ARG1 ***)%
IF .ARG1NODE[COMPLEXITY] GTR .ARG2NODE[COMPLEXITY]
THEN .ARG1NODE[COMPLEXITY]
ELSE .ARG2NODE[COMPLEXITY] + 1
END
ELSE
%(***FOR AND OR OR WHEN NEITHER ARG HAS TYPE CONTROL, TREAT LIKE ARITH***)%
CMPLA()
END
END; ! of CMPVBOOL
GLOBAL ROUTINE CMPLBL=
%(***************************************************************************
ROUTINE TO COMPUTE THE COMPLEXITY OF A CONTROL-TYPE BOOLEAN
CALLED WITH THE GLOBAL TREEPTR POINTING TO THE NODE
WHOSE COMPLEXITY IS TO BE RETURNED
***************************************************************************)%
BEGIN
LOCAL PEXPRNODE CNODE:ARG1NODE:ARG2NODE;
LOCAL CMPLX1,CMPLX2; !COMPLEXITY OF ARG1 AND ARG2
CNODE_.TREEPTR; !PTR TO THE NODE BEING PROCESSED
ARG1NODE_.CNODE[ARG1PTR];
ARG2NODE_.CNODE[ARG2PTR];
%(****FOR 1ST ARG**************************************)%
TREEPTR_.ARG1NODE;
%(****ARGS OF A CONTROL-TYPE BOOLEAN CAN BE EITHER CONTROL-TYPE
BOOLEANS, OR RELATIONALS************************)%
IF .ARG1NODE[OPRCLS] EQL RELATIONAL
THEN
%(****FOR A RELATIONAL USED FOR CONTROL PURPOSES ONLY***)%
ARG1NODE[COMPLEXITY]_(CMPLX1_CMPLREL())
ELSE
BEGIN
IF .ARG1NODE[OPRCLS] EQL BOOLEAN
THEN
%(****IF A SUBNODE IS A BOOLEAN, IT MUST BE A CONTROL-TYPE BOOLEAN****)%
ARG1NODE[COMPLEXITY]_(CMPLX1_CMPLBL())
ELSE
CGERR(5)
END;
%(****FOR 2ND ARG**************************************)%
TREEPTR_.ARG2NODE;
%(****ARGS OF A CONTROL-TYPE BOOLEAN CAN BE EITHER CONTROL-TYPE
BOOLEANS, OR RELATIONALS************************)%
IF .ARG2NODE[OPRCLS] EQL RELATIONAL
THEN
%(****FOR A RELATIONAL USED FOR CONTROL PURPOSES ONLY***)%
ARG2NODE[COMPLEXITY]_(CMPLX2_CMPLREL())
ELSE
BEGIN
IF .ARG2NODE[OPRCLS] EQL BOOLEAN
THEN
%(****IF A SUBNODE IS A BOOLEAN, IT MUST BE A CONTROL-TYPE BOOLEAN****)%
ARG2NODE[COMPLEXITY]_(CMPLX2_CMPLBL())
ELSE
CGERR(5)
END;
%(****SET THE FLAG "FNCALLSFLG" IN THE PARENT, IF ANY FNCALLS ARE UNDER
ANY OF THE ARGS****)%
%(****SET THE FLAG "RESRFFLG" IN THE PARENT IF REF TO LOC OF FINAL RESULT
OCCURS UNDER EITHER ARG*****)%
IF .ARG1NODE[FNCALLSFLG] OR .ARG2NODE[FNCALLSFLG] THEN CNODE[FNCALLSFLG]_1;
IF .ARG1NODE[RESRFFLG] OR .ARG2NODE[RESRFFLG] THEN CNODE[RESRFFLG]_1;
%(****FOR A CONTROL-TYPE BOOLEAN, COMPLEXITY IS EQUAL TO MAX
OF COMPLEXITY OF THE 2 ARGS**********************)%
IF .CMPLX2 GTR .CMPLX1
THEN
CMPLX1_.CMPLX2;
CNODE[COMPLEXITY] _.CMPLX1;
RETURN .CMPLX1
END; ! of CMPLBL
GLOBAL ROUTINE CMPLREL=
%(****************************************************************************
ROUTINE TO COMPUTE THE COMPLEXITY OF A RELATIONAL.
COMPUTES THE NUMBER OF REGISTERS NEEDED IF THE REL IS USED
FOR CONTROL PURPOSES ONLY.
CALLED WITH THE GLOBAL TREEPTR POINTING TO THE NODE FOR
THE RELATIONAL.
****************************************************************************)%
BEGIN
OWN CMPLX1;
LOCAL PEXPRNODE CNODE:ARG1NODE: ARG2NODE;
CNODE_.TREEPTR;
%(***USE SAME BASIC ALGORITHM FOR COMPLEXITY AS IS USED FOR ARITH NODES***)%
CMPLX1_CMPLA();
ARG1NODE_.CNODE[ARG1PTR]; !AFTER CMPLA, GET VALS OF ARG1PTR AND ARG2PTR
ARG2NODE_.CNODE[ARG2PTR];
CNODE[INREGFLG]_0; !CMPLA WOULD HAVE SET "INREGFLG" IF IT ALLOCATED
! THIS NODE TO BE COMPUTED IN FN-RET REG -
! BUT FOR A RELATIONAL, THE COMPAR
! IS PERF IN A REG, BUT THE VAL MIGHT BE LEFT
! IN A TEMP
%(***IF ARGS ARE DOUBLE-WORD, THEN NEED TWICE AS MANY REGS AS CMPLX1 INDICATES ***)%
IF .ARG1NODE[DBLFLG] THEN
BEGIN
CMPLX1_.CMPLX1^1;
PAIRMODE_TRUE !IF THE OPERANDS OF THE RELATIONAL ARE DP OR COMPLEX VARS
! WILL NEED A REG PAIR TO DO THE COMPARISON
END;
%(***IF ARG2 IS A REAL OR COMPLEX IMMED CONSTANT,
WILL HAVE TO ALLOCATE CORE FOR IT (SINCE
HAVE NO COMPARE IMMED INSTRUCTION FOR REALS) HANCE IF ONE ARG IS
REAL IMMED AND THE OTHER IS A VAR , LET ARG1 BE THE CONST ARG.
IF BOTH ARGS ARE REAL IMMED(POSSIBLE ONLY IF P2SKEL NOT USED),
ALLOCATE CORE FOR ARG2****)%
IF .CNODE[A2IMMEDFLG]
THEN
BEGIN
IF (.ARG2NODE[OPERATOR] EQL REALCONST OR .ARG2NODE[OPERATOR] EQL CPLXCONST)
AND (.ARG2NODE[CONST1] NEQ 0) !CAN USE CAI FOR ZERO
THEN
BEGIN
%(***IF ARG1 IS AN EXPRESSION (WHOSE VAL WILL PROBABLY BE LEFT IN A REG)
OR IS A VARIABLE WHOSE VAL CAN BE LEFT IN A REG BY A PREV STMNT
OR IF ARG1 IS ALSO AN IMMED CONSTANT,
ALLOCATE CORE FOR ARG2
********)%
IF .CNODE[A1IMMEDFLG] !IF ARG1 IS AN IMMED CONST
OR
(.ARG1NODE[OPRCLS] NEQ ARRAYREF !ARG1 NOT AN ARRAY REF
AND
NOT (.ARG1NODE[OPRCLS] EQL DATAOPR !ARG1 NOT A VAR THAT
AND NOT .ARG1NODE[RGCANDFLG]) ! COULD NOT HAVE BEEN LEFT IN A REG
)
THEN
BEGIN
%(***MUST ALLOCATE CORE FOR ARG2***)%
ALOCONST(.ARG2NODE);
CNODE[A2IMMEDFLG]_0;
END
%(***IF ARG1 IS A VAR THAT COULD NOT HAVE BEEN LEFT IN A REG BY A PREV STMNT
OR IF ARG1 IS AN ARRAYREF (IE IF ARG1 HAS TO BE LOADED INTO
A REG) AND IF ARG1 IS NOT ALSO AN IMMED REAL CONST,
EXCHANGE THE 2 ARGS***)%
ELSE
EXCHARGS(.CNODE)
END;
END;
%(***CANNOT GENERATE CODE FOR A RELATIONAL WHICH HAS A NEGFLG OVER
ARG2. GET RID OF ANY A2NEGFLG BY:
A LT -B = -A GT B
A LEQ -B = -A GEQ B
A EQ -B = -A EQ B
ETC
*****)%
IF .CNODE[A2NEGFLG]
THEN
BEGIN
CNODE[A1NEGFLG]_NOT .CNODE[A1NEGFLG];
CNODE[A2NEGFLG]_0;
IF NOT EQREL(.CNODE[OPERSP])
THEN CNODE[OPERSP]_REVREL(.CNODE[OPERSP])
END;
%(***IF A1NEGFLG IS NOW SET AND ARG1 IS AN EXPRESSION, TRY TO PROPAGATE
THE NEGATIVE OVER ARG1
*******)%
IF .CNODE[A1NEGFLG] AND NOT .CNODE[A1VALFLG]
THEN
BEGIN
IF PROPNEG(.CNODE[ARG1PTR]) THEN CNODE[A1NEGFLG]_0;
END;
%(***IF ARG1 IS A VAR OR CONST, ADD IT TO THE SET
OF VARS WHOSE VALS ARE LEFT IN REGS BY THE EVAL OF STMNTS***)%
IF .CNODE[A1VALFLG]
THEN
BEGIN
%(**IF BOTH ARGS ARE VARS/CONSTS THEN PUT ARG2 IN THE SET OF VARS
WHOSE VALS CAN BE LEFT IN REGS**)%
IF .CNODE[A2VALFLG]
THEN
BEGIN
%(**ONLY PUT ARG2 INTO THE SET OF POTENTIAL REG VARS IF
1. ARG1 IS A CONST OR VAR (NOT A CSB)
2. ARG1 WILL NOT BE AVAILABLE IN A REG FROM SOME
EARLIER STMNT
*****)%
ARG1NODE_.CNODE[ARG1PTR];
IF .ARG1NODE[OPRCLS] EQL DATAOPR
AND NOT .ARG1NODE[RGCANDFLG]
THEN ADDREGCANDATE(.CNODE[ARG2PTR],.CNODE);
END;
%(***ADD ARG1 TO SET OF POTENTIAL REG-VARS***)%
ADDREGCANDATE(.CNODE[ARG1PTR],.CNODE);
END;
RETURN .CMPLX1;
END; ! of CMPLREL
ROUTINE CMPLCONCAT=
BEGIN
!***************************************************************
! Compute the complexity of a concatenation node by examining
! its list of arguments. Called with the global treeptr
! pointing to the concatenation node.
!***************************************************************
%1474% ! Written by TFV on 12-Feb-82
BIND INCONCAT = TRUE; ! Flag for CMPFNARGS. It indicates that
! the first argument should be ignored
LOCAL ARGUMENTLIST ARGLST;
LOCAL PEXPRNODE CNODE;
LOCAL PEXPRNODE ARGNODE;
FNREF = TRUE; ! Set global flag indicating that this statement
! includes a function call
TREEPTR[FNCALLSFLG] = 1; ! Set flag in statement node for
! function calls occur under
! this node
CNODE = .TREEPTR; ! Save pointer to current node
! Complexity will be the maximum of complexities of the
! arguments in the argument list. For concatenations, the first
! argument is not set up until allocation.
%2401% ! Removed some useless, dangerously incorrect code.
%2401%
%2401% RETURN CMPFNARGS(.TREEPTR[ARG2PTR],.TREEPTR[DBLFLG],INCONCAT);
END; ! of CMPLCONC
GLOBAL ROUTINE CMPLFNCALL=
BEGIN
!***************************************************************
! Compute the complexity of a function call by examining its
! list of arguments. Called with the global TREEPTR pointing to
! the function call node.
!***************************************************************
BIND NOTINCONCAT = FALSE; ! Flag for CMPFNARGS. It means
! that the first argument must
! be processed.
LOCAL ARGUMENTLIST ARGLST;
LOCAL CMPLX1;
LOCAL PEXPRNODE CNODE;
LOCAL PEXPRNODE ARGNODE;
! Set global flag indicating that this statment includes a
! function call. Set the flag in the node also.
FNREF = TRUE;
TREEPTR[FNCALLSFLG] = 1;
%1422% IF .TREEPTR[VALTYPE] NEQ CHARACTER
%1422% THEN
%1422% BEGIN ! Non-character functions return the result in AC0, AC1
TREEPTR[ALCRETREGFLG] = 1;
TREEPTR[TARGTAC] = RETREG;
TREEPTR[INREGFLG] = 1;
TREEPTR[TARGADDR] = RETREG;
%1422% END; ! Non-character functions return the result in AC0, AC1
! If no arguments then complexity is 0
IF .TREEPTR[ARG2PTR] EQL 0 THEN RETURN 0;
CNODE = .TREEPTR; ! Setup pointer to the node
! Complexity will be the maximum of the complexities of the
! elements of the argument list
%1474% CMPLX1 = CMPFNARGS(.TREEPTR[ARG2PTR],.TREEPTR[DBLFLG],NOTINCONCAT);
! Determine whether any argument under this call is equal to the
! left hand side of this assignment or contains a reference to
! it.
ARGLST = .CNODE[ARG2PTR];
INCR CT FROM 1 TO .ARGLST[ARGCOUNT]
DO
BEGIN ! Walk down the argument list
ARGNODE = .ARGLST[.CT,ARGNPTR];
IF .ARGNODE[OPRCLS] EQL DATAOPR
THEN
BEGIN
IF .ARGNODE EQL .RESNAME THEN CNODE[RESRFFLG] = 1;
END
ELSE
IF .ARGNODE[RESRFFLG] THEN CNODE[RESRFFLG] = 1;
END; ! Walk down the argument list
RETURN .CMPLX1;
END; ! of CMPLFNCALL
GLOBAL ROUTINE CMPFNARGS(ARLISTT,PARDBLFLG,INCONCAT)=
BEGIN
!***************************************************************
! Compute the complexity of an argument list. Used for
! functions, subroutine calls, and concatenations. PARDBLFLG is
! true iff the function had a double word value and hence
! allocation at the parent level was done in double word mode.
! The flag INCONCAT is true if this is called from CMPLCONCAT.
! In that case the first argument is ignored since it is not set
! up until allocation.
!***************************************************************
%1474% REGISTER FIRSTARG; ! The first argument to examine
MAP ARGUMENTLIST ARLISTT;
LOCAL CMPLMAX, CMPL1;
LOCAL PEXPRNODE ARGNODE;
CMPLMAX = 0;
%1474% ! Decide which argument is the first to examine
%1474% IF .INCONCAT THEN FIRSTARG = 2 ELSE FIRSTARG = 1;
%1474% INCR CT FROM .FIRSTARG TO .ARLISTT[ARGCOUNT]
DO
BEGIN ! Walk down the argument list
%2401% ! See if we have a substring which can be replaced
%2401% ! with a .Dnnnn compile time constant descriptor.
%2401%
%2401% ARLISTT[.CT,ARGNPTR] = TREEPTR = ARGNODE =
%2401% DOTDCHECK(.ARLISTT[.CT,ARGNPTR]);
%2401%
%2401% IF .ARGNODE[OPRCLS] EQL DATAOPR ! In case it changed,
%2401% THEN ARLISTT[.CT,AVALFLG] = 1; ! get val flag right
! If this argument is a constant, set the flag to allocate
! memory for that constant
IF .ARGNODE[OPR1] EQL CONSTFL
THEN
BEGIN
ALOCONST(.TREEPTR);
CMPL1 = 0
END
ELSE
IF NOT .ARLISTT[.CT,AVALFLG]
THEN
BEGIN
! Compute the complexity of the argument
CMPL1 = SETCOMPLEXITY();
! Check for an argument that requires a double
! word computation. If parent was not also in
! double word mode, must double the size of the
! number of registers indicated
IF .ARGNODE[DBLFLG] AND NOT .PARDBLFLG
THEN CMPL1 = .CMPL1^1
ELSE
! If parent is in double word mode and the
! argument is in single word mode, divide the
! complexity in half
IF .PARDBLFLG AND NOT .ARGNODE[DBLFLG]
THEN CMPL1 = (.CMPL1+1)^(-1);
! Check if the argument is a formal array
IF ARRNARGBLK(ARLISTT[.CT,ARGNPTR],ARLISTT[.CT,AVALFLG])
THEN CMPL1 = 0;
END
ELSE CMPL1 = 0;
IF .CMPL1 GTR .CMPLMAX THEN CMPLMAX = .CMPL1;
END; ! Walk down the argument list
RETURN .CMPLMAX
END; ! of CMPFNARGS
GLOBAL ROUTINE CMPTPCNV=
%(***************************************************************************
TO COMPUTE THE COMPLEXITY OF A TYPE CONVERSION NODE.
IF THE CONVERSION IS BETWEEN SINGLE-WORD AND DOUBLE-WORD VALUES,
MUST ADJUST THE COMPLEXITY USED FOR NODES BELOW THIS ONE.
IF THE CONVERSION IS BETWEEN FIXED AND FLOAT ON THE KA10, WILL NEED AN
EXTRA REG.
***************************************************************************)%
BEGIN
LOCAL PEXPRNODE CNODE:ARGNODE;
OWN CMPLX1;
CNODE_.TREEPTR;
ARGNODE_.CNODE[ARG2PTR];
%(***GET COMPLEXITY OF THE ARG***)%
IF .CNODE[A2VALFLG]
THEN
BEGIN
CMPLX1_0;
%(***IF ARG IS EQUAL TO THE VARIABLE ON THE LHS OF THIS ASSIGNMENT
SET A FLG*****)%
IF .CNODE[ARG2PTR] EQL .RESNAME
THEN
CNODE[RESRFFLG]_1;
%(***IF THE ARG UNDER THIS NODE COULD HAVE BEEN LEFT IN A REG
BY THE EVAL OF A PRECEEDING STMNT, DO SO***)%
SAVREGCONTAINING(.ARGNODE);
END
ELSE
BEGIN
ARGNODE_.CNODE[ARG2PTR];
TREEPTR_.CNODE[ARG2PTR];
CMPLX1_SETCOMPLEXITY();
%(***IF VAL OF ARG IS COMPUTED INTO RETREG,
COMPUTE VAL OF PARENT INTO RETREG**)%
SNGARGPROP(.CNODE,.ARGNODE);
END;
%(***IF ARG IS A CONSTANT, MUST ALLOCATE CORE FOR IT (THIS WILL ONLY
OCCUR IF CALLED THE TYPE CONV ROUTINE EXPLICITLY)***)%
IF .ARGNODE[OPR1] EQL CONSTFL
THEN
ALOCONST(.ARGNODE);
%(***UNLESS NO CONVERSION CODE HAS TO BE GENERATED,
AT LEAST 1 REGISTER WILL BE NEEDED TO PERFORM
THE CONVERSION IN
*******)%
IF NOT NOCNV(CNODE)
THEN
BEGIN
IF .CMPLX1 EQL 0
THEN CMPLX1_1;
END;
%(***CHECK FOR CHANGE IN PRECISION ACROSS THIS NODE***)%
IF .CNODE[DBLFLG] AND NOT .CNODE[SDBLFLG]
THEN
%(***IF NODE BELOW IS SINGLE-WD AND THIS NODE
IS DOUBLE-WD***)%
CMPLX1_(.CMPLX1+1)^(-1)
ELSE
IF NOT .CNODE[DBLFLG] AND .CNODE[SDBLFLG]
THEN
%(***IF NODE BELOW IS DOUBLE-WD AND THIS NODE
IS SINGLE-WD***)%
CMPLX1_.CMPLX1^1;
RETURN .CMPLX1;
END; ! of CMPTPCNV
GLOBAL ROUTINE CMPLXARRAY=
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Returns the complexity of an array reference. Must get the
! value of the offset into a register (unless it is constant).
! Need as many regs as are needed to compute that val, or 1 reg
! if that val requires no computation but is not constant (ie is
! a variable).
!
! Set up TARGADDR of this ARRAYREF node to represent the
! constant part of the reference to this element (i.e. the sum
! of the address of the array base with any constants involved
! in the offset calculation). Do this by walking down the n-ary
! sum that is the address calculation, to get any constant term
! (which the canonicalizer will have left at bottom left).
! TARGADDR may already contain constant terms that were detected
! at the time that the address calculation was expanded.
!
! Note that if the array is numeric and the constant part of the
! ARRAYREF does not directly fit into TARGADDR, a CTE will be
! created for the constant, and the CTE's address will be placed
! in TARGADDR. The ARRAYREF's OPERSP will be changed to
! ARREFBIG to signify the offset's change in representation.
!
! Called with the global TREEPTR pointing to the ARRAYREF node
! to be processed.
!
! FORMAL PARAMETERS:
!
! None
!
! IMPLICIT INPUTS:
!
! Unknown
!
! IMPLICIT OUTPUTS:
!
! Unknown
!
! ROUTINE VALUE:
!
! Complexity of the array reference passed.
!
! SIDE EFFECTS:
!
! Unknown
!
!--
%2463% OWN BASE AADDR; ! Array address
OWN CMPLX1; ! Calculated complexity
OWN PEXPRNODE CONSTTERM; !EVENTUALLY WILL BE SET TO PT TO THE
! CONSTANT TERM IN THE ADDRESS CALC
OWN PEXPRNODE PAROFCONST; !PTR TO PARENT OF CONSTTERM
OWN PEXPRNODE GPOFCONST; !PTR TO PARENT OF "PAROFCONST"
REGISTER
PEXPRNODE ADDRNODE, ! Array address calculation
PEXPRNODE CNODE,
%2411% PEXPRNODE ARRNAME; ! Array symbol table entry
%2244% LOCAL BASE AOBJNPTR, ! Expression node pointing to
%2244% ! AOBJN REGCONTENTS node.
%2244% BASE AOBJNSTORNODE, ! STRHAOBJN node created.
%2244% CMPAOBJN; ! Added complexity if addr calc
%2244% ! is AOJBN and array is in .LARG.
%2411% ARRNAME _ .TREEPTR[ARG1PTR]; ! Symbol table name entry
ADDRNODE _ .TREEPTR[ARG2PTR]; ! Address node
CNODE _ .TREEPTR; ! Array ref node
%(***IF THE ARRAY NAME IS IDENTICAL TO THE ARRAY NAME ON LEFT HAND
SIDE OF ASSIGNMENT OR THE ADDRNODE IS IDENTICAL TO A SIMPLE VAR
ON THE LEFT HAND SIDE OF THE ASSIGNMENT, SET FLAGS
INDICATING THAT THERE IS A REFERENCE TO LHS UNDER THIS NODE***)%
%2411% IF (.ARRNAME EQL .RESNAME) OR (.ADDRNODE EQL .RESNAME) THEN CNODE[RESRFFLG]_1;
%2411% IF .ARRNAME[VALTYPE] NEQ CHARACTER
%1253% THEN
BEGIN ! NON-CHARACTER
! We want to try to add the base address of the array into the constant
! part of the address calculation if the array is not a formal.
%2411% IF .ARRNAME[FORMLFLG]
%2362% THEN AADDR = EXTSIGN(.CNODE[TARGADDR]) ! Formal array
%1766% ELSE
%2336% BEGIN ! Not formal array
%2336%
%2411% AADDR = EXTSIGN(.CNODE[TARGADDR]) + .ARRNAME[IDADDR];
%2336%
%2362% ! Check the size of the address so far. If the address is too
%2362% ! big to store into TARGADDR already, then we should keep these
%2362% ! constants separate. What is in TARGADDR obviously fits.
%2362% ! Make a new constant, ARRNAME[IDADDR], and insert an ADDOP
%2362% ! node directly below the array node to add the constant and
%2362% ! the existing address calculation.
%2336%
%2336% IF NOT STORETARGADDR(.AADDR)
%2336% THEN
%2336% BEGIN ! Too big for TARGADDR
%2336%
%2336% ! Reset AADDR
%2336% AADDR = EXTSIGN(.TREEPTR[TARGADDR]);
%2336%
%2360% ! Make a constant with the large IDADDR.
%2411% CONSTTERM = MAKECNST(INTEGER,0,.ARRNAME[IDADDR]);
%2336%
%2360% ! If there is no address expression, then make the
%2360% ! IDADDR the address calculation. Otherwise, make an
%2360% ! add node with the current address calc and the new
%2360% ! constant.
%2360%
%2361% IF .ADDRNODE EQL 0
%2361% THEN
%2362% BEGIN ! No address node
%2361% TREEPTR[ARG2PTR] = ADDRNODE = .CONSTTERM;
%2362% TREEPTR[A2VALFLG] = 1;
%2362% END ! No address node
%2360% ELSE
%2362% BEGIN ! Address node exists
%2362%
%2362% ! Create add node with constant
%2362%
%2336% TREEPTR[ARG2PTR] = ADDRNODE = MAKPR1( .TREEPTR,
%2336% ARITHMETIC, ADDOP, INDEX,
%2360% .CONSTTERM,
%2336% .ADDRNODE );
%2362%
%2362% ! Raise flags from ARRAYREF to add node that
%2362% ! was created. Then clear ARRAYREF's A2 flags.
%2362%
%2362% ADDRNODE[A2FLGS] = RAISEFLGS(.ADDRNODE[A2FLGS],
%2362% .TREEPTR[A2FLGS]);
%2362% TREEPTR[A2FLGS] = 0;
%2362%
%2362% END; ! Address node exists
%2336%
%2336% END; ! Too big for TARGADDR
%2336%
%2336% END; ! Not formal array
%(***IF THERE IS NO ADDRESS CALCULATION TO BE DONE (ADDR IS A CONSTANT WHICH
WAS DETECTED AT TIME OF EXPANSION OF THE ARRAY).
FILL IN CORRECT VAL FOR TARGET FIELD AND RETURN.
*******)%
IF .ADDRNODE EQL 0
THEN
BEGIN
TREEPTR[A2IMMEDFLG] = 1;
%1766% TREEPTR[TARGADDR] = .AADDR;
RETURN 0
END;
! If the array offset address calculation is a constant, then
! we may not need runtime address calculation. May be able to
! add the constant into the array ref's TARGADDR.
%1766% IF AROFCONST(.TREEPTR, .TREEPTR, .ADDRNODE, .AADDR)
%1766% THEN
%1766% BEGIN ! Constant optimized into TARGADDR
TREEPTR[ARG2PTR] = 0; ! Zero subscript list
RETURN 0 ! No registers needed
%1766% END;
! If the variable part of the address is a common sub set flag
! indicating "this cs used as a subscript" (this will cause it
! to get priority for a register)
IF .ADDRNODE[OPRCLS] EQL CMNSUB
THEN ADDRNODE[CSSSFLG]_1;
! If offset address computation is a sum, try to take any
! constant pieces out of the expression and add them into
! TARGADDR in the array ref node.
CONSTTERM = .ADDRNODE[ARG1PTR];
IF .ADDRNODE[OPR1] EQL ADDOPF
THEN
BEGIN ! Offset address computation is a sum
! +-------------+
! | ARRAYREF |
! +-------------+
! \
! V
! +-------+
! | + |
! +-------+
%1766% IF .CONSTTERM[OPR1] EQL CONSTFL
%1766% THEN
%1766% BEGIN ! Arg1 is constant
! +-------+
! | + |
! +-------+
! /
! V
! +-------------+
! | constant |
! +-------------+
%1766% IF AROFCONST(.TREEPTR,.ADDRNODE,.CONSTTERM,.AADDR)
%1766% THEN
%1766% BEGIN ! Try to optimize arg1
%1766% ! If 2nd argument to the plus node can
%1766% ! be optimized in, then there isn't any
%1766% ! expression to calculate. Otherwise
%1766% ! substitute arg2 for the address
%1766% ! calculation.
%2463% IF .TREEPTR[OPERSP] EQL ARREFSMALL
%2362% THEN AADDR = EXTSIGN(.TREEPTR[TARGADDR])
%2463% ELSE ! Large, offset in CTE
%2463% BEGIN ! ARREFBIG
%2463% AADDR = .TREEPTR[TARGADDR]; ! CTE
%2463% AADDR = .AADDR[CONST2]; ! Actual offset
%2463% END; ! ARREFBIG
%1766% IF AROFCONST(.TREEPTR, .ADDRNODE,
%1766% .ADDRNODE[ARG2PTR], .AADDR)
%1766% THEN
%2362% BEGIN ! Constant was opt into ARRAYREF
%2362%
%1766% TREEPTR[ARG2PTR] = 0; ! No subscripts
! A2VALFLG - true (Don't let CGETVAL
! recurse on NIL pointer)
! A2NOTFLG - false (It *is* false)
! A2NEGFLG - false (It *is* false)
! A2SAMEFLG - false (I hope)
! A2IMMEDFLG - true (Tradition)
%2362% TREEPTR[A2FLGS] = 0; ! Clear all
%2466% TREEPTR[A2VALFLG] ! Set some
%2466% = TREEPTR[A2IMMEDFLG] = 1;
%2466% SAVSPACE(EXSIZ-1,.ADDRNODE); ! Del +
%2466% RETURN 0; ! Complexity of 0
%2362% END ! Constant was opt into ARRAYREF
%1766% ELSE
%1766% BEGIN ! NOT OPT
%1766% TREEPTR[ARG2PTR] = .ADDRNODE[ARG2PTR];
%1766% TREEPTR[A2FLGS] = RAISEFLGS(
%1766% .TREEPTR[A2FLGS],
%1766% .ADDRNODE[A2FLGS]);
%1766% ! Delete plus node
%1766% SAVSPACE(EXSIZ-1,.ADDRNODE);
%1766% END; ! NOT OPT
%1766% END ! Try to optimize arg1
%1766% ELSE ! Can't optimize arg1
%1766% BEGIN ! Try to optimize arg2.
%1766%
%2012% IF AROFCONST(.TREEPTR, .ADDRNODE,
%2012% .ADDRNODE[ARG2PTR], .AADDR)
%1766% THEN
%1766% BEGIN ! Optimization succeeds. Delete
%1766% ! plus node and have the array
%1766% ! ref point to arg1 instead.
%1766%
%1766% TREEPTR[ARG2PTR] = .ADDRNODE[ARG1PTR];
%2362% TREEPTR[A2FLGS] = RAISEFLGS(
%2362% .TREEPTR[A2FLGS], ! Copy
%2362% .ADDRNODE[A1FLGS]); ! flags
%2362%
%1766% SAVSPACE(EXSIZ-1,.ADDRNODE); ! Del +
%1766% END
%1766% ELSE ! Neither arg1 nor arg2 stored
%1766% TREEPTR[TARGADDR] = .AADDR;
%1766%
%1766% END; ! Try to optimize arg2.
%1766%
%1766% END ! Arg1 is constant
%1766% ELSE
%1766% BEGIN ! Plus node's arg1 is not a constant
! If address computation is a sum, search down
! the N-ary sum for the constant term (which the
! canonicalizer will have left at bottom left).
! Try to extract this term from the tree and put
! it in the target field.
IF .CONSTTERM[OPR1] EQL ADDOPF
THEN
BEGIN ! ARG1 is add node
%2411% ! Set to top ADD node to search down...
%2411% CONSTTERM = .ADDRNODE;
! If there is a constant-term, it will
! be the first non-plus node reached.
%2411% ! If a neg or not flag exists, then we
%2411% ! can't do this optimization, since the
%2411% ! constant must be negated or notted.
DO
BEGIN ! Set parent and possible constant
PAROFCONST_.CONSTTERM;
CONSTTERM_.CONSTTERM[ARG1PTR];
END ! Set parent and possible constant
WHILE
%2411% BEGIN ! Condition to loop
.CONSTTERM[OPR1] EQL ADDOPF
%2411% AND NOT (.PAROFCONST[A1NOTFLG] OR
%2411% .PAROFCONST[A1NEGFLG])
%2411%
%2411% END; ! Condition to loop
! Check if we can store in TARGADDR. CONSTTERM
! is now the first non-plus node seen.
%1766% IF AROFCONST(.TREEPTR, .PAROFCONST,
%1766% .CONSTTERM, .AADDR)
%1766% THEN
%1766% BEGIN ! The offset stored in TARGADDR
! Remove the constant node from
! the tree, linking its brother
! under its parent plus-node
! directly to its grand-parent
! plus-node
GPOFCONST _ .PAROFCONST[PARENT];
GPOFCONST[A1FLGS] _
RAISEFLGS(.GPOFCONST[A1FLGS],
.PAROFCONST[A2FLGS]);
GPOFCONST[ARG1PTR] _ .PAROFCONST[ARG2PTR];
%1766% ! Delete the plus node containing
%1766% ! the constant we're not using.
%1766% SAVSPACE(EXSIZ-1,.PAROFCONST);
%1766%
%1766% END ! The offset stored in TARGADDR
%1766% ELSE ! Not stored
%1766% TREEPTR[TARGADDR] = .AADDR;
%1766%
%1766% END ! ARG1 is add node
%1766% ELSE ! Not add node
%1766% TREEPTR[TARGADDR] = .AADDR;
%1766%
%1766% END; ! Plus node's arg1 is not a constant
%1766%
%1766% END ! Address computation is a sum
%1766% ELSE ! Not sum
%1766% TREEPTR[TARGADDR] = .AADDR;
%1766% ADDRNODE = .TREEPTR[ARG2PTR]; ! Reset address calculation node
END ! NON-CHARACTER
%1253% ELSE
%1253% BEGIN ! [1253] CHARACTER
IF .ADDRNODE EQL 0 ! IF SUBSCRIPT IS CONSTANT AND HAS
THEN ! BEEN FOLDED INTO BASE (NYI),
RETURN 1; ! IT REQUIRES 1 REGISTER
IF .ADDRNODE[OPR1] EQL CONSTFL
THEN
PRCNSTARG(.TREEPTR,.ADDRNODE,FALSE);
END; ! [1253] CHARACTER
%(***IF THE VARIABLE PART OF THE ADDR IS A SINGLE VAR, THEN IF IT
COULD BE LEFT IN A REG EARLIER DO SO AND IF ITS NEEDED LATER THEN
LEAVE ITS REG ALONE AFTER EXECUTION OF THIS STMNT***)%
IF .TREEPTR[A2VALFLG]
THEN
BEGIN
SAVREGCONTAINING(.ADDRNODE); !SAVE THE REG FROM PREV REF
%2411% IF .ARRNAME[VALTYPE] NEQ CHARACTER !IF NON-CHARACTER
THEN ADDREGCANDATE(.ADDRNODE,.TREEPTR); !IF NEED THE REG LATER, CAN USE IT
! FROM THIS REF
END;
%(***FIND THE NUMBER OF REGISTERS NECESSARY TO COMPUTE THE ADDRESS,
THE COMPLEXITY OF THE ARRAYREF NODE IS 1 IF 0 REGS ARE NEEDED, OTHERWISE
IT IS EQUAL TO THE NUMBER OF REGS NEEDED*****)%
IF .TREEPTR[A2VALFLG]
THEN CMPLX1_1
ELSE
BEGIN
TREEPTR_.ADDRNODE;
CMPLX1_SETCOMPLEXITY();
%(**IF THERE IS A REFERENCE TO LHS OF ASSIGNMENT STMNT SOMEWHERE IN THE
ADDRESS CALCULATION, SET FLAG IN THE ARRAYREF NODE***)%
IF .ADDRNODE[RESRFFLG] THEN CNODE[RESRFFLG]_1;
IF .ADDRNODE[FNCALLSFLG] THEN CNODE[FNCALLSFLG]_1;
END;
%1253% IF .CNODE[DBLFLG]
THEN
BEGIN
%(***CONVERT CMPLX1 FROM NUMBER OF REGS TO NUMBER OF PAIRS***)%
CMPLX1_(.CMPLX1+1)/2;
%(***FOR A DOUBLE-WD ARRAY-REF - ALWAYS NEED AT LEAST 3 REGS TO
GET THE VALUE LOADED (SINCE CANT LOAD IT INTO THE
REG USED FOR THE INDEX). HENCE NEED AT LEAST 2 PAIRS***)%
IF .CMPLX1 LSS 2 THEN CMPLX1_2;
END
%(***FOR A SINGLE-WD ARRAYREF - ALWAYS NEED AT LEAST 1 REG***)%
ELSE IF .CMPLX1 EQL 0 THEN CMPLX1_1;
%2244% ! If array is in .LARG. and the address calculation expression
%2244% ! is a register containing an AOBJN count, then must must add a
%2244% ! STORECLS node between the arrayref and the regcontents nodes
%2244% ! to copy the right half of the AOBJN count to another register.
%2244%
%2244% CMPAOBJN = 0; ! No added complexity yet.
%2244%
%2244% IF .DOWDP NEQ 0 ! Within inner DO loop
%2411% THEN IF .ARRNAME[VALTYPE] NEQ CHARACTER ! and not character array
%2244% THEN IF .CDONODE[FLCWD] ! and DO is AOBJN
%2411% THEN IF (.ARRNAME[IDPSECT] EQL PSLARGE ! and .LARG. PSECT
%2464% OR .TREEPTR[OPERSP] EQL ARREFBIG) ! or large ARRAYREF
%2244% THEN ! Yep, don't AOBJN index EFIW
%2244% BEGIN ! MOBY
%2244%
%2244% ! Decide who might point to the AOBJN. If the address
%2244% ! calc is a common sub, then the AOBJN would be under
%2244% ! it.
%2244%
%2244% IF .ADDRNODE[OPRCLS] EQL CMNSUB
%2244% THEN AOBJNPTR = .ADDRNODE ! Common subexpresion node
%2244% ELSE AOBJNPTR = .CNODE; ! Array node
%2244%
%2244% ! Check if the array's address calculation is the same
%2244% ! as the REGCONTENTS node used for the AOBJN instruction
%2244% ! in the DO statement. If so, then we insert our
%2244% ! STORECLS node.
%2244%
%2244% IF .AOBJNPTR[ARG2PTR] EQL .DOWDP[DOREGPTR]
%2244% THEN
%2244% BEGIN ! Address calc is DO AOBJN register
%2244%
%2244% ! Make a STRHAOBJN node to copy the right half ac
%2244% ! into another register.
%2244%
%2244% AOBJNPTR[ARG2PTR] = AOBJNSTORNODE =
%2244% MAKPR1(.AOBJNPTR, STORECLS, STRHAOBJN, INDEX,
%2244% 0, .AOBJNPTR[ARG2PTR]);
%2244%
%2244% AOBJNSTORNODE[COMPLEXITY] = 1;
%2244%
%2244% ! Copy flags from pointer to new node. Clear the
%2244% ! pointer's A2VALFLG and A2IMMEDFLG.
%2244%
%2244% AOBJNSTORNODE[A2FLGS] = .AOBJNPTR[A2FLGS]; ! Copy
%2244%
%2244% AOBJNPTR[A2VALFLG] = 0; ! No longer is DATAOPR
%2244% AOBJNPTR[A2IMMEDFLG] = 0; ! No longer is immed
%2244% AOBJNPTR[A2SAMEFLG] = 1; ! Target (reg) same
%2244%
%2244% IF .AOBJNPTR[OPRCLS] NEQ CMNSUB
%2244% THEN CMPAOBJN = 1; ! Extra register needed.
%2244%
%2244% END; ! Address calc is DO AOBJN register
%2244%
%2244% END; ! MOBY
%2244% RETURN (.CMPLX1 + .CMPAOBJN) ! Return complexity calculated
END; ! of CMPLXARRAY
ROUTINE AROFCONST(ARREF,CPARENT,CONST,AADDR)= ![1766] New
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Attempts to optimize a given constant from an array reference
! offset calculation into TARGADDR in the array reference node. If
! the constant will not fit into TARGADDR or if the passed
! expression is not a constant, then the array's TARGADDR field is
! unchanged.
!
! FORMAL PARAMETERS:
!
! ARREF The array reference node.
!
! CPARENT CONST's parent. Flags and TARGADDR in this node
! may be changed.
!
! CONST Offset to try to store. This must be a constant,
! else nothing to do.
!
! AADDR Address so far calculated.
!
! IMPLICIT INPUTS:
!
! None
!
! IMPLICIT OUTPUTS:
!
! None
!
! ROUTINE VALUE:
!
! Returns True if offset is stored in TARGADDR
! False if not.
!
! Side Effects:
!
! None
!
!--
MAP BASE AADDR,
BASE ARREF,
BASE CONST,
BASE CPARENT;
REGISTER
BASE ARROFFSET; ! Calculated array offset
! Check if the offset expression is a constant
IF .CONST[OPR1] EQL CONSTFL
THEN
BEGIN ! Have a constant
! Set parent's flags indicating a leaf below depending
! on whether it's arg1 or arg2 for the parent
! expression.
IF .CONST EQL .CPARENT[ARG1PTR]
THEN CPARENT[A1VALFLG] = 1
ELSE CPARENT[A2VALFLG] = 1;
! Calculate the offset for this constant
ARROFFSET = .AADDR + .CONST[CONST2];
! Try to optimize if the offset will fit in TARGADDR
! correctly (what we put in will come out).
IF STORETARGADDR(.ARROFFSET)
THEN
BEGIN ! Put offset in
ARREF[TARGADDR] = .ARROFFSET; ! Put in offset
! Set parent's flags indicating a constant
! usable with an immediate instruction
! (depending on whether it's arg1 or arg2 for
! the parent expression).
IF .CONST EQL .CPARENT[ARG1PTR]
THEN CPARENT[A1IMMEDFLG] = 1
ELSE CPARENT[A2IMMEDFLG] = 1;
RETURN TRUE; ! Optimized into TARGADDR
END ! Put offset in
%2463% ELSE IF EXTENDED ! No room, EFIWs available?
%2463% THEN ! Yes, make ARREFBIG
%2464% BEGIN ! EXTENDED
! Flag TARGADDR change and store offset constant
%2463% ARREF[OPERSP] = ARREFBIG;
%2463% ARREF[TARGADDR] = MAKECNST(INTEGER,0,.ARROFFSET);
! Set parent's flags indicating a constant
! useable with an immediate instruction
! (depending on whether it's arg1 or arg2 for
! the parent expression).
%2463% IF .CONST EQL .CPARENT[ARG1PTR]
%2463% THEN CPARENT[A1IMMEDFLG] = 1
%2463% ELSE CPARENT[A2IMMEDFLG] = 1;
%2463% RETURN TRUE; ! Stored in TARGADDR (sort of)
%2464% END ! EXTENDED
%2463% ELSE PRCNSTARG(.CPARENT, .CONST, ! No EFIWs, allocate
(.CPARENT[ARG1PTR] EQL .CONST) ); ! constant
END; ! Have a constant
! If we get here, we're not optimizing the offset
RETURN FALSE;
END; ! of AROFCONST
GLOBAL ROUTINE CMPILF=
%(***************************************************************************
The complexity pass for an in-line-function node.
Number of regs needed is max of the following:
1. Number of regs needed to compute ARG1
2. 1+number of regs needed for computing ARG2
For MOD and CHAR, we need 1 more reg for calculating the result.
***************************************************************************)%
BEGIN
LOCAL
PEXPRNODE ARG1NODE, ! ARG1PTR from CNODE
PEXPRNODE ARG2NODE, ! ARG2PTR from CNODE
CMPLX1, ! Complexity of arg 1
CMPLX2; ! Complexity of arg 2
REGISTER
PEXPRNODE CNODE; ! Inline function node
CNODE_.TREEPTR;
ARG1NODE_.CNODE[ARG1PTR];
ARG2NODE_.CNODE[ARG2PTR];
%(***FOR CMPLX - USE CMPLA***)%
IF .CNODE[OPERSP] EQL CMPLXFN THEN
RETURN
BEGIN
IF (CMPLX1_CMPLA()) GTR 2 THEN .CMPLX1 ELSE 2
END;
%(***FOR MAX AND MIN - IF ONE OF THE ARGS IS A REAL OR NEGATIVE
CONSTANT, LET ARG1 BE THAT ARG (SINCE HAVE PROBS WITH
COMPARE-IMMED FOR REAL AN NEG CNSTS)***)%
IF .CNODE[OPERSP] EQL MAXFN OR .CNODE[OPERSP] EQL MINFN
THEN
BEGIN
IF .ARG2NODE[OPR1] EQL CONSTFL
AND .ARG1NODE[OPR1] NEQ CONSTFL
AND NOT .CNODE[A1NEGFLG]
THEN
BEGIN
IF .ARG2NODE[VALTP1] NEQ INTEG1 OR .ARG2NODE[CONST2] LSS 0
THEN
BEGIN
SWAPARGS(CNODE); !EXCHANGE THE 2 PTRS AND ALSO THE FLAGS THAT GO WITH
! THE 2 ARGS
ARG1NODE_.CNODE[ARG1PTR];
ARG2NODE_.CNODE[ARG2PTR];
END
END
END;
%(***PERFORM COMPLEXITY ANALYSIS FOR ARG1***)%
%(******************************)%
%(***PROCESS 1st ARG************)%
%(******************************)%
%2401% ! See if we have a substring which can be replaced with a
%2401% ! .Dnnnn compile time constant descriptor.
%2401%
%2401% CNODE[ARG1PTR] = TREEPTR = ARG1NODE = DOTDCHECK(.ARG1NODE);
%2401%
%2401% IF .ARG1NODE[OPRCLS] EQL DATAOPR ! In case it changed,
%2401% THEN CNODE[A1VALFLG] = 1; ! get val flag right
%(***IF ARG1 IS AN IMMED CNST SET A1IMMEDFLG, IF IT IS
A NON-IMMED CNST, ALLOCATE CORE FOR IT***)%
IF .ARG1NODE[OPR1] EQL CONSTFL
THEN (PRCNSTARG(.CNODE,.CNODE[ARG1PTR],TRUE);
CMPLX1_0)
ELSE
IF .CNODE[A1VALFLG]
THEN
BEGIN
%(***IF ARG IS RESULT NAME, SET RESRFFLG***)%
IF .ARG1NODE EQL .RESNAME THEN CNODE[RESRFFLG]_1;
CMPLX1_0
END
ELSE
BEGIN ! Non-zero complexity
CMPLX1_SETCOMPLEXITY();
! Set flags for "FNCALLS present under this node" and
! for ref to result under this node
IF .ARG1NODE[FNCALLSFLG] THEN CNODE[FNCALLSFLG]_1;
IF .ARG1NODE[RESRFFLG] THEN CNODE[RESRFFLG]_1;
%1567% ! If the node and arg differ in being either single or
%1567% ! double, then convert that complexity figured for the
%1567% ! argument to the mode of the parent.
%1567%
%1567% IF .CNODE[DBLFLG] AND NOT .ARG1NODE[DBLFLG]
%1567% THEN CMPLX1 = (.CMPLX1+1) ^ (-1) ! divide by 2
%1567% ELSE IF NOT .CNODE[DBLFLG] AND .ARG1NODE[DBLFLG]
%1567% THEN CMPLX1 = .CMPLX1 ^ 1; ! Mult by 2
END; ! Non-zero complexity
! For fns other than ABS if val of ARG1 can be left in a reg in
! a previous statment, bb allocator should do so. (Character
! args can't)
IF .CNODE[OPERSP] NEQ ABSFN THEN
%1567% IF .ARG1NODE[VALTYPE] NEQ CHARACTER
THEN SAVREGCONTAINING(.ARG1NODE);
%1567% ! Now that we know whether the first argument has any function
%1567% ! calls beneath it, if LEN has an array ref for an arg, we can
%1567% ! simplify the argument to be the array name and not go through
%1567% ! any calculation for the array element.
%1567% IF .CNODE[OPERSP] EQL LENFN THEN
%1567% IF .ARG1NODE[OPRCLS] EQL ARRAYREF THEN
%1567% IF NOT .ARG1NODE[FNCALLSFLG]
%1567% THEN
%1567% BEGIN
%1567% CNODE[ARG1PTR] = .ARG1NODE[ARG1PTR]; ! Array name
%1567% RETURN CMPLX1 = 1; ! Array names aren't complex
%1567% END;
%(******************************)%
%(***PROCESS 2ND ARG************)%
%(******************************)%
IF .ARG2NODE NEQ 0
THEN
BEGIN
%2401% ! See if we have a substring which can be replaced
%2401% ! with a .Dnnnn compile time constant descriptor.
%2401%
%2401% CNODE[ARG2PTR] = TREEPTR = ARG2NODE = DOTDCHECK(.ARG2NODE);
%2401%
%2401% IF .ARG2NODE[OPRCLS] EQL DATAOPR ! In case it changed,
%2401% THEN CNODE[A2VALFLG] = 1; ! get val flag right
%(***FOR ARG2 AN IMMED CNST, SET A2IMMEDFLG EXCEPT
IN THE CASES OF AMAX AND AMIN (SINCE CANT DO COMPARE IMMED
FOR A REAL) AND IN THE (UNLIKELY!) CASE OF SIGN***)%
IF .ARG2NODE[OPR1] EQL CONSTFL
THEN
BEGIN
IF .CNODE[OPERATOR] EQL AMAXFNOP OR .CNODE[OPERATOR] EQL AMINFNOP
OR .CNODE[OPERATOR] EQL DIMFNOP
OR .CNODE[OPERSP] EQL SIGNFN
THEN
ALOCONST(.ARG2NODE)
ELSE
IF IMMEDCNST(ARG2NODE)
THEN
BEGIN
IF .ARG2NODE[VALTP1] EQL INTEG1 AND .ARG2NODE[CONST2] LSS 0
THEN ALOCONST(.ARG2NODE)
ELSE
CNODE[A2IMMEDFLG]_1;
END
ELSE ALOCONST(.ARG2NODE);
CMPLX2_1;
END
ELSE
IF .CNODE[A2VALFLG]
THEN
BEGIN
IF .ARG2NODE EQL .RESNAME
%730% THEN CNODE[RESRFFLG]_1;
CMPLX2_1;
END
ELSE
BEGIN
CMPLX2_SETCOMPLEXITY()+1;
IF .ARG2NODE[RESRFFLG] THEN CNODE[RESRFFLG]_1;
IF .ARG2NODE[FNCALLSFLG] THEN CNODE[FNCALLSFLG]_1;
END;
END
ELSE CMPLX2_1;
%1567% ! If the node and arg differ in being either single or double,
%1567% ! then convert that complexity figured for the argument to the
%1567% ! mode of the parent.
%1567%
%1567% IF .ARG2NODE NEQ 0 THEN
%1567% IF .CNODE[DBLFLG] AND NOT .ARG2NODE[DBLFLG]
%1567% THEN CMPLX2 = (.CMPLX2+1) ^ (-1) ! divide by 2
%1567% ELSE IF NOT .CNODE[DBLFLG] AND .ARG2NODE[DBLFLG]
%1567% THEN CMPLX2 = .CMPLX2 ^ 1; ! Mult by 2
%(***IF ARG1 WILL BE COMPUTED INTO RETREG (FN RETURN REGISTER), THEN
1. IF ARG2 INCLUDES FN CALLS, THEN CANNOT COMPUTE ARG1 INTO
RETREG. UNDO THE ALLOCATION.
2. OTHERWISE, COMPUTE THE PARENT INTO RETREG ALSO
**********)%
IF NOT .CNODE[A1VALFLG] AND .ARG1NODE[ALCRETREGFLG]
THEN
BEGIN
IF NOT .CNODE[A2VALFLG] AND .ARG2NODE[FNCALLSFLG]
THEN
BEGIN
%(***UNDO THE ALLOCATION OF ARG1 TO RETREG (SINCE RETREG
WILL BE CLOBBERED WHILE COMPUTING ARG2)***)%
ARG1NODE[ALCRETREGFLG]_0;
ARG1NODE[A1SAMEFLG]_0;
ARG1NODE[A2SAMEFLG]_0;
ARG1NODE[INREGFLG]_0;
END
ELSE
BEGIN
%(***ALLOCATE CNODE TO BE COMPUTED IN RETREG***)%
CNODE[TARGTAC]_RETREG;
CNODE[INREGFLG]_1;
CNODE[A1SAMEFLG]_1;
CNODE[ALCRETREGFLG]_1;
END;
END;
IF .CMPLX2 GTR .CMPLX1 ! Return whichever complexity is greater.
THEN CMPLX1_.CMPLX2;
! Return the complexity computed. MOD and CHAR each need an
! extra register for computation.
IF .CNODE[OPERSP] EQL MODFN
THEN RETURN .CMPLX1+1
ELSE RETURN .CMPLX1;
END; ! of CMPILF
ROUTINE CMPLXSUBSTR= ![1431] New
%(**********************************************************************
**********************************************************************)%
BEGIN
REGISTER PEXPRNODE CNODE:ARGNODE;
LOCAL CMPLX1:CMPLX2:CMPLX4;
! Save pointer to substring node in CNODE
CNODE = .TREEPTR;
! Do arg 2, lower bound - 1 expression
ARGNODE = .CNODE[ARG2PTR]; ! Point to expression node
IF .CNODE[A2VALFLG]
THEN
BEGIN ! simple variable
CMPLX2 = 0; ! Complexity of a scalar is 0
IF .ARGNODE EQL .RESNAME ! Set RESRFFLG if this arg
THEN CNODE[RESRFFLG] = 1; ! matches global RESNAME
IF .ARGNODE[OPR1] EQL CONSTFL ! If it's constant, either set
THEN PRCNSTARG(.CNODE,.ARGNODE,FALSE); ! IMMEDFLG or allocate
! the constant
SAVREGCONTAINING(.ARGNODE); ! Request that it be saved if
! it's available in an AC.
END ! simple variable
ELSE
BEGIN ! expression
TREEPTR = .ARGNODE; ! Set TREEPTR to the expression
CMPLX2 = SETCOMPLEXITY(); ! Compute its complexity
IF .ARGNODE[RESRFFLG] THEN CNODE[RESRFFLG] = 1; ! Propagate
IF .ARGNODE[FNCALLSFLG] THEN CNODE[FNCALLSFLG] = 1; ! flags
%2052% ! Never allocate the lower bound node to RETREG (AC 0)
%2052% ! even if it's a function call node since we would
%2052% ! have to move it out of AC 0 before doing the ADJBP
%2052% ! anyway. If anything is to land in AC 0, let it be
%2052% ! the upper bound expression.
%2052%
%2052% IF .ARGNODE[ALCRETREGFLG]
%2052% THEN
%2052% BEGIN ! ALCRETREGFLG
%2052%
%2052% ARGNODE[ALCRETREGFLG] = 0;
%2052% ARGNODE[A1SAMEFLG] = 0;
%2052% ARGNODE[A2SAMEFLG] = 0;
%2052% ARGNODE[INREGFLG] = 0;
%2052%
%2052% END; ! ALCRETREGFLG
END;
! Do arg 1, upper bound expression
ARGNODE = .CNODE[ARG1PTR]; ! Point to expression node
IF .CNODE[A1VALFLG]
THEN
BEGIN ! simple variable
CMPLX1 = 0; ! Complexity of a scalar is 0
IF .ARGNODE EQL .RESNAME ! Set RESRFFLG if this arg
THEN CNODE[RESRFFLG] = 1; ! matches global RESNAME
IF .ARGNODE[OPR1] EQL CONSTFL ! If it's constant, either set
THEN PRCNSTARG(.CNODE,.ARGNODE,TRUE); ! IMMEDFLG or allocate
! the constant
SAVREGCONTAINING(.ARGNODE); ! Request that it be saved if
! it's available in an AC.
END ! simple variable
ELSE
BEGIN ! expression
TREEPTR = .ARGNODE; ! Set TREEPTR to the expression
CMPLX1 = SETCOMPLEXITY(); ! Compute its complexity
IF .ARGNODE[RESRFFLG] THEN CNODE[RESRFFLG] = 1; ! Propagate
IF .ARGNODE[FNCALLSFLG] THEN CNODE[FNCALLSFLG] = 1; ! flags
END; ! expression
! If we have substring of an arrayref, do subscript expression
ARGNODE = .CNODE[ARG4PTR]; ! Point to base variable of
! substring, must be DATAOPR or
! ARRAYREF
IF .ARGNODE[OPRCLS] EQL DATAOPR
THEN
BEGIN ! simple variable
CMPLX4 = 0; ! Complexity of subscript is 0
IF .ARGNODE EQL .RESNAME ! Set RESRFFLG if variable
THEN CNODE[RESRFFLG] = 1; ! matches global RESNAME
IF .ARGNODE[OPR1] EQL CONSTFL ! If subscript is a constant
THEN ALOCONST(.ARGNODE); ! allocate the constant
END ! simple variable
ELSE
BEGIN ! array reference
TREEPTR = .ARGNODE; ! Point to the ARRAYREF node
SETCOMPLEXITY(); ! Compute its complexity
TREEPTR = .ARGNODE[ARG1PTR]; ! Point to base variable
IF .ARGNODE EQL .RESNAME ! Check against RESNAME
THEN CNODE[RESRFFLG] = 1;
TREEPTR = .ARGNODE[ARG2PTR]; ! Point to subscript expression
CMPLX4 = .TREEPTR[COMPLEXITY]; ! Get its complexity
IF .ARGNODE[RESRFFLG] THEN CNODE[RESRFFLG] = 1; ! Propagate
IF .ARGNODE[FNCALLSFLG] THEN CNODE[FNCALLSFLG] = 1; ! flags
END;
! Set RVRSFLG in the substring node since code generation will evaluate
! args in the order ARG2 then ARG1.
CNODE[RVRSFLG] = 1;
! The complexity of the substring node is
! max (upper, 1+lower, 1+subscript, 2)
! The various subnodes are all known to be of type integer, so their
! complexities are in registers (as opposed to register pairs).
! The complexity of the substring node is in pairs, since character
! variables have DBLFLG set. Therefore this expression must be
! rounded up and divided by 2 to convert it to pairs. Also, the
! max-of-2 term can be dropped since the rounding up takes care of it.
IF .CMPLX2 GEQ .CMPLX1 THEN CMPLX1 = .CMPLX2 + 1;
IF .CMPLX4 GEQ .CMPLX1 THEN CMPLX1 = .CMPLX4 + 1;
CMPLX1 _ (.CMPLX1+1)^(-1);
RETURN .CMPLX1;
END; ! of CMPLXSUBSTR
GLOBAL ROUTINE CMPLIOLST=
%(***************************************************************************
ROUTINE TO PERFORM THE COMPLEXITY WALK FOR AN IOLIST
CALLED WITH THE GLOBAL CSTMNT POINTING TO A STATEMENT THAT HAS
AN IOLIST ASSOCIATED WITH IT.
CALLED WITH THE GLOBALS STBSYR AND STRGCT
INDICATING WHICH REGS ARE AVAILABLE FOR USE
THE COMPLEXITY OF AN IOLIST IS EQUAL TO THE COMPLEXITY OF ITS MOST COMPLEX
ELEMENT.
***************************************************************************)%
BEGIN
MAP BASE CSTMNT;
LOCAL CMPLXMAX,CMPLX1;
LOCAL BASE IOLELEM;
LOCAL SAVSTMNT;
LOCAL SAVPAIRMODE,SAVFNREF;
%(***GET PTR TO 1ST ELEMENT ON THE IOLIST TO BE PROCESSED***)%
IOLELEM_.CSTMNT[IOLIST];
%(***SAVE PTR TO CURRENT STATEMENT (IF THERE ARE DO-STMNTS IN THE IOLIST
WILL CLOBBER CSTMNT) ***)%
SAVSTMNT_.CSTMNT;
%(***INIT THE COMPLEXITY OF THE IOLOIST TO 0****)%
CMPLXMAX_0;
%(****WALK THRU THE ELEMENTS ON THE IOLOIST*****)%
UNTIL .IOLELEM EQL 0
DO
BEGIN
IF .IOLELEM[OPRCLS] EQL STATEMENT
THEN
BEGIN
CSTMNT_.IOLELEM;
SAVPAIRMODE_.PAIRMODE; SAVFNREF_.FNREF; !(THE GLOBALS "PAIRMODE" AND "FNREF" WILL
! DESCRIBE THIS SUBSTMNT WHEN WE RETURN FROM CMSTMN - SAVE THEIR
! OLD VALUES
CMSTMN();
PAIRMODE_.SAVPAIRMODE OR .PAIRMODE; !RESTORE "PAIRMODE" - IT SHOULD
! GET SET TO "TRUE" IF THIS SUBSTMNT USED ANY PAIRS
FNREF_.SAVFNREF OR .FNREF; !RESTORE "FNREF" - IT SHOULD
! GET SET TO "TRUE" IF THIS SUBSTMNT INCLUDED ANY FN CALLS
CMPLX1_.CSTMNT[SRCCMPLX];
END
ELSE
IF .IOLELEM[OPRCLS] EQL IOLSCLS
THEN
BEGIN
CASE .IOLELEM[OPERSP] OF SET
%(***FOR A DATACALL NODE*******)%
BEGIN
%2401% ! See if we have a substring which can
%2401% ! be replaced with a .Dnnnn compile
%2401% ! time constant descriptor.
%2401%
%2401% IOLELEM[DCALLELEM] = TREEPTR =
%2401% DOTDCHECK(.IOLELEM[DCALLELEM]);
%1202% IF .TREEPTR[OPR1] EQL CONSTFL THEN ALOCONST(.TREEPTR);
CMPLX1_SETCOMPLEXITY();
IF ARRNARGBLK(IOLELEM[DCALLELEM],0) THEN
CMPLX1_0;
END;
%(***FOR AN SLISTCALL NODE***)%
BEGIN
%(***PERFORM COMPLEXITY PASS FOR THE EXPRESSION TO
COMPUTE THE NUMBER OF ELEMENTS***)%
TREEPTR_.IOLELEM[SCALLCT];
%1507% IF .TREEPTR[OPR1] EQL CONSTFL
%1507% THEN ALOCONST(.TREEPTR);
%1507% ALOCONST(.ONEPLIT);
CMPLX1_SETCOMPLEXITY();
IF ARRNARGBLK(IOLELEM[SCALLCT],0) THEN
CMPLX1_0;
END;
%(***FOR AN IOLSTCALL NODE***)%
CMPLX1_CMPIOCALL(.IOLELEM);
%(***FOR AN E1LISTCALL - OPTIMIZED CODE ONLY***)%
BEGIN
LOCAL BASE SAVCSTMNT;
CMPE1LIST(.IOLELEM); !SET COMPLEXITY
SAVCSTMNT_.CSTMNT; !INCLUDE COMMON SUBS
CSTMNT_.IOLELEM; !SET STATEMENT
STCMCSB(); !INCLUDE COMMON SUBS
CMPLX1_.IOLELEM[SRCCMPLX]; !SET COMPLEXITY
CSTMNT_.SAVCSTMNT
END;
%(***FOR AN E2LISTCALL - OPTIMIZED CODE ONLY***)%
BEGIN
LOCAL BASE SAVCSTMNT;
CMPE2LIST(.IOLELEM); !SET COMPLEXITY
SAVCSTMNT_.CSTMNT; !INCLUDE COMMON SUBS
CSTMNT_.IOLELEM; !SET STATEMENT
STCMCSB(); !INCLUDE COMMON SUBS
CMPLX1_.IOLELEM[SRCCMPLX]; !SET COMPLEXITY
CSTMNT_.SAVCSTMNT
END
TES;
%(***IF THIS ELEMENT OF THE LIST REQUIRES MORE REGS TO
COMPUTE THAN ANY EARLIER ELEMENTS, SET CMPLXMAX
TO INDICATE THE NUMBER OF REGS THAT THIS ELEM NEEDS***)%
IF .CMPLXMAX LSS .CMPLX1 THEN CMPLXMAX_.CMPLX1;
END;
%(***GO ON TO NEXT ELEMENT***)%
IOLELEM_.IOLELEM[CLINK];
END;
CSTMNT_.SAVSTMNT;
CSTMNT[SRCCMPLX]_.CMPLXMAX;
END; ! of CMPLIOLST
GLOBAL ROUTINE CMPIOCALL(IOLSNODE)=
%(***************************************************************************
ROUTINE TO PERFORM THE COMPLEXITY WALK FOR AN IOLSTCALL NODE.
THE ARG IOLSNODE POINTS TO THE IOLSTCALL NODE.
THE NUMBER OF REGS THAT CAN BE USED FOR AN IOLSTCALL NODE
IS DETERMINED BY:
1. THE NUMBER OF ITEMS LEFT IN REGS ACROSS THE CALL
TO THE OPERATING SYSTEM
2. THE NUMBER OF REGS NEEDED TO COMPUTE THE EXPRESSIONS
WHICH MUST BE COMPUTED PRIOR TO CALLING THE OPERATING SYSTEM
THE COMPLEXITY OF THIS NODE IS THE MAXIMUM VALUE OF THE SUM OF:
1. THE NUMBER OF REGS NECESSARY TO COMPUTE A GIVEN EXPRESSION
2. THE NUMBER OF ITEMS PRECEEDING THIS EXPRESSION THAT WERE
LEFT IN REGS
***************************************************************************)%
BEGIN
MAP BASE IOLSNODE;
OWN SAVSTMNT;
OWN CMPLX,REGSINUSE;
OWN CMPLX1,REG1;
OWN BASE IOLELEM;
%(***SAVE PTR TO CSTMNT***)%
SAVSTMNT_.CSTMNT;
CMPLX_0;
REGSINUSE_0;
IOLELEM_.IOLSNODE[IOLSTPTR];
%(***WALK THRU THE ELEMENTS OF THE IOLST, KEEPING TRACK OF THE MAX VALUE OF
THE SUM OF THE COMPLEXITY OF A GIVEN ELEMENT WITH THE NUMBER OF REGS
BEING USED TO HOLD ELEMS BEFORE IT***)%
UNTIL .IOLELEM EQL 0
DO
BEGIN
CASE .IOLELEM[OPERSP] OF SET
%(***FOR A DATACALL NODE***)%
BEGIN
OWN PEXPRNODE DELEM; !EXPRESSION FOR DATA ELEMENT
%2401% ! See if we have a substring which can be
%2401% ! replaced with a .Dnnnn compile time constant
%2401% ! descriptor.
%2401%
%2401% IOLELEM[DCALLELEM] = TREEPTR = DELEM =
%2401% DOTDCHECK(.IOLELEM[DCALLELEM]);
%1202% IF .TREEPTR[OPR1] EQL CONSTFL THEN ALOCONST(.TREEPTR);
CMPLX1_SETCOMPLEXITY();
IF ARRNARGBLK(IOLELEM[DCALLELEM],0) THEN CMPLX1_0;
REG1_(IF .CMPLX1 EQL 0
THEN 0
ELSE IF .DELEM[DBLFLG] !IF THE VAL MUST BE LEFT
! IN AN EVEN-ODD PAIR
THEN 2 ! TAKE 2 REGS OUT OF SET
ELSE 1);
END;
%(***FOR A SLISTCALL NODE***)%
BEGIN
TREEPTR_.IOLELEM[SCALLCT];
%1507% IF .TREEPTR[OPR1] EQL CONSTFL
%1507% THEN ALOCONST(.TREEPTR);
%1507% ALOCONST(.ONEPLIT);
CMPLX1_SETCOMPLEXITY();
IF ARRNARGBLK(IOLELEM[SCALLCT],0) EQL 0
THEN CMPLX1_0;
REG1_0; ! Never bother to try to leave this
! count in a reg (store it in a temp
! before calling FOROTS)
END;
%(***IOLSTCALL NODE WITHIN AN IOLSTCALL NODE IS ILLEGAL***)%
CGERR();
%(***FOR AN E1LISTCALL NODE - OPTIMIZED CODE ONLY***)%
BEGIN
CMPLX1_CMPE1LIST(.IOLELEM);
REG1_0 !NO REGISTERS
END;
%(***FOR AN E2LISTCALL NODE - OPTIMIZED CODE ONLY***)%
BEGIN
CMPLX1_CMPE2LIST(.IOLELEM);
REG1_0
END
TES;
IF .REGSINUSE+.CMPLX1 GTR .CMPLX
THEN CMPLX_.REGSINUSE+.CMPLX1;
REGSINUSE_.REGSINUSE+.REG1;
IOLELEM_.IOLELEM[CLINK];
END;
IOLSNODE[SRCCMPLX]_.CMPLX;
%(***PERFORM COMPLEXITY ANALYSIS FOR COMMON SUBEXPRS UNDER THIS IOLSTCALL***)%
CSTMNT_.IOLSNODE;
STCMCSB();
%(***RESTORE CSTMNT****)%
CSTMNT_.SAVSTMNT;
RETURN .IOLSNODE[SRCCMPLX];
END; ! of CMPIOCALL
GLOBAL ROUTINE CMPE1LIST(IOLELEM)=
%(**********************************************************************
COMPUTE THE COMPLEXITY OF AN E1LISTCALL NODE
(EXCEPT FOR COMMON SUBEXPRESSIONS)
**********************************************************************)%
BEGIN
MAP BASE IOLELEM;
LOCAL BASE IOARRAY;
OWN CMPLX,REGSINUSE,CMPLX1,REG1;
%(***COMPUTE COMPLEXITY OF COUNT EXPRESSION***)%
%2402% ! Correct AOBJN problems
%2402%
%2402% IOLELEM[ECNTPTR] = TREEPTR = FIXAOBJN(.IOLELEM,.IOLELEM[ECNTPTR]);
%1507% IF .TREEPTR[OPR1] EQL CONSTFL
%1507% THEN ALOCONST(.TREEPTR);
CMPLX_SETCOMPLEXITY(); !INITIALIZE COMPLEXITY
IF ARRNARGBLK(IOLELEM[ECNTPTR],0)
THEN CMPLX_0; !RESET IF ARRAYREF IS REPLACED
REGSINUSE_0; !INITIALIZE REGISTER COUNT
%(***ADD IN COMPLEXITY OF INCREMENT EXPRESSION***)%
%2402% ! Correct AOBJN problems
%2402%
%2402% IOLELEM[E1INCR] = TREEPTR = FIXAOBJN(.IOLELEM,.IOLELEM[E1INCR]);
%1507% IF .TREEPTR[OPR1] EQL CONSTFL
%1507% THEN ALOCONST(.TREEPTR);
CMPLX1_SETCOMPLEXITY(); !COMPUTE COMPLEXITY
IF ARRNARGBLK(IOLELEM[E1INCR],0)
THEN CMPLX1_0; !RESET OF ARRAYREG IS REPLACED
REG1_0; !NEVER SAVE IN A REG
IF .REGSINUSE +.CMPLX1 GTR .CMPLX
THEN CMPLX_.REGSINUSE+.CMPLX1; !UPDATE COMPLEXITY
REGSINUSE_.REGSINUSE+.REG1; !UPDATE REGISTER COUNT
%(***ADD IN COMPLEXITY OF EACH ARRAYREF ON THE LIST***)%
IOARRAY_.IOLELEM[ELSTPTR]; !LOCATE LIST
WHILE .IOARRAY NEQ 0 DO
BEGIN
%2401% ! See if we have a substring which can be replaced
%2401% ! with a .Dnnnn compile time constant descriptor.
%2401%
%2401% IOARRAY[E2ARREFPTR] = TREEPTR =
%2401% DOTDCHECK(.IOARRAY[E2ARREFPTR]);
%1520% IF .TREEPTR[OPR1] EQL CONSTFL THEN ALOCONST(.TREEPTR);
CMPLX1_SETCOMPLEXITY(); !COMPUTE COMPLEXITY
IF ARRNARGBLK(IOARRAY[E2ARREFPTR],0) THEN CMPLX1_0;
REG1_0; !NEVER IN A REG
IF .REGSINUSE+.CMPLX1 GTR .CMPLX THEN
CMPLX_.REGSINUSE+.CMPLX1; !UPDATE COMPLEXITY
REGSINUSE_.REGSINUSE+.REG1; !UPDATE REGISTER COUNT
IOARRAY_.IOARRAY[CLINK] !NEXT ARRAYREF
END;
%(***WORK ON THE FINAL VALUE CHAIN (IF ANY)***)%
%1211% CSTMNT_.IOLELEM[ELPFVLCHAIN];
%1211% WHILE .CSTMNT NEQ 0 DO
%1211% BEGIN
%1211% CMSTMN(); ! Complexity of assignment statement
%1211% IF .CSTMNT[SRCCMPLX] GTR .CMPLX
%1211% THEN CMPLX_.CSTMNT[SRCCMPLX];
%1211% CSTMNT_.CSTMNT[CLINK] ! On to the next...
%1211% END;
%(***RETURN COMPLEXITY OF E1LISTCALL NODE***)%
RETURN (IOLELEM[SRCCMPLX]_.CMPLX)
END; ! of CMPE1LIST
GLOBAL ROUTINE CMPE2LIST(IOLELEM)=
%(**********************************************************************
COMPUTE THE COMPEXITY OF AN E2LISTCALL NODE
(EXCEPT FOR COMMON SUBEXPRESSIONS)
**********************************************************************)%
BEGIN
MAP BASE IOLELEM;
LOCAL BASE IOARRAY;
OWN CMPLX,REGSINUSE,CMPLX1,REG1;
%(***COMPUTE COMPLEXITY OF COUNT EXPRESSION***)%
%2402% ! Correct AOBJN problems
%2402%
%2402% IOLELEM[ECNTPTR] = TREEPTR = FIXAOBJN(.IOLELEM,.IOLELEM[ECNTPTR]);
%1507% IF .TREEPTR[OPR1] EQL CONSTFL
%1507% THEN ALOCONST(.TREEPTR);
CMPLX_SETCOMPLEXITY(); !INITIALIZE COMPLEXITY COUNTER
IF ARRNARGBLK(IOLELEM[ECNTPTR],0)
THEN CMPLX_0;
REGSINUSE_0; !INITIALIZE REGSISTER COUNTER
%(***COMPUTE COMPLEXITY OF EACH INCREMENT EXPRESSION***)%
IOARRAY_.IOLELEM[ELSTPTR]; !INITIALIZE POINTER
WHILE .IOARRAY NEQ 0 DO
BEGIN
%2402% ! Correct AOBJN problems
%2402%
%2402% IOARRAY[E2INCR] = TREEPTR =
%2402% FIXAOBJN(.IOARRAY,.IOARRAY[E2INCR]);
%1507% IF .TREEPTR[OPR1] EQL CONSTFL
%1507% THEN ALOCONST(.TREEPTR);
CMPLX1_SETCOMPLEXITY(); !COMPUTE COMPLEXITY
IF ARRNARGBLK(IOARRAY[E2INCR],0) THEN CMPLX1_0;
REG1_0; !NEVER SAVE IN A REG
IF .REGSINUSE+.CMPLX1 GTR .CMPLX
THEN .CMPLX_.REGSINUSE+.CMPLX1; !UPDATE CMPLEXITY
REGSINUSE_.REGSINUSE+.REG1; !UPDATE REGISTER COUNT
IOARRAY_.IOARRAY[CLINK] !ADVANCE TO NEXT ARRAYREF
END;
%(***COMPUTE COMPLEXITY FOR ARRAYREFS***)%
IOARRAY_.IOLELEM[ELSTPTR]; !INITIALIZE POINTER
WHILE .IOARRAY NEQ 0 DO
BEGIN
%2401% ! See if we have a substring which can be replaced
%2401% ! with a .Dnnnn compile time constant descriptor.
%2401%
%2401% IOARRAY[E2ARREFPTR] = TREEPTR =
%2401% DOTDCHECK(.IOARRAY[E2ARREFPTR]);
%1520% IF .TREEPTR[OPR1] EQL CONSTFL THEN ALOCONST(.TREEPTR);
CMPLX1_SETCOMPLEXITY(); !COMPUTE COMPLEXITY
IF ARRNARGBLK(IOARRAY[E2ARREFPTR],0)
THEN CMPLX1_0;
REG1_0; !NEVER SAVE IN A REG
IF .REGSINUSE+.CMPLX1 GTR .CMPLX
THEN .CMPLX_.REGSINUSE+.CMPLX1; !UPDATE CMPLEXITY
REGSINUSE_.REGSINUSE+.REG1; !UPDATE REGISTER COUNT
IOARRAY_.IOARRAY[CLINK] !ADVANCE TO NEXT ARRAYREF
END;
%(***WORK ON THE FINAL VALUE CHAIN (IF ANY)***)%
%1211% CSTMNT_.IOLELEM[ELPFVLCHAIN];
%1211% WHILE .CSTMNT NEQ 0 DO
%1211% BEGIN
%1211% CMSTMN(); ! Complexity of assignment statement
%1211% IF .CSTMNT[SRCCMPLX] GTR .CMPLX
%1211% THEN CMPLX_.CSTMNT[SRCCMPLX];
%1211% CSTMNT_.CSTMNT[CLINK] ! On to the next...
%1211% END;
%(***RETURN COMPLEXITY***)%
RETURN (IOLELEM[SRCCMPLX]_.CMPLX)
END; ! of CMPE2LIST
GLOBAL ROUTINE SNGARGPROP(PARENTNODE,SON)=
%(***************************************************************************
FOR NODES THAT HAVE ONLY ONE ARGUMENT (TYPE-CONVERSION,NEGNOT,
SPECIAL OPERATORS), SET RESRFFLG,FNCALLSFLG IN THE PARENT IF
THEY ARE SET IN THE SON.
ALSO, IF THE ARG IS COMPUTED INTO
THE FN-RESULT REGISTER ("RETREG"), THEN WILL WANT TO COMPUTE
THE PARENT INTO THE SAME REGISTER (IN MOST CASES).
***************************************************************************)%
BEGIN
MAP PEXPRNODE PARENTNODE:SON;
IF .SON[ALCRETREGFLG] AND .SON[INREGFLG] AND .SON[TARGTAC] EQL RETREG
THEN
BEGIN
PARENTNODE[TARGTAC]_RETREG;
PARENTNODE[INREGFLG]_1;
PARENTNODE[ALCRETREGFLG]_1;
%(***SET FLAG IN PARENT INDICATING WHICH ARG IS IN THE SAME REG***)%
IF .PARENTNODE[ARG1PTR] EQL .SON
THEN PARENTNODE[A1SAMEFLG]_1
ELSE PARENTNODE[A2SAMEFLG]_1;
END;
IF .SON[RESRFFLG] THEN PARENTNODE[RESRFFLG]_1;
IF .SON[FNCALLSFLG] THEN PARENTNODE[FNCALLSFLG]_1;
END ; ! of SNGARGPROP
GLOBAL ROUTINE EXCHARGS(CNODE) =
%(***************************************************************************
ROUTINE TO SWAP THE 1ST AND 2ND ARGS UNDER AN EXPRESSION NODE
IF POSSIBLE
CALLED WITH THE ARG "CNODE" POINTING TO THE NODE IN QUESTION
RETURNS "TRUE" IF A SWAP WAS POSSIBLE, "FALSE" IF NOT
***************************************************************************)%
BEGIN
MAP PEXPRNODE CNODE;
%(***SHOULD ONLY CALL THIS ROUTINE FOR NODES OF OPRCLS
RELATIONAL, BOOLEAN, ARITHMETIC, OR IN LINE FN*****)%
IF .CNODE[OPRCLS] GTR ARITHMETIC THEN
BEGIN
IF .CNODE[OPRCLS] EQL INLINFN !FOR IN LINE FNS
THEN
BEGIN
IF .CNODE[OPERSP] EQL MAXFN OR .CNODE[OPERSP] EQL MINFN !FOR MAX/MIN
! CAN SWAP ARGS
THEN (SWAPARGS(CNODE); RETURN TRUE) !EXCHANGE THE PTRS AND THE FLAGS
ELSE RETURN FALSE !FOR OTHER IN LINE FNS CANNOT
END
ELSE CGERR() !IF OPERATOR IS NOT BOOLEAN,REL,ARITH OR IN LINE FN HAVE AN ERROR
END;
IF .CNODE[OPR1] EQL DIVOPF OR .CNODE[OPR1] EQL EXPONOPF
THEN
RETURN FALSE;
%(***CANNOT SWAP THE ARGS IF HAVE SUB AND THE NOT FLAG IS ON FOR
ARG2 (WHICH WOULD NOW NEED TO BE NEGATED) ***)%
IF .CNODE[OPR1] EQL MULOPF AND .CNODE[A2NOTFLG]
THEN RETURN FALSE;
%(***SWAP THE 2 POINTERS*****)%
%(****ALSO THE FLAGS CORRESPONDING TO THE 2 ARGS (IE A1NEGFLG WITH A2NEGFLG ETC) ****)%
SWAPARGS(CNODE);
%(****FOR SUBTRACTION,COMPLEMENT NEGFLG
FOR THE ARG THAT WAS MOVED FROM 2ND TO 1ST AND
CHANGE OPERSP FROM "SUB2 TO "ADD"*******)%
IF .CNODE[OPR1] EQL SUBOPF
THEN
BEGIN
CNODE[OPR1]_ADDOPF;
CNODE[A1NEGFLG]_NOT .CNODE[A1NEGFLG];
END;
%(****FOR RELATIONALS(EXCEPT EQ AND NE) REVERSE THE MODE
OF THE RELATIONAL (EG SET LT TO GT, LE TO GE, ETC)*****)%
IF .CNODE[OPRCLS] EQL RELATIONAL
THEN
BEGIN
IF NOT EQREL(.CNODE[OPERSP])
THEN
CNODE[OPERSP]_REVREL(.CNODE[OPERSP]);
END;
RETURN TRUE;
END; ! of EXCHARGS
GLOBAL ROUTINE DOTDCHECK(EXPR) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine is passed a pointer to any expression node, EXPR.
! It then checks to see if EXPR points to a SUBSTRING node with
! constant bounds which can be converted into a .Dnnnn compile
! time constant descriptor. If so, it creates the .Dnnnn
! descriptor and returns a pointer to it. If not, it returns
! EXPR.
!
! In addition, this routine also performs bounds checking on
! EXPR (if EXPR points to a SUBSTRING node with a constant upper
! or lower bound).
!
! FORMAL PARAMETERS:
!
! EXPR Pointer to any expression node which may be a
! SUBSTRING node.
!
! IMPLICIT INPUTS:
!
! None
!
! IMPLICIT OUTPUTS:
!
! None
!
! ROUTINE VALUE:
!
! If no .Dnnnn is possible, EXPR is returned.
!
! If EXPR can be converted into a .Dnnnn, a pointer to the .Dnnnn
! is returned.
!
! SIDE EFFECTS:
!
! None
!
!--
![2401] New
BEGIN
MAP BASE EXPR; ! Potentially points to a SUBSTRING node
REGISTER BASE UNODE; ! Upper bound
REGISTER BASE LNODE; ! Lower bound minus one
REGISTER BASE ANODE; ! ARRAYREF or DATAOPR
REGISTER BASE CHLEN; ! Length of character variable or array element
LOCAL BASE DVAR; ! Points to the new .Dnnnn variable
IF .EXPR[OPRCLS] NEQ SUBSTRING THEN RETURN .EXPR; ! Forget it
UNODE = .EXPR[ARG1PTR]; ! Upper bound
LNODE = .EXPR[ARG2PTR]; ! Lower bound minus one
ANODE = .EXPR[ARG4PTR]; ! ARRAYREF or DATAOPR
! Get the length of the character variable or array element
! we're taking the substring from.
IF .ANODE[OPRCLS] NEQ ARRAYREF
THEN CHLEN = .ANODE[IDCHLEN] ! ANODE is scalar, get its length
ELSE
BEGIN ! ARRAYREF
CHLEN = .ANODE[ARG1PTR]; ! Array name
CHLEN = .CHLEN[IDCHLEN]; ! Length of array element
END; ! ARRAYREF
IF .LNODE[OPR1] EQL CONSTFL
THEN IF .LNODE[CONST2] LSS 0 ! Lower bound - 1 must be >= 0
OR ! and < CHLEN
(.CHLEN NEQ LENSTAR AND .LNODE[CONST2] GEQ .CHLEN)
THEN FATLERR(.ISN,E165<0,0>); ! Give bounds error
IF .UNODE[OPR1] EQL CONSTFL
THEN
BEGIN ! Upper bound is constant
IF .UNODE[CONST2] LSS 1 ! Upper bound must be >= 1
OR ! and <= CHLEN
(.CHLEN NEQ LENSTAR AND .UNODE[CONST2] GTR .CHLEN)
THEN FATLERR(.ISN,E165<0,0>); ! Give bounds error
IF .LNODE[OPR1] EQL CONSTFL
THEN
BEGIN ! Upper and lower bounds are both constant
! Give a bounds error if the lower bound minus
! one is >= the upper bound (i.e., the
! user-specified lower bound is > the upper
! bound). Also avoid creating a .Dnnnn, since
! a length which is <= 0 will cause an
! internal compiler error in HSDDESC.
IF .LNODE[CONST2] GEQ .UNODE[CONST2]
THEN FATLERR(.ISN,E165<0,0>) ! Give bounds error
! Both bounds are constant, and the substring
! length is > 0. We can now turn the
! reference into a .Dnnnn compile time
! constant descriptor if the base variable is
! a simple (non-formal) scalar.
ELSE IF .ANODE[OPR1] EQL VARFL
THEN IF NOT .ANODE[IDATTRIBUT(DUMMY)]
THEN
BEGIN ! .Dnnnn material
! We can create and return a .Dnnnn
! variable. First create it.
DVAR = NEWDVAR(1);
! Now set the base address (IDADDR) to
! point back to the original variable.
! Also fill in the length and offset.
DVAR[IDADDR] = .ANODE;
DVAR[IDCHLEN] = .UNODE[CONST2]-.LNODE[CONST2];
DVAR[IDBPOFFSET] = .LNODE[CONST2];
RETURN .DVAR; ! Success, return the .Dnnnn
END; ! .Dnnnn material
END; ! Upper and lower bounds are both constant
END; ! Upper bound is constant
RETURN .EXPR; ! We couldn't create a .Dnnnn
END; ! of DOTDCHECK
ROUTINE FIXAOBJN(PARNT,EXPR) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine is called to see if EXPR will be taken from an
! AOBJN register. This can happen if EXPR is a REGCONTENTS node
! or a CMNSUB node in a chain of CMNSUB nodes ending in a
! REGCONTENTS node, where the REGCONTENTS node is the AOBJN
! register for the current, innermost DO-loop.
!
! If this is the case, a STRHAOBJN node is inserted directly
! above the REGCONTENTS node. In any case, pointer to the new
! top-level expression is returned. It is assumed that the
! caller will link in the returned expression and set any
! necessary flags in the parent.
!
! Note that EXPR must not appear in a higher-level common
! subexpression node, since it is assumed that the complexity
! walk hasn't reached the common subexpressions for the current
! statement yet. Otherwise, the complexity for the additional
! STRHAOBJN node might not be set.
!
! FORMAL PARAMETERS:
!
! PARNT The parent of EXPR. This is used to set the
! parent field of the SRHAOBJN node if EXPR
! itself is an AOBJN REGCONTENTS node.
!
! EXPR The pointer to the expression which mustn't be
! taken from an AOBJN register.
!
! IMPLICIT INPUTS:
!
! None
!
! IMPLICIT OUTPUTS:
!
! None
!
! ROUTINE VALUE:
!
! A pointer to an expression equivalent to EXPR but which won't
! be taken directly from an AOBJN register. There are three
! cases:
!
! 1. EXPR was already safe and nothing changed. In this
! case EXPR is returned.
!
! 2. EXPR was a common subexpression node in a chain ending
! in an AOBJN REGCONTENTS node. In this case, a
! STRHAOBJN node is linked in and EXPR is returned.
!
! 3. EXPR itself was an AOBJN REGCONTENTS node. In this
! case, a STRHAOBJN node is created and returned.
!
! SIDE EFFECTS:
!
! None
!
!--
![2402] New
BEGIN
MAP BASE PARNT; ! Parent of top-level expression
MAP BASE EXPR; ! Top-level expression
REGISTER BASE AOBJNPAR; ! Parent of AOBJN REGCONTENTS node
REGISTER BASE AOBJNREG; ! AOBJN REGCONTENTS node
REGISTER BASE STRNODE; ! STRHAOBJN node
IF .DOWDP NEQ 0
THEN IF .CDONODE[FLCWD]
THEN
BEGIN ! In an AOBJN loop
AOBJNPAR = .PARNT;
AOBJNREG = .EXPR;
WHILE .AOBJNREG[OPRCLS] EQL CMNSUB
DO
BEGIN ! Keep looking
AOBJNPAR = .AOBJNREG;
AOBJNREG = .AOBJNREG[ARG2PTR];
END; ! Keep looking
IF .AOBJNREG EQL .DOWDP[DOREGPTR]
THEN
BEGIN ! Found AOBJN
! Create a STRHAOBJN node whose parent is AOBJNPAR.
STRNODE = MAKPR1(.AOBJNPAR,STORECLS,STRHAOBJN,
INTEGER,0,.AOBJNREG);
IF .AOBJNPAR NEQ .PARNT
THEN
BEGIN ! We walked down a CMNSUB
! We aren't changing the top-level
! expression. Link the STRHAOBJN node
! into its parent CMNSUB node, copy
! flags from the parent, and reset the
! parents flags.
AOBJNPAR[ARG2PTR] = .STRNODE;
STRNODE[A2FLGS] = .AOBJNPAR[A2FLGS];
AOBJNPAR[A2VALFLG] = 0;
AOBJNPAR[A2IMMEDFLG] = 0;
AOBJNPAR[A2SAMEFLG] = 1;
END ! We walked down a CMNSUB
ELSE
BEGIN ! Changing top-level expr
! EXPR pointed to the AOBJN
! REGCONTENTS node. Set flags in the
! STRHAOBJN node and return it (let
! the caller worry about linking it
! in).
STRNODE[A2VALFLG] = 1;
STRNODE[A2IMMEDFLG] = 1;
RETURN .STRNODE; ! New top-level expr
END; ! Changing top-level expr
END; ! Found AOBJN
END; ! In an AOBJN loop
RETURN .EXPR; ! The top-level expression hasn't changed
END; ! of FIXAOBJN
! The below is for putting through RUNOFF to get a PLM file.
!++
!.END LITERAL
!--
END
ELUDOM