! File:   NCSE.RTN
!
!    This work was supported by the Advanced Research
!    Projects Agency of the Office of the Secretary of
!    Defense (F44620-73-C-0074) and is monitored by the
!    Air Force Office of Scientific Research.

Module NCSE =
Begin

Require 'bliss.req';

!
!   DECLARATIONS AND SUPPORT ROUTINES FOR DETECTING AND
!   USING NAMES AS COMMON SUBEXPRESSIONS.

External Routine
	NONBOGUS,
	GETLOAD,
	GETFAKE;

Macro
	CTCNT	= 0, 0,32,0 %,
	CTST	= 0,32,32,0 %,
	NCGT	= 0, 0,32,0 %,
	NCST	= 0,32,32,0 %;

Literal
	CTSIZ=64,	!NUMBER OF ENTRIES IN CTTBL TABLE (MUST BE POWER OF 2)
	NCSIZ=32;	!NUMBER OF ENTRIES IN NCSE TABLE (MUST BE POWER OF 2)

External
	FLSTK		: Ref ITEM;

Macro
	NCNDX(X)	= ((X) And (NCSIZ-1)) %,
	NCHASH(X)	= (NCNDX((X)^(-3))) %;

Own
	CTTBL		: BlockVector[CTSIZ,1],
	NCSE		: BlockVector[NCSIZ,1];

Routine NCSEARCH(X : Ref GT)=
Begin
    Local
	N		: Integer,
	E		: Integer;

    E = N = NCHASH(.X);
    Do
	Begin
	If .NCSE[.N,NCST] Eql .X<lex_part> Then
	    Return .N
	Else If .NCSE[.N,NCST] Eql 0 Then
	    Exitloop
	End
    While NCNDX(N = .N+1) Neq .E;
    Return -1
End;

Routine NCINIT : Novalue =
Begin
    CLEARCORE(NCSE,NCSIZ*2);
    FLSTK = 0
End;

Routine NCINSERT(X : Ref GT) : Novalue =
Begin
    Local
	E		: Integer,
	N		: Integer;

    E = N = NCHASH(.X);
    Do
	Begin
	If .NCSE[.N,NCST] Eql .X<lex_part> Then
	    Exitloop
	Else If .NCSE[.N,NCST] Eql 0 Then
	    Begin
	    NCSE[.N,NCST] = .X<lex_part>;
	    Exitloop
	    End
	End
    While NCNDX(N = .N+1) Neq .E
End;

Macro
	CTNDX(X)= ((X) And (CTSIZ-1)) %,
	CTHASH(X)= (CTNDX((X)^(-3))) %;

Routine CTSEARCH(X : Ref GT) =
Begin
    Local
	N		: Integer,
	E		: Integer;

    E = N = CTHASH(.X);
    Do
	Begin
	If .CTTBL[.N,CTST] Eql .X<lex_part> Then
	    Return .N
	Else If .CTTBL[.N,CTST] Eql 0 Then
	    Return (1^63) Or .N
	End
      While CTNDX(N = .N+1) Neq .E;
    Return -1
End;

Routine CTINSERT(X : Ref GT) =
Begin
    Local
	N		: Integer;

    N = CTSEARCH(.X);
    If .N Eql -1 Then
	Return -1;
    If .N Lss 0 Then
	CTTBL[CTNDX(.N),CTST] = .X<lex_part>;
    Return CTNDX(.N)
End;

Routine NAMECOUNT(CHAIN) : Novalue =
Begin
    Local
	L		: Ref ST,
	NAME		: Ref GT,
	N		: Integer,
	S		: Ref ST,
	C		: Integer;
    Label
	aaa;

    L = .GTHASH[.CHAIN];
    While .L Neq 0 Do
	aaa: Begin
	Selectone .CHAIN Of Set
	    [OP_STORE]:
		NAME = .L[gt_arg1];
	    [OP_CALL]:
		If .GT[.L[gt_arg1],st_lnk_type] Eql LNK_HYDRA Then
		    Begin
		    L = .L[gt_gthread];
		    Leave aaa
		    End
		Else
		    NAME = .L[gt_arg2]
	Tes;
	If .NAME<lex_type> Eql T_SYMBOL Then
	    Begin
	    N = CTINSERT(.NAME);
	    If .N Geq 0 Then
		Begin
		S = .L;
		C = 0;
		Do
		    (C = .C+1)
		Until (S = .S[gt_fsthread]) Eql 0;
		CTTBL[.N,CTCNT] = .CTTBL[.N,CTCNT]+.C;
		End
	    End;
	L = .L[gt_gthread]
	End
End;

