Google
 

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