! File:   FLOWAN.BLI
!
Module FLOWAN=
Begin
!			FLOWAN MODULE
!			-------------
!
!	THE FUNCTION OF THIS MODULE IS TO PERFORM GLOBAL FLOW ANALYSIS.
!	IT PERFORMS COMMON-SUB-EXPRESSION RECOGNITION AND FINDS FEASIBLE
!	CODE MOTION OPTIMIZATIONS.
!
!
Require 'Bliss';

Global
	FLOOR		: LVL;

Own
	hdr_alpha	: Ref GT,
	hdr_omega	: Ref GT,
	hdr_psi		: Ref GT,
	hdr_chi		: Ref GT,
	hdr_rho		: Ref GT,
	FOUNDATION	: Ref Vector,
	CEILING		: LVL,
	LVLCOPY		: LVL,
	hdr_bogus	: LVL,
	hdr_prolog	: LVL,
	hdr_mu		: LVL,
	hdr_postlog	: LVL,
	hdr_epilog	: LVL,
	hdr_kill	: Ref ITEM,
	ABCBASE		: LVL;

External Routine
	DELETETOMARK	: Novalue;

Forward Routine
	ABCBETW,
	BINDPCSTHREAD	: Novalue,
	ENTVCHGLST	: Novalue,
	ENTVUSELST	: Novalue,
	GCSEFROMPSI	: Novalue,
	GENPRLG		: Novalue,
	GENPSI		: Novalue,
	SEARCHFORKILLS,
	WISCHUSED;

! PUSHLV and POPLV implement variable length stacks
! for LVLCOPY, FLOOR, CEILING, ABCBASE, hdr_prolog, etc.

Macro
	PUSHLV(L,N) =
		Begin
		Bind Q = L : LVL;
		Local ZQ14 : Ref LVL;
		ZQ14 = GETSPACE(N);
		ZQ14[stk_next] = .Q[stk_next];
		ZQ14[stk_data] = .Q[stk_data];
		Q[stk_next] = .ZQ14
		End %,
	POPLV(L,N) =
		Begin
		Bind Q = L : LVL;
		Local ZQ13 : Ref LVL;
		ZQ13 = .Q[stk_next];
		Q[stk_next] = .ZQ13[stk_next];
		Q[stk_data] = .ZQ13[stk_data];
		RELEASESPACE(.ZQ13,N)
		End %,
	FORALLRATORS(I) =
		Decr I From MAXOPERATOR To 0 Do  %,
	FORALLRANDS(I,J) =
		Decr I From J[gt_argc]-1 To 0 Do  %;


! GLOBAL FLOW ANALYSIS ROUTINES
! ------------------------------

!
! CALLED BY DOMODULE
! PERFORMS INITIALIZATION OF DATA USED BY FLOWAN
!
Global Routine FLOWINIT : Novalue =
Begin
    FLOOR[stk_data]      = 0;
    FLOOR[stk_next]      = 0;
    FOUNDATION           = 0;
    LEVEL                = 1;
    LEVELINC             = 1;
    CEILING[stk_data]    = 1;
    CEILING[stk_next]    = 0;
    LVLCOPY[stk_data]    = 1;
    LVLCOPY[stk_next]    = 0;
    ABCOUNT              = 1;
    ABCBASE[stk_data]    = 1;
    ABCBASE[stk_next]    = 0;
    hdr_bogus[stk_data]  = MAKHDR(BOGREMOVE,BOGENTER);
    hdr_prolog[stk_data] = MAKHDR(PRLGREMOVE,PRLGENTER);
    hdr_kill             = MAKHDR(KILREMOVE,KILENTER);
    CLEARCORE(GTHASH,MAXDELIMITER+2)
End;

! CALLED FROM:   ENRHO, NONBOGUS (RECURSIVE), FIND NAME, MARK DOT NODES,
!		 MARK UP, MARK ALL, GALOMBITS, OMEG DECR, OMEGHEADECR, F11.
!
! ARGUMENT: A GT NODE
!
! VALUE: A GT NODE FORMALLY IDENTICAL TO THE FIRST, BUT WHICH IS
!	 NOT A 'BOGUS' NODE.
!
! PURPOSE:	'BOGUS' NODES HAVE NO OPERANDS; THEREFORE, ANY ROUTINE
!		WHICH NEEDS TO SEE THE OPERANDS OF A NODE MUST (USUALLY)
!		CALL THIS ROUTINE.
!
! notes:
!	bogus nodes are created by GCSEFROMPSI.  They are much
!	like alpha/omega lists in characteristic.  they represent
!	CSE's which are common to all branches of a forked expressions
!	(IF and CASE).  these CSE's are still valid outside the
!	forked expression but may not be moved outside it due to
!	essential ordering constraints.
!
!	a bogus node represents a 'potential' CSE.  if it is
!	never referenced outside the fork then it behaves as if
!	nothing is common between the forks.

Global Routine NONBOGUS(NODE : Ref GT) =
Begin

! loop while bogus (can a bogus point to a bogus?)

    While .NODE[gt_v_bogus] Do

! if the bogus node has had its potential CSE list bound

	If .NODE[gt_csthread] Neqa 0 Then
	    NODE = .NODE[gt_csthread]
	Else

! the potential CSE list has not been bound

	    NODE = .NODE[gt_pcsthread];
    Return .NODE
End;

! PUSHES LISTS FLOOR OR CEILING AND SIMULTANEOUSLY LEVEL

Global Routine PUSHANDBUMP(Z : Ref LVL) : Novalue =
Begin
    LVLCOPY[stk_data] = .LEVEL;
    PUSHLV(LVLCOPY,SZ_LVL);
    PUSHLV(.Z,SZ_LVL);
    LEVEL = .LEVEL + .LEVELINC;
    Z[stk_data] = .LEVEL
End;

! POPS LIST FLOOR OR CEILING AND SIMULTANEOUSLY LEVEL

Global Routine POPANDDUMP(Z : Ref LVL) : Novalue =
Begin
    POPLV(.Z,SZ_LVL);
    POPLV(LVLCOPY,SZ_LVL);
    LEVEL = .LVLCOPY[stk_data]
End;

! CALLED BY: SLABEL, SFLABEL (IN SYNTAX)
! ARGUMENT:  SYMBOL TABLE ENTRY FOR A LABEL
! CALLED WHEN: SYNTAX PROCESSING FOR THE LABELED EXPRESSION
!		IS ABOUT TO BEGIN

Global Routine NOTELEVEL(S : Ref ST) : Novalue =
Begin
    S[st_lab_inc]   = .LEVELINC;
    S[st_lab_level] = .LEVEL;
    LEVELINC = .LEVELINC * 2
End;

! CALLED BY: F24
! ARGUMENTS: A STACK (EITHER LVLCOPY OR CEILING) 'STACK'
!	     THE INFORMATION SAVED BY NOTELEVEL IN SOME LABEL ('LABLEVEL','INC')
! CALLED WHEN: THE FIRST 'LEAVE' TO SOME LABEL IS ENCOUNTERED
! PURPOSE: FOLLOW DOWN THE STACK INCREMENTING VALUES BY 'INC'
!	   UNTIL A VALUE LESS THAN 'LABLEVEL' IS FOUND

Routine NOTELEAVE(STACK : Ref LVL,LABLEVEL : Integer,INC : Integer) : Novalue =
Begin
    Local
	s	: Ref LVL;

! when a LEAVE/EXITLOOP occurs, any CSE's discovered after the LEAVE/EXITLOOP
! must NOT be allowed to be placed in the alpha or omega lists.  This is
! because the CSE's may not be reached and thus not valid.  The invalidation
! is performed by raising level and ceiling between the level of the
! label and the current level.  The raised level will cause those CSE's
! to be purged.

    S = .STACK;
    Until .S Eqla 0 Or .S[stk_data] Lss .LABLEVEL Do
	Begin
	S[stk_data] = .S[stk_data]+.INC;
	S = .S[stk_next]
	End
End;

! CALLED FROM:   F1, F8, F10, F12
! CALLED WHEN:   ON ENTRY TO EACH LINEAR BLOCK.
! PURPOSE:	CREATE NEW PROLOG LIST & SAVE OLD; DITTO WITH ABCBASE

Routine PUSHFLO : Novalue =
Begin
    PUSHLV(ABCBASE,SZ_LVL);
    ABCBASE[stk_data] = .ABCOUNT;
    ABCOUNT = .ABCOUNT + 1;
    PUSHLV(hdr_prolog,SZ_LVL);
    hdr_prolog[stk_data] = MAKHDR(PRLGREMOVE,PRLGENTER)
End;

! CALLED FROM:   F4, F13, F16, F17, F18
! CALLED WHEN:   ON EXIT FROM EACH LINEAR BLOCK.
! PURPOSE:	POP WHAT PUSHFLO PUSHED.

Routine POPFLO : Novalue =
Begin
    POPLV(hdr_prolog,SZ_LVL);
    POPLV(ABCBASE,SZ_LVL)
End;

! CALLED FROM:   FIND NAME (RECURSIVE), MARK DOT NODES, GALOMBITS,
!		 ENTVUSELST, ENTVCHGLST, WISCHUSED, F11.
! ARGUMENT: A LEXEME
! VALUE:  IF THE LEXEME "LOOKS LIKE" AN UNDOTTED SYMBOL TABLE ENTRY,
!	  A POINTER TO THE SYMBOL TABLE ENTRY; OTHERWISE 0.
!	NOTE THAT IF THE LEXEME IS THE SYMBOL TABLE ENTRY FOR "A+4",
!	A POINTER TO THE STE FOR "A" IS RETURNED.

Routine FINDNAME(LEX : Ref GT) =
Begin
    Local
	L1		: Ref GT,
	L2		: Ref GT;

! Q: how can a non-address type symbol get here?

    If .LEX[gt_type] Eql T_VARIABLE Then
	LEX = .LEX[gt_disp];
    If .LEX[gt_type] Eql T_SYMBOL Then 
	If .LEX[st_code] Leq HIGHADDTYPE And .LEX[st_v_namexp] Then
	    Return .LEX[st_var_base]
	Else
	    Return .LEX;

! if a literal

    If .LEX[gt_type] Neq T_NODE Then
	Return 0;
    L1 = .LEX;
    Selectone .L1[gt_code] Of Set
	[OP_STORE]:

! see if it looks like it is taking the address of a name

	    Return FINDNAME(.L1[gt_arg2]);	! RHS of '='
	[OP_POINTER]:
	    Return FINDNAME(.L1[gt_arg1]);
	[OP_IF]:

! if both sides of a fork are the same name then return that name
!
! Q: why not do OP_CASE also in the same fashion?

	    Begin
	    L2 = FINDNAME(.L1[gt_arg3]);
	    If .L2 Eql FINDNAME(.L1[gt_arg4]) Then
		Return .L2
	    Else
		Return 0
	    End;
	[OP_COMPOUND]:

! compound statements are transparent

	    Return FINDNAME(.L1[gt_argv(.L1[gt_argc]-1)]);
	[OP_FPARM]:

! see if it looks like it is passing the address of a name in a call

	    Return FINDNAME(.L1[gt_arg1]);
	[OP_DOT]:
	    Return 0
    Tes;
    If .L1[gt_code] Gtr MAXOPERATOR Then
	Return 0;

! for operators, examine all the operands for a name.
!
! Q: what sense does it make to examine something like a '*'
!    operator for a name?  only '+' and '-' seem to make sense
!    and could be bogus in cases like 'A = .Max(B,C)'.

    L1 = NONBOGUS(.L1);
    FORALLRANDS(I,.L1)
	Begin
	L2 = FINDNAME(.L1[gt_argv(.I)]);
	If .L2 Neqa 0 Then
	    Return .L2
	End;
    Return 0
End;

Forward Routine
	MARKALL	: Novalue;

! CALLED FROM:   MARK DOT NODES, MARK ALL, F11
! PURPOSE:	SET 'MUST MARK' BIT OF A NODE, AND ADJUST ITS MARK LEVEL.


Macro MRK(L)=
		Begin

! if not purged

		If Not .L[gt_v_purge] And Not .L[gt_v_rm] Then

! if already marked then note the highest level

		    If .L[gt_v_mm] Then
			Begin
			If .L[gt_mklevel] Gtr .LEVEL Then
			    L[gt_mklevel] = .LEVEL
			End

! first time marked.  note the level

		    Else
			Begin
			L[gt_v_mm] = TRUE;
			L[gt_mklevel] = .LEVEL
			End
		End %;


! CALLED FROM:   FIND NO POI (RECURSIVE), FIND ANY OCCUR, MARK DOT NODES
! PURPOSE:	GIVEN E<P,S>, RETURNS E
!		GIVEN ANY OTHER LEXEME, RETURNS LEXEME ITSELF

Routine FINDNOPOI(NODE : Ref GT) =
Begin
    While .NODE[gt_type] Eql T_NODE And .NODE[gt_code] Eql OP_POINTER Do
	NODE = .NODE[gt_arg1];
    Return .NODE
End;

! CALLED FROM:   MARK DOT NODES
! FUNCTION:
!	PREDICATE INDICATING THAT L AND LEX ARE "APPROXIMATELY"
!	FORMALLY IDENTICAL. "APPROXIMATE" MEANS THAT WE MAY FIRST
!	HAVE TO STRIP <P,S> OFF OF LEX.
!
! note: 'L' has already had a 'FINDNOPOI' done to it.

Routine FINDANYOCCUR(L : Ref GT,NODE : Ref GT) =
Begin
    If .NODE Eql .L Then
	Return TRUE;
    NODE = FINDNOPOI(.NODE);
    If .NODE[gt_type] Neq T_NODE Then
	Return FALSE;
    If .L[gt_fparent] Eql .NODE[gt_fparent] Then
	Return TRUE;
    Return FALSE
End;

!
!   CALLED FROM:   GENGT (IN SYNTAX), F11
!   PURPOSE:
!	IF 'X = ' OCCURS, OR X APPEARS UNDOTTED AS A ROUTINE CALL
!	PARAMETER, MARK ALL '.X' NODES.
!
Global Routine MRKDOTNODES(LEX : Ref GT) : Novalue =
Begin
    Local
	L		: Ref GT,
	LFP		: Ref GT,
	M		: Ref GT,
	Q		: Ref ST,
	LLEX		: Ref GT;

! if quick then CSE's are not recognized.

    If .swit_quick Then
	Return;

! see if the dot of a name

    L = .GTHASH[OP_DOT];
    LLEX = FINDNAME(.LEX);

! if not a dotted variable

    If .LLEX Eqla 0 Then
	Begin

! if we should set the must mark of everything because of parnoid mode.

	If .swit_mark Then
	    Begin
	    MARKALL(FALSE);
	    Return
	    End;