Routine NCCOST(N : Ref GT) =
Begin
    Local
	TN		: Ref GT;

    If .N<lex_type> Neq T_SYMBOL Then
	Return 0;
    Case .N[gt_type] From LOWVARTYPE To HIGHADDTYPE Of Set

	[ S_LOCAL ]:
	    If (TN = .N[gt_reg]) Leq 8 Then
		Return 5
	    Else If .TN[tn_request] Eql SLREQDB Then
		Return 5
	    Else
		Return 0;

	[ S_OWN, S_EXTERNAL, S_GLOBAL, S_ROUTINE, S_GBL_ROUTINE, S_FORWARD ]:
	    Return 3;

	[ S_REGISTER ]:
	    Return 0;

	[ S_FORMAL ]:
	    If .N[gt_reg] Eql SP Then
		Return 5
	    Else
		Return 0;

	[ Outrange, Inrange ]:
	    Return 0
    Tes
End;

Global Routine GETNCSE : Novalue =
Begin
    Local
	L		: Ref GT,
	N		: Integer,
	S		: Ref GT,
	T		: Ref GT,
	M		: Ref GT,
	K		: Integer,
	C		: Integer;

    NCINIT();
    If .swit_quick Then
	Return;
    If .flg_enable Or Not .swit_optimize Then
	Return;
    NAMECOUNT(OP_CALL);
    NAMECOUNT(OP_STORE);
    L = .GTHASH[OP_DOT];
    While .L Neq 0 Do
	Begin
	T = NONBOGUS(.L);
	T = .T[gt_arg1];
	T = .T[gt_arg1];
	K = NCCOST(.T);
	If .K Neq 0 Then
	    Begin
	    S = .L;
	    C = 0;
	    Do
		Begin
		M = .S;
		C = .C+(1-.M[gt_v_bogus]);
		Until (M = .M[gt_csthread]) Eql 0 Do
		    C = .C+.M[gt_v_mustgencode]
		End
	    Until (S = .S[gt_fsthread]) Eql 0;
	    If .C Geq .K Then
		NCINSERT(.T)
	    Else
		Begin
		N = CTSEARCH(.T);
		If .N Geq 0 Then
		    Begin
		    If .C+.CTTBL[.N,CTCNT] Geq .K Then
			NCINSERT(.T);
		    CTTBL[.N,CTST] = 0
		    End
		End
	    End;
	L = .L[gt_gthread]
	End;
    Decr I From CTSIZ-1 To 0 Do
	If .CTTBL[.I,CTST] Neq 0 Then
	    If (K = NCCOST(.CTTBL[.I,CTST])) Gtr 0 Then
		If .CTTBL[.I,CTCNT] Geq .K Then
		    NCINSERT(.CTTBL[.I,CTST])
End;

!
! FUNCTION:
!	MERGE TWO NCSE LISTS ('NAMES1' AND 'NAMES2'; THE RESULTING LIST
!	WILL BE 'NAMES1').  WHEN MERGING LISTS FROM TWO BRANCHES OF THE
!	SAME FORK, 'ALPHLST' WILL BE A POINTER TO THE APPROPRIATE ALPHA
!	LIST; THEN, IF ANY ENTRY ON 'NAMES2' DUPLICATES AN ENTRY ON
!	'NAMES1' AND THE LATTER WAS CREATED BY 'GETLOAD', THAT NAME-CSE
!	WILL BE FORCED ONTO THE ALPHA LIST.
!
! notes:
!	this is DELAY's version of Alpha motion for named CSE's.

Global Routine MERGE(NAMES1 : Ref LSTHDR,NAMES2 : Ref LSTHDR,ALPHLST : Ref LSTHDR) : Novalue =
Begin
    Local
	I		: Ref ITEM,
	J		: Ref ITEM,
	K		: Ref ITEM,
	DATA		: Integer;
    Label
	aaa;

    NAMES1 = .NAMES1<lex_addr>;
    NAMES2 = .NAMES2<lex_addr>;

! loop for each item on NAMES2

    K = .NAMES2;
    Until (J = .K[itm_rlink]) Eql .K Do
	aaa: Begin

! if no alpha list then simply move the item from NAMES2 onto the NAMES1 list.
! note that enlisting on one list removes it from the other.

	If .ALPHLST Eqla 0 Then
	    ENLST(.NAMES1,.J)
	Else
	    Begin

! see if this NAMES2 item is on the NAMES1 list

	    DATA = .J[itm_ncse_data];
	    I = .NAMES1;
	    Until (I = .I[itm_rlink]) Eql .NAMES1 Do
		Begin
		If .DATA Gtr .I[itm_ncse_data] Then
		    Exitloop;
		If .DATA Eql .I[itm_ncse_data] Then
		    Begin

