Google
 

Trailing-Edge - PDP-10 Archives - FORTRAN-10_V7wLink_Feb83 - ver5.bli
There are 12 other files named ver5.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) DIGITAL EQUIPMENT CORPORATION 1976, 1983
! AUTHOR: STAN WHITLOCK

MODULE VER5(RESERVE(0,1,2,3),SREG = #17,VREG = #15,FREG = #16,DREGS = 4,START)=
BEGIN


!	REQUIRES FIRST, TABLES, OPTMAC

GLOBAL BIND VER5V = 7^24 + 0^18 + 7;		! Version Date:	13-Aug-81

%(

***** Begin Revision History *****

2	437	QAR771	PASS ORFIXFLG UP TO SUBSUMER IN DOTOFIX, (SJW)
3	505	QAR815	IN DOTORFIX MOVE MODIFIED .R INIT TO BEFORE
			  TOP ONLY IF NOT ALREADY THERE, (SJW)
4	515	QAR815	REMOVE "TEMP [EXPRUSE] _ 1" IN DOTORFIX, (SJW)

***** Begin Version 5A *****	 7-Nov-76

5	525	QAR949	DO CORRECT TYPECNV IN DOTOFIX ONLY IF NECESSARY, (SJW)

***** Begin Version 5B *****	 19-Dec-77

6	631	10962	TEACH VER5 HOW TO ZERO DEF POINTS IN IOLISTS, (JNG)

***** Begin Version 7 *****

7	1245	TFV	3-Aug-81	------
	Fix definition of REGSTUFF.  IDCHOS, IDUSED, IDDEF were moved from
	word 2 to word 8 of symbol table entry.  The left half of word 8
	also contains the PSECT field so we can not just clear the left half.

***** End Revision History *****

)%

SWITCHES  NOLIST;
REQUIRE  FIRST.BLI;
REQUIRE  TABLES.BLI;
REQUIRE  OPTMAC.BLI;
SWITCHES  LIST;
SWITCHES  NOSPEC;

FORWARD		![631]
%[631]%	ZIOLIST,	!CALLED FROM ZDEFPT AND ZSTATEMENT
%[631]%	ZDEFPT,		!CALLED FROM ZIOLIST
%[631]%	ZSTATEMENT;	!CALLED FROM ZDEFPT

!			ZERO DEFINITION POINTS IN AN IOLIST
!			  OR IN A LIST OF COMMON SUBEXPRESSIONS

ROUTINE ZIOLIST(LIST)=	![631]
BEGIN			![631]

MAP BASE LIST;		![631]

%[631]%	WHILE .LIST NEQ 0 DO
%[631]%	BEGIN
%[631]%	  ZDEFPT(.LIST);
%[631]%	  LIST_.LIST[CLINK]
%[631]%	END
END;			![631]

SWITCHES NOSPEC;	![631]

!			ZERO DEFINITION POINTS IN EXPRESSION

ROUTINE  ZDEFPT  (EXPR) =
BEGIN

MAP PEXPRNODE  EXPR;

!			ZERO DEFPT FOR ARG 1

MACRO  ZDEFPT1  =
	BEGIN
	  IF NOT .EXPR [A1VALFLG]
	    THEN BEGIN
	      ZDEFPT  (.EXPR [ARG1PTR]);
	    END;
	  EXPR [DEFPT1] _ 0;
	END$;

!			ZERO DEFPT FOR ARG 2

MACRO  ZDEFPT2  =
	BEGIN
	  IF NOT .EXPR [A2VALFLG]
	    THEN BEGIN
	      ZDEFPT  (.EXPR [ARG2PTR]);
	    END;
	  EXPR [DEFPT2] _ 0;
	END$;




	IF .EXPR EQL 0
	  THEN RETURN;
	CASE  .EXPR [OPRCLS]  OF SET
!BOOLEAN
	  BEGIN
	    ZDEFPT1;
	    ZDEFPT2;
	  END;
!DATAOPR
	  BEGIN  END;
!REALTIONAL
	  BEGIN
	    ZDEFPT1;
	    ZDEFPT2;
	  END;
!FNCALL
	  BEGIN
	  LOCAL ARGUMENTLIST  AG;
	    AG _ .EXPR [ARG2PTR];		! NEVER = 0
	    INCR  I  FROM 1  TO .AG [ARGCOUNT]
	      DO BEGIN
	        IF NOT .AG [.I, AVALFLG]
		  THEN ZDEFPT (.AG [.I, ARGNPTR]);
	      END;
	  END;
!ARITHMETIC
	  BEGIN
	    ZDEFPT1;
	    ZDEFPT2;
	  END;
!TYPECNV
	  BEGIN
	    ZDEFPT2;
	  END;
!ARRAYREF
	  BEGIN
	    EXPR [DEFPT1] _ 0;
	    ZDEFPT2;
	  END;
!CMNSUB
	  BEGIN  END;			! NONE GENERATED YET
!NEGNOT
	  BEGIN
	    ZDEFPT2;
	  END;
!SPECOP
	  BEGIN
	    ZDEFPT1;
	  END;
!FIELDREF
	  BEGIN  END;			! UNUSED
!STORECLS
	  BEGIN  END;
!REGCONTENTS
	  BEGIN  END;
!LABOP
	  BEGIN  END;
!STATEMENT
%[631]%	  BEGIN
%[631]%	    ZSTATEMENT(.EXPR)	!CAN HAPPEN UNDER IOLISTS
%[631]%	  END;
!IOLSCLS
%[631]%	  BEGIN
%[631]%	    CASE .EXPR[OPERSP] OF
%[631]%	    SET
%[631]%	    !DATACALL
%[631]%	      ZDEFPT(.EXPR[DCALLELEM]);
%[631]%	    !SLISTCALL
%[631]%	      BEGIN
%[631]%		ZDEFPT(.EXPR[SCALLELEM]);
%[631]%		ZDEFPT(.EXPR[SCALLCT])
%[631]%	      END;
%[631]%	    !IOLSTCALL
%[631]%	      BEGIN
%[631]%		ZIOLIST(.EXPR[IOLSTPTR]);
%[631]%		ZIOLIST(.EXPR[IOLCOMNSUB])
%[631]%	      END;
%[631]%	    !E1LISTCALL
%[631]%	      BEGIN
%[631]%		ZIOLIST(.EXPR[ELSTPTR]);
%[631]%		ZIOLIST(.EXPR[IOLCOMNSUB])
%[631]%	      END;
%[631]%	    !E2LISTCALL
%[631]%	      BEGIN
%[631]%		ZIOLIST(.EXPR[ELSTPTR]);
%[631]%		ZIOLIST(.EXPR[IOLCOMNSUB])
%[631]%	      END;
%[631]%	    !ESNGLELEM
%[631]%	      ZDEFPT(.EXPR[DCALLELEM]);
%[631]%	    !EDBLELEM
%[631]%	      ZDEFPT(.EXPR[DCALLELEM])
%[631]%	    TES
%[631]%	  END;
!INLINFN
	  BEGIN
	    ZDEFPT1;
	    IF .EXPR [ARG2PTR] NEQ 0		! NO ARG2 ON ABS
	      THEN ZDEFPT2;
	  END;
	TES;

	RETURN;
END;				! END OF ROUTINE ZDEFPT

SWITCHES  NOSPEC;

!	ZERO DEFINITION POINTS IN STATEMENT

ROUTINE  ZSTATEMENT (SRC) =
BEGIN

MAP BASE  SRC;

	CASE  .SRC [SRCID]  OF SET
!ASSIGNMENT
	  BEGIN
	    ZDEFPT  (.SRC [RHEXP]);
	    ZDEFPT  (.SRC [LHEXP]);
	  END;
!ASSIGN
	  BEGIN  END;
!CALL
	  BEGIN
	  LOCAL ARGUMENTLIST  AG;
	    AG _ .SRC [CALLIST];		! = 0 IF NO ARGS
	    IF .AG NEQ 0
	      THEN BEGIN
		INCR  I  FROM 1  TO .AG [ARGCOUNT]
		  DO BEGIN
		    IF NOT .AG [.I, AVALFLG]
		      THEN ZDEFPT  (.AG [.I, ARGNPTR]);
		  END;
	      END;
	  END;
!CONTINUE
	  BEGIN  END;
!DO
	  BEGIN
	    ZDEFPT  (.SRC [DOM1]);		! INITIAL EXPR
	    ZDEFPT  (.SRC [DOM2]);		! FINAL EXPR
	    ZDEFPT  (.SRC [DOM3]);		! INCR EXPR
	    ZDEFPT  (.SRC [DOLPCTL]);		! CONTROL EXPR
	  END;
!ENTRY
	  BEGIN  END;
!COMNSUB
	  BEGIN  END;
!GOTO
	  BEGIN  END;
!ASSIGNED GOTO
	  BEGIN  END;
!COMPUTED GOTO
	  BEGIN
	    ZDEFPT  (.SRC [CGOTOLBL]);
	  END;
!ARITHMETIC IF
	  BEGIN
	    ZDEFPT  (.SRC [AIFEXPR]);
	  END;
!LOGICAL IF
	  BEGIN
	    ZDEFPT  (.SRC [LIFEXPR]);
	    ZSTATEMENT  (.SRC [LIFSTATE]);	! THEN STATEMENT
	  END;
!RETURN
	  BEGIN
	    ZDEFPT  (.SRC [RETEXPR]);
	  END;
!STOP
	  BEGIN  END;
!READ
	  BEGIN
	    ZDEFPT  (.SRC [IORECORD]);
%[631]%	    ZIOLIST(.SRC[IOLIST]);
	  END;
!WRITE
	  BEGIN
	    ZDEFPT  (.SRC [IORECORD]);
%[631]%	    ZIOLIST(.SRC[IOLIST]);
	  END;
!DECODE
%[631]%	  BEGIN
%[631]%	    ZIOLIST(.SRC[IOLIST])
%[631]%	  END;
!ENCODE
%[631]%	  BEGIN
%[631]%	    ZIOLIST(.SRC[IOLIST])
%[631]%	  END;
!REREAD
%[631]%	  BEGIN
%[631]%	    ZIOLIST(.SRC[IOLIST])
%[631]%	  END;
!FIND
	  BEGIN
	    ZDEFPT  (.SRC [IORECORD]);
	  END;
!CLOSE
	  BEGIN  END;
!INPUID
	  BEGIN  END;			! UNUSED
!OUTPID
	  BEGIN  END;			! UNUSED
!BACKSPACE
	  BEGIN  END;
!BACKFILE
	  BEGIN  END;
!REWIND
	  BEGIN  END;
!SKIPFILE
	  BEGIN  END;
!SKIPRECORD
	  BEGIN  END;
!UNLOAD
	  BEGIN  END;
!RELSID
	  BEGIN  END;			! RELEASE ?
!ENDFILE
	  BEGIN  END;
!END
	  BEGIN  END;
!PAUSE
	  BEGIN  END;
!OPEN
	  BEGIN  END;
!STATEMENT FUNCTION
	  BEGIN  END;			! NO DEFPTS IN SFNEXPR
!FORMAT
	  BEGIN  END;
!BLTID
	  BEGIN  END;
!REGMARK
	  BEGIN  END;
	TES;

	RETURN;

END;				! END OF ROUTINE ZSTATEMENT

	SWITCHES  NOSPEC;

!	ZERO DEFINITION POINTS IN ENTIRE TREE
!	ZERO OUT ORFIXFLG, OMOVDCNS IN SYMTBL FOR .O VARS

!	CALLED FROM MRP2 IN PHA2

GLOBAL ROUTINE  ZTREE  =
BEGIN

EXTERNAL BASE  SORCPTR;

LOCAL BASE  PTR;
LOCAL BASE  SRC;

	PTR _ .SORCPTR <LEFT>;
	WHILE  .PTR NEQ .SORCPTR <RIGHT>
	  DO BEGIN
	    SRC _ .PTR;			! GET THIS STATEMENT
	    ZSTATEMENT  (.SRC);		! ZERO IT
	    PTR _ .SRC [SRCLINK];	! TO NEXT STATEMENT
	  END;

	DECR  I  FROM SSIZ-1  TO 0
	  DO BEGIN
	    PTR _ .SYMTBL [.I];
	    WHILE  .PTR NEQ 0
	      DO BEGIN
		IF .PTR [IDDOTO] EQL SIXBIT ".O"
		  THEN PTR [TARGET] _ 0;
		PTR _ .PTR [SRCLINK];
	      END;		! OF WHILE
	  END;			! OF DECR

	RETURN;

END;				! END OF ROUTINE ZTREE
SWITCHES  NOSPEC;

!	UNLINK T FROM BUSY & POSTDOM LISTS

!	CALLED FROM DOTOHASGN IN GCMNSB

!	IF T IS FROM IMPLIED DO (NOW BEING MOVED AS CONSTANT), IT
!	  WON'T BE ON LISTS => IGNORE

GLOBAL ROUTINE  UNBUSY  (T)  =
BEGIN

MAP PHAZ2  T;			! STATEMENT NODE PTR

EXTERNAL  TOP;
MAP PHAZ2  TOP;
REGISTER PHAZ2  P;
LOCAL PHAZ2  OLDP;		! TO FIND END OF POSTDOM LIST

LABEL  L;

	P _ .TOP;		! START SEARCH FOR RIGHT BROTHER
L:	WHILE  TRUE
	  DO BEGIN
	    IF .P EQL 0
	      THEN RETURN;	! T NOT ON BUSY LIST
	    IF .P [BUSY] EQL .T
	      THEN BEGIN
		P [BUSY] _ .T [BUSY];
		LEAVE L;	! DONE WITH BUSY LIST
	      END;
	    P _ .P [BUSY];	! NEXT ELEMENT
	  END;			! OF L:  WHILE  TRUE DO

	OLDP _ P _ .TOP;	! START SEARCH FOR RIGHT BROTHER
	WHILE  TRUE
	  DO BEGIN
	    IF .P [POSTDOM] EQL .T
	      THEN BEGIN
		P [POSTDOM] _ .T [POSTDOM];
		RETURN;		! ALL DONE
	      END;
	    OLDP _ .P;		! SAVE THIS ELEMENT
	    P _ .P [POSTDOM];	! NEXT ELEMENT
	    IF .P EQL .OLDP
	      THEN RETURN;	! T NOT ON POSTDOM LIST
	  END;			! OF WHILE  TRUE DO

END;				! OF ROUTINE UNBUSY

SWITCHES  NOSPEC;

!	REDUCE .R + X -> .O BECAUSE .R USE COUNT = 1
!	SET & RETURN HASHP [TEMPER] <- .O CREATED
!	NOTE X MUST BE LEAF SINCE MOVCNST HASHED .R + X FOR .O
!	     .R IS ALWAYS OF TYPE INTEGER
!	     X MUST BE SAME TYPE AS .R SINCE TO HASH .R + X, THERE
!	       CAN BE NO TYPECNV NODE IN BETWEEN + & X

!	CALLED FROM MOVCNST IN GCMNSB

!	IF .R IS REDUCED LOOP VAR
!	  THEN .R INIT IS DOM1 => DOM1 <- DOM1 + X
!		 BUT DOM1 ALWAYS VAR OR CNST NEVER EXPR =>
!		 MAKE .O' <- DOM1 + X STATEMENT BEFORE TOP
!		 & DOM1 <- .O'
!	         IF X = .O'' THEN .O' <- DOM1 + .O'' WILL BE AFTER
!	           .O'' <- E
!	         MUST PUT DOM1 + .O'' INTO HASH TBL FOR GLOBDEP
!	       .R INCR IS DOM3
!	       .R -> .O IN DOSYM => .O CANT MOVE OUTSIDE LOOP SO SET
!	         .O DEFPT <- TOP => SET .O HASHP [STPT] <- TOP
!	       MAKE DOM2 <- DOM2 + X FOR COMPLETENESS
!	  ELSE FIND .R <- Y INIT BETWEEN LENTRY & TOP
!	       FIND .R <- .R + Z INCR BETWEEN HERE & LEND (EASIER TO
!	         START AT TOP THAN TO FIND HERE)
!	       MAKE .R <- Y INTO .O <- Y + X
!	       IF X = .O'' THEN MOVE .O <- Y + .O'' TO AFTER .O'' <- E
!	         => MOVE TO BEFORE TOP SINCE FINDTHESPOT PUT .O'' <- E
!	         INTO TREE AFTER ALL OPTIM CREATED STATEMENTS 
!	         INCLUDING .R <- Y
!		 DON'T BOTHER MOVING IT IF IT'S ALREADY THERE !
!	         MUST PUT Y + .O'' INTO HASH TBL SO GLOBDEP WILL
!	         COMBINE .O'' BACK IN
!	         Y IS ALWAYS A LEAF (SO Y + .O'' CAN BE HASHED) SINCE
!	         Y IS INIT OF .R WHICH COMES FROM DOM1 WHICH IS
!	         ALWAYS A LEAF
!	       MAKE .R <- .R + Z INTO .O <- .O + Z (CANT ASSUME
!	         .R IS 1ST ARG ON RHS)

!	NOTE: DOPRED NOT CURRENT SO MUST SEARCH FOR STATEMENT BEFORE TOP

!	IF EXPR PUT INTO HASH TBL, MUST SET .O [ORFIXFLG] SO MOVCNST
!	  WILL IGNORE ENTRY & GLOBDEP WILL CALL DOTOFIX TO CLEAN UP
!	  POTENTIAL .O COMBINATION

GLOBAL ROUTINE  DOTORFIX  (PB, HASHP)  =

BEGIN

MAP BASE  PB;			! STRAIGHT EXPR .R + X
MAP BASE  HASHP;		! HASH TABLE ENTRY

EXTERNAL  GETOPTEMP, SKERR, MAKPR1, MAKASGN;
EXTERNAL  HASHIT, TBLSRCH, MAKETRY;
EXTERNAL  TOP, LENTRY, LEND;

MAP PEXPRNODE  TOP, LENTRY, LEND;

MACRO	FIXDOTO (O) =
	  BEGIN
	    HASHIT (.O [IDOPTIM], STGHT);	! HASH Y + .O''
	    PHI _ TBLSRCH ();			! LOOK IT UP
	    IF .FLAG
	      THEN SKERR ();			! ALREADY EXISTS
	    PHI _ MAKETRY (.PHI, .O [IDOPTIM], STGHT);	! INTO HASH TBL
	    PHI [TEMPER] _ .O;			! SINCE .O <- Y + .O''
	    PHI [STPT] _ .LENTRY;		! WHERE TO MOVE
	  END$;

LOCAL BASE  DOTR;		! .R SYMTAB ENTRY
LOCAL PEXPRNODE  RINIT;		! .R INITIALIZATION
LOCAL PEXPRNODE  RINITP;	! PRED OF RINIT
LOCAL PEXPRNODE  RINCR;		! .R INCREMENT
LOCAL BASE  DOTO;		! .O CREATED
LOCAL BASE  DOTO2;		! IF X = .O''
LOCAL BASE  TEMP;
LOCAL BASE  PHI;

LABEL  LTOP, LINIT, LINCR, LT1;

	DOTR _ .PB [ARG1PTR];		! CAN ASSUME .R IS 1ST ARG

	DOTO _ GETOPTEMP (INTEGER);	! CREATE .O

	IF .TOP [DOSYM] EQL .DOTR
	  THEN BEGIN			! .R IS REDUCED LOOP VAR
	    TOP [DOSYM] _ .DOTO;
	    HASHP [STPT] _ .TOP;	! CANT MOVE THIS .O OUTSIDE LOOP
	    TEMP _ MAKPR1 (0, ARITHMETIC, ADDOP, INTEGER,
			   .TOP [DOM1], .PB [ARG2PTR]);
	    TEMP [A2FLGS] _ .PB [A2FLGS];
	    TEMP [A1NEGFLG] _ .TOP [INITLNEG];
	    TOP [INITLNEG] _ 0;
	    TOP [DOM1] _ GETOPTEMP (INTEGER);		! .O'

	    RINIT _ .LENTRY;		! FIND STATEMENT BEFORE TOP
LTOP:	    WHILE  TRUE
	      DO BEGIN
		IF .RINIT EQL 0
		  THEN SKERR ();	! MISSED TOP
		IF .RINIT [SRCLINK] EQL .TOP
		  THEN LEAVE LTOP;
		RINIT _ .RINIT [SRCLINK];
	      END;			! OF LTOP:  WHILE  TRUE DO

	    RINIT [SRCLINK] _ MAKASGN (.TOP [DOM1], .TEMP);
	    RINIT _ .RINIT [SRCLINK];	! NEW STATEMENT IS IN TREE
	    RINIT [SRCLINK] _ .TOP;	! LINK TO REST OF TREE
	    TEMP [PARENT] _ .RINIT;	! FIX DOM1 + X EXPR PARENT

	    TOP [DOM2] _ MAKPR1 (.TOP, ARITHMETIC, ADDOP, INTEGER,
				 .TOP [DOM2], .PB [ARG2PTR]);	! COMPLETENESS
	    TOP [INITLTMP] _ 1;		! DOM1 COMES FROM EXPR
	    DOTO [IDOPTIM] _ .TOP [DOM1];

	    DOTO2 _ .TOP [DOM1];
	    DOTO2 [IDOPTIM] _ .TEMP;
	    TEMP _ .PB [ARG2PTR];
	    IF .TEMP [IDDOTO] EQL SIXBIT ".O"
	      THEN BEGIN
		FIXDOTO (DOTO2);
		DOTO2 [ORFIXFLG] _ 1;		! HASHED BY DOTORFIX
	!****	TEMP [EXPRUSE] _ 1;		! THIS 1 USEAGE
	      END;
	  END

	  ELSE BEGIN
	    RINIT _ .LENTRY;
	    RINITP _ .RINIT;
LINIT:	    WHILE  TRUE				! FIND .R <- Y INIT
	      DO BEGIN
	        IF .RINIT EQL .TOP
	          THEN SKERR ();		! .R INIT NOT FOUND
	        IF .RINIT [LHEXP] EQL .DOTR
	          THEN LEAVE LINIT;		! FOUND
		RINITP _ .RINIT;		! NEXT PREDECESSOR
	        RINIT _ .RINIT [SRCLINK];	! NEXT STATEMENT
	      END;			! OF LINIT:  WHILE  TRUE DO

	    RINCR _ .TOP;
LINCR:	    WHILE  TRUE				! FIND .R <- .R + Z INCR
	      DO BEGIN
	        IF .RINCR EQL .LEND
	          THEN SKERR ();		! .R INCR NOT FOUND
	        IF .RINCR [LHEXP] EQL .DOTR
	          THEN LEAVE LINCR;		! FOUND
	        RINCR _ .RINCR [SRCLINK];	! NEXT STATEMENT
	      END;			! OF LINCR:  WHILE  TRUE DO

	    RINIT [LHEXP] _ .DOTO;
	    TEMP _ MAKPR1 (.RINIT, ARITHMETIC, ADDOP, INTEGER,
			   .RINIT [RHEXP], .PB [ARG2PTR]);
	    TEMP [A2FLGS] _ .PB [A2FLGS];
	    RINIT [RHEXP] _ .TEMP;
	    DOTO [IDOPTIM] _ .TEMP;
	    TEMP [A1FLGS] _ .RINIT [A2FLGS];	! MOVE Y FLAGS DOWN
	    CLRA2FLGS (RINIT);

	    TEMP _ .PB [ARG2PTR];
	    IF .TEMP [IDDOTO] EQL SIXBIT ".O"
	      THEN BEGIN
	        !DON'T BOTHER MOVING .R INIT IF IT'S ALREADY IN CORRECT PLACE
		IF .RINIT [SRCLINK] NEQ .TOP
		THEN BEGIN
		TEMP _ .RINIT;
LT1:		WHILE  TRUE		! FIND STATEMENT BEFORE TOP
		  DO BEGIN
		    IF .TEMP EQL 0
		      THEN SKERR ();
		    IF .TEMP [SRCLINK] EQL .TOP
		      THEN LEAVE LT1;
		    TEMP _ .TEMP [SRCLINK];
		  END;			! OF LT1:  WHILE  TRUE DO

		RINITP [SRCLINK] _ .RINIT [SRCLINK];	! UNLINK RINIT
		TEMP [SRCLINK] _ .RINIT;		! LINK BACK IN
		RINIT [SRCLINK] _ .TOP;			! REST OF TREE
		END;

		FIXDOTO (DOTO);
	      END;

	    RINCR [LHEXP] _ .DOTO;
	    TEMP _ .RINCR [RHEXP];
	    IF .TEMP [ARG1PTR] EQL .DOTR
	      THEN TEMP [ARG1PTR] _ .DOTO	! WAS .R + Z
	      ELSE TEMP [ARG2PTR] _ .DOTO;	! WAS Z + .R
	  END;					! OF IF

	HASHP [TEMPER] _ .DOTO;
	HASHP [MOVDCNS] _ 0;		! .O ISNT CONSTANT IN LOOP NOW
	DOTO [ORFIXFLG] _ 1;			! HASHED BY DOTORFIX
	DOTR [IDATTRIBUT (NOALLOC)] _ 1;	! DONT ALLOCATE THIS .R

	RETURN .DOTO;

END;			! OF DOTORFIX


SWITCHES  NOSPEC;

!	IF SUBSUMING .O WHICH CAME FROM .R, FIND .O INCR (=.O + Z) &
!	  CHANGE TO NEW .O
!	IGNORE IF .O BEING SUBSUMED IS DOM1
!	IF SUBSUMEE IS DIFFERENT TYPE THAN SUBSUMER, MUST BUILD TYPECNV
!	  NODE ABOVE .O INCR EXPR (=Z) TO MAKE SUBSUMER GET CORRECT INCR
!	  EXPR (EXCEPT INTEGER <-> INDEX IS NOT NECESSARY) SO USE VALTP2
!	  TO CHECK 1ST 3 BITS OF VALTYPE: MUST CONVERT IF NEQ


!	CALLED FROM GLOBDEP IN GCMNSB


GLOBAL ROUTINE  DOTOFIX  (T, PAE)  =

BEGIN

MAP BASE  T;			! OLD .O TO BE REPLACED
MAP BASE  PAE;			! NEW .O <- EXPR (OLD .O) STATEMENT

EXTERNAL  SKERR, MAKPR1;
EXTERNAL  TOP, LEND;

MAP PEXPRNODE  TOP, LEND;

LOCAL BASE  P;			! TO MARCH DOWN TREE
LOCAL BASE  TEMP;
LOCAL BASE  NEWO;		! NEW .O (THE SUBSUMER)
LOCAL BASE  T1;

	IF .TOP [DOSYM] EQL .T
	  THEN RETURN;

	P _ .PAE;		! START TREE SEARCH
	WHILE  TRUE
	  DO BEGIN
	    IF .P EQL .LEND
	      THEN SKERR ();	! .O INCR NOT FOUND
	    IF .P [LHEXP] EQL .T
	      THEN BEGIN	! FOUND OLD .O (ONLY ONE)
		NEWO _ .PAE [LHEXP];
		!MARK SUBSUMING .O AS COMING FROM .R
		NEWO [ORFIXFLG] _ 1;		! PASS FLAG UP TO SUBSUMER
		P [LHEXP] _ .NEWO;
		TEMP _ .P [RHEXP];
		IF .TEMP [ARG1PTR] EQL .T
		  THEN TEMP [ARG1PTR] _ .NEWO		! WAS .O + Z
		  ELSE BEGIN
		    TEMP [ARG2PTR] _ .NEWO;		! WAS Z + .O
		    SWAPARGS (TEMP);			! MAKE IT .O + Z
		    T1 _ .TEMP [DEFPT1];
		    TEMP [DEFPT1] _ .TEMP [DEFPT2];
		    TEMP [DEFPT2] _ .T1;
		  END;
		!  DO TYPE CONVERSION ONLY IF NECESSARY AND DON'T CLOBBER "PARENT"
		IF .T [VALTP2] NEQ .NEWO [VALTP2]	! CONVERSION NECESSARY ?
		  THEN BEGIN
		    TEMP [VALTYPE] _ .NEWO [VALTYPE];
		    T1 _ MAKPR1 (.TEMP, TYPECNV, .T [VALTYPE],
		                 .NEWO [VALTYPE], 0,
		                 .TEMP [ARG2PTR]);
		    TEMP [ARG2PTR] _ .T1;
		    T1 [A2FLGS] _ .TEMP [A2FLGS];	! MOVE FLAGS DOWN
		    CLRA2FLGS (TEMP);
		  END;
		RETURN;
	      END;
	    P _ .P [SRCLINK];
	  END;			! OF WHILE  TRUE DO

END;				! OF DOTOFIX


SWITCHES NOSPEC;

!	GO THRU SYMBOL TABLE AND ZERO FIELDS USED BY THE OPTIMIZER
!	  EXCEPT FOR THE .O FIELDS
!	CALLED FROM PROPAGATE IN PNROPT (USED TO USE CLEANUP IN GOPT2)

!	.O EXPRUSE FIELD ZEROED IN GLOBDE & ORFIXFLG
!	  & OMOVDCNS FLAGS ZEROED BY ZTREE

GLOBAL ROUTINE  DFCLEANUP  =

BEGIN

	MACRO  IDDOTF = 0,3,24,12$;

!%1245%	Redefine REGSTUFF, IDCHOS, IDUSED, and IDDEF were moved from word 2 to
!%1245%	word 8.  The left half also contains the PSECT info so we can not clear the half word.

%1245%	MACRO  REGSTUFF = 0,8,18,7$;

	INCR  I  FROM 0  TO SSIZ-1
	  DO BEGIN

	  REGISTER BASE  T;

	    T _ .SYMTBL [.I];
	    WHILE  .T NEQ 0
	      DO BEGIN

!		KLUDGE BECAUSE OF STATEMENT FUNCTION OPTIMIZATIONS

		IF .T [IDDOTF] NEQ SIXBIT ".F"
		  THEN BEGIN
		    IF .T [IDDOTF] NEQ SIXBIT ".O"
		      THEN T [REGSTUFF] _ 0;

!		    IF THIS IS A FORMAL ARRAY THE PSEUDO ENTRY
!		      MUST ALSO BE ZERO IF NOT ADJUSTABLY DIMENSIONED

		    IF .T [OPERSP] EQL FORMLARRAY
		      THEN BEGIN

		    REGISTER BASE  ET;

			ET _ .T [IDDIM];
			IF NOT .ET [ADJDIMFLG]
			  THEN BEGIN
			    ET _ .ET [ARADDRVAR];

!			    THIS PSEUDO ENTRY IS POINTED TO BY THE
!			      ARADDRVAR FIELD OF THE DIM TABLE ENTRY

			    ET [REGSTUFF] _ 0;
			  END;
		      END;	! SPECIAL STUFF FOR FORMAL ARRAYS
		  END;		! SFN KLUDGE
		T _ .T [CLINK];
	      END;		! WHILE .T NEQ 0
	  END;			! INCR I

END;				! OF DFCLEANUP

END	    		! END OF MODULE VER5
ELUDOM