! if a dotted literal

	LEX = FINDNOPOI(.LEX);
	If .LEX[gt_type] Eql T_LITERAL Then

! search for dotted references to the same literal and set must marks

	    While .L Neq 0 Do
		Begin
		M = NONBOGUS(.L);
		If FINDNOPOI(.M[gt_arg1]) Eql .LEX Then
		    Begin
		    LFP = .L[gt_fparent];
		    Do
			MRK(LFP)
		    While (LFP = .LFP[gt_fsthread]) Neq 0
		    End;
		L = .L[gt_gthread]
		End
	Else

! search for dotted references to similar expressions

	    While .L Neq 0 Do
		Begin
		M = NONBOGUS(.L);
		If FINDANYOCCUR(.LEX,.M[gt_arg1]) Then
		    Begin
		    LFP = .L[gt_fparent];
		    Do
			MRK(LFP)
		    While (LFP = .LFP[gt_fsthread]) Neq 0
		    End;
		L = .L[gt_gthread]
		End;
	Return
	End;

! a dotted variable.  look for dotted variables similar to this
! and expressions when this is not a register and the mark flag
! is set.

    Do
	Begin
	While .L Neq 0 Do
	    Begin
	    M = NONBOGUS(.L);
	    Q = FINDNAME(.M[gt_arg1]);
	    If .Q Eql .LLEX Then
		Begin
		LFP = .L;
		Exitloop
		End;
	    If .Q Eqla 0 Then
		If .swit_mark And (.LLEX[st_code] Neq S_REGISTER) Then
		    Begin
		    LFP = .L;
		    Exitloop
		    End;
	    L = .L[gt_gthread]
	    End;
	If .L Eql 0 Then
	    Return;
	Do
	    MRK(LFP)
	While (LFP = .LFP[gt_fsthread]) Neq 0
	End
    While (L = .L[gt_gthread]) Neq 0
End;

! PROPAGATES THE MARK-BITS UP FROM L'S DESCENDANTS TO L.
! CALLED FROM MARKMMNODES.

Routine MARKUP(NODE : Ref GT) =
Begin
    Local
	MARKED		: Boolean,
	Q		: Ref GT,
	L		: Ref GT;

! only expressions may be marked

    If .NODE[gt_type] Neq T_NODE Then
	Return FALSE;

! return if already marked

    L = .NODE[gt_csparent];
    If .L[gt_v_rm] Then
	Return TRUE;

! if a must-mark node then mark it and return.  the mark level was
! noted when the MM bit was set

    Q = NONBOGUS(.L);
    If .L[gt_v_mm] Then
	Begin
	Q[gt_v_rm] = TRUE;
	Q[gt_v_mm] = FALSE;
	L[gt_v_rm] = TRUE;
	L[gt_v_mm] = FALSE;
	Return TRUE
	End;

! try to mark any children

    MARKED = FALSE;
    FORALLRANDS(I,.Q)
	MARKED = .MARKED Or MARKUP(.Q[gt_argv(.I)]);

! if any children were marked then mark this one as well
! and also note the level it was marked at

    If .MARKED Then
	Begin
	If Not .L[gt_v_purge] Then
	    Q[gt_mklevel] = L[gt_mklevel] = .LEVEL;
	Q[gt_v_rm] = TRUE;
	L[gt_v_rm] = TRUE
	End;
    Return .MARKED
End;

! CALLED FROM:   F4, F5, F7, F9, F15, F17, F19, F23, SCOMPOUND
! CALLED WHEN:   SIDE EFFECTS MUST BE ACCOUNTED FOR, E.G. AT
!		 EVERY SEMICOLON IN A COMPOUND STATEMENT
! PURPOSE: SET 'REAL MARK' BITS IN ALL NODES WHOSE 'MUST MARK' BITS ARE ON.
!
! notes:
!	see page 39 of "The Design of an Optimizing Compiler".

Global Routine MARKMMNODES : Novalue =
Begin
    Local
	L		: Ref GT,
	LFP		: Ref GT;

    ABCOUNT = .ABCOUNT + 1;

! if no optimize then just mark everything

    If Not .swit_optimize Then
	MARKALL(TRUE);

! return if no CSE recognition

    If .swit_quick Then
	Return;

! loop for each CSE parent, setting the real mark of those with
! the must mark set

    FORALLRATORS(I)
	Begin
	LFP = .GTHASH[.I];
	While .LFP Neqa 0 Do
	    Begin
	    L = .LFP;
	    Do
		MARKUP(.L)
	    While (L = .L[gt_fsthread]) Neqa 0;
	    LFP = .LFP[gt_gthread]
	    End
	End
End;

!
!     CALLED FROM   MARK DOT NODES, MARK MM NODES, F3, F21
!     MARK ALL NODES ON THE DOT CHAIN.
!     IF 'MRKREGS' ISN'T SET, DON'T MARK '.R' IF R IS A REGISTER VARIABLE.
!
Routine MARKALL(MRKREGS : Boolean) : Novalue =
Begin
    Local
	L		: Ref GT,
	LFP		: Ref GT,
	M		: Ref GT;

! return if no CSE recognition

    If .swit_quick Then
	Return;

! loop for each CSE parent, setting the must mark of everything but
! dotted registers (unless we want dotted registers as well)

    LFP = .GTHASH[OP_DOT];
    While .LFP Neqa 0 Do
	Begin
	L = .LFP;
	M = NONBOGUS(.L);
	M = .M[gt_arg1];
	If .MRKREGS Or .M[gt_type] Neq T_VARIABLE Or .M[st_code] Neq S_REGISTER Then
	    Do
		MRK(L)
	    While (L = .L[gt_fsthread]) Neqa 0;
	LFP = .LFP[gt_gthread]
	End;
End;

! CALLED FROM:   F6, F7, F14, F25
! CALLED WHEN:   AFTER PARSING ANY EXPRESSION WHOSE EXECUTION WILL BE
!		 OPTIONAL, E.G. AFTER EACH BRANCH OF A FORK, OR AFTER
!		 "DO" EXPRESSION OF A WHILE-DO, DO-WHILE, OR INCR LOOP.
! PURPOSE:	SET THE 'PURGEBIT' OF THAT EXPRESSION
!		AND ALL ITS SUBEXPRESSIONS.
! ASSUMES:     PUSHANDBUMP(CEILING) WAS EXECUTED BEFORE PARSING EXPRESSION,
!	       BUT MATCHING POPANDDUMP(CEILING) HAS NOT YET BEEN EXECUTED.
!
! notes:
!	see page 39 of "The Design of an Optimizing Compiler".

Routine PURGE : Novalue =
Begin
    Local
	LFP		: Ref GT,
	LCSP		: Ref GT,
	C		: Integer;

! return if no CSE recognition

    If .swit_quick Then
	Return;

! loop for each CSE parent

    C = .CEILING[stk_data]-.LEVELINC;
    FORALLRATORS(I)
	Begin
	LFP = .GTHASH[.I];
	While .LFP Neqa 0 Do
	    Begin
	    LCSP = .LFP;
	    Do

! if created above the ceiling and not already purged

		If .LCSP[gt_crlevel] Gtr .C And Not .LCSP[gt_v_purge] Then
		    Begin
		    LCSP[gt_v_purge] = TRUE;
		    LCSP[gt_mklevel] = 0
		    End
	    While (LCSP = .LCSP[gt_fsthread]) Neqa 0;
	    LFP = .LFP[gt_gthread]
	    End
	End
End;

! CALLED FROM:   F4
! CALLED WHEN:   AFTER EACH BRANCH OF A FORK
! PURPOSE:
!	FOR EVERY NODE THAT WAS VALID BEFORE THE BRANCH BUT WAS
!	INVALIDATED DURING IT, TURN OFF THE NODE'S 'REAL MARK' BIT,
!	BUT TURN ON ITS 'JOIN MARK' BIT TO 'REMEMBER' THE RM BIT.
!
! notes:
!	see page 39 of "The Design of an Optimizing Compiler".
!

Routine REFRESH : Novalue =
Begin
    Local
	L		: Ref GT,
	LFP		: Ref GT,
	C		: Integer;

! purge anything created above the ceiling

    PURGE();

    If .swit_quick Then
	Return;

! loop for all CSE parents

    C = .CEILING[stk_data]-.LEVELINC;
    FORALLRATORS(I)
	Begin
	LFP = .GTHASH[.I];
	While .LFP Neqa 0 Do
	    Begin
	    L = .LFP;
	    Do

! if marked above the ceiling and either a real or must mark then
! set the join mark and reset MM and RM

		If .L[gt_mklevel] Gtr .C And (.L[gt_v_rm] Or .L[gt_v_mm]) Then
		    Begin
		    L[gt_v_jm] = TRUE;
		    L[gt_v_rm] = FALSE;
		    L[gt_v_mm] = FALSE
		    End
	    While (L = .L[gt_fsthread]) Neqa 0;
	    LFP = .LFP[gt_gthread]
	    End
	End
End;

! CALLED FROM:   F5, F6, F7, F14
! CALLED WHEN:   AFTER ALL BRANCHES OF A FORK
! PURPOSE:	INVALIDATE ANY NODE WHICH WAS INVALIDATED ON SOME BRANCH
!		BUT RE-VALIDATED BY 'REFRESH'.

Routine MARKUPDATE : Novalue =
Begin
    Local
	L		: Ref GT,
	LFP		: Ref GT,
	C		: Integer;

    If .swit_quick Then
	Return;

! loop for each CSE parent

    C = .CEILING[stk_data]-.LEVELINC;
    FORALLRATORS(I)
	Begin
	LFP = .GTHASH[.I];
	While .LFP Neqa 0 Do
	    Begin
	    L = .LFP;
	    Do

! if marked above the ceiling then set the must-mark if a join mark
! was set and update the mark level

		If .L[gt_mklevel] Gtr .C Then
		    Begin
		    Local Q : Ref LVL;

		    Q = .CEILING[stk_next];
		    If .L[gt_v_jm] Then
			L[gt_v_mm] = TRUE;
		    L[gt_mklevel] = .Q[stk_data]
		    End
	    While (L = .L[gt_fsthread]) Neqa 0;
	    LFP = .LFP[gt_gthread]
	    End
	End
End;

!
! CALLED FROM:   F2, F3, F11, F24
! PURPOSE:	PUT AN ENTRY ON THE KILL LIST WITH FIELDS SET TO:
!		  KCAUSE  -  .GTINDEX
!		  KTYPE   -  .TYPE
!		  KABC    -  .ABCOUNT
!
Routine KILL(TYPE,GTINDEX : Ref GT) : Novalue =
Begin
    ENLST(.hdr_kill,MAKITEM(.ABCOUNT^48 + .TYPE^32 + .GTINDEX))
End;

Macro
	WASUSED(NODEPTR)	= WISCHUSED(0,     0,NODEPTR) %,
	ISUSED(ZORONE,NODEPTR)	= WISCHUSED(ZORONE,1,NODEPTR) %,
	WASCHGED(NODEPTR)	= WISCHUSED(0,     2,NODEPTR) %,
	ISCHGED(ZORONE,NODEPTR)	= WISCHUSED(ZORONE,3,NODEPTR) %;


! CALLED WHEN A BOGUS NODE (INITNODE) IS RECOGNIZED AS A C-S-E
! TO SEQUENCE DOWN THE PCSTHREAD FROM INITNODE:
!	(1) TOTALLING OCCURRENCE COUNTS
!	(2) THREADING VIA CSTHREAD ALL C-S-E'S OFF INITNODE
!	(3) SETTING EACH CSPARENT FIELD TO POINT TO BOGUS NODE

Global Routine BINDPCSTHREAD(INITNODE : Ref GT) : Novalue =
Begin
    Local
	NODE		: Ref GT,
	L		: Ref GT,
	VAL		: Integer,
	COUNT		: Integer;

    VAL   = 0;
    COUNT = 0;
    NODE  = .INITNODE;

! bogus nodes may not be unlinked by DELAY.
!
! Q: why?

    INITNODE[gt_v_dont_unlink] = TRUE;

! loop over each node in the 'potential' CSE chain attached to the bogus node.

    While (NODE = .NODE[gt_pcsthread]) Neqa 0 Do
	Begin
	If .NODE[gt_v_csp] Then
	    Begin

! the first node will become the true CSE parent

	    If .COUNT Eql 0 Then
		COUNT = -1

! all others become children if it.
!
! Q: I don't think this is a true CSE because each branch of a fork must
!    evaluate its own instance (it would have been alpha or omega moved
!    otherwise).  why is the occurence count decremented and won't that
!    cause havoc later on?

	    Else
		DECROCC(.NODE);

! set to not unlink.  this disables some optimizations in delay but is
! used to make sure that delay does not transform the expression.

	    NODE[gt_v_dont_unlink] = TRUE;

! accumulate total occurences.

	    VAL = .VAL + .NODE[gt_occ];

! find the location on the bogus node's CSE chain for this one

	    L = .INITNODE;
	    Until .L[gt_csthread] Eqla 0 Do
		L = .L[gt_csthread];
	    L[gt_csthread] = .NODE;

! if not the formal parent then move it after the bogus node on the formal
! parent list.

	    If Not .NODE[gt_v_fp] Then
		Begin
		L = .INITNODE[gt_fparent];
		Until .L[gt_fsthread] Eqla .NODE Do
		    L = .L[gt_fsthread];
		L[gt_fsthread] = .NODE[gt_fsthread];
		NODE[gt_fsthread] = 0;
		End;
	    NODE[gt_v_csp] = FALSE
	    End
	End;

! make the bogus node the CSE parent of all

    L = .INITNODE[gt_csthread];
    Until .L Eqla 0 Do
	Begin
	L[gt_csparent]  = .INITNODE;
	L[gt_pcsthread] = 0;
	L = .L[gt_csthread]
	End;

! bogus node is no longer the header of a potential CSE chain

    INITNODE[gt_pcsthread]  = 0;
    INITNODE[gt_end_of_pcs] = 0;
    INITNODE[gt_occ]        = .VAL
End;

! CALLED FROM:   GENPSLGBITS
! CALLED TO TURN OFF THE PSLG-BITS OF ALL COMP-EXPS IN SEQUENCE
! BELOW (AND INCLUDING) NODELEX WHEN NODELEX IS DISCOVERED TO BE
! AN "ESSENTIAL CONSTITUENT" OF ITS ANCESTOR.  E.G.: A = (F();X = .Y)
! TURNS OFF PSLG BIT OF "X = .Y" AND OF ENCLOSING COMPOUND EXPRESSION.
!
! notes:
!	due to the structure of LEXSYM and FLO being in the same
!	phase, FLOWAN cannot determine whether all essential
!	constituents.  e.g., for:
!
!		IF .A THEN B ELSE C
!
!	it has to assume that B and C are both essential because
!	it does not know whether the value of the IF statement is
!	used or is discarded.

