Trailing-Edge
-
PDP-10 Archives
-
bb-4157h-bm_fortran20_v10_16mt9
-
fortran-compiler/goptim.bli
There are 12 other files named goptim.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: */AHM/MEM
MODULE GOPTIM(RESERVE(0,1,2,3),SREG=#17,VREG=#15,FREG=#16,DREGS=4,GLOROUTINES)=
BEGIN
SWITCHES NOLIST;
REQUIRE FIRST.BLI;
REQUIRE TABLES.BLI;
REQUIRE OPTMAC.BLI;
SWITCHES LIST;
GLOBAL BIND GOPTIV = #10^24 + 0^18 + #2057; ! Version Date: 11-Jun-84
%(
***** Begin Revision History *****
52 ----- ----- REMOVE REFERENCES TO THISLEVL
***** Begin Version 4B *****
53 18869 404 FIX UP THE CREATION OF ASSOCIATE VARIABLE LIST, (DCE)
***** Begin Version 5B *****
54 ----- 733 IF RHS OF ASSIGNMENT STMNT RESOLVES TO "NOT CONST",
FOLD THE NOT INTO THE CONSTANT, (DCE)
***** Begin Version 6 *****
55 Q20-01654 1126
Remove last vestiges of CALL DEFINE FILE support. (AHM)
***** Begin Version 7 *****
***** End V7 Development *****
2057 MEM 11-Jun-84
Add a parameter to LOKCALST so that concatenation argument
lists can be walked properly.
***** End Revision History *****
)%
!
!************************************
!
!
!********************************************
!
GLOBAL ROUTINE LOOKUP(VAR)=
BEGIN
EXTERNAL CHOSEN;
MAP PEXPRNODE VAR;
!LOOKUP IS CALLED BY THE DEFINITION ALGORITHM AND GLOBAL REGISTER
!ALLOCATION TO SEARCH A LINEAR LIST (CHOSEN) TO DETERMINE IF
!VAR IS IN THAT LIST
!
IF .VAR[IDATTRIBUT(INCOM)] THEN VAR_.VAR[IDCOMMON];
INCR I FROM 0 TO 31 DO
IF .CHOSEN[.I]<RIGHT> EQL .VAR THEN RETURN(.I);
RETURN(64);
END;
!
!***********************************************
!
ROUTINE CHKUA(CPTR)=
BEGIN
!THIS ROUITNE HELPS THE GLOBAL ALLOCATOR DETERMINE USED BEFORE
!ASSIGNED AND ASSIGNED BEFORE FIRST USE INFO. UNFORTUNATELY,
!WE DO NOT HAVE THE INDEX INTO GLOBREG AT THIS TIME SO WE
!WILL LOOK THE POINTER UP (USING LOOKUP) AND THEN CHECK
EXTERNAL GLOBREG,CHOSEN,SPECCASE;
REGISTER INX;
IF .SPECCASE NEQ 1 THEN RETURN;
!GET OUT FAST IF THIS IS NOT THE GLOBAL ALLOCATION CASE
INX_LOOKUP(.CPTR);
IF .INX GEQ 64 THEN RETURN;
IF NOT .GLOBREG[.INX]<ASGND4USED> THEN
GLOBREG[.INX]<USED4ASGND>_1;
END;
GLOBAL ROUTINE LOKCALST(PTR,NUMB,COMPR,SUBSTITUTE,INCONCAT)= ![2057] Add param
BEGIN
LOCAL BASE ARGG;
MAP ARGUMENTLIST PTR;
EXTERNAL LEAFSUBSTITUTE,SPECCASE;
EXTERNAL TOP;
MAP BASE TOP:SUBSTITUTE;
!LOOK AT A LIST OF ARGUMENTS POINTED TO BY PTR
!LOOK AT NUMB ELEMENTS OF THE LIST.
!COMPARE ELEMENTS OF THE LIST WITH COMPR.
!WHEN COMPR IS FOUND REPLACE IT WITH SUBSTITUTE
!
%2057% ! Skip first parameter if argument list is in a concatenation
%2057% ! (i.e., if INCONCAT is TRUE)
%2057%
%2057% INCR K FROM (IF .INCONCAT THEN 2 ELSE 1) TO .NUMB
%2057% DO
BEGIN
ARGG_.PTR[.K,ARGNPTR];
IF .ARGG[OPRCLS] EQL DATAOPR THEN
BEGIN
IF .ARGG EQL .COMPR THEN
BEGIN
!DONT DO IT IF THIS
!IS A HALF WORD INDUCTION VARIABLE
IF .TOP NEQ 0 THEN
IF .TOP[DOSYM] EQL .COMPR THEN
IF .TOP[FLCWD] AND .SPECCASE EQL 1 THEN
TOP[NEDSMATRLZ]_1;
!NOW SUBSTITUTE ANYWAY.
PTR[.K,ARGNPTR]_.SUBSTITUTE;
PTR[.K,AVALFLG]_1;
CHKUA(.SUBSTITUTE);
END;
END ELSE
!IT COULD BE THIS EXPRESSION ITSELF
IF .ARGG EQL .COMPR THEN
BEGIN
PTR[.K,ARGNPTR]_.SUBSTITUTE;
CHKUA(.SUBSTITUTE);
!SET VAL FLAG IF IT SHOULD BE SET
!IT SHOULD BE SET FOR A COMMON SUB OR DATA ITEM
IF .SUBSTITUTE[OPRCLS] EQL DATAOPR OR
.SUBSTITUTE[OPRCLS] EQL CMNSUB THEN
PTR[.K,AVALFLG]_1;
END
ELSE
!MUST WALK EXPRESSION TREE LOOKING FOR IT
LEAFSUBSTITUTE(.ARGG);
END; !INCR LOOP
END;
!******************************************************
!ROUTINE
!
GLOBAL ROUTINE REPLACARG(STMT,OLDARG,NEWARG)=
BEGIN
REGISTER INX;
EXTERNAL TOP,GLOBREG,CELMNT;
MAP BASE TOP;
EXTERNAL OPTERR;
MAP BASE STMT:NEWARG;
EXTERNAL SPECCASE;
!A PARENT THAT POINTS TO A STATEMENT HAS BEEN FOUND
!LIKE UP ARG TO THE CORRECT STAEMENT TYPE
!
SELECT .STMT[SRCID] OF NSET
ASGNID: !ASSIGNMENT STATEMENT
BEGIN
!IT COULD BE BOTH RIGHT AND LEFT HAND SIDES
IF .STMT[RHEXP] EQL .OLDARG THEN
BEGIN
STMT[RHEXP]_.NEWARG;
IF .NEWARG[OPRCLS] EQL DATAOPR THEN
![733] FOLD IN ANY NOT FLAG FROM THE STATEMENT NODE IF A
![733] CONSTANT HAS JUST APPEARED! CODE GENERATION GETS ILL OTHERWISA.
%[733]% (STMT[A2VALFLG]_1;
%[733]% IF .STMT[A2NOTFLG] AND .NEWARG[OPERSP] EQL CONSTANT THEN
%[733]% ( STMT[RHEXP]_NOTCNST(NEWARG);
%[733]% STMT[A2NOTFLG]_0 ));
IF .NEWARG[OPRCLS] EQL REGCONTENTS THEN
BEGIN
STMT[A2VALFLG]_1;
IF .SPECCASE EQL 2 THEN
STMT[A2IMMEDFLG]_1
ELSE
IF .SPECCASE EQL 1 THEN
BEGIN
IF .TOP[DOSYM] EQL .OLDARG
AND .TOP[FLCWD] THEN
STMT[A2IMMEDFLG]_1;
!ONCE AGAIN GET THE USED/ASSIGNED INFO
CHKUA(.NEWARG);
END;
END;
END;
IF .STMT[LHEXP] EQL .OLDARG THEN
BEGIN
STMT[LHEXP]_.NEWARG;
IF .NEWARG[OPRCLS] EQL DATAOPR THEN
STMT[A1VALFLG]_1;
IF .NEWARG[OPRCLS] EQL REGCONTENTS THEN
BEGIN
STMT[A1VALFLG]_1;
IF .SPECCASE EQL 2 THEN
STMT[A1IMMEDFLG]_1
ELSE
IF .SPECCASE EQL 1 THEN
BEGIN
IF .TOP[DOSYM] EQL .OLDARG
AND .TOP[FLCWD] THEN
STMT[A1IMMEDFLG]_1;
!HER WE ALSO WANT TO SET ASGND4USED BIT
INX_LOOKUP(.NEWARG);
IF .INX LSS 64 THEN
IF NOT .GLOBREG[.INX]<USED4ASGND> THEN
GLOBREG[.INX]<ASGND4USED>_1;
END;
END;
END;
END;
!
!
CALLID: !SUBROUTINE CALL
BEGIN
LOCAL ARGUMENTLIST AG;
AG_.STMT[CALLIST];
IF .AG NEQ 0 THEN
LOKCALST(.AG,.AG[ARGCOUNT],.OLDARG,.NEWARG);
END;
!
!
DOID:
BEGIN
IF .STMT[DOLPCTL] EQL .OLDARG THEN
STMT[DOLPCTL]_.NEWARG;
END;
!
!
IFAID:
BEGIN
IF .STMT[AIFEXPR] EQL .OLDARG THEN
BEGIN
STMT[AIFEXPR]_.NEWARG;
IF .NEWARG[OPRCLS] EQL REGCONTENTS THEN
BEGIN
IF .SPECCASE EQL 2 THEN
STMT[A1IMMEDFLG]_1
ELSE
IF .SPECCASE EQL 1 THEN
BEGIN
IF .TOP[DOSYM] EQL .OLDARG
AND .TOP[FLCWD] THEN
STMT[A1IMMEDFLG]_1;
CHKUA(.NEWARG);
END;
END;
END;
END;
!
!
IFLID:
BEGIN
IF .STMT[LIFEXPR] EQL .OLDARG THEN
BEGIN
STMT[LIFEXPR]_.NEWARG;
IF .NEWARG[OPRCLS] EQL REGCONTENTS THEN
BEGIN
IF .SPECCASE EQL 2 THEN
!P2S, AOBJN WORD. VALUE IS +
!CUZ WE DONT DO AOBJNS THRU ZERO
!IT IS FALSE SO THE STATEMENT GOES AWAY
STMT[SRCID]_CONTID
ELSE
IF .SPECCASE EQL 1 THEN
BEGIN
!GLOBAL CASE, IF AOBJN, INDUCTION VARABLE
!DO THE SAME THING
IF .TOP[DOSYM] EQL .OLDARG
AND .TOP[FLCWD] THEN
STMT[SRCID]_CONTID
ELSE
CHKUA(.NEWARG);
END;
END;
END;
END;
!
AGOID:
BEGIN
IF .STMT[AIFEXPR] EQL .OLDARG THEN
STMT[AIFEXPR]_.NEWARG;
END;
!
!
CGOID:
BEGIN
!WE SHOULD BE TRYING THIS ONLY FOR GLOBAL REGISTER ALLOCATION
IF .STMT[CGOTOLBL] EQL .OLDARG THEN
BEGIN
STMT[CGOTOLBL]_.NEWARG;
IF .SPECCASE EQL 1 THEN !GLOBAL REG ALLOC.
BEGIN
IF .TOP[SRCID] EQL DOID AND
.TOP[FLCWD] THEN
STMT[A1IMMEDFLG]_1;
CHKUA(.NEWARG);
END;
END;
END;
!
!
READID: REPLACARG(.CELMNT,.OLDARG,.NEWARG);
WRITID: REPLACARG(.CELMNT,.OLDARG,.NEWARG);
ENCOID: REPLACARG(.CELMNT,.OLDARG,.NEWARG);
DECOID: REPLACARG(.CELMNT,.OLDARG,.NEWARG);
REREDID: REPLACARG(.CELMNT,.OLDARG,.NEWARG);
TESN;
END;
!MORE WILL BE INCLUDED IN THIS WHEN THE FORMAT OF I/O STATEMENTS IS
!EXPLICIT
GLOBAL ROUTINE DOPARMS(CNODE)=
!ROUTINE CALLED TO COLLECT GLOBAL PARAMETERS USED BY THE
!OPTIMIZER.
!THE PARAMETER IS A POINTER TO THE DO DEPTH ANALYSIS TREE.
BEGIN
EXTERNAL TOP,BOTTOM,LEND,LENTRY,INDVAR;
REGISTER BASE TMP;
MAP BASE TOP:BOTTOM:LEND:LENTRY;
MAP BASE CNODE;
!PICK UP INFORMATION ABOUT THIS DO LOOP
!CNODE POINTS TO THE NODE OF THE DO STRUCTURE TREE
!FIELDS FROM DO WALK TREE
TOP_.CNODE[DOSRC]; !PTR TO DO STATEMENT ITSELF
!
!FIELDS FROM DO STATEMENT ITSELF
LENTRY_.TOP[DOPRED]; !STATEMENT BEFORE DO
!NEEDED FOR CODE MOTION OUT OF LOOP
!IT MAY NOT BE EXACT OF A DO LOOP TERMINATOR IS
!INVOLVED. TO MAKE SURE WE WILL LOOK FOR TOP.
WHILE .LENTRY[SRCLINK] NEQ .TOP DO
LENTRY_.LENTRY[SRCLINK];
TMP_.TOP[DOLBL];
LEND_.TMP[SNHDR]; !POINT TO SOURCE ENTRY FOR LABELED STATEMENT
BOTTOM_.LEND[SRCLINK]; !ONE STATEMENT PAST END OF LOOP
!USED IN WHILE TYPE CONTROL WHERE PTR IS
!UPDATED BEFORE TESTING
INDVAR_.TOP[DOSYM]; !THE INDUCTION VARIABLE
END;
GLOBAL ROUTINE MAKASSOC=
BEGIN
!ROUITNE LOOKS AT ALL CALLS FOR CALLS TO DEFINE FILE
!AND ALL OPENS FOR ASSOCIATE VARIABLES AND CREATES A LINKED
!LIST OF THE SAME HEADED BY THE GLOBAL ASSOCPT.
%1126% EXTERNAL ASSOCPT;
%1126% MAP BASE ASSOCPT;
EXTERNAL CSTMNT,SORCPTR;
MAP BASE CSTMNT;
EXTERNAL NAME,CORMAN;
ROUTINE LNKASSOC(AVAR)=
BEGIN
!LINK THE ASSOCIATED VARIABLE INTO
!THE LINKED LIST
MAP BASE AVAR;
IF .AVAR[OPR1] EQL CONSTFL THEN
ELSE
IF .AVAR[OPRCLS] EQL ARRAYREF OR .AVAR[OPRCLS] EQL DATAOPR
THEN
BEGIN
LOCAL BASE NEWLNK;
NAME<LEFT>_1;
!GET THE CORE FOR THE LINKED LIST
NEWLNK_.ASSOCPT;
ASSOCPT_CORMAN();
!CREATE THE LINKED LIST PROPERLY
ASSOCPT[RIGHTP]_.NEWLNK;
!NO ITS LINKED IN FILL IN THE INFO
ASSOCPT[LEFTP]_(IF .AVAR[OPRCLS] EQL ARRAYREF
THEN .AVAR[ARG1PTR] ELSE
.AVAR);
END;
END;
CSTMNT_.SORCPTR<LEFT>;
!FROM FIRST TO LAST
WHILE .CSTMNT NEQ 0 DO
BEGIN
![1126] Delete check for CALL DEFINE FILE
IF .CSTMNT[SRCID] EQL OPENID THEN
BEGIN
LOCAL OPENLIST AG;
AG_.CSTMNT[OPLST];
INCR I FROM 0 TO .CSTMNT[OPSIZ]-1 DO
BEGIN
IF .AG[.I,OPENLCODE] EQL OPNCASSOCI THEN
LNKASSOC(.AG[.I,OPENLPTR]);
END;
END;
CSTMNT_.CSTMNT[SRCLINK];
END;
END;
END
ELUDOM