Trailing-Edge
-
PDP-10 Archives
-
BB-4157E-BM
-
fortran-compiler/doalc.bli
There are 12 other files named doalc.bli in the archive. Click here to see a list.
!THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
! OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
!COPYRIGHT (C) 1972,1981 BY DIGITAL EQUIPMENT CORPORATION
!AUTHOR: NORMA ABEL/MD/DCE/JNG
MODULE DOALC(RESERVE(0,1,2,3),SREG=#17,VREG=#15,FREG=#16,DREGS=4)=
BEGIN
SWITCHES NOLIST;
REQUIRE FIRST.BLI;
REQUIRE TABLES.BLI;
SWITCHES LIST;
GLOBAL BIND DOALCV = 6^24 + 0^18 + 109; ! Version Date: 23-Jul-81
%(
***** 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)
***** End Revision History *****
)%
EXTERNAL AFREEREG; !ROUTINE TO SELECT A FREE REGISTER TO USE
! IF POSSIBLE IT WILL NOT SELECT A REG OF FUTURE
! USE IN THIS BASIC BLOCK
GLOBAL RETNCT; !NUMBER OF "RETURN" STMNTS IN THE PROGRAM
GLOBAL ASVCT; !NUMBER OF ASSIGNMENT STMNTS THAT ASSIGN THE VAL OF THIS FN
! AND DIRECTLY PRECEDE A RETURN STMNT
GLOBAL ROUTINE STCMDO=
BEGIN
!PERFORM COMPLEXITY CALCULATIONS FOR DO LOOP
EXTERNAL CDONODE,DOWDP,SPECCASE,MAKEPR;
MAP OBJECTCODE DOWDP;
EXTERNAL CSTMNT,ALOCONST,STCMCSB,TREEPTR,SETCOMPLEXITY;
!CONTROL EXPRESSION.
!THE GLOBAL CSTMNT POINTS AT THE ENCODED SOURCE FOR THE
!DO STATEMENT.
MAP BASE CSTMNT;
OWN PEXPRNODE IXSYM;
OWN PEXPRNODE DOCTL;
OWN PEXPRNODE PEXPR;
OWN PEXPRNODE DOINITL: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;
GLOBAL ROUTINE ALCDOSTMT=
BEGIN
REGISTER PEXPRNODE IXSYM; !SYM TAB ENTRY FOR LOOP INDEX
EXTERNAL RGTOU1;
EXTERNAL CSTMNT,CORMAN,SSIZTMP,GBSYREGS,CGERR,CLOBBREGS,TREEPTR,
ALCINREG,ALCCMNSB,STBSYR,STRGCT,ALOCONST;
EXTERNAL DBLMODE,GBSYCT;
MAP PEXPRNODE CSTMNT: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;
!
!****************************************
!
GLOBAL ROUTINE ALCDOEND(TLAB)=
BEGIN
!RETURN REGISTER TO GBSYREGS IF WE ARE ENDING AN INNER DO
EXTERNAL REGCLOBB; !ROUTINE TO TELL BB ALLOCATOR THAT THE PREV CONTENTS OF A REG ARE CLOBBERED
EXTERNAL GBSYREGS,GBSYCT;
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);
TMP_.TMP[RIGHTP]; !GO ON TO NEXT LINK IN LIST
END;
END;
!MACRO CREATES 3 SIXBIT CHARACTERS OF SUBROUTINE NAME TO
!BE USED IN FORMING TEMPORARY NAMES. THE NAMES ARE PREFIXED WITH
!A, AND SUFFIXED WITH THE NUMBERS 2-17.
!2-16 ARE FOR REGISTER SAVES.
!17 IS FOR THE EPILOGUE ADDRESS IF THERE ARE MULTIPLE ENTRIES
!MACRO GETXXX=
! (.PROGNAME <30,6>^24
! +(IF .PROGNAME <24,6> EQL 0 THEN 16
! ELSE .PROGNAME <24,6>)^18
! +(IF .PROGNAME <18,6> EQL 0 THEN 16
! ELSE .PROGNAME <18,6>)^12)$;
!ADD THE DOT AND NUMBER WITH THE MACRO TNAME
!MACRO TNAME DEFINES .A00NN TEMP NAMES TO SAVE THE REGISTERS
!USED IN THE FUNCTION. THE USE OF .XXXNN WHERE XXX IS THE
!FIRST THREE CHARS OF THE FUNCTION NAME IS DELETED
!BECAUSE IT HAD CONFLICTS WITH FUNCTIONS NAMED F OR Q
!OR ANY OTHER TEMP NAMES USED BY THE COMPILER.
MACRO TNAME(INDX)=
!MAKE IT .A00NN WHERE NN IS THE REGISTER NUMBER
(SIXBIT '.A00'
+((INDX AND #70)^(-3)+16)^6
+((INDX AND #7)+16))$;
GLOBAL ROUTINE STCMRETURN=
BEGIN
!DETERMINE COMPLEXITY FOR A RETURN EXPRESSION
EXTERNAL CSTMNT,ALOCONST,SETCOMPLEXITY,TREEPTR;
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;
GLOBAL ROUTINE ALCRETURN=
BEGIN
!
!REGISTER ALLOCATION FOR A RETURN I
LOCAL RA;
EXTERNAL STBSYR,STRGCT,TREEPTR,CSTMNT,ALCINREG;
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;
GLOBAL ROUTINE ALCTEMP=
BEGIN
!ALLOCATE TEMPS NEEDED FOR REGISTER SAVE AND
!RESTORE IF THIS IS A SUBPROGRAM FUNCTION
LOCAL NEDTOSAV,NAMER,T;
LABEL FNLOK;
EXTERNAL LASTONE,SYMTYPE;
EXTERNAL CLOBBREGS,PROGNAME,ENTRY,NAME,TBLSEARCH;
MAP BASE T;
!FIRST FIND OUT IF IT IS A SUBPROGRAM.
IF .FLGREG<PROGTYP> EQL MAPROG THEN RETURN;
!NOW WE KNOW IT IS A SUBPROGRAM
!GENERATE A TEMP FOR AC16 IF AC16 MUST BE PRESERVED
!SET SYMTYPE SO THESE WILL BE SINGLE WORD
!ITEMS
SYMTYPE_REAL;
NAME_IDTAB;
IF NOT (.BTTMSTFNFLG AND .IOFIRST EQL 0 AND NOT .LIBARITHFLG) !IF AC 16 MUST BE PRESERVED
THEN
BEGIN
ENTRY_TNAME(#16);
TBLSEARCH();
END;
!IF MULTIPLE ENTRIES THEN
!GENERATE A TEMPORARY TO HOLD THE EPILOGUE ADDRESS
IF .FLGREG<MULTENT> THEN
BEGIN
ENTRY_TNAME(#17);
TBLSEARCH();
END;
!NOW FIND OUT IF IT IS A FUNCTION
!AND GENERATE TEMPS TO SAVE CLOBBERED REGISTERS
FNLOK:
IF .FLGREG<PROGTYP> EQL FNPROG THEN
BEGIN
!DETERMINE HOW MANY AND WHICH REGISTERS
!MUST BE SAVED.
! CLOBBREGS DETERMINES THIS
NEDTOSAV_LASTONE(.CLOBBREGS);
IF .NEDTOSAV LSS 0 THEN
LEAVE FNLOK;
DECR I FROM .NEDTOSAV TO 2 DO
BEGIN
ENTRY_TNAME(.I);
TBLSEARCH();
END;
END;
END;
EXTERNAL ITMCT;
EXTERNAL LEAFSUBSTITUTE;
!**********************************************
GLOBAL ROUTINE STCMSFN=
BEGIN
!COMPLEXITY OF A STATEMENT FUNCTION
!PLUS
!LOTS OF SUBTRFUGE
!ITEMS OF SUBTRAFUGE INCLUDE:
! 1. SUBSTITUTE A NEW VARIABLE FOR EACH FORMAL.
! THIS IS DONE TO ELIMINATE CONFUSION BETWEEN SFN
! FORMALS AND ROUTINE LOCALS OF THE SME NAME.
! 2. CHANGE THE SLOT HOLDING THE POINTER TO THE EXPRESSION
! TO A POINTER TO AN ASSIGNMENT STATEMENT OF THE
! STATEMENT FUNCTION NAME TO THE EXPRESSION.
EXTERNAL FNTMP,MAKRC0;
EXTERNAL ADDREGCANDATE; !ROUTINE TO TELL BB REG ALLOCATOR THAT THE VAL OF
! A GIVEN VAR CAN BE LEFT IN A REG
!MACRO MAKES SIXBIT NAME FROM NUMBER.
!MUST NEVER COMPILE THIS FILE WITH OPTMAC
MACRO MAKNAM(NUMB)=
(.NUMB<9,3>+16)^18 + (.NUMB<6,3>+16)^12 + (.NUMB<3,3>+16)^6
+ (.NUMB<0,3>+16)$;
LOCAL T,NAMER,OCSTMNT;
MAP BASE OCSTMNT;
MAP ARGUMENTLIST T;
EXTERNAL TBLSEARCH,NAME,ENTRY,CORMAN,CSTMNT;
EXTERNAL STCMASMNT,QQ,GLOBREG,CHOSEN,SPECCASE,PREV;
MAP BASE QQ:PREV:CSTMNT;
OWN BASE RHNODE; !PTR TO RHS OF THE ASSIGNMENT IN THE SFN
!QQ AND PREV ARE CONVENIENT TEMPS
T_.CSTMNT[SFNLIST];
INCR I FROM 1 TO .T[ARGCOUNT] DO
BEGIN
PREV_.T[.I,ARGNPTR];
ADDREGCANDATE(.PREV,.CSTMNT); !ADD THE PARAM TO THE SET OF VARS
! THAT CAN BE LEFT IN REGS IF NEEDED IN REGS LATER
T[.I,ENTGALLOCFLG]_0; !INIT TO 0 THE FLAGFOR "PARAM WAS GLOBALLY ALLOCATED"
! (THIS BIT IS SOMETIMES LEFT SET BY PHASE 1)
END;
!EXAMINE ASIGNMENT STATEMENT OF THE FORM
!SFNNAME=EXPRESSSION
QQ_.CSTMNT[SFNEXPR];
PREV_.QQ[LHEXP];
!INSERT A REGCONTENS ZERO NODE
QQ[LHEXP]_MAKRC0(.PREV[VALTYPE]);
CSTMNT[VALINR0]_1;
QQ[A1VALFLG]_1;
OCSTMNT_.CSTMNT;
CSTMNT_.QQ;
!COMPUTE COMPLEXITY OF ASSIGNMENT
STCMASMNT();
RHNODE_.CSTMNT[RHEXP];
T_.OCSTMNT[SFNLIST]; !PTR TO SFN ARG LIST
INCR I FROM 1 TO .T[ARGCOUNT] !LOOK AT EACH ARG
DO
BEGIN
PREV_.T[.I,ARGNPTR]; !PTR TO THIS ARG
IF .RHNODE[FNCALLSFLG] !IF WE'RE GOING TO MAKE LOCAL COPIES OF ALL PARAMETERS,
THEN ! THEN DON'T BOTHER FOR THOSE NEVER REFERENCED
BEGIN
IF .PREV[IDATTRIBUT(NOALLOC)] !IF THIS ARG IS NEVER REFERENCED (AND
! HENCE IS NOT ALLOCATED
AND .PREV[OPERSP] NEQ FORMLARRAY !(FOR A FORMAL ARRAY MUST PICK UP THE PTR)
THEN
T[.I,ENTNOCOPYFLG]_1; !DONT PICK UP THE ARG
END
ELSE
![726] WE REALLY NEED TO ALLOCATE DP ON KA AND COMPLEX VARIABLES
![726] BECAUSE REGULAR CODE GENERATION IS UNPREPARED TO COPE WITH
![726] THE COMPLEXITIES OF PICKING UP THESE SPECIAL TYPES LATER ON.
%[726]% IF .PREV[VALTYPE] NEQ COMPLEX THEN
BEGIN
!IF RHS OF ASSIGNMENT STMNT CONTAINS NO FN CALLS, THE ARGS TO THIS
! STMNT FN WILL NOT NEED TO BE COPIED INTO LOCALS
PREV[IDATTRIBUT(NOALLOC)]_1; !DONT ALLOC CORE FOR THE LOCAL
PREV[IDTARGET]_INDBIT+#16^18
+(.I-1); !REFERENCE THE VAR BY @K(16)
! WHERE K IS THE CONST (.I-1)
T[.I,ENTNOCOPYFLG]_1;
END
END;
CSTMNT_.OCSTMNT;
CSTMNT[SRCCMPLX]_0;
END;
GLOBAL ROUTINE ALCSFN=
BEGIN
!REGISTER ALLOCATE STATEMENT FUNCTION
!ASSIGNMENT STATEMENT WHICH IS POINTED TO
!BY SFNEXPR
LOCAL OCSTMNT,OCLBRGS,OLSTLNK;
EXTERNAL ALCASMNT,CLOBBREGS,CSTMNT,FRSTLNK,LSTLNK,NXTTMP;
EXTERNAL ALCENLIST; !ROUTINE TO DECIDE WHAT REGS TO USE TO PICK UP PARAMS
MAP BASE CSTMNT;
!SAVE THE OLD VALUE OF CLOBBREGS
!THIS WILL BE NON-ZERO AND CAUSE ERRORS IN THE
!GLOBALLY OPTIMIZING CASE
OCLBRGS_.CLOBBREGS;
!SAVE POINTER TO TEMPS TO USE
OLSTLNK_.LSTLNK;
!ZERO CLOBBREGS
CLOBBREGS_0;
ALCENLIST(.CSTMNT[SFNLIST]); !DECIDE WHAT REGS TO USE TO PICK UP THE PARAMS
OCSTMNT_.CSTMNT; !SAVE CSTMNT
CSTMNT_.CSTMNT[SFNEXPR];
ALCASMNT(); !ALLOCATE ASSIGNMENT
!CLOBBREGS INFO WILL BE SAVED IN
!FLAGS FIELD OF STATEMENT FUNCTION NODE
CSTMNT_.OCSTMNT;
CSTMNT[SFNCLBREG]_.CLOBBREGS<18,18>;
CLOBBREGS_.OCLBRGS; !REINITIALIZE IT
!IF ANY TEMPS WERE NEEDED WE MUST PREVENT REUSE OF
!THE .QXXXX VARIABLES GENERATED. IF ANY WERE GENERATED
!WE HAVE TO SET FRSTLNK TO A NEW ONE WE CREATE TO BE ONE BEYOND
!THE ONE LAST USED.
!SETTING FRSTLNK TO LSTLNK
!LSTLNK IS UPDATED IN THE ROUTINE MAKTMP (MODULE UTIL) AS TEMPS ARE MADE.
!IF ANY TEMPS WERE USED
!USE THE EXTRENAL ROUTINE NXTTMP TO GENERATE THE NEW ONE
!THE PARM OF NXTTMP INDICATES DOUBLE WORD OR SINGLE WORD.
!WE ONLY WANT A SINGLE WORD SO 0 DOES IT.
IF .LSTLNK NEQ 0 THEN !IF ANY QTEMPS HAVE BEEN ALLOCATED,
FRSTLNK_NXTTMP(0);
END;
GLOBAL ROUTINE STCMSUB=
BEGIN
EXTERNAL ADDREGCANDATE; !ROUTINE TO TELL THE BASIC BLOCK ALLOCATOR THAT A GIVEN
! VAR CAN POTENTIALLY BE LEFT IN A REG
LOCAL ARGUMENTLIST ARGLSTPT;
OWN BASE ARGUMENT;
EXTERNAL BASE CSTMNT;
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[OPERSP] NEQ FORMLARRAY 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;
GLOBAL ROUTINE LPIXSUB=
BEGIN
!SUBSTITUTE REGCONTENTS NODES IN THE LOOP FOR
!ALL REFERENCES TO THE INDUCTION VARIBALE.
!CDONODE POINTS TO THE DO STATEMENT NODE
!DOWDP ALSO CONTAINS KEY INFO.
!FIELD DOISUBS = BIT ON MEANS SUBS; BIT OFF MEANS NO SIBS
!FIELD DOREGPTR = POINTE TO THE REGCONTENTS NODE TO BE SUBSTITUTED
EXTERNAL CSTMNT,CDONODE,DOWDP,GLOBREG,CHOSEN,ITMCT,
LEAFSUBSTITUTE,MISCIO;
MAP BASE CSTMNT:CDONODE;
MAP OBJECTCODE DOWDP;
OWN BASE ARGNOD;
!!LOCAL ROUTINE
ROUTINE DOIO=
BEGIN
!LOOK AT I/O LISTS
EXTERNAL IOSUBSTITUTE,MISCIO;
LOCAL BASE TMP;
MISCIO(.CSTMNT);
TMP_.CSTMNT[IOLIST];
WHILE .TMP NEQ 0 DO
BEGIN
IOSUBSTITUTE(.TMP);
TMP_.TMP[SRCLINK];
END;
END;
IF .DOWDP EQL 0 THEN RETURN;
IF .CSTMNT[SRCID] GEQ ENCOID THEN RETURN;
ITMCT_1;
GLOBREG[1]_.CDONODE[DOSYM];
CHOSEN[1]_.DOWDP[DOREGPTR];
!LOOK AT THE COMMON SUB-EXPRESSIONS TOO
IF .CSTMNT[SRCCOMNSUB] NEQ 0 THEN
BEGIN
ARGNOD_.CSTMNT[SRCCOMNSUB];
WHILE .ARGNOD NEQ 0 DO
BEGIN
LEAFSUBSTITUTE(.ARGNOD);
ARGNOD_.ARGNOD[SRCLINK];
END;
END;
SELECT .CSTMNT[SRCID] OF NSET
ASGNID: !ASSIGNMENT
BEGIN
LEAFSUBSTITUTE(.CSTMNT[LHEXP]);
LEAFSUBSTITUTE(.CSTMNT[RHEXP]);
END;
IFAID: !ARITHMETIC IF
LEAFSUBSTITUTE(.CSTMNT[AIFEXPR]);
IFLID: ! LOGICAL IF
BEGIN
LOCAL T1;
LEAFSUBSTITUTE(.CSTMNT[LIFEXPR]);
T1_.CSTMNT;
CSTMNT_.CSTMNT[LIFSTATE];
LPIXSUB();
CSTMNT_.T1;
END;
READID: !READ
DOIO();
WRITID: !WRITE
DOIO();
FINDID:
MISCIO(.CSTMNT);
DECOID: !DECODE
DOIO();
ENCOID: !ENCODE
DOIO();
CGOID: !COMPUTED GO TO
LEAFSUBSTITUTE(.CSTMNT[CGOTOLBL]);
AGOID: !ASSIGNED GO TO
LEAFSUBSTITUTE(.CSTMNT[AGOTOLBL]);
RETUID: !RETURN
IF .CSTMNT[RETEXPR] NEQ 0 THEN
LEAFSUBSTITUTE(.CSTMNT[RETEXPR]);
STOPID: !STOP
IF .CSTMNT[STOPIDENT] NEQ 0 THEN
LEAFSUBSTITUTE(.CSTMNT[STOPIDENT]);
!REMEMBER ASSIGN STATEMENTS WITH ARRAY ELEMENTS
ASSIID: !ASSIGN STATEMENT
LEAFSUBSTITUTE(.CSTMNT[ASISYM]);
TESN;
IF .CSTMNT[SRCLBL] NEQ 0 THEN
IF .CSTMNT[SRCLBL] EQL .CDONODE[DOLBL] THEN
DOWDP_0;
END;
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
EXTERNAL ALCENLIST; !ROUTINE TO DETERMINE WHICH REGS TO USE TO PICK UP PARAMSOF
! A FN,SUBR, OR STMNT FN
EXTERNAL CSTMNT;
MAP BASE CSTMNT;
IF .CSTMNT[ENTLIST] NEQ 0 !IF THIS ENTRY HAS PARAMETERS
THEN ALCENLIST(.CSTMNT[ENTLIST]); !DETERMINE WHICH REGS TO USE TO PICK
! THEM UP
END;
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
EXTERNAL CLOBBREGS; !GLOBAL CONTAINING A BIT PATTERN INDICATING
! WHICH REGS ARE CLOBBERED IN THIS
! SUBROUTINE (A BIT IS 1 IF THE CORRESP REG
! GETS CLOBBERED)
REGISTER PEXPRNODE ARGN; !PTR TO THE SYMBOL TABLE ENTRY FOR A GIVEN ARG
MAP ARGUMENTLIST ARGLST; !PTR TO THE ARG LIST FOR THIS ENTRY
EXTERNAL SAVEREG; !ROUTINE TO REMEMBER THAT A GIVEN VAR IS INA GIVEN REG
EXTERNAL CGERR; !ROUTINE FOR INTERNAL COMPILER ERROR DETECTED
EXTERNAL AFREEREG; !ROUTINE TO GET A FREE REGISTER TO USE
EXTERNAL STBSYR; !BIT PATTERN INDICATING WHICH REGS ARE LEGAL TO
! USE FOR THIS STMNT
EXTERNAL REGCLOBB; !ROUTINE TO TELL BB ALLOCATOR THAT A REG
! HAS BEEN CLOBBERED
%(**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; !END OF ROUTINE "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; !END OF ROUTINE "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
EXTERNAL ASNFNVAL; !ROUTINE TO CHECK WHETHER THE STMNT POINTED TO BY CSTMNT ASSIGNS THE FN VAL
! AND PRECEDES A RETURN
EXTERNAL CSTMNT;
EXTERNAL SORCPTR;
EXTERNAL MAKRC0; !ROUTINE TO BUILD A REGCONTENTS 0 NODE
EXTERNAL CGERR;
MAP BASE CSTMNT;
REGISTER BASE TSTMNT;
REGISTER PEXPRNODE LHNODE;
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; !END OF ROUTINE "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
EXTERNAL CSTMNT;
MAP BASE CSTMNT;
EXTERNAL ASNFNVAL; !ROUTINE TO CHECK FOR "CSTMNT" POINTING
! TO AN ASSIGNMENT OF THE FN VAL DIRECTLY BEFORE A RETURN
IF ASNFNVAL() THEN ASVCT_.ASVCT+1;
END; !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
EXTERNAL CSTMNT;
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; !END OF ROUTINE ASNFNVAL
END !END OF MODULE
ELUDOM