Routine TURNOFFPSLG(NODE : Ref GT) : Novalue =
Begin

! only works for expression nodes

    If .NODE[gt_type] Neq T_NODE Then
	Return;

! descend for each compound expression

    While .NODE[gt_code] Eql OP_COMPOUND Do
	Begin

! turn off postlog bit and descend

	NODE[gt_v_postlog] = FALSE;
	NODE = .NODE[gt_argv(.NODE[gt_argc]-1)];
	If .NODE[gt_type] Neq T_NODE Then
	    Exitloop
	End;
    If .NODE[gt_type] Eql T_NODE Then
	NODE[gt_v_postlog] = FALSE
End;

! CALLED FROM GENALPHA, GALPHATOPRLG, GCHITOPRLG, AND GOMEGATOPSLG
! FUNCTION:
!	PREDICATE INDICATING THAT 'NODELEX' HAS AN ESSENTIAL
!	PREDECESSOR (SUCCESSOR) IN THE RANGE [LO,HI].
!
! notes:
!	see page 29 of "The Design of an Optimizing Compiler".
!
!	this routine tests for pro-dominators/epi-dominators

Routine GALOMBITS(HI : Integer,LO : Integer,NODE : Ref GT) =
Begin
    Local
	LEX		: Ref ST;

! literals and addresses may always be put on the alpha/omega lists

    If .NODE[gt_type] Neq T_NODE Then
	Return TRUE;

! fake CSE nodes are created by FAKECSE in SYNTAX and act as placeholders
! for bind expressions.

    If .NODE[gt_code] Eql OP_FAKE_CSE Then
	NODE = .NODE[gt_csparent];

! make sure its not bogus because we are accessing the operands

    NODE = NONBOGUS(.NODE);

! if any operand may not be placed on the alpha/omega list then
! this node may not

    FORALLRANDS(I,.NODE)
	Begin
	If Not GALOMBITS(.HI,.LO,.NODE[gt_argv(.I)]) Then
	    Return FALSE
	End;

! a '.' operator may not be moved if:
!
!	- the dotting of an expression
!
!	- there is a kill entry which kills this access in the range
!
!	- there is a store entry for the variable in the range

    If .NODE[gt_code] Eql OP_DOT Then
	Begin
	LEX = FINDNAME(.NODE[gt_arg1]);
	If .LEX Eqla 0 Then
	    Return FALSE;		! SEE NOTE, BELOW
	If SEARCHFORKILLS(.LEX,.HI,.LO,1) Then
	    Return FALSE;
	If ABCBETW(.HI,.LO,.LEX[st_var_chg_list]) Then
	    Return FALSE
	End

! a '=' operator may not be moved if:
!
!	- the storing into an expression
!
!	- there is a kill entry which kills a store in this range
!
!	- there is a fetch entry for the variable in the range

    Else If .NODE[gt_code] Eql OP_STORE Then
	Begin
	LEX = FINDNAME(.NODE[gt_arg1]);
	If .LEX Eqla 0 Then
	    Return FALSE;		! SEE NOTE, BELOW
	If SEARCHFORKILLS(.LEX,.HI,.LO,0) Then
	    Return FALSE;
	If ABCBETW(.HI,.LO,.LEX[st_var_use_list]) Then
	    Return FALSE
	End;

! IN THE TWO CASES ABOVE, IT WOULD BE UNWISE TO SUBSTITUTE
! " ... THEN RETURN (NOT .MRKFLG);" FOR " ... THEN RETURN 0;".
! THE Q SWITCH TELLS THE COMPILER WHETHER  "A = " HAS ANY EFFECT
! ON ".(.B+.C)"; BUT REGARDLESS OF WHETHER THE Q SWITCH IS ON,
! "(.B+.C) = " HAS AN EFFECT ON ".(.B+.C)" .  SO WE DON'T WANT
! TO INDICATE, BY RETURNING 1 AT EITHER OF THE ABOVE POINTS,
! THAT THE CODE FOR .(.B+.C) CAN BE MOVED FORWARD OVER THE CODE
! FOR (.B+.C) =  .

! node is ok to be placed on an alpha/omega list

    Return TRUE
End;

! EXAMINES AN OMEGA LIST FOR ENTRIES WHICH CAN BE ENTERED IN THE
! POSTLOG SET OF THE ENCLOSING LINEAR BLOCK
!
! notes:
!	see page 42 of "The Design of an Optimizing Compiler".

Routine GOMEGATOPSLG(HDR : Ref LSTHDR,LO : Integer) : Novalue =
Begin
    Local
	L		: Ref ITEM;

! loop for each omega list entry

    L = .HDR;
    While (L = .L[itm_rlink]) Neqa .HDR Do
	Begin

! if the entry is not killed between here and abcount then move it
! to the postlog list

	If GALOMBITS(.ABCOUNT,.LO,.L[itm_int_ldata(1)]) Then ! 2
	    ENLST(.hdr_postlog[stk_data],MAKITEM(.L[itm_int_data(1)]))
	End

! % 1 % HAD TO BE REPLACED BY % 2 %, UNFORTUNATELY.  THE PROBLEM IS
! THAT, IN A LIST ENTRY, THE 'ITEMFPARENT' AND 'ABCVAL' FIELDS ARE IN
! THE SAME PLACE.  GENOMEGA FILLS THE LATTER, ZONKING THE FORMER, AND
! SINCE THIS ROUTINE DOESN'T GET CALLED TILL AFTER GENOMEGA, THE
! 'ITEMFPARENT' FIELD HAS TO BE CONSIDERED INVALID.  THE SOLUTION TO
! THE PROBLEM IS THAT AN OMEGA LIST ENTRY IS MADE UP OF SEVERAL POSTLOG
! LIST ENTRIES, EACH OF WHICH HAS ITS OWN 'ITEMFPARENT' FIELD, AND
! ALL THESE FORMAL PARENTS ARE THE SAME AS THE FORMAL PARENT OF THE
! WHOLE OMEGA LIST ENTRY.

End;

! EXAMINES AN ALPHA LIST FOR ENTRIES WHICH CAN BE ENTERED IN THE
! PROLOG SET OF THE ENCLOSING LINEAR BLOCK

Routine GALPHATOPRLG(HDR : Ref LSTHDR,HI : Integer) : Novalue =
Begin
    Local
	L		: Ref ITEM,
	FPAR		: Ref GT;

! loop for each alpha list entry

    L = .hdr;
    While (L = .L[itm_rlink]) Neqa .hdr Do
	Begin

! if the entry is not killed in the range of the start of this block
! to here then add it to the prolog list.  Note:  the alpha list
! entry rather than the node is question is added.

	FPAR = .L[itm_fparent];
	If GALOMBITS(.HI,.ABCBASE[stk_data],.FPAR) Then
	    ENLST(.hdr_prolog[stk_data],MAKITEM(.FPAR^32 + 1 + .L))	! note the 1
	End
End;

! CALLED TO GENERATE PSLG-BITS FOR AN EXPRESSION IN A LINEAR BLOCK
!
! notes:
!	see page 42 of "The Design of an Optimizing Compiler".

Routine GENPSLGBITS(NODE : Ref GT) =
Begin
    Local
	VAL		: Integer,
	L		: Ref GT,
	RANDVAL		: Integer;

! handle omega lists differently

    If .NODE[gt_type] Eql T_QUEUE And .NODE[que_code] Eql T_OMEGA Then
	Begin
	GOMEGATOPSLG(.NODE[que_head],.NODE[que_abc]);
	Return FALSE
	End;

! literals and addresses are always in the postlog

    If .NODE[gt_type] Neq T_NODE Then
	Return TRUE;

! control statements are never moved

    If .NODE[gt_v_flow] Then
	Return FALSE;

! examine all the operands of this node and see if they all may go in
! the postlog.

    VAL = TRUE;
    FORALLRANDS(I,.NODE)
	Begin
	L = .NODE[gt_argv(.I)];
	RANDVAL = GENPSLGBITS(.L);

! if a compound statement, set the postlog bit as it may be non essential

	If .NODE[gt_code] Eql OP_COMPOUND Then
	    Begin
	    If .RANDVAL And .L[gt_type] Eql T_NODE Then
		L[gt_v_postlog] = TRUE
	    End
	Else

! this operand is essential.  turn off any postlog bits which may have been set

	    Begin
	    TURNOFFPSLG(.L);
	    If Not .RANDVAL Then
		Return FALSE
	    End;
	VAL = .VAL And .RANDVAL
	End;
    Selectone .NODE[gt_code] Of Set

! call parameters may never move without their call and calls may not
! move period because any call side effects are not known.

	[OP_CALL]:
	    VAL = FALSE;

! a '.' may not move if there is a store between here and there

	[OP_DOT]:
	    If ISCHGED(1,.NODE) Then
		VAL = FALSE;

! a '=' may not moved if there is a fetch between here and there

	[OP_STORE]:
	    If ISUSED(1,.NODE) Then
		VAL = FALSE
    Tes;

! if something could not move

    If Not .VAL Then
	Return FALSE;

! bind expressions may not move

    L = .NODE[gt_csparent];
    Until (L = .L[gt_csthread]) Eqla 0 Do
	If .L[gt_code] Eql OP_FAKE_CSE Then
	    Begin
	    NODE[gt_v_postlog] = FALSE;
	    Return FALSE
	    End;

! set the postlog bit only if there is a cse parent

    If .NODE[gt_code] Neq OP_COMPOUND Then
	NODE[gt_v_postlog] = .NODE[gt_v_csp];
    Return TRUE
End;

! GENERATES THE POSTLOG SET FOR A LINEAR BLOCK (B) AND
! ALSO BUILDS THE SET: B-(PROLOG <UNION> POSTLOG) WHICH IS
! CALLED THE MU LIST OF THE LINEAR BLOCK
!
! note: nothing uses the MU list

Routine GENMUPSLGLST(NODE : Ref GT) : Novalue =
Begin

    If Not .swit_optimize Then
	Return;

! only expressions may be placed in the postlog

    If .NODE[gt_type] Neq T_NODE Then
	Return;

! control statements may not move

    If .NODE[gt_v_flow] Then
	Return;

! if part of the postlog, move it onto the list

    If .NODE[gt_v_postlog] Then
	ENLST(.hdr_postlog[stk_data],MAKITEM(.NODE[gt_fparent],.NODE))
    Else
!
!    IF .NODE[CSP] THEN IF NOT .NODE[PRLGBIT] THEN
!	  ENLST(.hdr_mu[stk_data],MAKITEM(.NODE[gt_fparent],.NODE));
!

! this is not part of the postlog but maybe one of its children is

	FORALLRANDS(I,.NODE)
	    GENMUPSLGLST(.NODE[gt_argv(.I)])
End;

! GENERATES THE EPILOG SET FOR A LINEAR BLOCK BY DISCOVERING ALL
! AVAILABLE (I.E. UNMARKED) C-S-E'S.

Routine GENEPLGLST(NODE : Ref GT) : Novalue =
Begin
    Local
	L		: Ref GT,
	LCS		: Ref GT,
	F		: Integer;

    If Not .swit_optimize Then
	Return;

! only expressions may go on the epilog

    If .NODE[gt_type] Neq T_NODE Then
	Return;

! if quick then there are no CSE's

    If .swit_quick Then
	Return;

! loop for all CSE's

    F = .FLOOR[stk_data];
    FORALLRATORS(I)
	Begin
	L = .GTHASH[.I];
	Until .L Eqla 0 Do
	    Begin
	    LCS = .L;
	    Do

! if not purged and not marked and created in this level then
! move it to the epilog and stop searching this formal list

		If Not .LCS[gt_v_purge] And Not .LCS[gt_v_rm] And
			.LCS[gt_crlevel] Geq .F Then
		    Begin
		    ENLST(.hdr_epilog[stk_data],MAKITEM(.L^32 + .LCS));
		    Exitloop
		    End
	    While (LCS = .LCS[gt_fsthread]) Neqa 0;
	    L = .L[gt_gthread]
	    End
	End
End;

! GENERATES CHANGE AND USE LIST HEADERS FOR THE DECLARED
! VARIABLES WHOSE SYMBOL TABLES ENTRY IS S.  ALSO ENTERS
! USE AND CHANGE LIST ENTRIES TO PREVENT THE MOVE OF A
! VARIABLE REFERENCE BACKWARD PAST DECLARATION POINT.

Global Routine INITSYMLSTS(S : Ref ST) : Novalue =
Begin
    If .swit_quick Then
	Return;

! no lists for 'outer block' st entries

    If .S[st_scope] Eql 0 Then
	Return;
    S[st_var_use_list] = MAKHDR(VUSEREMOVE,VUSEENTER);
    S[st_var_chg_list] = MAKHDR(VCHGREMOVE,VCHGENTER);
    ENTVCHGLST(.S,0);
    ENTVUSELST(.S,0)
End;

! ENTER VARIABLE USE LIST
! CALLED FROM:   GENGT, INITSYMLSTS, F10, F11
! ENTERS AN ITEM ON THE USE LIST OF THE NAME (IF ANY) INVOLVED
! IN THE EXPRESSION POINTED TO BY "OPRND" REFLECTING THE FACT THAT
! A REFERENCE TO THE VALUE OCCURED IN THE EXPRESSION
! "GTINDEX".  THE FORM OF THE ENTRY IS: ABCOUNT,,GTINDEX.

Global Routine ENTVUSELST(OPRND : Ref GT,GTINDEX : Ref GT) : Novalue =
Begin
    Local
	S		: Ref ST;

! find the name referenced.  if no name is involved then generate
! a general kill if the mark flag is set

    S = FINDNAME(.OPRND);
    If .S Eqla 0 Then
	Begin
	If .swit_mark Then
	    KILL(3,.GTINDEX)
	End

! if a storage variable and it has a use list then add an entry
! to the use list
!
! Q: how can it not be a storage variable?
!
! A: maybe if it's a routine

    Else If ISSTVAR(S) And .S[st_var_use_list] Neqa 0 Then
	ENLST(.S[st_var_use_list],MAKITEM(.ABCOUNT^32 + .GTINDEX))
End;

! ENTER VARIABLE CHANGE LIST
! CALLED FROM:   GENGT, INITSYMLSTS, F10, F11
! SAME AS ENTVUSELST EXCEPT THAT THE NAME IN OPRND WAS THE
! TARGET OF A STORE.

Global Routine ENTVCHGLST(OPRND : Ref GT,GTINDEX : Ref GT) : Novalue =
Begin
    Local
	S		: Ref ST;

! find the name referenced.  is no name is invoved then note a
! general kill unless the mark flag is set

    S = FINDNAME(.OPRND);
    If .S Eqla 0 Then
	Begin
	If .swit_mark Then
	    KILL(2,.GTINDEX)
	End

