Trailing-Edge
-
PDP-10 Archives
-
bb-4157j-bm_fortran20_v11_16mt9
-
fortran-compiler/doalc.bli
There are 12 other files named doalc.bli in the archive. Click here to see a list.
!COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1972, 1987
!ALL RIGHTS RESERVED.
!
!THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
!ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
!INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
!COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
!OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
!TRANSFERRED.
!
!THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
!AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
!CORPORATION.
!
!DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
!SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
!AUTHOR: NORMA ABEL/MD/DCE/JNG/TFV/AHM/TGS/MEM
MODULE DOALC(RESERVE(0,1,2,3),SREG=#17,VREG=#15,FREG=#16,DREGS=4)=
BEGIN
GLOBAL BIND DOALCV = #11^24 + 0^18 + #4515; ! Version Date: 20-SEP-85
%(
***** Begin Revision History *****
95 ----- ----- PUT CHECK INTO "ALCDOS" SO THAT THE FN-VAL RETURN
REGISTER WILL NEVER BE USED FOR A DO LOOP INDEX OR COUNT
96 ----- ----- FIX STCMSFN TO RESET NAME TO IDTAB PRIOR TO
EACH CALL TO TBLSEARCH
97 ----- ----- CHANGE REFERENCES RO PROEPITYP AND PROGNAME
98 ----- ----- SET ENTNOCOPYFLG ON ENTRY ARGS THAT AR NOT
FORMAL ARRAYNAMES AND HAVE NOALLOC SET
99 ----- ----- SET COMPLEXITY FIELD IN DO STMNTS
100 ----- ----- DO NOT ALLOCATE TEMP TO SAVE REG 16 IF REG
16 WONT BE SAVED
101 ----- ----- IN "ASNFNVAL" - IF THIS STMNT IS TE LAST STMNT
OF A DO LOOP, CANNOT TREAT IT AS ASSIGNMENT OF FN VAL
102 ----- ------ IF A STMNT FN PARAM IS NEVER REFERENCED, DONT
PICK IT UP (SET FLAG "ENTNOCOPYFLG")
103 ----- ----- DO NOT ALLOCATE A COMMON SUBEXPRESSION ON A DO STMNT
TO THE REG THAT THE INDEX WILL GO INTO
104 ----- ----- THE TEST FOR ALLOCATING A DO LP CT
SHOULD NOT BE INSIDE THE CONDITIONAL ON STEP SIZE
ALSO, THE TEST FOR IMMED CNST SHOULD BE MADE
105 ----- ----- FOR STMNT FNS, SHOULD SET FTEMP TO NXTTTMP
WHENEVER ANY QTEMPS HAVE BEEN USED
IN THE PROGRAM AT ALL (CANNOT TELL THAT THIS SFN
USED ANY QTEMPS SIMPLY BY SEEING IF THE VAL OF LSTLNK
CHANGED- SINCE THE PREVIOUS SFN MIGHT HAVE
CALLED NXTTMP AND THEN THIS SFN WILL SIMPLY
USE THE QTEMP THAT WAS ALREADY CREATED)
106 323 16729 USE .A00NN FOR NAME OF TEMPORARY USED TO SAVE
REGISTERS IN PROLOGUE OF A FUNCTION, (MD)
107 332 17045 IN LPIXSUB PROPAGATE REGCONTENTS TO ASSIGN
STATEMENTS WITH SUBSCRIPTED ARGUMENTS., (DCE)
108 426 18816 DON'T ALLOCATE TEMP STORAGE IN STMNT FN'S FOR
DOUBLE PRECISION & COMPLEX PARAMETERS - IT
DOESN'T SOLVE ANYTHING. SET FNCALLSFLG INSTEAD., (JNG)
***** Begin Version 5B *****
109 726 28283 KA DOUBLE PRECISION AND COMPLEX REALLY DO
NEED TO BE ALLOCATED (FIX EDIT 426), (DCE)
***** Begin Version 6A *****
1163 TGS 1-Jul-82 20-17540
If /DEBUG:INDEX was specified, bypass optimization that substitutes
a regcontents node using the function return reg for the left hand side
of an assignment statement to the function variable.
***** Begin Version 7 *****
110 1245 TFV 3-Aug-81 ------
Redo ALCTEMP; it is now called ALCAVARS. Have it allocate the
.A variables and list them.
111 1274 TFV 20-Oct-81 ------
Fix ALCSFN to set LASTSFNQ and QSFNMAX so that the .Qnnnn
variables used by statement functions are not reused by other
statements.
112 1455 TFV 5-Jan-82 ------
Rewrite STCMSFN and ALCSFN to handle character statement
functions. A character statement function is turned into either
a call to CHSFN. (the subroutine form of CHASN.) or a call to
CHSFC. (the subroutine form of CONCA.). CHSFC. is used if the
character expression has concatenations at its top level, CHSFN.
is used for all other character expressions.
1474 TFV 15-Mar-82
Add a new argument to CMPFNARGS. Character concatenation
expressions also use CMPFNARGS, the first argument is not yet
allocated for concatenations so it must be ignored by CMPFNARGS.
1505 AHM 12-Mar-82
Speed up the compiler by changing a LSH -3 followed by a LSH 6
to a LSH 3 in macro TNAME in routine ALCAVARS.
***** End V7 Development *****
1722 SRM 1-Feb-83 10-33235
Always copy double precision args to statement functions.
This is necessary if they are used in relationals.
1742 TFV 14-Apr-83
Fix LPIXSUB to do substitution of the loop index variable for
all I/O statement keywords.
1774 CDM 29-Aug-83
We were alocating a variable to save register 16 in .A0016 for
block data subprograms, which is not necessary.
2070 MEM 28-Aug-84
Prevent extraneous copies of complex and double precision variables,
that are not referenced. These extra copies of unreferenced variables
may cause incorrect results in statement functions.
***** Begin Version 10 *****
2206 TFV 27-Jun-83
Add case to LPIXSUB for INQUIRE. It calls MISCOCI a la OPEN/CLOSE.
Also cleanup ALCAVAR so it uses less code.
2275 CDM 24-Jan-84
Move zeroing of DOWDP from routine LPIXSUB (substitute
REGCONTENTS nodes for DO induction variable) to routine CMSTMN
(complexity walk for statements). It was being zeroed before
the complexity for the last statement of the DO loop was being
processed. This meant that it was not known in the processing
of the last statement of a DO loop that the statement was in an
innermost DO loop.
2451 AHM 16-Aug-84
Remove check from STCMSFN and STCMSUB which prevented them
from setting ENTNOCOPYFLG on NOALLOC FORMLARRAY's. This
caused DMOVE/DMOVEM's to be generated for CHARACTER formals
which would smash variables allocated to 1' (since unallocated
two word descriptors have an address of 0').
2543 MEM 9-Aug-85
Call VARCLOBB on DO variable at end of register allocation for a
DO LOOP.
***** End V10 Development *****
***** End Revision History *****
***** Begin Version 11 *****
4502 MEM 22-Jan-85
Modified LPIXSUB for DELETE statement.
4503 MEM 22-Jan-85
Modified LPIXSUB for REWRITE statement.
4504 MEM 22-Jan-85
Modified LPIXSUB for UNLOCK statement.
4515 CDM 20-Sep-85
Phase I for VMS long symbols. Create routine ONEWPTR for Sixbit
symbols. For now, return what is passed it. For phase II, return
[1,,pointer to symbol].
ENDV11
)%
SWITCHES NOLIST;
REQUIRE FIRST.BLI;
REQUIRE TABLES.BLI;
REQUIRE REQREL.BLI;
SWITCHES LIST;
FORWARD
STCMDO,
ALCDOSTMT,
ALCDOEND(1),
STCMRETURN,
ALCRETURN,
HDRTMP,
ALCAVARS,
STCMSFN,
ALCSFN,
STCMSUB,
LPIXSUB,
ALCENTRY,
ALCENLIST(1), ! Routine to determine which registers to use to
! pick up the params of a function, subroutine,
! or statement function
ARGSIZREST(1),
FNVALCHK,
FNVLCH1,
ASNFNVAL; ! Routine to check whether the statement pointed
! to by cstmnt assigns the function value and
! directly precedes a return
EXTERNAL
ADDREGCANDATE, ! Routine to tell the basic block register
! allocator that the value of a given variable
! can be left in a register.
AFREEREG, ! Routine to select a free register to use if
! possible. It will not select a register of
! future use in this basic block.
ALCASMNT, ! Routine to do register allocation for an assignment
%1455% ALCCALL, ! Routine to do register allocation for a call
ALCCMNSB,
ALCINREG,
ALOCONST,
CDONODE,
CGERR, ! Routine for internal compiler error detected
CHOSEN,
CLOBBREGS, ! Global containing a bit pattern indicating
! which registers are clobbered in this
! subroutine (a bit is 1 if the corresponding
! register gets clobbered)
%1455% CMPFNARGS, ! Routine to find complexity of function arguments
CORMAN,
CSTMNT,
DBLMODE,
OBJECTCODE DOWDP,
ENTRY,
FNTMP,
GBSYCT,
GBSYREGS,
GLOBREG,
HDRFLG,
%1245% HEADCHK, ! Routine to check the amount of space left on a
! listing page
ITMCT,
IOSUBSTITUTE,
LASTONE,
%1274% LASTQ, ! Pointer to the last .Qnnnn variable used by
! the current statement.
%1274% LASTSFNQ, ! Pointer to the last .Qnnnn variable used by
! statement functions. The .Qnnnn variables
! between QANCHOR and LASTSFNQ can not be reused
! by other statements.
LEAFSUBSTITUTE,
%1245% LISTSYM, ! Routine to list a symbol in the listing
LOWLOC,
%1245% LSTHDR, ! Routine to output a header to the listing
%1245% LSTOUT,
MAKEPR,
MAKRC0, ! Routine to build a regcontents 0 node
MISCIO,
%1742% MISCOCI, ! Do register subs for OPEN/CLOSE/INQUIRE statements
%4515% ONEWPTR, ! Returns [1,,pointer] to Sixbit argument
NAME,
PREV,
PROGNAME,
%1274% QMAX, ! Maximum size of .Q space for all statements
QQ,
%1274% QSFNMAX, ! Maximum size of .Q space used by statement
! functions.
REGCLOBB, ! Routine to tell the basic block allocator that
! the previous contents of a register are
! clobbered
RGTOU1,
SAVEREG, ! Routine to remember that a given variable is
! in a given register
SETCOMPLEXITY,
SORCPTR,
SPECCASE,
SSIZTMP,
STBSYR, ! Bit pattern indicating which registers are
! legal to use for this statement
STCMASMNT,
STCMCSB,
STRGCT,
SYMTYPE,
TBLSEARCH,
%1245% TCNT,
TREEPTR,
%2543% VARCLOBB;
GLOBAL
ASVCT, ! Number of assignment statements that assign
! the value of this function and directly
! precede a return statement.
RETNCT; ! Number of return statements in the program
GLOBAL ROUTINE STCMDO=
BEGIN
!PERFORM COMPLEXITY CALCULATIONS FOR DO LOOP
!THE GLOBAL CSTMNT POINTS AT THE ENCODED SOURCE FOR THE
!DO STATEMENT.
MAP BASE CSTMNT;
OWN
PEXPRNODE IXSYM,
PEXPRNODE DOCTL,
PEXPRNODE PEXPR,
PEXPRNODE DOINITL,
PEXPRNODE DOSTEPSIZ;
DOSTEPSIZ_.CSTMNT[DOSSIZE];
IXSYM_.CSTMNT[DOSYM];
DOCTL_.CSTMNT[DOLPCTL];
DOINITL_.CSTMNT[DOM1];
%(***FOR AN AOBJN LOOP, ALLOCATE CORE FOR THE AOBJN CONSTANT***)%
IF .CSTMNT[FLCWD] THEN ALOCONST(.CSTMNT[DOLPCTL])
ELSE
BEGIN
IF .DOCTL[OPRCLS] NEQ DATAOPR THEN
BEGIN
TREEPTR_.DOCTL;
CSTMNT[SRCCMPLX]_SETCOMPLEXITY()
+ (IF .IXSYM[DBLFLG]
THEN 2 !2 REGS USED FOR DP INDEX
ELSE 1); !1 REG FOR INDEX OTHERWISE
END;
%(***IF THE INITIAL VAL IS A CONSTANT DECIDE WHETHER TO TREAT IT IMMED
OR TO ALLOCATE CORE FOR IT***)%
IF .DOINITL[OPR1] EQL CONSTFL
THEN
BEGIN
IF IMMEDCNST(DOINITL)
THEN
%(***IF INTIAL VAL IS AN IMMEDIATE SIZE CONSTANT***)%
BEGIN
IF .DOINITL[VALTP1] EQL INTEG1 AND .DOINITL[CONST2] LSS 0
THEN
%(***FOR NEGATIVE INTEGERS - TO HANDLE IMMED MODE, MUST
USE THE ABSOLUTE VAL PICKED UP NEGATED***)%
BEGIN
CSTMNT[INITLNEG]_1;
CSTMNT[DOM1]_MAKECNST(.DOINITL[VALTYPE],0,-.DOINITL[CONST2]);
END;
CSTMNT[INITLIMMED]_1;
END
ELSE
%(***IF INITIAL VAL IS A CONSTANT NOT IMMED, ALLOCATE CORE FOR IT***)%
ALOCONST(.DOINITL);
END;
%(***IF THE STEP SIZE IS A CONSTANT, DECIDE WHETHERTO USE IT IMMED OR ALLOCATE CORE
FOR IT*****)%
IF .DOSTEPSIZ[OPR1] EQL CONSTFL AND (NOT .CSTMNT[SSIZONE]
OR .DOSTEPSIZ[VALTYPE] EQL DOUBLPREC)
THEN
BEGIN
IF IMMEDCNST(DOSTEPSIZ)
THEN
BEGIN
IF .DOSTEPSIZ[VALTP1] EQL INTEG1 AND .DOSTEPSIZ[CONST2] LSS 0
THEN
BEGIN
CSTMNT[SSIZNEGFLG]_1;
CSTMNT[DOSSIZE]_MAKECNST(.DOSTEPSIZ[VALTYPE],0,-.DOSTEPSIZ[CONST2]);
END;
CSTMNT[SSIZIMMED]_1;
END
ELSE
ALOCONST(.DOSTEPSIZ);
END;
%(***IF THE CONTROL EXPR IS A CONSTANT, NOT IMMEDIATE SIZE,
ALLOCATE CORE FOR IT***)%
IF .DOCTL[OPR1] EQL CONSTFL
THEN
BEGIN
IF IMMEDCNST(DOCTL)
THEN
BEGIN
CSTMNT[CTLIMMED]_1;
IF .DOCTL[CONST2] LSS 0 !FOR NEG IMMED
THEN
BEGIN
CSTMNT[CTLNEG]_NOT .CSTMNT[CTLNEG];
!USE MOVNI OF THE POSITIVE CONST
CSTMNT[DOLPCTL]_MAKECNST(.DOCTL[VALTYPE],0,-.DOCTL[CONST2]);
DOCTL_.CSTMNT[DOLPCTL];
END;
END
ELSE ALOCONST(.DOCTL)
END;
END;
!MAKE EXTRA SURE THAT NEDSMATRLZ IS SET IF THE DO LOOP
!INDEX IS A DOUBLE WORD QUANTITY.
PEXPR_.CSTMNT[DOSYM];
IF .PEXPR[DBLFLG] THEN CSTMNT[NEDSMATRLZ]_1;
!COMPUTE COMPLEXITY OF COMMON SUB-EXPRESSIONS
STCMCSB();
!DEFINE THE REG TO BE USED FOR THE LOOP INDEX. THIS MAY BE CHANGED
! BY THE GLOBAL ALLOCATOR (MUST SPECIFY IT HERE SO CAN SUBSTITUTE
! REGCONTENTS NODES FOR REFS TO THE VAR)
CSTMNT[DOIREG]_DOIXREG;
!IF THE LOOP INDEX OF THIS LOOP WILL LIVE IN A REGISTER, SET A GLOBAL
! TO ENABLE SUBSTITUTION OF "REGCONTENTS" NODES FOR ALL OCCURRENCES OF
! THAT INDEX INSIDE OF THE LOOP
IF NOT .CSTMNT[NEDSMATRLZ] AND NOT .CSTMNT[MATRLZIXONLY] THEN
BEGIN
!SET UP VARIABLES AND FIELDS NECESSARY FOR
!SUBSTITUTION OF REGCONTENTS NODES.
CDONODE_.CSTMNT;
DOWDP[DOREGPTR]_.CSTMNT[DOIREG];
PEXPR_MAKEPR(REGCONTENTS,0,INDEX,0,.CSTMNT[DOSYM]);
PEXPR[INREGFLG]_1;
PEXPR[TARGADDR]_.DOWDP[DOREGPTR];
PEXPR[TARGTAC]_.DOWDP[DOREGPTR];
DOWDP[DOREGPTR]_.PEXPR;
IF .CSTMNT[FLCWD] THEN
BEGIN
SPECCASE_2; !THIS FLAG TELLS "LEAFSUB" TO SET THE
! IMMEDFLG ABOVE THE REGISTER SUBSTITUTED FOR LOOP INDEX
PEXPR[VALTYPE]_INDEX;
END ELSE
BEGIN
SPECCASE_0; !IF "FLCWD" WAS NOT SET IN THE DO NODE, DO
! NOT WANT TO SET IMMEDFLG OVER REFS TO LOOP INDEX
DOSTEPSIZ_.CSTMNT[DOSYM];
PEXPR[VALTYPE]_.DOSTEPSIZ[VALTYPE];
END;
END
END; ! of STCMDO
GLOBAL ROUTINE ALCDOSTMT=
BEGIN
REGISTER PEXPRNODE IXSYM; !SYM TAB ENTRY FOR LOOP INDEX
MAP
PEXPRNODE CSTMNT,
PEXPRNODE TREEPTR;
!REGISTER ALLOCATION FOR A DO STATEMENT
!CSTMNT: POINTS AT DO STATEMENT
LOCAL SSIZPT;
LOCAL PEXPRNODE DOCEXPR;
MAP BASE SSIZPT;
!DONT USE THE FN RETURN REG FOR THE IX OR CT OF A DO LOOP
STBSYR_REMRETREG(.STBSYR);
STRGCT_ONESCOUNT(.STBSYR);
IXSYM_.CSTMNT[DOSYM]; !PTR TO SYM TAB ENTRY FOR LP IX
IF NOT BITSET(.STBSYR,.CSTMNT[DOIREG]) !IF THE REG PREVIOUSLY ASSIGNED
! TO BE USED FOR THE LOOP INDEX IS NOT AVAILABLE
AND NOT .CSTMNT[IXGALLOCFLG] ! AND THAT REG WAS NOT ASSIGNED BY THE GLOBAL REG ALLOCATOR
THEN
BEGIN
IF NOT .CSTMNT[NEDSMATRLZ] AND NOT .CSTMNT[MATRLZIXONLY] !IF HAVE ALREADY
! SUBSTITUTED REGCONTENTS NODES FOR THE LOOP INDEX
THEN CGERR(); ! HAVE AN INTERNAL COMPILER ERROR
CSTMNT[DOIREG]_ !PICK ANOTHER REG TO USE
AFREEREG(.STBSYR,.CSTMNT[SRCSAVREGFLG],.IXSYM[DBLFLG])
END;
!ALLOCATE COMMON SUB-EXPRESSIONS FIRST
IF BITSET(.STBSYR,.CSTMNT[DOIREG]) !DO NOT WANT TO LEAVE A COMMON
THEN ! SUB IN THE REG TO BE USED FOR THE LOOP INDEX
BEGIN
STBSYR_CLRBIT(.STBSYR,.CSTMNT[DOIREG]); !TAKE THAT REG OUT OF
STRGCT_.STRGCT-1; ! THE SET OF AVAILABLE REGS TEMPORARILY
ALCCMNSB();
STBSYR_SETBIT(.STBSYR,.CSTMNT[DOIREG]); !THEN PUT IT BAK (MAY HAVE TAKEN
! SOME OTHERS OUT IN THE MEANTIME)
STRGCT_.STRGCT+1;
END
ELSE !IF THAT REG WAS UNAVAILABLE ANY WAY (BECAUSE IT WAS GLOBALLY ALLOCATED)
ALCCMNSB();
%(***GET PTR TO EXPRESSION FOR LOOP CTL CT***)%
DOCEXPR_.CSTMNT[DOLPCTL];
TREEPTR_.DOCEXPR;
CLOBBREGS_SETBIT(.CLOBBREGS,.CSTMNT[DOIREG]); !THE REG TO BE USED FOR THE LOOP INDEX
! WAS DETERMINED PREVIOUSLY (EITHER BY THE GLOBAL ALLOCATOR
! OR IN COMPLEXITY PASS). SET BIT INDICATING THAT THAT
! REG HAS BEEN CLOBBERED
IF .IXSYM[DBLFLG] !IF INDEX TAKES 2 REGS
THEN CLOBBREGS_SETBIT(.CLOBBREGS,.CSTMNT[DOIREG]+1);
IF .CSTMNT[FLCWD] THEN !NICE AOBJN CASE
CSTMNT[DOCREG]_.CSTMNT[DOIREG]
ELSE
!PERFORM ALLOCATION FOR THE CALCULATION OF THE LOOP CTL COUNT
BEGIN
REGISTER RA; !REG TO USE FOR LOOP CTL
STBSYR_CLRBIT(.STBSYR,.CSTMNT[DOIREG]); !DO NOT USE THE REG CONTAINING THE
! THE LOOP INDEX IN CALCULATING THE CTL COUNT
IF .IXSYM[DBLFLG] !IF INDEX TAKES 2 REGS
THEN STBSYR_CLRBIT(.STBSYR,.CSTMNT[DOIREG]+1);
IF .CSTMNT[IXGALLOCFLG] !IF THE GLOBAL OPTIMIZER HAS DECIDED TO
! LEAVE THE INDEX OF THIS LOOP IN A REG
AND NOT .CSTMNT[MATRLZCTLONLY] ! AND HAS ALSO DECIDED TO LEAVE THE CTL-COUNT
! IN A REG THROUGHOUT THE LOOP
THEN STBSYR_CLRBIT(.STBSYR,DOIXREG); ! DO NOT PUT THE COUNT INTO THE
! REG THAT WILL BE USED FOR THE INDICES OF THE INNER DO LOOPS
RA_AFREEREG(.STBSYR,FALSE,FALSE); !GET A REG TO USE FOR THE CTL COUNT
IF .TREEPTR[OPRCLS] NEQ DATAOPR THEN
BEGIN
ALCINREG(.RA,.STBSYR,.STRGCT-1);
%(***IF POSSIBLE USE THE SAME REG INTO WHICH THE CTL EXPR
WAS CALCULATED FOR THE LOOP CTL REG***)%
IF .DOCEXPR[INREGFLG] AND NOT .DOCEXPR[ALCRETREGFLG]
THEN
BEGIN
CSTMNT[DOCREG]_.DOCEXPR[TARGTAC];
CSTMNT[CTLSAMEFLG]_1;
END
ELSE
BEGIN
RA_RGTOU1(.CSTMNT,.DOCEXPR,.RA,.STBSYR);
CSTMNT[DOCREG]_.RA;
END
END ELSE
CSTMNT[DOCREG]_.RA;
!MAKE SURE THE STEP CONSTANT IS ALLOCATED
SSIZPT_.CSTMNT[DOSSIZE];
IF .SSIZPT[OPR1] EQL CONSTFL THEN
ALOCONST(.SSIZPT);
CLOBBREGS_SETBIT(.CLOBBREGS,.CSTMNT[DOCREG]);
END;
%(***IF EITHER LOOP INDEX OR CTL VAR WILL BE MAINTAINED IN A REG THROUGHOUT THE
THE LOOP, TAKE THOSE REGS OUT OF THE SET OF FREE REGS***)%
IF NOT .CSTMNT[NEDSMATRLZ] AND NOT .CSTMNT[MATRLZIXONLY] !IF LP INDEX IS IN A REG
THEN
BEGIN
REGISTER RI; !REG USED FOR THE LOOP INDEX
RI_.CSTMNT[DOIREG]; !REG USED TO HOLD THE INDEX
GBSYREGS_CLRBIT(.GBSYREGS,.RI); !TAKE LOOP INDEX REG OUT OF SET
!AVAILABLE FOR LOCAL USE
IF .IXSYM[DBLFLG] THEN !IF IX IS DOUBLE-WD, MUST TAKE OUT
GBSYREGS_CLRBIT(.GBSYREGS,.RI+1); !NEXT REG ALSO
END;
IF NOT .CSTMNT[NEDSMATRLZ] AND NOT .CSTMNT[MATRLZCTLONLY] !IF CTL VAR IN A REG
THEN
GBSYREGS_CLRBIT(.GBSYREGS,.CSTMNT[DOCREG]); !TAKE OUT REG USED FOR LOOP CTL
GBSYCT_ONESCOUNT(.GBSYREGS);
END; ! of ALCDOSTMT
GLOBAL ROUTINE ALCDOEND(TLAB)=
BEGIN
!RETURN REGISTER TO GBSYREGS IF WE ARE ENDING AN INNER DO
OWN PEXPRNODE DOVAR; !LOOP INDEX VARIABLE
OWN RA; !REG USED TO HOLD LOOP INDEX VAR
REGISTER TMP,CURDO;
MAP BASE TLAB:CURDO:TMP;
IF .TLAB[SNDOLVL] EQL 0 THEN RETURN; !NO DO'S END HERE
TMP_.TLAB[SNDOLNK];
CURDO_.TMP[LEFTP]; !THIS POINTS AT FIRST DO IN LIST
IF NOT .CURDO[NEDSMATRLZ] AND NOT .CURDO[MATRLZIXONLY] !IF LOOP INDEX WAS MAINTAINED IN A REG
THEN !RETURN THAT REG TO SET OF FREE REGS
BEGIN
DOVAR_.CURDO[DOSYM]; !LOOP INDEX VARIABLE
RA_.CURDO[DOIREG]; !REG USED TO HOLD LOOP INDEX VAR
GBSYREGS_SETBIT(.GBSYREGS,.RA); !RETURN THIS REG TO SET OF AVAILABLE REGS
IF .DOVAR[DBLFLG] !FOR LOOP INDEX DP, MUST RETURN THE REG AFTER RA
THEN ! TO THE SET OF FREE REGS
GBSYREGS_SETBIT(.GBSYREGS,.RA+1);
END;
IF NOT .CURDO[NEDSMATRLZ] AND NOT .CURDO[MATRLZCTLONLY] !IF CTL VAR WAS IN A REG THROUGHOUT
! THE LOOP, RETURN THAT REG TO SET OF FREE REGS
THEN
GBSYREGS_SETBIT(.GBSYREGS,.CURDO[DOCREG]);
GBSYCT_ONESCOUNT(.GBSYREGS);
%(***FOR ALL LOOPS THAT END ON THIS LABEL, MUST TELL THE BB ALLOCATOR
THAT THE REGS USED FOR CALCULATING THE LP INDEX AND THE LP CT GET
THEIR PREVIOUS CONTENTS CLOBBERED***)%
UNTIL .TMP EQL 0 !WALK THRU LINKED LIST OF DO STMNTS THAT TERMINATE ON THIS LABEL
DO
BEGIN
CURDO_.TMP[LEFTP]; !DO STMNT POINTED TO BY THIS ELEM IN LINKED LIST
! OF DO STMNTS THAT END ON THIS LABEL
REGCLOBB(.CURDO[DOCREG]); !REG USED FOR LP CT
REGCLOBB(.CURDO[DOIREG]); !REG USED FOR LP IX
DOVAR_.CURDO[DOSYM]; !VAR USED FOR LP INDEX
IF .DOVAR[DBLFLG] !IF LP INDEX IS DP OR COMPLEX
THEN REGCLOBB(.CURDO[DOIREG]+1);
%2543% IF NOT .DOVAR[MAYBEZTRIP]
%2543% THEN VARCLOBB(.DOVAR);
TMP_.TMP[RIGHTP]; !GO ON TO NEXT LINK IN LIST
END;
END; ! of ALCDOEND
GLOBAL ROUTINE STCMRETURN=
BEGIN
!DETERMINE COMPLEXITY FOR A RETURN EXPRESSION
MAP BASE CSTMNT:TREEPTR;
REGISTER BASE NXTSTMN; !NEXT STMNT AFTER THE RETURN
%(***KEEP A COUNT OF "RETURN" STMNTS. DO NOT COUNT A RETURN THAT PRECEDES THE END STMNT**)%
NXTSTMN_.CSTMNT[SRCLINK];
IF .NXTSTMN EQL 0 THEN RETNCT_.RETNCT+1
ELSE
%(**SKIP OVER THE CONTINUE INSERTED BY THE OPTIMIZER AT THE END OF THE PROGRAM**)%
IF .NXTSTMN[SRCID] EQL CONTID AND .NXTSTMN[OPTCONFLG]
THEN
BEGIN
NXTSTMN_.NXTSTMN[SRCLINK];
IF .NXTSTMN[SRCID] NEQ ENDID THEN RETNCT_.RETNCT+1
END
ELSE IF .NXTSTMN[SRCID] NEQ ENDID THEN RETNCT_.RETNCT+1;
!IF THERE IS NO EXPRESSION COMPLEXITY IS ZERO
IF .CSTMNT[RETEXPR] EQL 0 THEN
CSTMNT[SRCCMPLX]_0
ELSE
BEGIN
TREEPTR_.CSTMNT[RETEXPR];
CSTMNT[SRCCMPLX]_SETCOMPLEXITY();
END;
!IF ITS A SIMPLE CONSTANT ALLOCATE IT.
!THIS WILL CAUSE BAD CODE
!BUT IS EXPEDIENT
IF .TREEPTR[OPR1] EQL CONSTFL THEN ALOCONST(.TREEPTR);
END; ! of STCMRETURN
GLOBAL ROUTINE ALCRETURN=
BEGIN
!
!REGISTER ALLOCATION FOR A RETURN I
LOCAL RA;
MAP PEXPRNODE TREEPTR:CSTMNT;
IF .CSTMNT[RETEXPR] EQL 0 THEN RETURN;
TREEPTR_.CSTMNT[RETEXPR];
IF .TREEPTR[OPRCLS] NEQ DATAOPR THEN
BEGIN
RA_FIRSTONE(.STBSYR);
ALCINREG(.RA,.STBSYR,.STRGCT);
END;
END; ! of ALCRETURN
ROUTINE HDRTMP=
LSTHDR(4,3,PLIT'?M?JTEMPORARIES?M?J?M?J?0');
GLOBAL ROUTINE ALCAVARS=
BEGIN
%1245% ! Rewritten by TFV on 3-Aug-81
! Allocate temporaries needed for register save and restore if
! this is a subprogram function
ROUTINE ALCA(I)=
BEGIN
%2206% REGISTER BASE T;
%2206% ! Define .A00NN temp name to save the register used in
%2206% ! the function, where "nn" comes from the argument I.
%4515% ENTRY = ONEWPTR(
%2206% (SIXBIT '.A0000' OR
%1505% ((.I AND #70)^3) OR
%2206% ((.I AND #7))) );
%2206% T = TBLSEARCH(); ! Get symbol table pointer
T[IDADDR] = .LOWLOC; ! Allocate one word for .Annnn variable
LOWLOC = .LOWLOC + 1;
IF .FLGREG<LISTING>
THEN
BEGIN ! List .Annnn variable
IF .HDRFLG EQL 0
THEN
BEGIN ! Output header
HDRFLG = 1;
HDRTMP();
END; ! Output header
LISTSYM(.T); ! List .Annnn variable
TCNT = .TCNT + 1;
IF .TCNT GTR 5
THEN
BEGIN ! Output CRLF after 5 items
TCNT = 0;
CRLF;
HEADCHK();
END; ! Output CRLF after 5 items
END; ! List .Annnn variable
END;
! The following code involves saving register values. If we are
! not compiling a SUBROUTINE or FUNCTION, then this is not
! necessary.
IF .FLGREG<PROGTYP> EQL MAPROG
%1774% OR .FLGREG<PROGTYP> EQL BKPROG
THEN RETURN;
! It is a subprogram so generate a temporary for AC16 if AC16
! must be preserved. Set symtype so that all the .Annnn
! variables will be a single word.
SYMTYPE = REAL;
NAME = IDTAB;
IF NOT (.BTTMSTFNFLG AND .IOFIRST EQL 0 AND NOT .LIBARITHFLG)
%2206% THEN ALCA(#16); ! Allocate and list .A0016 variable
! If multiple entry points then generate a temporary to hold the
! epilogue address
IF .FLGREG<MULTENT>
%2206% THEN ALCA(#17); ! Allocate and list .A0017 variable
! If it is a function then generate temporaries to save
! clobbered registers. Determine how many and which registers
! must be saved by examining CLOBBREGS.
IF .FLGREG<PROGTYP> EQL FNPROG
%2206% THEN DECR I FROM LASTONE(.CLOBBREGS) TO 2
%2206% DO ALCA(.I); ! Allocate and list .Annnn variable
END; ! of ALCAVARS
GLOBAL ROUTINE STCMSFN=
BEGIN
%1455% ! Rewritten by TFV on 5-Jan-82
! Compute complexity of a statement function plus lots of
! subterfuge. Items of subterfuge include:
! 1. Substitute a new variable for each formal. This is
! done to eliminate confusion between statement
! function formals and routine locals of the same name.
! 2. For numeric statement functions, change the slot
! holding the pointer to the expression into a pointer
! to an assignment statement of the statement function
! name to the expression.
! 3. For character statement functions, change the slot
! holding the pointer to the expression into a pointer
! to a call statement. It is either a call to CHSFN.
! (the subroutine form of CHASN.) or a call to CHSFC.
! (the subroutine form of CONCA.). CHSFC. is used if
! the character expression has concatenations at its
! top level, CHSFN. is used for all other character
! expressions.
%1474% BIND NOTINCONCAT = FALSE; ! Flag for CMPFNARGS. It means
! that the first argument must
! be processed.
REGISTER
NAMER,
OCSTMNT,
T;
LOCAL BASE FNID; ! The identifier name for this function
OWN BASE COPYARGS; ! Used to determine if local copies of
! the arguments are needed
MAP
BASE OCSTMNT,
ARGUMENTLIST T,
BASE QQ, ! Convenient temporary
BASE PREV, ! Convenient temporary
BASE CSTMNT;
T = .CSTMNT[SFNLIST]; ! Get the argument list
FNID = .CSTMNT[SFNNAME]; ! Get the statement function name
DECR I FROM .T[ARGCOUNT] TO 1 DO
BEGIN
PREV = .T[.I,ARGNPTR]; ! Get the argument
! Add the parameter to the set of variables that can be
! left in registers if needed in registers later.
ADDREGCANDATE(.PREV,.CSTMNT);
! Init to 0 the flag for parameter was globally
! allocated (this bit is sometimes left set by phase 1)
T[.I,ENTGALLOCFLG] = 0;
END;
OCSTMNT = .CSTMNT; ! Save pointer to current statement
CSTMNT = .CSTMNT[SFNEXPR]; ! Point cstmnt to assignment or
! call node
IF .FNID[VALTYPE] NEQ CHARACTER
THEN
BEGIN ! Numeric statement function
! Examine the assignment statement of the form SFNNAME =
! EXPRESSSION. Compute complexity of assignment.
PREV = .CSTMNT[LHEXP];
! Insert a regcontents zero node and mark the current
! statement and the assignment node
CSTMNT[LHEXP] = MAKRC0(.PREV[VALTYPE]);
CSTMNT[A1VALFLG] = 1;
OCSTMNT[VALINR0] = 1;
STCMASMNT(); ! Compute the complexity of the assigment
COPYARGS = .CSTMNT[RHEXP]; ! Pointer to the rhs of
! the assignment node
! We want to copy the arguments if there are function
! calls under the rhs expression
COPYARGS = .COPYARGS[FNCALLSFLG];
END ! Numeric statement function
ELSE
BEGIN ! Character statement function
! Compute the complexity of the argument list
CSTMNT[SRCCMPLX] =
(IF .CSTMNT[CALLIST] EQL 0
THEN 0
%1474% ELSE CMPFNARGS(.CSTMNT[CALLIST],FALSE,NOTINCONCAT));
STCMCSB(); ! Process any common subs
COPYARGS = 1; ! Make local copies of the arguments
END; ! Character statement function
T = .OCSTMNT[SFNLIST]; ! Pointer to argument list
DECR I FROM .T[ARGCOUNT] TO 1 DO
BEGIN ! Look at each arg
PREV = .T[.I,ARGNPTR]; ! Pointer to this argument
IF .COPYARGS EQL 1
THEN
BEGIN
! If local copies of all parameters are needed,
! don't bother for those never referenced and
! hence not allocated. Also for a formal array
! must pick up the pointer.
IF .PREV[IDATTRIBUT(NOALLOC)]
THEN T[.I,ENTNOCOPYFLG] =1;
END
ELSE
BEGIN
%726% IF .PREV[VALTYPE] NEQ COMPLEX
%1722% AND .PREV[VALTYPE] NEQ DOUBLPREC
THEN
BEGIN
%726% ! We need to allocate complex variables
%1722% ! and double precision variables
%726% ! because regular code generation is
%726% ! unprepared to cope with the
%726% ! complexities of picking up these
%726% ! special types later on.
! If rhs of assignment statement
! contains no function calls, the
! arguments to this statement function
! will not need to be copied into
! locals. The variable will be
! referenced by @n(16) where n is the
! constant (.I-1).
PREV[IDATTRIBUT(NOALLOC)] = 1;
PREV[IDTARGET] = INDBIT + #16^18 + (.I - 1);
T[.I,ENTNOCOPYFLG] = 1;
END
%2070% ELSE IF .PREV[IDATTRIBUT(NOALLOC)]
%2070% THEN T[.I,ENTNOCOPYFLG] =1;
END;
END; ! Look at each arg
CSTMNT = .OCSTMNT; ! Restore the current statement pointer
CSTMNT[SRCCMPLX] = 0; ! Complexity of statement function
END; ! of STCMSFN
GLOBAL ROUTINE ALCSFN=
BEGIN
%1455% ! Rewritten by TFV on 5-Jan-82
! Register allocation for a statement function. SFNEXPR points
! to either an assignment statement for a numeric statement
! function or to a call to either CHSFN. or CHSFC.
REGISTER
BASE FNID,
OCSTMNT,
OCLBRGS;
MAP BASE CSTMNT;
! Save the old value of clobbregs. This will be non-zero and
! cause errors in the globally optimizing case. Clobbregs info
! for the statement function will be saved in the flags field of
! the statement function node.
OCLBRGS = .CLOBBREGS; ! Save clobbregs
CLOBBREGS = 0; ! Zero clobbregs
ALCENLIST(.CSTMNT[SFNLIST]); ! Decide which registers to use
! to pick up the parameters
OCSTMNT = .CSTMNT; ! Save pointer to the statement
FNID = .CSTMNT[SFNNAME]; ! Get pointer to the function name
CSTMNT = .CSTMNT[SFNEXPR]; ! Point cstmnt to the expression
IF .FNID[VALTYPE] NEQ CHARACTER
THEN ALCASMNT() ! Numeric - allocate assignment
ELSE ALCCALL(); ! Character - allocate call
CSTMNT = .OCSTMNT; ! Restore pointer to the statement
CSTMNT[SFNCLBREG] = .CLOBBREGS<18,18>; ! Save the clobbregs info
CLOBBREGS = .OCLBRGS; ! Restore the old clobbregs info
%1274% ! If any temps were needed we must prevent reuse of the .Qnnnn
%1274% ! variables generated. If any are generated we set LASTSFNQ to
%1274% ! the last used (i.e. LASTQ). We also set QSFNMAX to QMAX.
%1274% LASTSFNQ = .LASTQ; ! Keep track of last .Qnnnn used
%1274% QSFNMAX = .QMAX; ! Keep track of size of .Q space
END; ! of ALCSFN
GLOBAL ROUTINE STCMSUB=
BEGIN
MAP BASE CSTMNT;
LOCAL ARGUMENTLIST ARGLSTPT;
OWN BASE ARGUMENT;
CSTMNT[SRCCMPLX]_0;
IF .CSTMNT[ENTLIST] NEQ 0 THEN
BEGIN
ARGLSTPT_.CSTMNT[ENTLIST];
INCR I FROM 1 TO .ARGLSTPT[ARGCOUNT] DO
BEGIN
%(***INIT TO 0 THE FLAG FOR "THIS VAR WAS GLOBALLY ALLOCATED" (NOTE THAT
PHASE 1 INITS THIS TO 1 BECAUSE IT WOULD BE THE VALFLG IN AN ARGLIST)***)%
ARGLSTPT[.I,ENTGALLOCFLG]_0;
ARGUMENT_.ARGLSTPT[.I,ARGNPTR];
IF .ARGUMENT NEQ 0 THEN
BEGIN
!CHECK THIS FOR NO ALLOCATE BIT IF A
!SYMBOL THAT IS NOT AN ARRAYNAME.
!ARRAYNAMES CANNOT BE INCLUDED BECAUSE OF
!THE DUMMY "ADDRESS" ENTRY CREATED FOR THEM.
!IT IS NOT THE DUMMY ENTRY THAT IS ON THE
!LIST BUT IS THE DUMMY ENTRY THAT WILL HAVE THE
!BIT (NOALLOC) RESET.
IF .ARGUMENT[OPRCLS] EQL DATAOPR
THEN IF .ARGUMENT[IDATTRIBUT(NOALLOC)]
THEN ARGLSTPT[.I,ENTNOCOPYFLG]_1;
IF .CSTMNT[ENTNUM] EQL 0 !IF THIS IS THE 1ST ENTRY TO THE SUBROUTINE
THEN
ADDREGCANDATE(.ARGUMENT,.CSTMNT); ! THEN THIS PARAM COULD BE LEFT
! IN A REG FOR USE LATER IN THE 1ST BASIC BLOCK
END;
END;
END;
END; ! of STCMSUB
GLOBAL ROUTINE LPIXSUB=
BEGIN
!***************************************************************
! Substitute REGCONTENTS nodes in the innermost loop for all
! references to the induction variable. CDONODE points to the
! do statement node, DOWDP contains flags and pointers. Flag
! DOISUBS is true if index substitutions are performed.
! DOREGPTR points to the regcontents node to be substituted.
!***************************************************************
%1742% ! Rewritten by TFV on 14-Apr-83
%1742% ! Fix I/O problems. Test all I/O statement keywords for substitution.
MAP BASE CSTMNT:CDONODE;
REGISTER
ARGUMENTLIST ARGL,
BASE TMP;
IF .DOWDP EQL 0 THEN RETURN; ! Not inside loop
ITMCT = 1; ! Flag for leafsubstitution
GLOBREG[1] = .CDONODE[DOSYM];
CHOSEN[1] = .DOWDP[DOREGPTR];
IF .CSTMNT[SRCCOMNSUB] NEQ 0
THEN
BEGIN ! Look at the common sub-expressions too
TMP = .CSTMNT[SRCCOMNSUB];
WHILE .TMP NEQ 0 DO
BEGIN
LEAFSUBSTITUTE(.TMP);
TMP = .TMP[SRCLINK];
END;
END; ! Look at the common sub-expressions too
CASE .CSTMNT[SRCID] OF SET
BEGIN ! ASSIGNMENT
LEAFSUBSTITUTE(.CSTMNT[LHEXP]);
LEAFSUBSTITUTE(.CSTMNT[RHEXP]);
END; ! ASSIGNMENT
LEAFSUBSTITUTE(.CSTMNT[ASISYM]); ! ASSIGN with possible arrayref
BEGIN END; ! CALL
BEGIN END; ! CONTINUE
BEGIN END; ! DO
BEGIN END; ! ENTRY
BEGIN END; ! COMMONSUB - already done
BEGIN END; ! GOTO
LEAFSUBSTITUTE(.CSTMNT[AGOTOLBL]); ! ASSIGNED GOTO
LEAFSUBSTITUTE(.CSTMNT[CGOTOLBL]); ! COMPUTED GOTO
LEAFSUBSTITUTE(.CSTMNT[AIFEXPR]); ! ARITHMETIC IF
BEGIN ! LOGICAL IF
LEAFSUBSTITUTE(.CSTMNT[LIFEXPR]); ! Conditional expr
TMP = .CSTMNT; ! Save CSTMNT
CSTMNT = .CSTMNT[LIFSTATE]; ! Get consequent statement
LPIXSUB(); ! Substitute in consequent
CSTMNT = .TMP; ! Restore CSTMNT
END; ! LOGICAL IF
IF .CSTMNT[RETEXPR] NEQ 0 ! RETURN
THEN LEAFSUBSTITUTE(.CSTMNT[RETEXPR]);
IF .CSTMNT[STOPIDENT] NEQ 0 ! STOP
THEN LEAFSUBSTITUTE(.CSTMNT[STOPIDENT]);
MISCIO(.CSTMNT); ! READ
MISCIO(.CSTMNT); ! WRITE
MISCIO(.CSTMNT); ! DECODE
MISCIO(.CSTMNT); ! ENCODE
MISCIO(.CSTMNT); ! REREAD
MISCIO(.CSTMNT); ! FIND
MISCOCI(.CSTMNT); ! CLOSE
%4502% MISCIO(.CSTMNT); ! DELETE
%4503% MISCIO(.CSTMNT); ! REWRITE
MISCIO(.CSTMNT); ! BACKSPACE
MISCIO(.CSTMNT); ! BACKFILE
MISCIO(.CSTMNT); ! REWIND
MISCIO(.CSTMNT); ! SKIP FILE
MISCIO(.CSTMNT); ! SKIP RECORD
MISCIO(.CSTMNT); ! UNLOAD
%4504% MISCIO(.CSTMNT); ! UNLOCK
MISCIO(.CSTMNT); ! ENDFILE
BEGIN END; ! END
BEGIN END; ! PAUSE
MISCOCI(.CSTMNT); ! OPEN
BEGIN END; ! SFN
BEGIN END; ! FORMAT
BEGIN END; ! BLT
BEGIN END; ! REGMASK - change set of available registers -
! inserted by global register allocator
%2206% MISCOCI(.CSTMNT); ! INQUIRE
TES;
END; ! of LPIXSUB
GLOBAL ROUTINE ALCENTRY=
%(***************************************************************************
ROUTINE TO PERFORM REGISTER ALLOCATION FOR THE REGS TO BE USED TO
PICK UP THE VARS ON THE PARAMETER LIST AT AN ENTRY.
CALLED WITH THE GLOBAL CSTMNT POINTING TO THE STATEMENT NODE FOR
THE ENTRY STATEMENT
***************************************************************************)%
BEGIN
MAP BASE CSTMNT;
IF .CSTMNT[ENTLIST] NEQ 0
THEN ALCENLIST(.CSTMNT[ENTLIST]); ! If this entry has
! parameters, determine
! which registers to use
! to pick them up
END; ! of ALCENTRY
GLOBAL ROUTINE ALCENLIST(ARGLST)=
%(***************************************************************************
ROUTINE TO DETERMINE WHICH REGS TO USE TO PICK UP THE
THE PARAMS OF A FN,SUBR,OR STMNT FN.
CALLED WITH THE ARG "ARGLST" POINTING TO THE PARAMETER LIST.
***************************************************************************)%
BEGIN
OWN OSTBSYR; !SAVE VAL OF STBSYR
REGISTER PEXPRNODE ARGN; !PTR TO THE SYMBOL TABLE ENTRY FOR A GIVEN ARG
MAP ARGUMENTLIST ARGLST; !PTR TO THE ARG LIST FOR THIS ENTRY
%(**ALLOW REGS 0 AND 1 TO BE USED FOR PICKING UP ARGS**)%
OSTBSYR_.STBSYR;
STBSYR_.STBSYR OR #600000000000;
%(***ALLOC A REG TO USE TO PICK UP EACH ARG***)%
INCR I FROM 1 TO .ARGLST[ARGCOUNT]
DO
BEGIN
ARGN_.ARGLST[.I,ARGNPTR]; !SYM TABLE ENTRY FOR THIS ARG
IF .ARGLST[.I,ENTGALLOCFLG] !IF THIS PARAM WAS ALREADY ASSIGNED A REG
! BY THE GLOBAL ALLOCATOR
OR .ARGLST[.I,ENTNOCOPYFLG] ! OR IF THIS PARAM WONT BE COPIED INTO A LOCAL
THEN BEGIN END ! LEAVE THAT ASSIGNMENT ALONE
ELSE
BEGIN
OWN RA; !REG TO USE FOR PICKING UP THE ARG
RA_AFREEREG(.STBSYR,TRUE,.ARGN[DBLFLG]); !GET A FREE REG TO USE
REGCLOBB(.RA); !IF RA PREVIOUSLY HAD A VAR IN IT
! IT WILL NOW BE CLOBBERED
IF .ARGN[DBLFLG] THEN REGCLOBB(.RA+1); !IF ARG IS DP, CLOBBER 2 REGS
ARGLST[.I,ENTAC]_.RA; !SET FIELD IN ARGLIST ENTRY INDICATING REG
IF .ARGLST[.I,ENTSAVREGFLG] !IF IT WILL BE USEFUL IN THE 1ST BASIC BLOCK
! OF THE ROUTINE TO HAVE THIS PARAM LEFT IN A REG
THEN
SAVEREG(.RA,.ARGN,0,.ARGLST[.I,ENTSONNXTUSE]); !REMEMBER THAT THIS REG CONTAINS
! THE VAL OF THIS ARG
CLOBBREGS_SETBIT(.CLOBBREGS,.RA); !REMEMBER THAT THIS REG GETS CLOBBERED
! WHEN EXECUTING THIS SUBROUTINE
IF .ARGN[DBLFLG] THEN CLOBBREGS_SETBIT(.CLOBBREGS,.RA+1);
END;
END;
STBSYR_.OSTBSYR
END; ! of ALCENLIST
GLOBAL ROUTINE ARGSIZREST(ENTSTMNT)=
%(***************************************************************************
FOR THE ENTRY STMNT POINTED TO BY "ENTSTMNT", DETERMINE THE
MAXIMUM PRECISION OF ANY ARGUMENTS WHOSE VALUES
MUST BE COPIED BACK AT SUBROUTINE EXIT.
THUS IF THERE ARE NO PARAMETERS AT THIS ENTRY WHOSE VALS
ARE MODIFIED IN THE ROUTINE, RETURN 0. IF ONLY SINGLE PRECISION
PARAMETERS HAVE THEIR VALS MODIFIED RETURN 1. IF DOULBLE-WORD
PARAMETERS HAVE THEIR VALS MODIFIED RETURN 2.
ARGS THAT ARE GLOBALLY ALLOCATED TO REGISTERS AND ARGS THAT DO
NOT HAVE LOCAL COPIES DONT COUNT.
***************************************************************************)%
BEGIN
MAP BASE ENTSTMNT;
REGISTER ARGUMENTLIST ARGLST;
REGISTER SNGLFOUND; !FLAG FOR "A SINGLE PREC ARG TO BE RESTORED" WAS FOUND
IF (ARGLST_.ENTSTMNT[ENTLIST]) EQL 0 THEN RETURN 0; !IF THERE ARE NO PARAMETERS
SNGLFOUND_FALSE;
INCR I FROM 1 TO .ARGLST[ARGCOUNT] !LOOK AT ALL ARGS ON THE LIST
DO
BEGIN
IF .ARGLST[.I,ENTNOCOPYFLG] !PARAMS THAT DO NOT HAVE LOCAL COPIES
OR .ARGLST[.I,ENTGALLOCFLG] ! OR THAT ARE GLOBALLY ALLOCATED
OR .ARGLST[.I,ARGNPTR] EQL 0 ! OR THAT ARE LABELS
THEN BEGIN END ! SHOULD BE IGNORED
ELSE
BEGIN
REGISTER PEXPRNODE SYMENTRY;
SYMENTRY_.ARGLST[.I,ARGNPTR];
IF .SYMENTRY[IDATTRIBUT(STORD)] !IF PARAM IS STORED INTO
AND .SYMENTRY[OPERSP] EQL FORMLVAR ! AND IS A VARIABLE (NOT AN ARRAY)
THEN
BEGIN
IF .SYMENTRY[DBLFLG] !IF PARAM IS DOUBLE-WORD
THEN RETURN 2
ELSE
SNGLFOUND_TRUE;
END
END
END; !END OF INCR LOOP
IF .SNGLFOUND THEN RETURN 1 ELSE RETURN 0;
END; ! of ARGSIZREST
GLOBAL ROUTINE FNVALCHK=
%(***************************************************************************
CHECK WHETHER THE ASSIGNMENT STATEMENT POINTED TO BY THE GLOBAL
"CSTMNT" ASSIGNS THE VALUE TO BE RETURNED BY THIS FUNCTION
AND WHETHER THE ASSIGNMENT IS IMMEDIATELY FOLLOWED BY A "RETURN".
IF SO, AND IF THE FUNCTION IS SINGLE ENTRY AND IF REG 0 WILL
NOT BE NEEDED FOR STORING BACK VALUES OF PARAMETERS, SUBSTITUTE
A "REGCONTENTS" OF REG 0 ON THE LHS OF THE ASSIGNMENT STMNT AND
DONT PICK UP THE FN VAL INTO REG 0 WHEN EXITING THE FUNCTION.
***************************************************************************)%
BEGIN
MAP BASE CSTMNT;
REGISTER BASE TSTMNT;
REGISTER PEXPRNODE LHNODE;
%1163% IF .FLGREG<DBGINDX> THEN RETURN; !/DEB:INDEX - must update function variable
IF (.RETNCT+1) NEQ .ASVCT !IF THERE ARE MORE "RETURN" (PLUS "END") STMNTS IN THIS PROGRAM
! THAN THERE ARE ASSIGNMENTS OF THE VAL DIRECTLY BEFORE RETURN STMNTS
! CANNOT DO THIS OPTIM
THEN RETURN;
IF NOT ASNFNVAL() THEN RETURN; !IF THE FN VAL IS NOT ASSIGNED BY THIS STMNT OR THIS STMNT DOES
! NOT PRECEDE A RETURN
LHNODE_.CSTMNT[LHEXP]; !PTR TO LHS OF ASSIGNMENT
TSTMNT_.SORCPTR<LEFT>; !PTR TO 1ST STMNT IN PROGRAM
WHILE .TSTMNT[SRCID] NEQ ENTRID !SKIP DUMMY CONTINUES AT START OF PROGRAM
DO
BEGIN
TSTMNT_.TSTMNT[CLINK];
IF .TSTMNT EQL 0 THEN CGERR(); !IF REACH END OF PROGRAM AND HAVENT FOUND THE ENTRY
END;
IF ARGSIZREST(.TSTMNT) + (1+.LHNODE[DBLFLG]) !SUM OF NUMBER OF REGS NEEDED FOR
! RESTORING ARGS IN EPILOGUE AND NUMBER OF REGS NEEDED TO HOLD THE FN VAL
GTR 2 ! IF NEED MORE THAN 2 REGS ALTOGETHER THEN
! CANT LEAVE THE FN VAL IN REGS 0-1 WHILE ARGS
! ARE RESTORED
THEN RETURN;
!RETURN IF THERE ARE MULTIPLE ENTRIES
IF .FLGREG<MULTENT> THEN RETURN;
IF .TSTMNT[ENTSYM] NEQ .LHNODE THEN CGERR(); !SYMBOL AT THIS ENTRY BETTER BE THE LHS OF
! THIS ASSIGNMENT OR WE HAVE AN INTERNAL COMPILER ERROR
TSTMNT[VALINR0]_1; !SET FLAG IN ENTRY FOR "VAL OF THIS FN ALREADY IN REG 0, NEEDNT PICK IT UP
CSTMNT[LHEXP]_MAKRC0(.LHNODE[VALTYPE]); !SUBSTITUTE A REGCONTENTS 0 ON LHS
IF NOT .CSTMNT[A2VALFLG] !IF RHS IS NOT A SIMPLE VAR
THEN
BEGIN
REGISTER PEXPRNODE RHNODE;
RHNODE_.CSTMNT[RHEXP]; !EXPRESSION ON RHS
RHNODE[RESRFFLG]_0; ! IF HAD FLAG FOR "REF TO LHS VAR OCCURS IN THIS EXPR, CLEAR IT
END;
END; ! of FNVALCHK
GLOBAL ROUTINE FNVLCH1=
%(***************************************************************************
ROUTINE CALLED IN "COMPLEXITY" PASS FOR EACH ASSIGNMENT STMNT.
CHECKS WHETHER THAT STMNT ASSIGNS THE VAL OF THE FN
DIRECTLY BEFORE A "RETURN". KEEEPS A COUNT OF ALL
SUCH ASSIGNMENTS.
***************************************************************************)%
BEGIN
MAP BASE CSTMNT;
IF ASNFNVAL() THEN ASVCT_.ASVCT+1;
END; ! of FNVLCH1
GLOBAL ROUTINE ASNFNVAL=
%(***************************************************************************
ROUTINE TO CHECK WHETHER THE STMNT POINTED TO BY CSTMNT
ASSIGNS THE VAL OF THIS FN AND
ITS EXECUTION DIRECTLY PRECEDES EXECUTION OF A "RETURN"
STMNT. CSTMNT IS ASSUMED TO PT TO AN ASSIGNMENT STMNT.
***************************************************************************)%
BEGIN
MAP BASE CSTMNT;
REGISTER PEXPRNODE LHNODE;
REGISTER BASE TSTMNT;
REGISTER PEXPRNODE LABENT; !LABEL ENTRY FOR LABEL ON THE RETURN(IF THERE IS ONE)
LHNODE_.CSTMNT[LHEXP]; !LHS OF ASSIGNMENT STMNT
IF NOT(.LHNODE[OPRCLS] EQL DATAOPR AND .LHNODE[IDATTRIBUT(FENTRYNAME)]) !IF LHS IS NOT THE FN VAL
THEN
RETURN FALSE;
IF (LABENT_.CSTMNT[SRCLBL]) NEQ 0 !IF THIS STMNT HAS A LABEL
THEN (IF .LABENT[SNDOLVL] NEQ 0 ! IF THAT LABEL ENDS ANY DO LOOPS
THEN RETURN FALSE); ! THEN THE VAR FOR THE FN VAL MIGHT
! BE USED AGAIN AFTER EXECUTION OF THIS STMNT
TSTMNT_.CSTMNT[CLINK]; !STMNT AFTER THE ASSIGNMENT
IF .TSTMNT EQL 0 THEN RETURN FALSE; !IF THIS ASSIGNMENT WAS UNDER AN IF
IF .TSTMNT[SRCID] EQL CONTID AND .TSTMNT[OPTCONFLG] !SKIP THE DUMMY CONTINUE INSERTED BY THE OPTIMIZER
THEN TSTMNT_.TSTMNT[CLINK];
IF NOT(.TSTMNT[SRCID] EQL RETUID OR .TSTMNT[SRCID] EQL ENDID) !IF NEXT STMNT IS NOT RETURN OR END
THEN RETURN FALSE;
IF (LABENT_.TSTMNT[SRCLBL]) NEQ 0 !IF THE RETURN HAS A LABEL
THEN (IF .LABENT[SNREFNO] GTR 1 THEN RETURN FALSE); ! IF THAT LABEL IS REFERENCED, RETURN FALSE
RETURN TRUE; !OTHERWISE, DO HAVE THE FN VAL ASSIGNED JUST BEFORE A RETURN
END; ! of ASNFNVAL
END
ELUDOM