! it is on the list.  if this was a GETLOAD (as opposed to a GETFAKE) then
! note which alpha list it is on.
!
! note:	if the item is on both lists then it is on more than one
!	fork of a branch and so we do simple Alpha motion on it.
!	this is not true alpha motion because for a CASE statement,
!	two instances will cause Alpha motion.

		    If .I[itm_ncse_csp] Then
			Begin
			I[itm_ncse_lst1] = 0;		! undo MARKLSTNAMES
			I[itm_ncse_lst2] = .ALPHLST
			End;

! discard the duplicate entry

		    RELITEM(.J,SZ_FLSTK_ITEM);
		    Leave aaa
		    End
		End;

! if not found, just move the entry to the appropriate spot on the list.
! I suppose we could have used ENLST but since the insert position has
! been determined here the same as XORTENTER does, why not use what we got.

	    LINK(DELINK(.J),.I[itm_llink])
	    End
	End
End;

!
! FUNCTION:
!	UPDATE THE LST1 FIELDS OF ALL NCSE LIST ENTRIES CREATED BY GETLOAD
!	WITHIN A FORK OR LOOP CONSTRUCT. 'NAMELST' IS THE LIST OF SAID
!	NCSE LIST ENTRIES, AND 'LST' IS THE APPROPRIATE ALPHA OR CHI LIST.
!

Global Routine MARKLSTNAMES(NAMELST : Ref LSTHDR,LST : Ref LSTHDR) : Novalue =
Begin
    Local
	I		: Ref ITEM;

    NAMELST = .NAMELST<lex_addr>;
    I = .NAMELST;
    Until (I = .I[itm_rlink]) Eql .NAMELST Do

! if a GETLOAD, note the list it is associated with

	If .I[itm_ncse_csp] Then
	    I[itm_ncse_lst1] = .LST
End;

Global Routine FINDNCSE(NODE : Ref GT) =
Begin
    Local
	L		: Integer,
	R		: Ref GT;

    L = NCSEARCH(.NODE);
    If .L Lss 0 Then
	Return 0;
    R = .NCSE[.L,NCGT];
    If .R Eqla 0 Then
	Begin
	If .GETLCNT Eql 0 Then
	    Begin
	    NODE = GETLOAD(.NODE,.L);
	    NCSE[.L,NCGT] = .NODE;
	    ENLST(.FLSTK,MAKITEM(.NODE+1^32,0));
	    Return .NODE
	    End
	End
    Else
	Begin
	If .INENABLE Eql 0 Then
	    Begin
	    NODE = GETFAKE(.R);
	    ENLST(.FLSTK,MAKITEM(.R,0));
	    Return .NODE
	    End
	End;
    Return 0
End;

! enter an item on FLSTK.  called by ENLST

Global Routine XSORTENTER(L : Ref LSTHDR,A : Ref ITEM) =
Begin
    Local
	I		: Ref ITEM,
	DATA		: Integer;

! loop for each item on the fake load stack

    I = L = .L<lex_addr>;
    DATA = .A[itm_ncse_data];
    Until (I = .I[itm_rlink]) Eqla .L Do
	Begin
	If .I[itm_ncse_data] Lssa .DATA Then
	    Exitloop;

! if a duplicate entry...

	If .I[itm_ncse_data] Eqla .DATA Then
	    Begin

! we don't want duplicate entries on the fake load stack
! so what we do is copy the existing entry to the one being
! entered and releasing the old entry.  thus the new
! entry will take the place of the old entry with the
! same values.  a real hack if I say so.  the problem
! is using ENLST for FLSTK because ENLST allows for
! duplicates.

	    A[itm_ncse_data] = .I[itm_ncse_data];
	    A[itm_ncse_csp]  = .I[itm_ncse_csp];
	    A[itm_ncse_lst1] = .I[itm_ncse_lst1];
	    A[itm_ncse_lst2] = .I[itm_ncse_lst2];

! if a GETLOAD and MARKLSTNAMES got to it (i.e. it had the
! potential for being on an alpha list but was not put on
! it) then move it to its alpha list now.
!
! this situation occurs an NCSE occurs first within a forked
! expression and later on outside that forked expression.
! we move it to the alpha list here because the alpha list
! is at the same fork level as the latter expression and thus
! is an essential predecessor.

	    If .A[itm_ncse_csp] And .A[itm_ncse_lst1] Neqa 0 Then
		Begin
		A[itm_ncse_lst2] = .A[itm_ncse_lst1];
		A[itm_ncse_lst1] = 0
		End;
	    I = .I[itm_rlink];
	    RELITEM(.I[itm_llink],SZ_FLSTK_ITEM);
	    Exitloop
	    End
	End;
    Return .I[itm_llink]
End;

End
Eludom