! if a storage variable and it has a change list then add an entry
! to the change list

    Else If ISSTVAR(S) And .S[st_var_chg_list] Neqa 0 Then
	ENLST(.S[st_var_chg_list],MAKITEM(.ABCOUNT^32 + .GTINDEX))
End;

! GENERATE PRLG LIST AND BITS.  ALWAYS CALLED WITH PTR TO GT-NODE
!
! called by: GENGT

Global Routine GENPRLG(NODE : Ref GT) : Novalue =
Begin
    Macro
	ISRELOP(X)=ONEOF(X,OP_GTR,OP_LEQ,OP_LSS,OP_GEQ,OP_EQL,OP_NEQ,
			OP_GTRU,OP_LEQU,OP_GEQU,OP_LSSU,OP_EQLU,OP_NEQU) %;
    Local
	PARENT		: Ref GT;

    If .swit_quick Then
	Return;
    If Not .swit_optimize Then
	Return;

! only operators and '=' may go on the prolog

    If .NODE[gt_code] Gtr OP_STORE Then
	Return;

! THIS IS A DECISION THAT OUGHT, REALLY, TO BE MADE IN DELAY.
! THE IDEA IS THAT RELATIONAL OPERATOR NODES AREN'T ALPHA- OR
! CHI-LISTED, BECAUSE THEY'RE USUALLY IN CONTEXTS WHERE IT'S
! CHEAPER TO PUT OUT A 'CMP' (OR 'TST') INSTRUCTION ON EACH
! BRANCH OF A FORK (OR IN A LOOP) THAN TO GENERATE A REAL
! RESULT (1 OR 0) BEFORE THE FORK (OUTSIDE THE LOOP).

    If ISRELOP(.NODE[gt_code]) Then
	Return;

! examine all operands.  if the operand is a flow control operator
! or is not on the prolog then return

    FORALLRANDS(I,.NODE)
	Begin
	Local P : Ref GT;

	P = .NODE[gt_argv(.I)];
	If .P[gt_type] Eql T_NODE Then
	    Begin
	    If .P[gt_v_flow] Then
		Return;
	    If Not .P[gt_v_prolog] Then
		Return
	    End
	End;

! special cases

    Select .NODE[gt_code] Of Set

! call parameters never move

	[OP_CALL]:
	    Return;

! a '.' cannot move if there was a store between the start of the block and here

	[OP_DOT]:
	    If WASCHGED(.NODE) Then
		Return;

! a '=' cannot move if there was a fetch between the start of the block and here

	[OP_STORE]:
	    If WASUSED(.NODE) Then
		Return
    Tes;

! if not a CSE parent then mark it as being in the prolog if the parent
! is in the prolog or the parent was created outside the block.  do not
! place it in the prolog list

    If Not .NODE[gt_v_csp] Then
	Begin
	PARENT = .NODE[gt_csparent];
	NODE[gt_v_prolog] = .PARENT[gt_v_prolog] Or
				(.PARENT[gt_abc] Leq .ABCBASE[stk_data])
	End
    Else

! add CSE heads to the prolog list

	Begin
	ENLST(.hdr_prolog[stk_data],MAKITEM(.NODE[gt_fparent]^32 + .NODE));
	NODE[gt_v_prolog] = TRUE
	End
End;

! WAS-IS CHANGED-USED ...
! ARGUMENTS:
!	NODEPTR:   A  =  NODE OR A . NODE
!	ZORONE:	   ZERO OR ONE; VALID ONLY FOR "IS" CHANGED-USED.
! CALLED TO CHECK THE VCHGLST OR VUSELST WHEN A ELEMENT IS
! CONSIDERED FOR INSERTION ON A FLOLST
!	S=0 --> WASUSED
!	S=1 --> ISUSED
!	S=2 --> WASCHGED
!	S=3 --> ISCHGED

Routine WISCHUSED(ZORONE,S,NODEPTR : Ref GT)=
Begin
    Local
	LEX		: Ref ST,
	HI		: Integer,
	LO		: Integer,
	P		: Ref LSTHDR;

! find the name referenced.  if there is no name then assume the value
! was/is changed

    LEX = FINDNAME(.NODEPTR[gt_arg1]);
    If .LEX Eqla 0 Then
	Return TRUE;

! if not a storage variable then assume changed

    If Not ISSTVAR(LEX) Then
	Return TRUE;

! compute the bounds to search

    If .S<0,1> Then		! to end for epilog/postlog
	Begin
	HI = .ABCOUNT;
	LO = .NODEPTR[gt_abc]+.ZORONE
	End
    Else
	Begin			! to start for prolog
	HI = .NODEPTR[gt_abc]-1;
	LO = .ABCBASE[stk_data]
	End;

! if a kill exists in the range then was/is changed

    If SEARCHFORKILLS(.LEX,.HI,.LO,.S<1,1>) Then
	Return TRUE;

! determine which list to check.  if the list does not exist then
! assume the variable was/is changed

    P = (If .S<1,1> Then .LEX[st_var_chg_list] Else .LEX[st_var_use_list]);
    If .P EQLA 0 Then
	Return TRUE;

! check the list

    Return ABCBETW(.HI,.LO,.P)
End;

! ABCOUNT BETWEEN
! CALLED FROM   GALOMBITS, WISCHUSED
! ATOMIC BLOCK COUNT BETWEEN ...
! PREDICATE INDICATING THERE IS AN ENTRY ON LIST HEADED BY HDR
! WHOSE ABCVAL IS IN THE CLOSED INTERVAL [LO,HI]

Routine ABCBETW(HI : Integer,LO : Integer,HDR : Ref LSTHDR) =
Begin
    Local
	I		: Ref ITEM;

! loop for each list entry

    I = .HDR;
    Until (I = .I[itm_rlink]) Eqla .HDR Do
	Begin
	If .I[itm_abc] Lss .LO Then
	    Exitloop;
	If .I[itm_abc] Leq .HI Then
	    Return TRUE
	End;
    Return FALSE
End;

!
! SUPPLEMENTS THE ACTION OF 'ABCOUNT BETWEEN' BY LOOKING
! ON THE KILL LIST.
!
! ARGUMENTS:
!   STVAR - THE VARIABLE WHOSE CHANGED OR USED STATUS IS IN QUESTION
!   USEORCHG - BOOLEAN; TRUE IF CHANGE (RATHER THAN USE) IS BEING
!		LOOKED FOR
!   HI, LO - SEE 'ABCOUNT BETWEEN'
!
!	KILL TYPES:
! 0 - A RETURN. A USE LIST ENTRY FOR ALL VARIABLES.
! 1 - A LEAVE. SAME AS A RETURN, BUT KILL LIST ENTRY
!     DISAPPEARS WHEN SYNTAX PROCESSING FOR THE LABEL ENDS.
! 2 - STORE INTO CALCULATED ADDRESS (.A = EXPR). A CHANGE
!     LIST ENTRY FOR ALL BUT REGISTER VARIABLES.
! 3 - FETCH FROM A CALCULATED ADDRESS (VAR = ..A). A USE
!     LIST ENTRY FOR ALL BUT REGISTER VARIABLES.
! 4 - A ROUTINE CALL. A CHANGE AND USE, FOR GLOBAL,
!     EXTERNAL, AND OWN VARIABLES.
! 5 - AN INLINE. A CHANGE AND USE, FOR ALL VARIABLES.
!
! Q: why is a return a use of all variables?

Routine SEARCHFORKILLS(STVAR : Ref ST,HI : Integer,LO : Integer,USEORCHG) =
Begin
    Bind
	matrix = Uplit Byte (
			3,3,2,3,0,0,1,
			3,3,0,0,0,0,1,
			3,3,2,3,0,0,1,
			3,3,2,3,1,0,1,
			3,3,2,3,1,0,1,
			3,3,2,3,1,0,1
		) : Vector[36,Byte];
    Local
	TYPE		: Integer,
	I		: Ref ITEM,
	j		: Integer;

! compute index into matrix

    J = (.STVAR[st_code] - LOWVARTYPE) * 6;

! loop for each kill list entry

    I = .hdr_kill;
    Until (I = .I[itm_rlink]) Eqla .hdr_kill Do
	Begin
	If .I[itm_kill_abc] Lss .LO Then
	    Exitloop;
	If .I[itm_kill_abc] Leq .HI Then
	    Case .matrix[.J + .I[itm_kill_type]] From 0 To 3 Of Set

! does not kill

		[0]:
		    0;

! always kills

		[1]:
		    Return TRUE;
		[2]:

! kills a change

		    If .USEORCHG Then
			Return TRUE;

! kills a use

		[3]:
		   If Not .USEORCHG Then
			Return TRUE
	    Tes
	End;
    Return FALSE
End;

! CALLED FROM:   GFDOWHILE, F19
! GENERATES EPILOG SET FOR WHILE EXPRESSION IN WHILE-DO CONSTRUCT

Routine GFWHILE : Novalue =
Begin
    Local
	LSTPTR		: Ref FLOLSTPTR;

! only expressions may have a flow list

    If .SYM[gt_type] Eql T_NODE Then
	Begin
	LSTPTR = SYM[gt_flow] = GETSPACE(SZ_FLOLIST);
	LSTPTR[flow_epilog] = hdr_epilog[stk_data] = MAKHDR(EPLGREMOVE,EPLGENTER);
	GENEPLGLST(.SYM);
	SYM[gt_v_flow] = TRUE
	End
End;

! CALLED FROM:   F26
! GENERATES EPILOG SET FOR COMBINED DO & WHILE EXPRESSIONS OF
! A DO-WHILE CONSTRUCT; IF "WHILE" EXPR. IS A NON-GRAPH-TABLE
! LEXEME, ATTACHES EPILOG LIST TO "DO" EXPRESSION.

Routine GFDOWHILE : Novalue =
Begin
    If .SYM[gt_type] Eql T_NODE Then
	GFWHILE()
    Else
	Begin
	SYM = .STK[.TOS-1];	! GET "DO" EXPRESSION
	GFWHILE();
	SYM = .STK[.TOS]	! RETRIEVE "WHILE" EXPRESSION
	End
End;

! CALLED BY    F4
! CALLED AFTER EACH BRANCH OF A FORK
! GENERATES PROLOG, EPILOG, AND POSTLOG SETS FOR LINEAR BLOCK
! WHICH FORMS BRANCH IN FORKED CONSTRUCT

Routine GFBRANCH : Novalue =
Begin
    Local
	LSTPTR		: Ref FLOLSTPTR;

! only expressions may have a flow list

    If .SYM[gt_type] Neq T_NODE Then
	Return;
    LSTPTR = SYM[gt_flow] = GETSPACE(SZ_FLOLIST);
    LSTPTR[flow_prolog] = .hdr_prolog[stk_data];
!
!   LSTPTR[MULSTF] = hdr_mu[stk_data] = MAKHDR(MUREMOVE,MUENTER);
!
    LSTPTR[flow_postlog] = hdr_postlog[stk_data] = MAKHDR(PSLGREMOVE,PSLGENTER);
    LSTPTR[flow_epilog] = hdr_epilog[stk_data] = MAKHDR(EPLGREMOVE,EPLGENTER);
    If Not .swit_quick Then
	Begin
	GENPSLGBITS(.SYM);
	GENMUPSLGLST(.SYM);
	GENEPLGLST(.SYM)
	End;
    SYM[gt_v_flow] = TRUE
End;

! CALLED FROM    F16, F17, F18
! GENERATES PROLOG FOR LINEAR BLOCK WHICH FORMS BODY (AND
! PERHAPS PREDICATE) OF LOOPING CONSTRUCT

Routine GFLOOP : Novalue =
Begin
    Local
	LSTPTR		: Ref FLOLSTPTR;

! only expresisons may have flow lists

    If .SYM[gt_type] Eql T_NODE Then
	Begin
	LSTPTR = SYM[gt_flow] = GETSPACE(SZ_FLOLIST);
	LSTPTR[flow_prolog] = .hdr_prolog[stk_data];
	SYM[gt_v_flow] = TRUE
	End
End;

! GENERATE ALPHA (ALOMFLAG=1) AND OMEGA SETS FOR FORKED CONTROL
! ENVIRONMENTS.
! AN ALPHA (OMEGA) ELEMENT FOR AN N-BRANCH FORK:
!	0: LLINK,,RLLINK
!	1: FORMAL-PARENT,,NUM-OF-BRANCHES
! AND N ENTRIES WHERE THE K-TH IS
!	   FORMAL-PARENT,,X
! AND WHERE IF LOW ORDER BIT OF X IS ON THEN THE X POINTS TO
! ANOTHER ALPHA ELEMENT ELSE X IS A NODE ON THE K-TH BRANCH.

Routine GENALOMLST(ALOMFLAG : Boolean) =
Begin
    Local
	L		: Ref ITEM,
	NODE		: Ref GT,
	HDR		: Ref LSTHDR,
	LSTPTR		: Ref FLOLSTPTR;

! choose the list to scan

    LSTPTR = .Block[.STK[.LASTMARK+3],gt_flow];
    HDR = (If .ALOMFLAG
		Then .hdr_alpha[que_head]
		Else .hdr_omega[que_head]);

! generate the initial list

    MAKINTLST(.TOS-(.LASTMARK+3),
		  If .ALOMFLAG
		    Then .LSTPTR[flow_prolog]
		    Else .LSTPTR[flow_postlog],
		  .HDR);

! now discarded

    If .ALOMFLAG Then
	LSTPTR[flow_prolog] = 0
    Else
	LSTPTR[flow_postlog] = 0;

! loop for the other lists

    Incr I From .LASTMARK+4 To .TOS-1 Do
	Begin
	LSTPTR = .Block[.STK[.I],gt_flow];
	SORTFINT(.I-(.LASTMARK+2),
		     .HDR,
		     If .ALOMFLAG
			Then .LSTPTR[flow_prolog]
			Else .LSTPTR[flow_postlog]);
	If .ALOMFLAG Then
	    LSTPTR[flow_prolog] = 0
	Else
	    LSTPTR[flow_postlog] = 0
	End
End;

! GENERATE THE ALPHA LIST FOR A FORKED CONTROL CONSTRUCT

Routine GENALPHA : Novalue =
Begin
    Local
	L		: Ref ITEM,
	M		: Ref GT,
	NODE		: Ref GT,
	ALPHNODE	: Ref GT,
	L2		: Ref ITEM,
	VAL		: Integer,
	HDR		: Ref ITEM,
	N		: Ref ITEM;

! generate the intersections of all the prologs

    GENALOMLST(TRUE);
    If EMPTY(.hdr_alpha[que_head]) Then
	Return;
