! File:   NCSE.RTN

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 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);
    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 Then
	    Exitloop
	Else If .NCSE[.N,NCST] Eql 0 Then
	    Begin
	    NCSE[.N,NCST] = .X;
	    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 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;
    Return CTNDX(.N)
End;

! notes:
!	CHAIN is either OP_CALL or OP_STORE.

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

! loop for each formal parent on the chain

    L = .GTHASH[.CHAIN];
    While .L Neq 0 Do
	Begin

! for store, get the LHS.  for CALL, get the called name

	If .CHAIN Eql OP_STORE Then
	    NAME = .L[gt_arg1]
	Else
	    NAME = .L[gt_arg2];

! if a symbol then look it up/enter it into the CT table

	If .NAME[gt_type] Eql T_VARIABLE Then
	    Begin
	    N = CTINSERT(.NAME);

! if in the table then count the number of CSE parents which is
! approximately the number of access.  this is not true because
! DELAY may break up CSE chains but it's good enough.

	    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;

! get the cost trade-off for a symbol
!
! notes
!	the cost trade-off is the number of accesses needed to
!	make it worthwhile to keep the address of the symbol in
!	a register.
!
!	a return of zero means the symbol is not worth keeping in
!	a register.

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

! only consider symbols

    If .N[gt_type] Neq T_VARIABLE Then
	Return 0;
    Case .N[st_code] From LOWVARTYPE To HIGHADDTYPE Of Set

	[ S_LOCAL ]:
	    Begin

! trade-off for local variables and formal variables is higher because
! an addition must be perform.  i.e.:
!
!		MOV	#n,R
!		ADD	SP,R
!
! which is three words plus two words for saving and restoring the
! register makes five.

	    TN = .N[gt_reg];
	    If .TN Lequ 8 Or .TN[tn_request] Eql BIND_STATIC Then
		Return 5;

! must be a register variable otherwise

	    Return 0
	    End;

	[ S_OWN, S_EXTERNAL, S_GLOBAL, S_ROUTINE, S_GBL_ROUTINE, S_FORWARD ]:

! trade-off for static addresses is the cost of a load and the saving
! and restoring of the variable.
!
! Q: the cost I calculate is four.  it seems then that returning a three
!    may generate more code when there are exactly three accesses.

	    Return 3;

	[ S_REGISTER ]:
	    Return 0;

	[ S_FORMAL ]:

! see above for local variables.

	    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();

! only find NCSE's in slow mode

    If .swit_quick Or Not .swit_optimize Then
	Return;

! don't allow NCSE's in enable blocks because of its volatile nature
! and because the code motion of GETLOAD's in DELAY does not seem to
! take enables into account.

    If .flg_enable Then
	Return;

! count the number of occurences of names on the LHS of a '=' or as
! the target of a call

    NAMECOUNT(OP_CALL);
    NAMECOUNT(OP_STORE);

! loop for each '.' node

    L = .GTHASH[OP_DOT];
    While .L Neq 0 Do
	Begin

! need to refer to the arguments

	T = NONBOGUS(.L);

! get what is to the RHS of the '.'

	T = .T[gt_arg1];

! get the number of accesses needed to make placing this name
! in a register worthwhile

	K = NCCOST(.T);
	If .K Neq 0 Then
	    Begin
	    C = 0;

! loop for each CSE parent

	    S = .L;
	    Do
		Begin

! add one for this CSE parent unless bogus

		C = .C + (1 - .S[gt_v_bogus]);

! add one for each entry on the CSE chain which generates code

		M = .S;
		Until (M = .M[gt_csthread]) Eql 0 Do
		    C = .C + .M[gt_v_mustgencode]
		End
	    Until (S = .S[gt_fsthread]) Eql 0;

! if it looks worthwhile to place it in a register then add it

	    If .C Geq .K Then
		NCINSERT(.T)
	    Else
		Begin

! it didn't make it on just '.' accesses alone.  see if '=' and
! call accesses push it over the threshold.

		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;

! now move entries which were found in the '=' and call chains
! but not on the '.' chain but have enough accesses.

    Decr I From CTSIZ-1 To 0 Do
	If .CTTBL[.I,CTST] Neq 0 Then
	    Begin
	    K = NCCOST(.CTTBL[.I,CTST]);
	    If .K Gtr 0 And .CTTBL[.I,CTCNT] Geq .K Then
		NCINSERT(.CTTBL[.I,CTST])
	    End
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;

! 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;

    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;
    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