!
! AT THIS POINT 'M' HOLDS A POINTER TO THE BOOLEAN OF AN
! IF-THEN-ELSE EXPRESSION, OR THE CASE INDEX OF A CASE EXPRESSION.
! THE FOLLOWING CODE CHECKS WHETHER EACH ALPHA-LIST ENTRY HAS
! AN ESSENTIAL PREDECESSOR IN M.
!
! when the prolog sets were built for the THEN and ELSE parts,
! they only considered essential predecessors within themselves.
! now we consider essential predecessors in the IF condition.

    M = .STK[.LASTMARK+2];
    VAL = .M[gt_abc];
    HDR = .hdr_alpha[que_head];

! loop, discarding all alpha list entries which have essential predecessors
! in 'M'

    L = .HDR[itm_rlink];
    While .L Neqa .HDR Do
	Begin
	L2 = .L;
	L = .L[itm_rlink];
	If Not GALOMBITS(.VAL,.hdr_alpha[que_abc],.L2[itm_fparent]) Then
	    RELITEM(.L2,SZ_INT_ITEM(.L2[itm_size]))
	End;

! return if nothing left

    If EMPTY(.hdr_alpha[que_head]) Then
	Return;

! place any alpha list entries onto the prolog which fit

    GALPHATOPRLG(.hdr_alpha[que_head],.hdr_alpha[que_abc]);
!
! AT THIS POINT, THE CURRENT ALPHA LIST CONTAINS A BUNCH OF ENTRIES,
! SOME OF WHICH ARE POINTED TO BY PROLOG LIST ENTRIES, AND SOME OF
! WHICH CONTAIN POINTERS TO OTHER LIST ENTRIES RATHER THAN TO NODES.
! FOR GENALPHA'S OWN USE AND FOR DELAY, TNBIND, AND CODE, THE ALPHA
! LIST ENTRIES SHOULD ONLY CONTAIN POINTERS TO GT-NODES.  THEREFORE
! THE FOLLOWING CODE MAKES A NEW COPY OF EACH ENTRY; THE OLD COPY IS
! STILL POINTED TO BY THE PROLOG LIST ENTRY (IF ANY), AND THE NEW
! COPY, WHICH REPLACES IT ON THE ALPHA LIST, HAS POINTERS ONLY TO NODES.
!
! Q: the old entry is removed from the alpha list but is not released
!    because it may have been placed on the prolog.  if it was not
!    placed on the prolog then this looks like a memory leak.  am
!    I missing something?

    L = .HDR[itm_rlink];
    While .L Neqa .HDR Do
	Begin
	Local M : Ref ITEM;

! create a new item

	M = GETSPACE(SZ_INT_ITEM(.L[itm_size]));
	M[itm_llink]   = .M;
	M[itm_rlink]   = .M;
	M[itm_size]    = .L[itm_size];
	M[itm_fparent] = .L[itm_fparent];

! replace L with M

	LINK(.M,.L[itm_llink]);
	DELINK(.L);

! loop, copying item entries from L to M

	Incr I From 1 To .L[itm_size] Do
	    Begin
	    N = .L[itm_int_rdata(.I)];

! the purge bit is reset for entries on the alpha list.  entries coming
! from another alpha list supposedly already have the prolog bit turned
! off but it wouldn't hurt to turn it off here also.

	    If Not .N<0,1> Then
		Block[.N,gt_v_purge] = FALSE
	    Else
		Do
		    Begin
		    N<0,1> = 0;
		    N = .N[itm_int_rdata(1)]
		    End
		While .N<0,1>;
	    M[itm_int_rdata(.I)] = .N
	    End;
	L = .M[itm_rlink]
	End;

! END OF ABOVE NOTED CODE

! another pass over alpha entries...
!
! this pass takes the first node in each alpha entry and makes it
! the CSE parent of the rest of the nodes in the entry.

    L = .HDR;
    While (L = .L[itm_rlink]) Neqa .HDR Do
	Begin

! select the first intersection item as the CSE head and link
! all the other item entries to it

	ALPHNODE = .L[itm_int_rdata(1)];
	VAL = 0;
	Incr I From 2 To .L[itm_size] Do
	    Begin
	    NODE = .L[itm_int_rdata(.I)];

! count occurances

	    VAL = .VAL+.NODE[gt_occ];

! add to end of CSE thread

	    M = .ALPHNODE;
	    Until .M[gt_csthread] Eqla 0 Do
		M = .M[gt_csthread];
	    M[gt_csthread] = .NODE;

! remove from formal parent list.  Note:  the first entry is guaranteed
! to come before this entry on the formal parent chain so the gthash
! chains do not have to be adjusted

	    M = .ALPHNODE[gt_fparent];
	    Until .M[gt_fsthread] Eqla .NODE Do
		M = .M[gt_fsthread];
	    M[gt_fsthread] = .NODE[gt_fsthread];
	    NODE[gt_fsthread] = 0;

! no longer a CSE parent

	    NODE[gt_v_csp]         = FALSE;
	    NODE[gt_v_mustgencode] = FALSE;
	    End;

! now assign the CSE parent to all the entries

	M = .ALPHNODE;
	Until (M = .M[gt_csthread]) Eqla 0 Do
	    M[gt_csparent] = .ALPHNODE;

! update the occurence count

	ALPHNODE[gt_occ] = .ALPHNODE[gt_occ] + .VAL;

! adjust the occurence count for all expression operands
! and mark all operands.  a later pass will remove these
! from the alpha list since their parent is already on the list

	FORALLRANDS(I,.ALPHNODE)
	    Begin
	    Local P : Ref GT;

	    P = .ALPHNODE[gt_argv(.I)];
	    If .P[gt_type] Eql T_NODE Then
		Begin
		P[gt_occ] = .P[gt_occ] - (.L[itm_size]-1);
		P[gt_v_alpha] = TRUE
		End
	    End
	End;

! another pass through the alpha list
!
! this pass removes nodes whoose parent is on the alpha list.
! it also reverses the order of the alpha list.

    L = .hdr_alpha[que_head];
    L = .L[itm_rlink];
    While .L Neqa .hdr_alpha[que_head] Do
	Begin
	NODE = .L[itm_int_rdata(1)];
	L2 = .L;
	L = .L[itm_rlink];

! if marked then this is a child of another node already on the alpha
! list so remove it

	If .NODE[gt_v_alpha] Then
	    RELITEM(.L2,SZ_INT_ITEM(.L2[itm_size]))
	Else
	    Begin
	    L2[itm_abc] = .NODE[gt_abc];

! mark all other intersection entries as DONTUNLINK

	    Decr I From .L2[itm_size] To 1 Do
		Begin
		M = .L2[itm_int_rdata(.I)];
		M[gt_v_dont_unlink] = TRUE
		End;

! reverse the list order

	    ENLST(.hdr_alpha[que_head],.L2)
	    End
	End;

! now set the alpha bit on all entries on the alpha list.
! this marks the node as ineligible for omega motion.

    While (L = .L[itm_rlink]) Neqa .hdr_alpha[que_head] Do
	Begin
	NODE = .L[itm_int_rdata(1)];
	NODE[gt_v_alpha] = TRUE
	End
End;

! decrement occurence count for non-CSE parent omega entries

Routine OMEGDECR(NODE : Ref GT) : Novalue =
Begin
    Local
	L		: Ref GT,
	P		: Ref GT;

! non-bogus because we need to access the arguments

    L = NONBOGUS(.NODE);

! apply recursively to all children

    FORALLRANDS(I,.L)
	Begin
	P = .L[gt_argv(.I)];
	If .P[gt_type] Eql T_NODE Then
	    OMEGDECR(.P)
	End;

! adjust the occurence count of our CSE parent

    p = .NODE[gt_csparent];
    p[gt_occ] = .p[gt_occ] - 1;

! if it turns out this is a CSE parent with other CSE entries then
! turn on the MUSTGENCODE for them.
!
! Q: why turn off MUSTGENCODE?
!
! A: with omega motion, the nodes are not actually moved but are only
!    placed on the omega list.  thus the original nodes are seen before
!    the omega list is actually processed.  turning off the mustgencode
!    bit causes these nodes to be passed over until the omega list is
!    processed.  this is also why we see the mustgencode bit being set
!    in pulse routines.

    If .p[gt_occ] Gtr 0 And .NODE[gt_v_csp] And Not .NODE[gt_v_alpha] Then
	Begin
	L = .NODE;
	While (L = .L[gt_csthread]) Neq 0 Do
	    Begin
	    NODE[gt_occ] = .NODE[gt_occ]-1;
	    L[gt_v_mustgencode] = TRUE
	    End
	End
End;

! decrement occurent count for CSE parent omega entries

Routine OMEGHEADECR(NODE : Ref GT,DEPTH : Integer) : Novalue =
Begin
    Local
	L		: Ref GT,
	P		: Ref GT;

! need non-bogus due to access of arguments

    L = NONBOGUS(.NODE);

! apply recursively to all arguments

    FORALLRANDS(I,.L)
	Begin
	P = .L[gt_argv(.I)];
	If .P[gt_type] Eql T_NODE Then
	    OMEGHEADECR(.P,.DEPTH+1)
	End;
    p = .NODE[gt_csparent];

! if not the top level and this is a CSE head with CSE followers
! then turn on MUSTGENCODE for the followers

    If .DEPTH Gtr 0 And .p[gt_occ] Gtr 1 And .NODE[gt_v_csp] Then
	Begin
	L = .NODE;
	While (L = .L[gt_csthread]) Neqa 0 Do
	    Begin
	    NODE[gt_occ] = .NODE[gt_occ]-1;
	    L[gt_v_mustgencode] = TRUE
	    End
	End
End;

! test whether a node or any of its children is on the alpha list
!
! notes:
!	nodes are not moved to the omega list if they are already on
!	the alpha list.

Routine CHECKALPHA(NODE : Ref GT) =
Begin
    Local
	OPND		: Ref GT;

! see if this node is on the alpha list

    If .NODE[gt_v_alpha] Then
	Return TRUE;

! see if any of its children is on the alpha list

    FORALLRANDS(I,.NODE)
	Begin
	OPND = .NODE[gt_argv(.I)];
	If .OPND[gt_type] Eql T_NODE Then
	    If CHECKALPHA(.OPND) Then
		Return TRUE
	End;
    Return FALSE
End;

! GENERATE THE OMEGA LIST FOR A FORKED CONTROL CONSTRUCT

Routine GENOMEGA : Novalue =
Begin
    Local
	L		: Ref ITEM,
	L2		: Ref ITEM,
	OMEGNODE	: Ref GT,
	SRCNODE		: Ref GT,
	NODE		: Ref GT,
	SIZE		: Integer;
    Label
	aaa;

! generate the omega intersection list

    GENALOMLST(FALSE);
    If Not EMPTY(.hdr_omega[que_head]) Then
	Begin

! loop for each omega list entry

	L = .hdr_omega[que_head];
	While (L = .L[itm_rlink]) Neqa .hdr_omega[que_head] Do
	    aaa: Begin
	    OMEGNODE = .L[itm_int_rdata(1)];

! it can't be on both the alpha and omega lists

	    If CHECKALPHA(.OMEGNODE) Then
		Begin
		SIZE = .L[itm_size];
		L = .L[itm_llink];
		RELITEM(.L[itm_rlink],SZ_INT_ITEM(.SIZE));
		Leave aaa
		End;

! check each intersection item entry.  if it is on an inner omega
! list then make the entries CSE followers again and release the inner
! list.
!
! Q: what about the occurence count?
!
! Q: what about the INNEROMEGAENT field?  should it not be set to 0?

	    Incr I From 1 To .L[itm_size] Do
		Begin
		SRCNODE = .L[itm_int_rdata(.I)];
		L2 = .SRCNODE[gt_inner_omega];
		If .L2 Neqa 0 Then
		    Begin
		    SIZE = .L2[itm_size];
		    Incr K From 2 To .SIZE Do
			Begin
			NODE = .L2[itm_int_rdata(.K)];
			NODE[gt_v_mustgencode] = FALSE
			End;
		    RELITEM(.L2,SZ_INT_ITEM(.SIZE))
		    End
		End;

! decrement the occurence count for the item entries because
! omega entries are not really CSE's (?) but are merged into a
! single node

	    Incr I From 2 To .L[itm_size] Do
		Begin
		NODE = .L[itm_int_rdata(.I)];
		OMEGDECR(.NODE);
		NODE[gt_v_omega] = TRUE;
		End;

! now adjust the omega head entry

	    OMEGHEADECR(.OMEGNODE,0);
	    OMEGNODE[gt_v_omega] = TRUE;
	    End;

! loop for each omega entry and mark the inner omega entry it is on

	L = .hdr_omega[que_head];
	L = .L[itm_rlink];
	While .L Neqa .hdr_omega[que_head] Do
	    Begin
	    OMEGNODE = .L[itm_int_rdata(1)];
	    OMEGNODE[gt_inner_omega] = .L;
	    L[itm_abc] = .OMEGNODE[gt_abc];

! reverse the omega list also

	    L = .L[itm_rlink];
	    ENLST(.hdr_omega[que_head],DELINK(.L[itm_llink]))
	    End
	End;

! turn off all alpha bits now (but what about entries which were
! removed from the alpha list?)

    L = .hdr_alpha[que_head];
    While (L = .L[itm_rlink]) Neqa .hdr_alpha[que_head] Do
	Begin
	NODE = .L[itm_int_rdata(1)];
	NODE[gt_v_alpha] = FALSE
	End
End;

! CALLED AT END OF FORKED CONTROL STRUCURE TO COMPUTE ALPHA,
! OMEGA LISTS AS WELL AS GENERATE BOGUS NODES FOR THOSE
! C-S-E'S WHICH WERE MADE AVAILABLE BY FORKED EXPRESSIONS.

Routine GPOSTFORK : Novalue =
Begin
    Local
	NODE		: Ref GT,
	ALLGT		: Boolean;

    If .swit_quick Then
	Return;

! if too few entries

    If (.TOS - .LASTMARK) Lss 5 Then
	Return;
    hdr_alpha  = .STK[.LASTMARK+1];
    hdr_omega = .STK[.TOS];

! quick scan to see if all operands are expressions.  a non-expression
! guarantees the alpha and omega lists will be null

    ALLGT = (
	Incr I From .LASTMARK+3 To .TOS-1 Do
	    Begin
	    NODE = .STK[.I];
	    If .NODE[gt_type] Neq T_NODE Then
		Exitloop 0
	    End);
    If .ALLGT Then
	Begin
	GENALPHA();
	GENOMEGA();
	GENPSI();
	GCSEFROMPSI()
	End
End;

! CALLED FROM:   GENPSI
! VERY SIMILAR IN PURPOSE, STRUCTURE TO SORTFINT (SEE LSTPKG).
! PURPOSE:	"GROWS" PSI LIST AND PCS CHAINS
! ARGUMENT:  NXTHDR - HEADER OF AN EPILOG LIST
! LOCALS:
!	PPSI - CURRENT LIST ENTRY FROM PSI LIST
!	PNXT - CURRENT LIST ENTRY FROM EPILOG LIST (NXTHDR)
!	VALPSI,VALNXT - EPILOG LISTS ARE SORTED BY THEIR 'ITEMFPARENT'
!			FIELDS, AND THESE ARE THE 'ITEMFPARENT'S OF
!			PPSI AND PNXT, RESPECTIVELY.
!
Routine PSIINT(NXTHDR : Ref LSTHDR) : Novalue =
Begin
    Local
	PPSI		: Ref ITEM,
	PNXT		: Ref ITEM,
	VALPSI		: Ref GT,
	VALNXT		: Ref GT,
	NL		: Ref GT,
	L		: Ref GT;

    Routine PSIENTER(I : Ref GT,T : Ref GT,V : Ref GT) : Novalue =
    Begin
	Local
	    NI		: Ref GT;

	If Not .I[gt_v_csp] Then
	    I = .I[gt_csparent];
	Do
	    Begin
	    NI = .I[gt_pcsthread];
	    Do
		Begin
		If .T Eqla .I Then
		    Exitloop;
		If .T[gt_pcsthread] Eqla 0 Then
		    Begin
		    T[gt_pcsthread] = .I;
		    I[gt_pcsthread] = 0;
		    T = .V;
		    Exitloop
		    End;
		T = .T[gt_pcsthread]
		End
	    While 1
	    End
	Until (I = .NI) Eql 0
    End;

    Macro
	UDPSI=	! GET NEXT PSI,VALPSI
		Begin
		PPSI = .PPSI[itm_rlink];
		VALPSI = .PPSI[itm_fparent]
		End %;

    Macro
	UDNXT=	! GET NEXT PNXT,VALNXT
		Begin
		PNXT = .PNXT[itm_rlink];
		If .PNXT Eqla .NXTHDR Then
		    VALNXT = 0
		Else
		    VALNXT = .PNXT[itm_fparent]
		End %;

    PPSI = .hdr_psi;
    PNXT = .NXTHDR;
    UDPSI;
    UDNXT;
    While .PPSI Neqa .hdr_psi Do
	Begin
	If .VALPSI Eqla .VALNXT Then

! ADD A NEW ENTRY TO THE PSI LIST

	    Begin
	    PSIENTER(.PNXT[itm_rdata(1)],.PPSI[itm_rdata(1)],
			.PPSI[itm_rdata(1)]);
	    UDPSI;
	    UDNXT
	    End
	Else If .VALPSI Gtr .VALNXT Then
!
! NO FORMAL COPY OF THE NODE POINTED TO BY PPSI IS ON THE
! EPILOG LIST (POINTED TO BY NXTHDR).  THE PCSTHREAD CHAIN
! THAT HAS BEEN BUILT HANGING OFF THAT NODE IS BROKEN; NOTE
! THAT IF SOME NODE 'L' ON THAT CHAIN IS ITSELF 'BOGUS', I.E.
! HAS AN ALREADY-BUILT PCS CHAIN OF ITS OWN THAT MUST NOT BE
! BROKEN DURING THIS PROCESS, L'S 'END OF PCS' FIELD POINTS
! TO THE END OF THAT CHAIN.
!
	    Begin
	    Do
		Begin
		L = .PPSI[itm_rdata(1)];
		While .L Neqa 0 Do
		    Begin
		    If .L[gt_v_bogus] And .L[gt_end_of_pcs] Neqa 0 Then
			L = .L[gt_end_of_pcs];
		    NL = .L[gt_pcsthread];
		    L[gt_pcsthread] = 0;
		    L = .NL
		    End;
		UDPSI;
		RELITEM(.PPSI[itm_llink],SZ_PSI_ITEM);
		If .PPSI Eqla .hdr_psi Then
		    Return
		End
	    Until .VALPSI Leq .VALNXT
	    End
	Else
	    Begin
	    Do
		UDNXT
	    Until .VALNXT Leq .VALPSI
	    End
	End
End;

Routine GENPSI : Novalue =
Begin
    Local
	LSTPTR		: Ref FLOLSTPTR;

    LSTPTR = .Block[.STK[.LASTMARK+3],gt_flow];
    hdr_psi = .LSTPTR[flow_epilog];
    LSTPTR[flow_epilog] = 0;
    Incr I From .LASTMARK+4 To .TOS-1 Do
	Begin
	LSTPTR = .Block[.STK[.I],gt_flow];
	PSIINT(.LSTPTR[flow_epilog]);
	FreeList(.LSTPTR[flow_epilog]);
	LSTPTR[flow_epilog] = 0
	End
End;

!
! CALLED FROM:   G CSE FROM PSI
! ASSUMES THAT FORMER IS THE FORMAL PARENT OF BOGUS,
! AND THAT .FORMER[FSTHREAD] == .BOGUS; CAUSES THE TWO
! NODES TO SWITCH PLACES IN THE GT HASH TABLE.
!
Routine CHANGEFPAR(FORMER : Ref GT,BOGUS : Ref GT) : Novalue =
Begin
    Local
	L		: Ref GT,
	M		: Ref GT;

! locate where on the GTHASH chain the new formal parent should go

    L = .GTHASH[.FORMER[gt_code]];
    If .L Eqla .FORMER Then
	GTHASH[.FORMER[gt_code]] = .BOGUS
    Else
	Begin
	Until .L[gt_gthread] Eqla .FORMER Do
	    L = .L[gt_gthread];
	L[gt_gthread] = .BOGUS
	End;

! give the GTTHREAD to the bogus node and make former a member
! of bogus's formal thread

    BOGUS[gt_gthread]   = .FORMER[gt_gthread];
    FORMER[gt_fsthread] = .BOGUS[gt_fsthread];
    BOGUS[gt_fsthread]  = .FORMER;

! give a new formal parent to all the entries

    L = .BOGUS;
    Do
	Begin
	M = .L;
	Do
	    M[gt_fparent] = .BOGUS
	Until (M = .M[gt_csthread]) Eqla 0
	End
    Until (L = .L[gt_fsthread]) Eqla 0
End;

Routine GCSEFROMPSI : Novalue =
Begin
    Local
	L		: Ref ITEM,
	BOGNODE		: Ref GT,
	FNODE		: Ref GT,
	CNODE		: Ref GT,
	M		: Ref GT,
	I		: Ref ITEM,
	X		: Ref GT;
    Label
	aaa;

! loop for each Psi list entry

    L = .hdr_psi;
    While (L = .L[itm_rlink]) Neq .hdr_psi Do
	aaa: Begin
	CNODE = .L[itm_rdata(1)] And Not 1;

! catch (and throw out) nodes that were created before the fork, and
! were not invalidated on any branch.  they would have been created
! before the fork if they haven't been invalidated yet.

	If Not .CNODE[gt_v_purge] And Not .CNODE[gt_v_rm] Then
	    Leave aaa;

! catch (and throw out) nodes of the form '.variable'.  these are too
! simple to move.

	If .CNODE[gt_code] Eql OP_DOT And Not .CNODE[gt_v_bogus] Then
	    Begin
	    X = .CNODE[gt_arg1];
	    If .X[gt_type] Neq T_NODE Then
		Leave aaa
	    End;

! catch (and throw out) nodes on the current alpha list.  if they
! are already moving out the front then there is no sense in moving
! them out the back.

	I = .hdr_alpha[que_head];
	Until (I = .I[itm_rlink]) Eql .hdr_alpha[que_head] Do
	    Begin
	    M = .CNODE;
	    Do
		Begin
		Decr J From .I[itm_size] To 1 Do
		    If .M Eql .I[itm_int_rdata(.J)] Then
			Leave aaa
		End
	    Until (M = .M[gt_pcsthread]) Eql 0
	    End;

! create a bogus node to represent this Psi list entry

	Mark();
	FNODE = .L[itm_fparent];
	BOGNODE = MAKGT(-.FNODE,.FNODE[gt_code]);
!
! 'FPARSEARCH' MUST ENCOUNTER 'BOGNODE' BEFORE IT ENCOUNTERS
! ANY OF THE BRANCH NODES; THEREFORE, THE FOLLOWING CHECK IS
! MADE, AND IF ANY OF THE BRANCH NODES IS FORMAL PARENT OF THE
! REST OF THEM, IT CHANGES PLACE IN THE GT-HASH TABLE WITH
! 'BOGNODE'.
!
	M = .CNODE;
	Do
	    If .M Eqla .FNODE Then
		Begin
		CHANGEFPAR(.M,.BOGNODE);
		Exitloop
		End
	Until (M = .M[gt_pcsthread]) Eqla 0;

! add to the bogus list

	ENLST(.hdr_bogus[stk_data],MAKITEM(.BOGNODE));

! give it all the characteristics of a bogus node

	BOGNODE[gt_v_bogus]    = TRUE;
	BOGNODE[gt_occ]        = 0;

! tack the Psi list onto the bogus node and also note the end of the list

	BOGNODE[gt_pcsthread]  = .CNODE;
	FNODE = .CNODE;
	Until .FNODE[gt_pcsthread] Eqla 0 Do
	    FNODE = .FNODE[gt_pcsthread];
	BOGNODE[gt_end_of_pcs] = .FNODE;

! lower the level of the head of the Psi list so it look usable

	CNODE[gt_crlevel]      = .LEVEL;
	CNODE[gt_v_purge]      = FALSE;
	CNODE[gt_v_rm]         = FALSE;
	CNODE[gt_v_mm]         = FALSE
	End;
    FreeList(.hdr_psi)
End;

!
! CALLED FROM:   BIND LOOP CSE
! ARGUMENT:  NODE - A GT NODE WITHIN THE CURRENT LOOP
! VALUE RETURNED:  IF THE NODE HAS A CSE PARENT OUTSIDE THE LOOP,
!		   RETURN A POINTER TO THE CSE PARENT; OTHERWISE 0.
!
Routine FINDPRELOOPCSE(NODE : Ref GT) =
Begin
    Local
	L		: Ref GT,
	Q		: Ref LVL,
	NEXTFLOOR	: Integer,
	THISFLOOR	: Integer;

! loop for a CSE between the current floor and the previous floor

    THISFLOOR = .FLOOR[stk_data];
    Q = .FLOOR[stk_next];
    NEXTFLOOR = .Q[stk_data];
    L = .NODE[gt_fparent];
    Do

! if not invalidated and created above the lower floor then we found it

	If Not .L[gt_v_rm] And Not .L[gt_v_purge] And .L[gt_crlevel] Lss .THISFLOOR Then
	    If .L[gt_crlevel] Geq .NEXTFLOOR Then
		Return .L
    While (L = .L[gt_fsthread]) Neqa 0;
    Return 0
End;

!
! CALLED FROM:   BIND LOOP CSE
! ARGUMENT: X - A GT NODE IN THE CURRENT LOOP, FOR WHICH A
!		CSE PARENT HAS JUST BEEN FOUND OUTSIDE THE LOOP.
! PURPOSE:  TAKE X OFF THE PROLOG OF THE CURRENT LINEAR BLOCK (IF IT'S ON).
!
! notes
!	'X' has just been found to be a CSE outside the loop.  it thus
!	does not belong in the prolog of the current block
!
Routine REMOVEFROMPRLG(X : Ref GT) : Novalue =
Begin
    Local
	FPAR		: Ref GT,
	L		: Ref ITEM;

    FPAR = .X[gt_fparent];
    L = .hdr_prolog[stk_data];
    While (L = .L[itm_rlink]) Neqa .hdr_prolog[stk_data] Do
	If .L[itm_fparent] Eqla .FPAR Then
	    Return RELITEM(.L,SZ_ITEM(1))
End;

!
! CALLED FROM:   GPOSTWDW, GPOSTREP
! PURPOSE:
!	FOR EVERY NODE CREATED IN THE CURRENT LOOP, TRY TO FIND
!	A CSPARENT OUTSIDE THE LOOP, AND IF IT IS FOUND, RESET
!	ALL THE APPROPRIATE 'CSTHREAD','CSPARENT',ETC. FIELDS.
!
! notes
!	CSE recognition is disabled across the floor of a loop.
!	for those expression created in the loop but not invalidated
!	a check is made for a matching CSE outside the loop and
!	if found, the CSE inside the loop is bound to it.
!
Routine BINDLOOPCSE : Novalue =
Begin
    Local
	L		: Ref GT,
	LFP		: Ref GT,
	LC		: Ref GT,
	L1		: Ref GT,
	A		: Integer,
	F		: Integer,
	M		: Ref GT;
    Label
	aaa,bbb,ccc;

    If .swit_quick Then
	Return;

    F = .FLOOR[stk_data];
    A = .ABCBASE[stk_data];

! loop for all CSE's

    FORALLRATORS(I)
	Begin
	LFP = .GTHASH[.I];
	While .LFP Neq 0 Do
	    Begin
	    M = .LFP;
	    While (M = L = .M[gt_fsthread]) Neq 0 Do
		ccc: Begin

! if created above the floor (e.g. inside the loop) and in this
! linear block and not purged...

		If .L[gt_crlevel] Lss .F Then
		    Leave ccc;
		If .L[gt_abc] Lss .A Then
		    Leave ccc;
		If .L[gt_v_rm] Then
		    Leave ccc;

! if there is a CSE outside the loop which it is a CSE of...

		LC = FINDPRELOOPCSE(.L);
		If .LC Eqla 0 Then
		    Leave ccc;

! if an unbound Psi CSE then bind it

		If .LC[gt_v_bogus] And .LC[gt_occ] Eql 0 Then
		    BINDPCSTHREAD(.LC);

! if a Psi list parent...

		If .L[gt_v_bogus] Then
		    Begin
		    L[gt_v_rm] = TRUE;
		    L[gt_mklevel] = 0;

! ... with CSE's off it (if bogus, how could it not have children?  if
! it was split up earlier?)

		    If .L[gt_occ] Gtr 0 Then
			Begin

! attach all the entries to their new CSE parent

			L1 = .L[gt_csthread];
			Do	! RESET 'CSPARENT' FIELDS OF CSE USES
			    Begin
			    L1[gt_csparent] = .LC;
			    L1[gt_depth] = .LC[gt_xdepth];
			    L1[gt_v_mustgencode] = FALSE;
			    If .L1[gt_csthread] Eqla 0 Then
				Exitloop;
			    L1 = .L1[gt_csthread]
			    End
			While TRUE;

! attach them to the CSE list

			L1[gt_csthread] = .LC[gt_csthread];
			LC[gt_csthread] = .L[gt_csthread];
			L[gt_csthread] = 0;
			LC[gt_occ] = .LC[gt_occ]+.L[gt_occ];
			DECROCC(.LC)
			End
		    End
		Else ! if .LC[BOGUSBIT]

! if not bogus

		    Begin
		    L1 = .L;
		    Do	! RESET 'CSPARENT' FIELDS OF CSE USES
			Begin
			L1[gt_csparent] = .LC;
			If .L1[gt_csthread] Eqla 0 Then
			    Exitloop;
			L1 = .L1[gt_csthread];
			L1[gt_depth] = .LC[gt_xdepth]
			End
		    While TRUE;
		    L[gt_v_mustgencode] = FALSE;
		    aaa: Begin	! PUT 'L' AT END OF CSE CHAIN OF 'LC'
			L1 = .LC;
			While .L1[gt_csthread] Neqa 0 Do
			    If .L1[gt_csthread] Eqla .L Then
				Leave aaa
			    Else
				L1 = .L1[gt_csthread];
			L1[gt_csthread] = .L
			End;
		    L1 = .LFP;
		    bbb: Begin	! TAKE 'L' OFF CHAIN OF CSE PARENTS
			While .L1[gt_fsthread] Neqa .L Do
			    If (L1 = .L1[gt_fsthread]) Eqla 0 Then
				Begin
				L1 = .L;
				Leave bbb
				End;
			L1[gt_fsthread] = .L[gt_fsthread];
			L[gt_fsthread] = 0
			End;
		    LC[gt_occ] = .LC[gt_occ]+.L[gt_occ];
		    DECROCC(.LC);
		    M = .L1
		    End;
		REMOVEFROMPRLG(.L);
		L[gt_depth] = .LC[gt_xdepth]
		End;
	    LFP = .LFP[gt_gthread]
	    End
	End
End;

! test whether a node from a loop prolog may be placed on a Chi list
! (e.g. is loop invariant.)
!
! notes:
!	here is the reason why entries may point to alpha lists
!	rather than items.  it is because all the items on the
!	alpha list must be checked.
!
!	see page 31 of "The Design of an Optimizing Compiler".
!
!	"Given a loop control environment, the set of loop invariant
!	expressions is described by:  X = prolog(B) /\ epilog(B),
!	where B is the linear block relative to the compound
!	expression (B1;B2) in the "do-while" case and (B2;B1) in the
!	"while-do" case."

Routine ISCHI(I : Ref ITEM) =
Begin
    Bind
	NODE = I	: Ref GT;
    Local
	P		: Ref GT;

! if this is an alpha list entry then it is a Chi entry if all the
! items on the alpha list may be on the Chi list

    If .I<0,1> Then
	Begin
	I<0,1> = 0;
	Decr J From .I[itm_size] To 1 Do
	    If Not ISCHI(.I[itm_int_rdata(.J)]) Then
		Return FALSE
	End
    Else

! for regular expressions, an item is available for the Chi list if
! the node has not been killed and its CSE parent has not been killed

	Begin
	If .NODE[gt_v_rm] Or .NODE[gt_v_purge] Then
	    Return FALSE;
	p = .NODE[gt_csparent];
	If .p[gt_v_rm] Or .p[gt_v_purge] Then
	    Return FALSE
	End;
    Return TRUE
End;

!
! VALUE:   IF Z AND LFP TOGETHER BELONG ON RHO LIST OF CURRENT LOOP,
!	   RETURN LFP; IF NO SUCH LFP CAN BE FOUND, RETURN 0.
!
! notes:
!	this routine determines whether an expressions is cyclically
!	re-evaluated.
!
!	'L' had previously been discovered to be invalidated by ISCHI above.
!
!	this routine searches for a later instance of the expression
!	'L' which is still valid in the loop.  if found, it will
!	supply the next valid value for 'L'.
!
!	see page 32 of "The Design of an Optimizing Compiler".
!
!	"Given a loop control environment where B is the linear block
!	relative to the expression (B1;B2) ("do-while") or (B2;B1)
!	("while-do"), the set of expressions whose evaluations at
!	the head of B are redundant to evaluations at the tail of B
!	are described by the set:  P = prolog(B) /\ epilog(B)."

Routine ENRHO(L : Ref ITEM) =
Begin
    Local
	LFP		: Ref GT,
	Z		: Ref GT;

! simple dotted variables never go on the Rho list

    Z = .Block[NONBOGUS(.LFP),gt_arg1];
    If .LFP[gt_code] Eql OP_DOT And .Z[gt_type] Eql T_VARIABLE Then
	Return 0;

! look for a CSE parent which has not been invalidated and was created
! in this loop

    LFP = .L[itm_fparent];
    Do
	If Not .LFP[gt_v_rm] And Not .LFP[gt_v_purge] Then
	    If .LFP[gt_crlevel] Geq .FLOOR[stk_data] Then
		Return .LFP
    While (LFP = .LFP[gt_fsthread]) Neqa 0;
    Return 0
End;

! GENERATE THE CHI AND RHO LISTS FOR A LOOP CONTROL CONSTRUCT

Routine GENCHIRHOLST : Novalue =
Begin
    Local
	L		: Ref ITEM,
	HDR		: Ref LSTHDR,
	NODE		: Ref GT,
	RANDLEX		: Ref GT,
	LC		: Ref ITEM,
	L2		: Ref ITEM;

! loop, selecting items from the prolog to place on either the
! Chi list or maybe the Rho list
!
! note: this code is similar to the code in GENALPHA

    L = HDR = .hdr_prolog[stk_data];
    While (L = .L[itm_rlink]) Neqa .HDR Do

! try first to put it on the Chi list

	If ISCHI(.L[itm_rdata(1)]) Then
	    ENLST(.hdr_chi[que_head], MAKITEM(.L[itm_data(1)]))

! try second to put it on the Rho list

	Else If (LC = ENRHO(.L)) Neqa 0 Then
	    ENLST(.hdr_rho[que_head], MAKITEM(.L[itm_data(1)],.LC));

! convert pointers to other alpha lists to real nodes

    HDR = L = .hdr_chi[que_head];
    While (L = .L[itm_rlink]) Neqa .HDR Do
	Begin
	LC = .L[itm_rdata(1)];

! if an alpha list entry rather than an item, resolve to the real entry

	While .LC<0,1> Do
	    Begin
	    LC<0,1> = 0;
	    LC = .LC[itm_int_rdata(1)]
	    End;
	L[itm_rdata(1)] = .LC
	End;

! the same for the Rho list

    HDR = L = .hdr_rho[que_head];
    While (L = .L[itm_rlink]) Neqa .HDR Do
	Begin
	LC = .L[itm_rdata(1)];
	While .LC<0,1> Do
	    Begin
	    LC<0,1> = 0;
	    LC = .LC[itm_int_rdata(1)]
	    End;
	L[itm_rdata(1)] = .LC
	End;

! mark all children of Rho list entries as Rho children.

    L = .HDR;
    While (L = .L[itm_rlink]) Neqa .HDR Do
	Begin
	NODE = .L[itm_rdata(1)];
	FORALLRANDS(I,.NODE)
	    Begin
	    RANDLEX = .NODE[gt_argv(.I)];
	    If .RANDLEX[gt_type] Eql T_NODE Then
		RANDLEX[gt_v_rho] = TRUE
	    End
	End;

! now remove the children marked above from the Rho list

    L = .HDR[itm_rlink];
    While .L Neq .HDR Do
	Begin
	NODE = .L[itm_rdata(1)];
	L2 = .L;
	L = .L[itm_rlink];
	If Not .NODE[gt_v_rho] Then
	    Begin
	    L2[itm_abc] = .NODE[gt_abc];

! reverse the order of the Rho list

	    ENLST(.HDR,DELINK(.L2))
	    End
	Else
	    Begin
	    NODE = .L2[itm_rdata(2)];
	    NODE[gt_v_rho] = TRUE;
	    RELITEM(.L2,SZ_RHO_ITEM)
	    End;
	End;
End;

!
! CALLED FROM:   F16, F17, F18
! SEE GALPHATOPRLG
!
! notes:
!	this routine moves Chi list entries to the prolog.  it
!	also makes sure that a child of a Chi entry is not on
!	the Chi list with its parent.

Routine GCHITOPRLG(chi_level : Integer) : Novalue =
Begin
    Local
	L		: Ref ITEM,
	HDR		: Ref LSTHDR,
	NODE		: Ref GT,
	HI		: Integer,
	RANDLEX		: Ref GT,
	L2		: Ref ITEM;

    If .NOTREE Then
	Return;

! loop for each Chi entry.  if not killed, add it to the prolog list

    HI = .hdr_chi[que_abc];
    L = HDR = .hdr_chi[que_head];
    While (L = .L[itm_rlink]) Neqa .HDR Do
	If GALOMBITS(.HI,.ABCBASE[stk_data],.L[itm_fparent]) Then
	    ENLST(.hdr_prolog[stk_data],MAKITEM(.L[itm_data(1)]));
    L = .HDR;

! now mark all the children of Chi list entries
!
! Q: why was this not done above?
!
! A: maybe to emphasize that the above loop moved all entries on the
!    Chi listing including children of other Chi entries.

    While (L = .L[itm_rlink]) Neqa .HDR Do
	Begin
	NODE = .L[itm_rdata(1)];
	FORALLRANDS(I,.NODE)
	    Begin
	    RANDLEX = .NODE[gt_argv(.I)];
	    If .RANDLEX[gt_type] Eql T_NODE Then
		RANDLEX[gt_v_chi] = TRUE
	    End
	End;

! REVALIDATE ALL NODES ON THE CHI LIST.  ALSO SEE OPENWUCSE
! if a node is a child of another entry on the Chi list then remove it

    L = .HDR[itm_rlink];
    While .L Neqa .HDR Do
	Begin
	NODE = .L[itm_rdata(1)];
	NODE[gt_crlevel] = .chi_level;
	NODE[gt_v_jm]    = FALSE;
	NODE[gt_v_rm]    = FALSE;
	NODE[gt_v_mm]    = FALSE;
	NODE[gt_v_purge] = FALSE;
	L2 = .L;
	L  = .L[itm_rlink];

! if a child of a Chi entry then remove it.  don't want both
! parents and children on the same list.

	If .NODE[gt_v_chi] Then
	    RELITEM(.L2,SZ_CHI_ITEM)
	Else
	    Begin
	    L2[itm_abc] = .NODE[gt_abc];

! reverse the order of the Chi list

	    ENLST(.HDR,DELINK(.L2))
	    End
	End
End;

!
! CALLED FROM:   F16, F18
! CALLED WHEN:   AFTER WHILE-DO,UNTIL-DO,DO-WHILE,DO-UNTIL LOOP
! PURPOSE:
!	TAKE ALL NODES THAT 1.  WERE CREATED IN THE LOOP
!			    2.  WERE NOT INVALIDATED AFTER CREATION
!			    3.  MUST BE EXECUTED AT LEAST ONCE
!   (I.E. FOR A WHILE-DO LOOP, THE EPILOGUE LIST OF THE WHILE PART;
!	  FOR A DO-WHILE LOOP, THE EPILOGUE LIST OF THE ENTIRE LOOP)
!   (N.B. THE SAME LISTS THAT WERE CREATED BY GFWHILE,GFDOWHILE)
!	AND REVALIDATES THE NODES, LOWERING THEIR CRLEVEL VALUES
!	TO MAKE THEM LOOK AS IF THEY WERE CREATED OUTSIDE THE LOOP.
! ARGUMENT: WHICHTYPE - TRUE FOR DO-WHILE,DO-UNTIL
!			FALSE FOR WHILE-DO,UNTIL-DO
!
! notes:
!	this routine exposes redundant expressions to their
!	surrounding environment.
!
!	see page 32-33 of "The Design of an Optimizing Compiler".
!

Routine OPENWUCSE(WHICHTYPE : Boolean) : Novalue =
Begin
    Local
	LSTPTR		: Ref FLOLSTPTR,
	NODE		: Ref GT,
	L		: Ref ITEM,
	HDR		: Ref LSTHDR,
	LCP		: Ref GT;

! if tree generation turned off...

    If .NOTREE Then
	Return;

! if DO...

    If .WHICHTYPE Then
	Begin
	NODE = .SYM[gt_arg4];			! DO condition
	If .NODE[gt_type] Neq T_NODE Then
	    NODE = .SYM[gt_arg3]		! DO body
	End
    Else

! if WHILE...

	NODE = .SYM[gt_arg3];			! WHILE condition

! return if the condition/body is not a null because it would not
! have an epilog set

    If .NODE[gt_type] Neq T_NODE Then
	Return;

! loop for each epilog entry

    LSTPTR = .NODE[gt_flow];
    L = HDR = .LSTPTR[flow_epilog];
    While (L = .L[itm_rlink]) Neqa .HDR Do
	Begin
	LCP = .L[itm_rdata(1)];

! loop for each CSE parent

	Do
	    Begin

! if the CSE parent was not purged and created in this loop then
! lower its creation level and make it look valid outside the loop.

	    LCP = .LCP[gt_csparent];
	    If Not .LCP[gt_v_purge] And .LCP[gt_crlevel] Geq .LEVEL Then
		Begin
		If .LCP[gt_v_rm] Then
		    LCP[gt_v_mm] = TRUE;
		LCP[gt_v_rm]    = FALSE;
		LCP[gt_crlevel] = .LEVEL;
		LCP[gt_xdepth]  = .LOOPDEPTH;
		Exitloop
		End
	    End
	While (LCP = .LCP[gt_fsthread]) Neqa 0
	End;

! all done with the epilog list now

    FreeList(.HDR);
    LSTPTR[flow_epilog] = 0
End;

!
! CALLED FROM:   F16, F18
! CALLED WHEN:   A WHILE OR UNTIL LOOP HAS BEEN PARSED
!
Routine GPOSTWDW : Novalue =
Begin
    Local
	LSTPTR		: Ref FLOLSTPTR;

    If .NOTREE Then
	Return;

! find any expressions within the loop which have not been invalidated
! and have a CSE outside the loop and bind them together.

    BINDLOOPCSE();

! form the Chi and Rho lists

    hdr_chi = .SYM[gt_arg2];
    hdr_rho = .SYM[gt_arg1];
    GENCHIRHOLST();

! we can release the prologue now.

    FreeList(.hdr_prolog[stk_data]);
    If .SYM[gt_type] Eql T_NODE Then
	Begin
	LSTPTR = .SYM[gt_flow];
	LSTPTR[flow_prolog] = 0
	End
End;

!
! CALLED BY:   F25
! CALLED WHEN:  A LABELED EXPRESSION HAS BEEN PARSED
! PURPOSE:
!	REMOVE TYPE 1 KILLS CAUSED BY "LEAVE"S TO THAT LABEL
!	FROM THE KILL LIST.
!
! notes:
!	LEAVE's block alpha and omega code motion.  when the
!	block the LEAVE is contained in goes out of scope then
!	the blockage is removed.

Routine REMOVELEAVEKILLS(LABNODE : Ref GT) : Novalue =
Begin
    Local
	I		: Ref ITEM,
	I2		: Ref ITEM,
	NODE		: Ref GT;

    I = .hdr_kill;
    I = .I[itm_rlink];
    While .I Neqa .hdr_kill Do
	Begin
	I2 = .I;
	I = .I[itm_rlink];
	If .I2[itm_kill_abc] Lss .ABCOUNT Then
	    Return;
	NODE = .I2[itm_kill_cause];
	If .I2[itm_kill_type] Eql 1 And .NODE[gt_arg2] Eqla .LABNODE[gt_arg2] Then
	    RELEASESPACE(DELINK(.I2),SZ_ITEM(1))
	End
End;

!
! I'M NOT SURE THERE'S ANY JUSTIFICATION FOR THIS ROUTINE.
! CALLED BY GPOSTREP; SETS THE CKF FIELD OF THE REQUEST
! WORD PASSED (IN "DELAY") TO THE 'BY' OR 'TO' PARTS OF
! AN INCR-DECR LOOP.
!
! notes
!	this routines notes whether the TO and BY parts are
!	invalidated within the loop.  If they are then they
!	most certainly have to be placed in a temporary.  If
!	not then delay may choose to use the value directly.

Routine BYTOCHK(N : Ref GT) =
Begin
    Macro
	FLD_K_OPERAND	= 1^57 %,
	FLD_K_TEMP	= 3^57 %;  ! CAUTION, COPIED FROM DELAY

    If .N[gt_type] Neq T_NODE Then
	Return .N+FLD_K_OPERAND
    Else If .N[gt_v_rm] Eql 0 And .N[gt_v_mm] Eql 0 Then
	Return .N+FLD_K_OPERAND
    Else
	Return .N+FLD_K_TEMP
End;

!
! CALLED FROM:   F17
! CALLED WHEN:   AN INCR-DECR LOOP HAS BEEN PARSED
!

Routine GPOSTREP : Novalue =
Begin
    Local
	LSTPTR		: Ref FLOLSTPTR;

    If .NOTREE Then
	Return;

! find any expressions not invalidated within the loop and
! which are CSE's outside the loop and bind them together.

    BINDLOOPCSE();

! give information to DELAY as to whether the loop increment
! and limit expressions were invalidated within the loop.

    STK[.TOS-3] = BYTOCHK(.STK[.TOS-3]);
    STK[.TOS-4] = BYTOCHK(.STK[.TOS-4]);

! generate the Chi and Rho lists and release the prolog afterward

    hdr_chi = .STK[.TOS-1];
    hdr_rho = .STK[.TOS-2];
    GENCHIRHOLST();
    FreeList(.hdr_prolog[stk_data]);

! note that this node no longer has a valid prolog list attached to it
!
! Q: how can sym not be a node?

    If .SYM[gt_type] Eql T_NODE Then
	Begin
	LSTPTR = .SYM[gt_flow];
	LSTPTR[flow_prolog] = 0
	End
End;

! called by:
!	SELECT   pre-e2
!	LEAVE    pre-e0
!	EXITLOOP pre-e0
!	ENABLE

Global Routine F0 : Novalue =
Begin
    PUSHANDBUMP(CEILING)
End;

! called by:
!	DO	pre-e1

Global Routine F1 : Novalue =
Begin
    PUSHANDBUMP(FLOOR);
    PUSHFLO();
    PushQueue(T_RHO);
    PushQueue(T_CHI)
End;

! called by:
!	RETURN	post-e0

Global Routine F2 : Novalue =
Begin
    KILL(0,.SYM)
End;

! called by:
!	INLINE	post-e0

Global Routine F3 : Novalue =
Begin
    KILL(5,.SYM);
    MARKALL(TRUE)
End;

! called by:
!	IF	post-e1
!	IF	post-e2
!	CASE	post-e1

Global Routine F4 : Novalue =
Begin
    MARKMMNODES();
    GFBRANCH();
    POPFLO();
    REFRESH()
End;

! called by:
!	IF	pre-make
!	CASE	pre-make

Global Routine F5 : Novalue =
Begin
    PushQueue(T_OMEGA);
    MARKUPDATE();
    POPANDDUMP(CEILING);
    MARKMMNODES();
    GPOSTFORK()
End;

! called by:
!	INCR	pre-make

Global Routine F6 : Novalue =
Begin
    PURGE();
    MARKUPDATE();
    POPANDDUMP(CEILING);
    POPANDDUMP(FLOOR)
End;

! called by:
!	SELECT	post-e2
!	ENABLE	post-e2

Global Routine F7 : Novalue =
Begin
    PURGE();
    MARKUPDATE();
    POPANDDUMP(CEILING);
    MARKMMNODES()
End;

! called by:
!	IF	pre-e1
!	IF	pre-e2
!	CASE	pre-e1

Global Routine F8 : Novalue =
Begin
    PUSHFLO()
End;

! called by:
!	SINCR between initial, low, and high values
!	CALL between each argument
!	SELECT
!	CREATE between each argument
!	SIF after creating a node for a literal condition
!	DO after parsing the loop condition

Global Routine F9 : Novalue =
Begin
    MARKMMNODES()
End;

! called by:
!	SINCR before parsing the loop body

Global Routine F10 : Novalue =
Begin
    PUSHANDBUMP(FLOOR);
    PUSHANDBUMP(CEILING);
    ENTVUSELST(.STK[.LASTMARK+1],0);
    ENTVCHGLST(.STK[.LASTMARK+1],0);
    PUSHFLO();
    PushQueue(T_RHO);
    PushQueue(T_CHI)
End;

! called by:
!	CALL and CREATE after creating a CALL node
!
! note:	CREATE is really a special form of call.

Global Routine F11 : Novalue =
Begin
    Local
	L		: Ref GT,
	LFP		: Ref GT,
	B		: Ref GT,
	Q		: Ref GT;

    Routine MLST(L : Ref ST) : Novalue =
    Begin
	Do
	    MRK(L)
	While (L = .L[gt_fsthread]) Neqa 0
    End;

    If .swit_quick Then
	Return;
    If .NOTREE Then
	Return;

! look for arguments which are the addresses of names and mark those
! names as being both referenced and modified.

    FORALLRANDS(I,.SYM)
	Begin
	Q = FINDNAME(.SYM[gt_argv(.I)]);
	If .Q Neqa 0 Then
	    Begin
	    MRKDOTNODES(.Q);
	    ENTVCHGLST(.Q,.SYM);
	    ENTVUSELST(.Q,.SYM);
	    End
	End;

! next, mark all non-local variables (e.g. variables which the
! called routine may modify) which have been dotted.

    LFP = .GTHASH[OP_DOT];
    While .LFP Neqa 0 Do
	Begin
	B = NONBOGUS(.LFP);
	Q = FINDNAME(.B[gt_arg1]);
	If .Q Neqa 0 Then
	    Begin
	    If Not .Q[st_v_nouplevel] And ISSTVAR(Q) Then
		MLST(.LFP)
	    End
	Else If .swit_mark Then
	    MLST(.LFP);
	LFP = .LFP[gt_gthread]
	End;

! insert a kill so loads and store may not move past the call

    KILL(4,.SYM)
End;

! called by:
!	RNAMESFOLLOWS before parsing a routine body
!
! notes
!	this routine saves the current flow context for a nested
!	routine declaration.

Global Routine F12 : Novalue =
Begin
    Local
	L	: Ref Vector;

    PUSHFLO();
    PUSHLV(hdr_bogus,SZ_LVL);
    hdr_bogus[stk_data] = MAKHDR(BOGREMOVE,BOGENTER);
    If .swit_quick Then
	Return;
    L = GETSPACE(MAXDELIMITER+2);
    MOVECORE(GTHASH,.L,MAXDELIMITER+1);
    CLEARCORE(GTHASH,MAXDELIMITER+1);
    L[MAXDELIMITER+1] = .FOUNDATION;
    FOUNDATION = .L
End;

! called by:
!	RNAMEFOLLOWS after creating a routine body node

Global Routine F13 : Novalue =
Begin
    Local
	L1		: Ref Vector,
	L		: Ref ST,
	E		: Ref ITEM,
	Q		: Ref LSTHDR;

    FreeList(.hdr_prolog[stk_data]);
    POPFLO();
    ABCOUNT = .ABCBASE[stk_data];

! release all kill items created in the current routine

    Q = .hdr_kill;
    Until (E = .Q[itm_rlink]) Eqla .hdr_kill Do
	Begin
	If .E[itm_kill_abc] Leq .ABCOUNT Then
	    Exitloop;
	RELEASESPACE(DELINK(.E),SZ_ITEM(1))
	End;
    If .swit_quick Then
	Return;

! restore the GT hash chains

    L1 = .FOUNDATION;
    FOUNDATION = .L1[MAXDELIMITER+1];
    MOVECORE(.L1,GTHASH,MAXDELIMITER+1);

! release all the use/change list entries created for this routine

    Decr J From HTSIZE-1 To 0 Do
	Begin
	L = .HT_THREAD[.J];
	While .L Neqa 0 Do
	    Begin
	    If ISSTVAR(L) Then
		If .L[st_var_chg_list] Neqa 0 Then
		    Decr I From 1 To 0 Do
			Begin
			Q = (If .I
				Then .L[st_var_use_list]
				Else .L[st_var_chg_list]);
			While (E = .Q[itm_rlink]) Neqa .Q Do
			    Begin
			    If .E[itm_abc] Leq .ABCOUNT Then
				Exitloop;
			    RELEASESPACE(DELINK(.E),SZ_ITEM(1))
			    End
			End;
	    L = .L[st_next]
	    End
	End;
    RELEASESPACE(.L1,MAXDELIMITER+2)
End;

Global Routine CLEANUPFLOW : Novalue =
Begin
    If .num_error Eql 0 Then
	Begin
	FreeList(.hdr_bogus[stk_data]);
	POPLV(hdr_bogus,SZ_LVL)
	End
End;

! called by:
!	SOPERATOR for AND/OR and by SEXITLOOP after parsing the leave
!	expression.

Global Routine F14 : Novalue =
Begin
    PURGE();
    MARKUPDATE();
    POPANDDUMP(CEILING)
End;

! called by:
!	SIF after parsing the conditional expression

Global Routine F15 : Novalue =
Begin
    MARKMMNODES();
    PUSHANDBUMP(CEILING)
End;

! called by:
!	SDO after creating the DO node

Global Routine F16 : Novalue =
Begin
    GFLOOP();
    GPOSTWDW();
    POPANDDUMP(FLOOR);
    POPFLO();
    GCHITOPRLG(.LEVEL);
    OPENWUCSE(TRUE)
End;

! called by:
!	SINCR after parsing the loop body

Global Routine F17 : Novalue =
Begin
    Local
	L		: Ref LVL;

    GFLOOP();
    MARKMMNODES();
    GPOSTREP();
    POPFLO();
    L = .LVLCOPY[stk_next];
    L = .L[stk_next];
    GCHITOPRLG(.L[stk_data])
End;

! called by:
!	SWU after creating the while node

Global Routine F18 : Novalue =
Begin
    GFLOOP();
    GPOSTWDW();
    PURGE();
    MARKUPDATE();
    POPANDDUMP(CEILING);
    POPANDDUMP(FLOOR);
    POPFLO();
    GCHITOPRLG(.LEVEL);
    OPENWUCSE(FALSE)
End;

! called by:
!	SWU after parsing the while condition

Global Routine F19 : Novalue =
Begin
    MARKMMNODES();
    PUSHANDBUMP(CEILING);
    GFWHILE()
End;

! called by:
!	SIF before the conditional expression is parsed

Global Routine F20 : Novalue =
Begin
    PushQueue(T_ALPHA)
End;

! called by:
!	SCOMPOUND after creating an enable block label

Global Routine F21 : Novalue =
Begin
    MARKALL(TRUE)
End;

! called by:
!	ENABLE	pre-e0

Global Routine F22 : Novalue =
Begin
    PUSHANDBUMP(CEILING);
    PUSHANDBUMP(FLOOR)
End;

! called by:
!	ENABLE	post-make

Global Routine F23 : Novalue =
Begin
    PURGE();
    MARKUPDATE();
    POPANDDUMP(CEILING);
    POPANDDUMP(FLOOR);
    MARKMMNODES()
End;

! called by:
!	LEAVE	post-make
!	EXITLOOP post-make

Global Routine F24 : Novalue =
Begin
    Local
	LABL		: Ref ST,
	LABLEVEL	: Integer,
	OLDINC		: Integer;

    If .swit_quick Then
	Return;
    If .NOTREE Then
	Return;

! add a kill entry so that code may not move past this point

    KILL(1,.SYM);
    LABL = .SYM[gt_arg2];

! if this is the first leave then raise the levels up to the point
! of the labelled block.  this makes all nodes after the leave
! look sorta like the else part of an if statement and thus follow
! the same rules for code motion as an else part.

    If Not .LABL[st_lab_left] Then
	Begin
	LABL[st_lab_left] = TRUE;
	OLDINC = .LABL[st_lab_inc];
	LABLEVEL = .LABL[st_lab_level];
	NOTELEAVE(CEILING,.LABLEVEL,.OLDINC);
	NOTELEAVE(LVLCOPY,.LABLEVEL,.OLDINC);
	LEVEL = .LEVEL+.OLDINC
	End
End;

! called by:
!	SFLABEL after the label node is created

Global Routine F25 : Novalue =
Begin
    Local
	S		: Ref ST;

    If .swit_quick Then
	Return;
    If .NOTREE Then
	Return;
    S = .SYM[gt_arg2];

! reduce the level increment

    LEVELINC = .LEVELINC/2;

! if the label was really referenced then nothing created inside
! it is available as a CSE.  Also, restore the level and ceiling
! to what they were before the leave.

    If .S[st_lab_left] Then
	Begin
	PURGE();
	REMOVELEAVEKILLS(.SYM);
	CEILING[stk_data] = .CEILING[stk_data] - .LEVELINC;
	LEVEL = LVLCOPY[stk_data] = .LEVEL - .LEVELINC
	End
End;

! called by:
!	SDO after the loop body is parsed

Global Routine F26 : Novalue =
Begin
    GFDOWHILE()
End;

! called by:
!	SCASE after the selector expression is parsed

Global Routine F27 : Novalue =
Begin
    PushQueue(T_ALPHA);
    MARKMMNODES();
    PUSHANDBUMP(CEILING)
End;

! called by:
!	SIF and SCASE when IF condition and CASE selector is
!	found to be a constant.

Global Routine F28 : Novalue =
Begin
    POPANDDUMP(CEILING)
End;

! called by:
!	SCOMP after declarations and before first statement

Global Routine F29 : Novalue =
Begin
    ABCOUNT = .ABCOUNT + 1
End;

End
Eludom