! File:   TNBIND.BLI
!
!    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 TNBIND=
Begin
!
!                                       AUGUST 1972
!                                       BILL WULF
!                                       RICHARD JOHNSSON
!
!                                       LATER ADDITIONS
!                                       PAUL KNUEVEN
!                                       BRUCE LEVERETT
!
!
!			TNBIND    MODULE
!			----------------
!
!	THIS MODULE ASSIGN SYMBOLIC 'TEMPORARY NAMES' TO HOLD THE
!	RESULTS OF EXPRESSIONS - THEN BINDS THESE NAMES TO REGISTERS
!	AND/OR MEMORY LOCATIONS. THE MODULE CONSISTS OF THREE
!	DISTINCT SEQUENTIALLY EXECUTED PHASES: TN-ASSIGNMENT, RANKING,
!	AND PACKING.
!
!	ASSIGNMENT: IN THIS PHASE A TREE-WALK (IN EXECUTION ORDER)
!	IS MADE. A SEPARATE ROUTINE IS CALLED FOR EACH TYPE OF 
!	NODE (+,*,IF, ETC.). GENERALLY THE FUNCTIONS OF THESE ROUTINES
!	ARE TO:
!		1) ASSIGN TEMP-NAMES AND/OR LABELS IN SUCH A WAY 
!		   THAT ,IF POSSIBLE, THE SAME NAME
!		   IS USED FOR THE ENTIRE EVALUATION OF AN EXPRESSION.
!		   AN ATTEMPT IS MADE TO 'TARGET' THE VALUES OF SOME
!		   (SEVERAL) EXPRESSIONS TO THE SAME NAME.
!		2) COMPUTE THE RELATIVE 'IMPORTANCE' OF A PARTICULAR
!		   TEMP-NAME BY EXAMINING THE WAY AND NUMBER OF
!		   TIMES IT IS USED.
!		3) DETERMINE THE 'LIFE' OF A TEMP NAME -- THAT IS, THE
!		   SPAN OF PROGRAM OVER WHICH THE NAME MUST OCCUPY
!		   A SINGLE LOCATION.
!
!	RANKING: USING THE 'IMPORTANCE' MEASURE COMPUTED IN THE FIRST
!	PHASE, THE RANKING PHASE ORDERS THE TEMP-NAMES SO THAT THE
!	PACKING PHASE MAY ALLOCATE THE MOST IMPORTANT FIRST.
!	THIS INSURES THAT THE MOST IMPORTANT TEMP-NAMES WILL BE BOUND
!	TO THE MOST DESIRABLE LOCATIONS -- GENERALLY REGISTERS.
!
!	PACKING: THE FINAL PHASE PROCESSES TEMP-NAMES IN THE ORDER
!	DEFINED BY THE RANKING PHASE. USING THE 'LIFE-SPAN' INFORMATION
!	THIS PHASE ATTEMPTS TO 'FIT' OR 'PACK' THE TEMP-NAMES INTO
!	THE VARIOUS POSSIBLE LOCATIONS. ROUGHLY, THE ORDER OF PREFERENCE
!	FOR VARIOUS LOCATIONS IS:
!
!		1) AN 'OPEN' REGISTER -- THIS IS A REGISTER WHICH HAS ALREADY
!		   BEEN USED (AND THUS ITS CONTENTS NEED NOT BE SAVED).
!		2) AN 'OPEN LOCAL' -- AT LEAST IF THE COST OF USING
!		   A LOCAL FOR THIS TEMP IS LESS THAN OPENING A NEW
!		   REGISTER.
!		3) A 'CLOSED REGISTER'
!		4) AN 'OPEN LOCAL'
!		5) A 'CLOSED LOCAL'.
!
!
!	THIS BRIEF DESCRIPTION HARDLY DOES JUSTICE TO THE ALGORITHMS,
!	BUT IT SHOULD GIVE AN OVERVIEW OF WHATS GOING ON. DETAILS 
!	WILL BE FOUND BELOW. ALSO, NOTE THE OUTLINE OF THE ORGANIZATION
!	OF THE CODE GIVEN BELOW!
!

Require 'Bliss';

Literal
	SZ_ULST	= 4,	! SIZE OF USUAL LIST VECTOR
	VREGNUM	= 0,	! NUMBER OF THE VALUE REGISTER
	MAGIC3	= 3,	! CAN "IF" RESULT REG BE USED AS TARGET?
	MAGIC2	= 5;	! IS TOS OK FOR TARGET?

! copied from RESHUF.BLI

Literal
	SRCHDEPTH = 4,
	SRCHWIDTH = 3;

! tempname list:
!
!	SRLST	specific register list.  holds TN's which must go
!		into a specific register.  e.g.: the result of a function
!		call goes into the specific register R0.  also used
!		for linkages which require parameters in specific
!		registers and in REGISTER declarations for specific
!		registers.
!
!	ARLST	arbitrary register list.  holds TN's which must go
!		into a register of which the compiler may decide
!		which.  used for REGISTER variables not bound to
!		any specific register.
!
!	ULST	usual list.  holds TN's, sorted by a combination
!		of complexity and lon span, which would like to
!		go into a register if possible but are willing to
!		accept a stack location.  exception is 'register-or-forget'
!		tempnames which want a register but will not accept
!		a stack location.  the usual list is capable of
!		getting long and so is divided into four lists.
!
!	SLLST	static local list.  hold's TN's which may not be
!		placed in a register.  variables which have their
!		address taken are placed here.

Own
	SRLST		: LSTHDR,
	ARLST		: LSTHDR,
	ULST		: Vector[SZ_ULST,Quad],
	SLLST		: LSTHDR,
	stk_fon		: LSTHDR,
	stk_dtd		: LSTHDR,
	stk_loop_lf	: LSTHDR,
	stk_loop	: Ref ITEM,
	stk_call	: Ref ITEM,
	PREFLST		: Ref TNREPR,
	ESTIM		: Integer,
	MAXKOST		: Integer,
	MAXFONSPAN	: Integer;

! OUTLINE OF THE TNBIND MODULE
!------------------------------
!
! I. - GENERAL UTILITIES FOR TNBIND
!   A. - FOR MANIPULATING STACKS OF LISTS
!   B. - FOR ACCESSING TN REPRESENTATIVES
!   C. - FOR PERFORMING AN ACTION ON A LIST OF TN'S
!   D. - ROUTINES FROM THE LOWSEGMENT
!   E. - MISCELLANEOUS
! II. - TEMP NAME AND LABEL ASSIGNMENT
!   A. - UTILITIES
!   B. - SPECIFIC ROUTINES
!   C. - DRIVER FOR TEMP NAME/LABEL ASSIGNMENT
! III. - RANKING TEMP NAMES
!   A. - UTILITIES
!   B. - SORTING OF TEMP NAMES
!   C. - DRIVER FOR RANKING
! IV. - PACKING
!   A. - UTILITIES
!	1. - PREFERENCES
!	2. - FITTING	!
!	3. - OPENING	!
!   B. - REGISTERS	! FOR THESE FIVE, SEE TRY.BLI
!   C. - STATIC TEMPS	!
!   D. - DYNAMIC TEMPS	!
!   E. - DRIVER FOR PACKING
!   F. - MARKING OF TNS AFTER PACKING
! V. - DRIVER FOR TNBIND MODULE

! I. - GENERAL UTILITIES FOR TNBIND
! ------------------------------------------------

!   A. - FOR MANIPULATING STACKS OF LISTS
! ------------------------------------------------
!	
!	THE FOLLOWING STRUCTURES/MACROS/AND ROUTINES DEFINE
!	A SYSTEM OF STACKS OF LISTS -- THAT IS, EACH STACK
!	ELEMENT IS THE HEADER OF A DOUBLY LINKED CIRCULAR
!	LIST. THESE STACKS ARE USED, IN GENERAL, WHERE SEVERAL
!	PIECES OF INFORMATION MUST BE RECORDED AT A SINGLE
!	LEVEL OF (OBJECT PROGRAM) CONTROL. THE TYPICAL ENTRIES
!	ARE 'TN-REPRESENTATIVES' -- TWO WORD CELLS WHICH
!	POINT TO A TN CELL.
!
!
! note:
!	the indices for these stacks start at -1 rather than 0.
!	this allows the top element of the stack to be referenced
!	using only '[stk_idx]' rather than '[stk_idx]-1'.
!
!	used for STEMPS, DETEMPS, stk_call, stk_loop

Macro
	INITSTK(STK)=
		Begin
		STK = GETSPACE(STKSIZE+2);
		STK[stk_idx] = -1;
		STK[stk_max] = -1
		End %;

!   B. - FOR ACCESSING TN REPRESENTATIVES
! ------------------------------------------------
!
!
!	THIS SECTION DEFINES ACCESSING OF 'TN-REPRESENTATIVES'.
!	IN THE PROCESS OF TNBINDING IT IS NECESSARY TO
!	INCLUDE THE TN'S ON SEVERAL LISTS SIMULTANEOUSLY.
!	RATHER THAN ALLOW SPACE IN THE TN-CELL FOR ALL POSSIBLE
!	SUCH LINKINGS, A 'REPRESENTATIVE' OF THE TN-CELL IS
!	PLACED ON THE APPROPRIATE LISTS.  THE STRUCTURE OF
!	TN-REPS IS DEFINED SO THAT FIELDS IN THE TNCELL MAY
!	BE ACCESSED ,BY NAME, INDIRECTLY.
!
!

Macro
	RELTNREP(A)	= RELEASESPACE((A),SZ_TNREP) %;

!   E. - MISCELLANEOUS
! ------------------------------------------------

Forward Routine
	TLA,
	WANTPREF	: Novalue;

Macro
	FILLTX		= (If .TX Eqla 0 Then TX = GETTN()) %,
	ISRELOP(NODE)	= ONEOF(.NODE[gt_code],
				OP_GTR,OP_LEQ,OP_LSS,OP_GEQ,OP_EQL,OP_NEQ,
				OP_GTRU,OP_LEQU,OP_LSSU,OP_GEQU,OP_EQLU,OP_NEQU,
				OP_BIT) %,
	LASTOPERAND	= gt_argv(.NODE[gt_argc]-1) %,
	REQ_RESULT	= (.NODE[rw_real_flow] Neq RFNONE) %;


!   F. STRUCTURE/MACROS/ROUTINES FOR LIST-IMPLEMENTED STACKS
! ------------------------------------------------
!
! notes:
!	these macros implement a variable length stack.
!	it seems that if there were a reasonable maximum
!	for its depth that it could be implemented must
!	more efficiently.
!
!	used by stk_fon, stk_loop_lf, and stk_dtd

Macro
	PUSHLS(STK,ZVAL1,ZVAL2)=
				Begin
				Local ZQ : Ref ITEM;
				ZQ = GETSPACE(SZ_PLSTSTK);
				ZQ[itm_llink] = .ZQ;
				ZQ[itm_rlink] = .ZQ;
				LINK(.ZQ,STK);
				ZQ[stk_fon_hi] = ZVAL1;
				ZQ[stk_fon_lo] = ZVAL2
				End %,
	  POPLS(STK)	= RELEASESPACE(DELINK(.STK[itm_rlink]),SZ_PLSTSTK) %,
	  INITLS(STK)	= NULLLST(STK) %;


! II. - TEMP NAME AND LABEL ASSIGNMENT
! ------------------------------------------------
!
!	THIS SECTION CONTAINS THE CODE TO DO PHASE 1: ASSIGNMENT
!	OF TEMP NAMES AND LABELS. SEE BELOW FOR DETAILS.
!
!
!   A. - UTILITIES
! ------------------------------------------------

!	COST COMPUTATIONS: THESE UTILITIES DEFINE THE COST OF
!	USING A PARTICULAR TEMP NAME. TWO COSTS ARE COMPUTED:
!	1) A 'MAX' COST -- WHICH RESULTS IF THE TEMP WERE
!	ASSIGNED TO A MEMORY LOCATION, AND 2) A 'MIN' COST
!	-- WHICH RESULTS IF A REGISTER IS USED. IN BOTH CASES
!	THE COST IS A FUNCTION OF THE OPERATOR, TYPE OF USE, AND CURRENT LOOPDEPTH.
!
! notes:
!	costs represent the number of memory accesses needed
!	to reference an operand.  the auto-decrement modes
!	are included since their values are known but they
!	are never seen (only final generates auto-decrement).
!	the same goes for auto-increment modes except that
!	the PC variation is actually used.

Bind
	KOPND = Uplit Byte (
			0,	! R
			1,	! @R
			1,	! (R)+
			2,	! @(R)+
			1,	! -(R)
			2,	! @-(R)
			2,	! n(R)
			3	! @n(R)
		) : Vector[,Byte];

Bind
	KOPNDX = Uplit Byte (
			1,	! R
			2,	! @R
			7,	! (R)+
			9,	! @(R)+
			7,	! -(R)
			9,	! @-(R)
			7,	! n(R)
			8	! @n(R)
		) : Vector[,Byte];

!
! FUNCTION:
!	INCREMENT THE MIN AND MAX USE COMPLEXITY FIELDS OF THE TEMP NAME
!	POINTED TO BY 'NODE' (A GT NODE OR SYMBOL TABLE ENTRY) BY 'MN' & 'MX'
!	RESPECTIVELY. ALSO UPDATE 'MAXKOST' IF ANY LARGER ONE COMES THRU.
!

Routine UPDATE(NODE : Ref GT,MN,MX) : Novalue =
Begin
    Local
	TN		: Ref GT,
	Z		: Ref GT;

! want either a symbol, node, or tempname

    If .NODE<lex_type> Eql T_LITERAL Then
	Return;

! get the associated tempname

    TN = .NODE[gt_reg];
    If .TN Lssu 8 Then
	Return;

! only tempnames which are not literals may be updated

    If .TN[gt_type] Neq S_TEMPNAME Then
	Return;
    If .TN[tn_v_lit] Then
	Return;

! if this tempname is bound to another tempname then update what it's
! bound to.

    Z = .TN[gt_reg];
    If .Z Gequ 8 Then	! TAKING ACCOUNT OF BINDSTORE
	Begin
	If .Z[gt_type] Eql S_TEMPNAME Then
	    UPDATE(.TN,.MN,.MX)
	Else
	    UPDATE(.Z,.MN,.MX)
	End
    Else

! otherwise this is a tempname not bound to another, so update it

	Begin
	TN[tn_min_complexity] = .TN[tn_min_complexity]+.MN*(.LOOPDEPTH+1);
	Z = TN[tn_max_complexity] = .TN[tn_max_complexity] + .MX*(.LOOPDEPTH+1);
	If .Z Gtr .MAXKOST Then
	    MAXKOST = .Z
	End
End;

!
! FUNCTION:
!	COST OF ACCESSING NODE 'N' IF IT'S IN A REGISTER.
!
! notes:
!	for literals, cost is that of auto-increment

Macro
	K(N)=	Begin
		If .N<lex_type> Eql T_LITERAL Then
		    1
		Else
		    .KOPND[.N[gt_mode]]
		End %;
!
! FUNCTION:
!	COST OF ACCESSING NODE 'N' IF IT'S IN MEMORY.
!
! notes:
!	for literals, cost is that of auto-increment

Macro
	KX(N)=
		Begin
		If .N<lex_type> Eql T_LITERAL Then
		    1
		Else
		    .KOPNDX[.N[gt_mode]]
		End %;

! notes:
!	this macro only works for literals and nodes which
!	have been found to be a constant.

Macro
	CLITVALUE(OP)=
		Begin
		If .OP<lex_type> Eql T_LITERAL Then
		    .OP<lex_value>
		Else
		    .OP[gt_disp_16]
		End %;

! common form of cost updating

Routine UPDATE2(NODE : Ref GT,N : Integer) : Novalue =
Begin
    UPDATE(.NODE,.N * K(NODE),.N * KX(NODE) )
End;

!
! FUNCTION:
!	COMPUTE THE APPROXIMATE NUMBER OF ACCESSES TO A WORD
!	REQUIRED TO SHIFT A FIELD OF SIZE 'SIZE' A DISTANCE
!	OF 'DIST' BITS.
!
Routine SHIFTKOST(DIST : Integer,SIZE : Integer) =
Begin
    DIST =  Abs(.DIST);

! if the top four bits, cost is number of rotates left plus
! an extra rotate out of carry (e.g. 16-.dist + 1)

    If .DIST Gtr 12 Then
	DIST = 17-.DIST;

! for a high byte access, cost is that of a low byte access
! plus the cost of a SWAB (e.g. .dist-8 + 1)

    If .DIST Gtr 7 Then
	DIST = .DIST-7;

! single bit access is independent of the distance

    If .SIZE Eql 1 Then
	DIST = 2;
    Return .DIST
End;

!
! FUNCTION:
!	COMPUTE THE NUMBER OF ACCESSES TO A WORD REQUIRED TO MAKE IT
!	DESTROYABLE AND/OR SHIFT THE REQUIRED FIELD TO THE RIGHT END
!	OF THE WORD.
!
Routine KOSTOFTEMP(NODE : Ref GT) =
Begin
    Local
	Z		: Integer;

! only expressions are destroyable

    If .NODE<lex_type> Neq T_NODE Then
	Z = 0

! if not destroyable then cost is a move to a new register

    Else If Not .NODE<ss_destroyable> Then
	Z = 1

! if destroyable and a full word then no moves needed

    Else If .NODE[gt_len] Eql 16 Then
	Z = 0
    Else

! if destroyable but a bad size then the cost is that of
! a shift plus the cost of a mask (1)

	Z = 1 + SHIFTKOST(-.NODE[gt_pos],.NODE[gt_len]);
    Return .Z
End;

!
! FUNCTION:
!	COMPUTE THE NUMBER OF ACCESSES TO 'NODE2' REQUIRED
!	TO GENERATE A MOVE FROM 'NODE1' TO 'NODE2'.
!
Routine KKMOV(NODE1 : Ref GT,NODE2 : Ref GT) =
Begin

! what does it mean to move to a literal?  to an absolute address
! perhaps (e.g.   512 = .X)?

    If .NODE2<lex_type> Eql T_LITERAL Then
	Return 1

! if not an expression then it must be some form of literal.  but
! what if NODE2 is a field?  it seems to assume either it is
! not a field or that the value stored is nice (e.g. zero or
! all ones).  in either case it may be so rare it doesn't matter.

    Else If .NODE1<lex_type> Neq T_NODE Then
	Return 1
    Else

! otherwise the is:
!		+1 if to a different tempname
!		+n if shifts are involved where 'n' is the shift cost
!		+1 if masking is needed

	Return (.NODE1[gt_reg] Neqa .NODE2[gt_reg]) +
		SHIFTKOST(.NODE2[gt_pos]-.NODE1[gt_pos],.NODE1[gt_len]) +
		(.NODE2[gt_len] Neq 16)
End;

!
! FUNCTION:
!	DRIVER FOR COST UPDATING FOR TYPICAL UNARY OPERATOR NODES.
!
Routine KUNOP(NODE : Ref GT,UOP : Ref GT,KOP : Integer) : Novalue =
Begin
    Local
	KMOV		: Integer;

! a unary operation is normally a move to the destination and then
! an operate.

    KMOV = KKMOV(.UOP,.NODE);

! the cost of the source is one access if it had to be moved

    If .KMOV Neq 0 Then
	UPDATE2(.UOP,1);

! the cost of the destination is the cost of moving, shifting, and
! masking plus the cost of the operation itself

    UPDATE2(.NODE,.KMOV + .KOP)
End;

!
! FUNCTION:
!	DRIVER FOR COST UPDATING FOR TYPICAL BINARY OPERATOR NODES.
!
Routine KBINOP(NODE : Ref GT,LOP : Ref GT,ROP : Ref GT,KOP : Integer) : Novalue =
Begin
    Local
	KMOV		: Integer;

! place the operands in the correct target path order

    If .NODE[gt_v_tpath] Then
	Begin
	KMOV = .LOP;
	LOP  = .ROP;
	ROP  = .KMOV
	End;

! get the cost of moving one operand to the target and update the
! source if a move will actually be required

    KMOV = KKMOV(.LOP,.NODE);
    If .KMOV Neq 0 Then
	UPDATE2(.LOP,1);

! update the second operand by the cost of the operation (no shift
! or masking cost? why not use KOSTOFTEMP?)

    UPDATE2(.ROP,.KOP);

! the cost of the target is the cost of moving, shifting, masking
! plus the cost of the operation itself

    UPDATE2(.NODE,.KMOV + .KOP)
End;

!
! FUNCTION:
!	DRIVER FOR COST UPDATING FOR +,- NODES.
!
Routine KASOP(NODE : Ref GT,LOP : Ref GT,ROP : Ref GT) : Novalue =
Begin
    Local
	Z		: Ref GT,
	N		: Integer;

! taking account of distributed multiply?

    If .NODE[rw_immediate] And .NODE[gt_mode] Gtr GENREG+DEFERRED Then
	NODE[gt_mode] = GENREG;

! place the operands in the correct target path order

    If .NODE[gt_v_tpath] Then
	Begin
	Z   = .LOP;
	LOP = .ROP;
	ROP = .Z
	End;

! add/sub nodes may generate several instructions.  count the number
! of instruction that would be performed.

    N = SUMBITS(.NODE[RCBITS]);

! if a move is required, add it the cost of the move less one because
! [rc_mov_target] was added in the SUMBITS above.

    If .NODE[rc_mov_target] Then
	N = .N - 1 + KKMOV(.LOP,.NODE);

! now update the target

    If .N Gtr 0 Then
	UPDATE2(.NODE,.N);

! update the left operand if it is not the same as node

    If .NODE[rc_mov_target] And .LOP<lex_type> Eql T_NODE And
			.NODE[gt_reg] Neqa .LOP[gt_reg] Then
	UPDATE2(.LOP,1);

! update the right operand if it is actually operated upon

    If .NODE[rc_operate] Then
	UPDATE2(.ROP,KOSTOFTEMP(.ROP)+1)
End;

!
! FUNCTION:
!	DRIVER FOR COST UPDATING FOR A ^ NODE.
!
! notes:
!	the cost determinations in this routine are tightly
!	coupled to the actual code generated by GSHIFTROT
!	in code.bli

Routine KSHFTOP(NODE : Ref GT,LOP : Ref GT,NUM : Integer) : Novalue =
Begin
    Local
	KMIN		: Integer,
	KMAX		: Integer,
	KMOV		: Integer;

    KMIN = 0;
    KMAX = 0;

! if it looks like a SWAB is needed

    If .NUM Geq 8 Then
	Begin
	KMIN = 1;
	KMAX = 1;
	NUM = .NUM - 8
	End;

! a shift of seven generates SWAB, RORB, ROR, mask (see GSHIFTROT in code.bli)

    If .NUM Eql 7 Then
	KMIN = KMAX = .KMAX + 4
    Else

! otherwise count the number of shifts needed.  for right shifts,
! GSHIFTROT may code a tiny loop and so adjust for its cost.

	Begin
	KMIN = KMAX = .KMAX + Abs(.NUM);
	If .NUM Leq -8 Then
	    KMAX = .KMIN + 5
	End;

! TAKING ACCT. OF DISTRIB. MULTIPY.

    If .NODE[rw_immediate] And .NODE[gt_mode] Gtr GENREG+DEFERRED Then
	NODE[gt_mode] = GENREG;

! get the cost of moving the source to the target and update the
! source if a move is really required

    KMOV = KKMOV(.LOP,.NODE);
    If .KMOV Neq 0 Then
	UPDATE2(.LOP,1);

! update the target now.

    UPDATE(.NODE,(.KMOV+.KMIN)*K(NODE),(.KMOV+.KMAX)*KX(NODE))
End;

!
! FUNCTION:
!	DRIVER FOR COST UPDATING FOR RELATIONAL OPERATOR NODES.
!
Routine KRELOP(NODE : Ref GT,LOP : Ref GT,ROP : Ref GT) : Novalue =
Begin

! single access to both operands (should it not be KOSTOFTEMP?)

    UPDATE2(.LOP,1);
    UPDATE2(.ROP,1);

! if code is to be generated, include cost of a CLR and INC of
! the target (see GREL)

    If .NODE[rw_real] Then
	UPDATE2(.NODE,2)
End;

!
! FUNCTION:
!	COMPUTE NUMBER OF ACCESSES TO THE TEMP OF A LOAD NODE.
!
! notes:
!	cost =
!		+1 for the load
!		+1 if it needs to be negated
!		+1 if it needs to be complemented
!		+2 if an address calculation is required
!
!	this assumes that there is no load-negate or load-complemented
!	instruction.

Macro
	LOADANALYSIS=(	  1
			+ .NODE[rc_negate]
			+ .NODE[rc_complement]
			+ 2 * .NODE[rw_immediate]) %;

!
! FUNCTION:
!	DRIVER FOR COST UPDATING FOR ANY CONTROL NODE WHICH HAS
!	A DEFAULT VALUE RETURNED, E.G. -1 FOR A LOOP, ETC.
!
! notes:
!	the cost of a control is the cost of loading up
!	the default value.

Macro
	CTRLKOST	= UPDATE2(.NODE,1) %;

!
! FUNCTION:
!	DRIVER FOR COST UPDATING FOR INCR/DECR NODES.
!
Routine IDKOST(NODE : Ref GT) : Novalue =
Begin
    Local
	O1		: Ref GT,
	O3		: Ref GT,
	O4		: Ref GT;

    O1 = .NODE[gt_arg1];		! variable
    O3 = .NODE[gt_arg3];		! TO part
    O4 = .NODE[gt_arg4];		! BY part
    LOOPDEPTH = .LOOPDEPTH+1;

! two accesses to the variable (test and increment)

    UPDATE2(.O1,2);

! one each to the TO and BY parts

    UPDATE2(.O3,1);
    UPDATE2(.O4,1);
    LOOPDEPTH = .LOOPDEPTH-1;

! calculate the cost of moving the FROM part to the variable

    KUNOP(.O1,.NODE[gt_arg2],0)		! FROM part
End;

!
! FUNCTION:
!	MAIN COST CONTROL ROUTINE. CALLED BY TLA FOR COST UPDATING OF
!	THE CURRENT NODE. SWITCHES TO THE NODE-SPECIFIC COST UPDATING
!	ROUTINES.
!
Routine KOST(NODE : Ref GT) : Novalue =
Begin
    Local
	LOP		: Ref GT,
	ROP		: Ref GT,
	O2		: Ref GT;
    Literal
	KLABEL		= 2,	! EST. AVG. NUMBER OF LEAVES TO ANY LABEL
	MUSTBEREG	= 20;

! no costs if nothing being generated here

    If Not .NODE[gt_v_mustgencode] Then
	Return;

! for control operators...

    If .NODE[gt_code] Gtr MAXOPERATOR Then
	Begin
	Selectone .NODE[gt_code] Of Set
	    [OP_WHILE,OP_UNTIL,OP_DO_WHILE,OP_DO_UNTIL]:
		CTRLKOST;

	    [OP_STORE]:
		Begin

! get the operands in target path order

		If .NODE[gt_v_tpath] Then
		    Begin
		    LOP = .NODE[gt_arg2];
		    ROP = .NODE[gt_arg1]
		    End
		Else
		    Begin
		    LOP = .NODE[gt_arg1];
		    ROP = .NODE[gt_arg2]
		    End;

! if the result is wanted then calculate the cost of moving the
! source to the target and the target to the destination
! otherwise just calculate the cost of moving the source to
! the destination

		If REQ_RESULT Then
		    Begin
		    KUNOP(.NODE,.ROP,0);
		    KUNOP(.LOP,.NODE,0)
		    End
		Else
		    KUNOP(.LOP,.ROP,0)
		End;

	    [OP_IF]:
		Begin

! calculate the cost of the condition

		UPDATE2(.NODE[gt_arg2],1);

! if the result is needed, calculate the cost of the THEN and ELSE parts
! moving to the target

		If REQ_RESULT Then
		    Begin
		    KUNOP(.NODE,.NODE[gt_arg3],0);
		    KUNOP(.NODE,.NODE[gt_arg4],0)
		    End
		End;

	    [OP_CASE]:
		Begin

! calculate the cost of the case selector.  a ridiculous number
! is used (20) as the cost because GCASE will generate several
! accesses to it.

		UPDATE2(.NODE[gt_arg2],MUSTBEREG);

! if the result is needed, calculate the cost of moving each case
! to the target.

		If REQ_RESULT Then
		    Incr I From 2 To .NODE[gt_argc]-2 Do
			KUNOP(.NODE,.NODE[gt_argv(.I)],0)
		End;

	    [OP_SELECT]:
		Begin
		Macro
		    OPND(I)=NODE[gt_argv(I)] %,
		    LAST(I)=NODE[gt_argv(.NODE[gt_argc]-I)] %;
		Local
		    FO		: Integer,
		    LAS2	: Ref GT,
		    L		: Ref GT;

! calculate the cost of moving a -1 into the result

		If REQ_RESULT And Not .NODE[rc_otherwise] Then
		    CTRLKOST;

! get the index of the OTHERWISE case.  if there is an OTHERWISE
! then a tempname is kept to record whether any of the cases have
! been used. and the cost update here is for initializing that
! tempname.

		L = .LAST(1);
		FO = .L<lex_value>;
		If .FO Neq 0 Then
		    Begin
		    LAS2 = .LAST(2);
		    UPDATE2(.LAS2,1)
		    End;

! loop for each select case

		LOP = .OPND(0);
		Incr I From 1 To .NODE[gt_argc]-4 By 2 Do
		    Begin

! before the first otherwise, an INC is generated for each case

		    If .I Leq .FO Then
			UPDATE2(.LAS2,1);

! calculate the cost of comparing the selector against this case

		    ROP = .OPND(.I);
		    If .ROP Neq LEXALWAYS And .ROP Neq LEXOTHERWISE Then
			Begin
			UPDATE2(.LOP,1);
			UPDATE2(.ROP,1)
			End;

! update the cost of moving this selection to the target

		    If REQ_RESULT Then
			KUNOP(.NODE,.OPND(.I+1),0)
		    End
		End;

	    [OP_INCR,OP_DECR]:
		IDKOST(.NODE);

	    [OP_FPARM]:

! cost of stacking a call parameter

		KUNOP(.NODE,.NODE[gt_arg1],LOADANALYSIS);

	    [OP_LABEL]:

! the cost of a labelled block is the estimated number of leaves
! in it plus the cost of moving the block value itself into
! the target.  it seems that the actual number of leaves could
! be saved in the node and so an exact count rather than an
! estimate could be used.

		If REQ_RESULT Then
		    KUNOP(.NODE,.NODE[gt_arg1],
				If .GT[.NODE[gt_arg2],st_lab_left]
					Then KLABEL
					Else 1)
	Tes
	End
    Else

! cost of operator nodes...

	Begin

! no cost if the result of the operator is not needed

	If Not REQ_RESULT Then
	    Return;

! get the operands

	LOP = .NODE[gt_arg1];
	If .NODE[gt_argc] Geq 2 Then
	    ROP = .NODE[gt_arg2];
	If ISRELOP(NODE) Then
	    KRELOP(.NODE,.LOP,.ROP)
	Else
	    Selectone .NODE[gt_code] Of Set
		[OP_ADD,OP_SUB]:
		    KASOP(.NODE,.LOP,.ROP);
		[OP_SWAB]:
		    KUNOP(.NODE,.LOP,1);
		[OP_LOAD_NODE]:
		    KUNOP(.NODE,.LOP,LOADANALYSIS);
		[OP_AND,OP_OR]:

! cost = 2 for AND because of need to use COM and BIC.  not
! sure for OR but it may have to do with state of complemented
! operands.

		    KBINOP(.NODE,.LOP,.ROP,2);
		[OP_MAX,OP_MIN]:

! cost = 2 because of two potential moves to the target

		    KBINOP(.NODE,.LOP,.ROP,2);
		[OP_XOR,OP_EQV]:

! where they get four, I don't know

		    KBINOP(.NODE,.LOP,.ROP,4);
		[OP_SHIFT]:
		    KSHFTOP(.NODE,.LOP,CLITVALUE(ROP));
		[OP_ROT]:
		    Begin
		    Local X;
		    X = CLITVALUE(ROP);
		    X = Abs(.X);
		    If .X Gtr 8 Then
			X = 17 - .X;
		    KUNOP(.NODE,.LOP,.X)
		    End
	    Tes
	End
End;

!	THE FOLLOWING ROUTINES,ETC., ARE CONCERNED
!	WITH DETERMINING THE LIFE 'SPAN' OF A TEMP NAME.
!	THE 'SPAN' IS DEFINED IN TERMS OF TWO QUANTITIES,
!	THE 'LON' AND 'FON'. (SEE THE TNBIND DOCUMENTATION
!	FOR THE DEFINITION AND USE OF THESE).
!
!	THE PROCESS OF DETERMINING THE 'SPAN' IS ACCOMPLISHED
!	BY A SINGLE ROUTINE 'SPAN' AND A NUMBER OF NODE-SPECIFIC
!	DRIVERS FOR SPAN. FOR EXAMPLE, ALL BINARY OPERATORS
!	INVOKE THE ROUTINE 'SPANBINARY' WHICH, IN TURN,, 
!	MAKES SEVERAL CALLS ON SPAN.
!
!

Macro
	NEXTLON		= (LON = .LON+1) %,
	NEXTFON		= (FON = .FON+1) %,
	SAVDTD		= PUSHLS(stk_dtd,-1,.DTEMPS[stk_idx]) %,
	POPDTD		= POPLS(stk_dtd) %;
!
! FUNCTION:
!	USED AFTER EACH BRANCH OF A FORK. KEEPS TRACK (IN stk_dtd_hi) OF THE
!	LOWEST LEVEL TO WHICH ANY BRANCH RAISED DTEMPS[CURD] (THE
!	DYNAMIC TEMPS STACK DEPTH). ALSO RESETS THE DYTEMP STACK TO
!	WHATEVER IT WAS BEFORE THE BRANCH.
!
Macro
	RESETDTD=
		Begin
		Local P : Ref ITEM;
		P = .stk_dtd[itm_rlink];
		If .DTEMPS[stk_idx] Lss .P[stk_dtd_hi] Then
		    P[stk_dtd_hi] = .DTEMPS[stk_idx];
		CLOSEDYTEMPS(.P[stk_dtd_lo])
		End %;
!
! FUNCTION:
!	USED AFTER AN ENTIRE FORK. CUTS BACK THE DYTEMPS STACK
!	TO THE MINIMUM HEIGHT, KEPT TRACK OF AS NOTED ABOVE.
!
Macro
	MINDTD=
		Begin
		Local P : Ref ITEM;
		P = .stk_dtd[itm_rlink];
		If .DTEMPS[stk_idx] Lss .P[stk_dtd_hi] Then
		    P[stk_dtd_hi] = .DTEMPS[stk_idx];
		CLOSEDYTEMPS(.P[stk_dtd_hi])
		End %;

Macro
	NOTEDTD=NODE[gt_dtdelete] = -1 %,		!  (.DTEMPS[CURD]+1)*2

! create a new FON stack entry with [stk_fon_hi] = [stk_fon_lo] = .FON

	SAVFON= PUSHLS(stk_fon,.FON,.FON) %,

! starts a new branch by noting whether the last branch was the
! highwater point and resets back to the original FON

	RESETFON=
		Begin
		Local P : Ref ITEM;
		P = .stk_fon[itm_rlink];
		If .FON Gtru .P[stk_fon_hi] Then
		    P[stk_fon_hi] = .FON;
		FON = .P[stk_fon_lo]
		End %,

! at the end of the last branch, set FON to the highest FON in all
! the branches.

	MAXFON=
		Begin
		Local P : Ref ITEM;
		P = .stk_fon[itm_rlink];
		If .P[stk_fon_hi] Gtru .FON Then
		    FON = .P[stk_fon_hi];
		POPLS(stk_fon)
		End %;

Macro
	UPDATELONFON=(NODE[gt_lon] = NEXTLON; NODE[gt_fon] = NEXTFON) %,
	ASSIGNLABELS=
		If .NODE[rw_flow] Then
		    Begin
		    NODE[gt_lab_t] = .LAB_T;
		    NODE[gt_lab_f] = .LAB_F;
		    If .LAB_T Neqa 0 Then LAB_T[gt_v_lab_req] = TRUE;
		    If .LAB_F Neqa 0 Then LAB_F[gt_v_lab_req] = TRUE
		    End %;

Macro
	FLOWRES	= (.NODE[rw_real_flow] Eql RFFLOW) %,
	TNNEEDED= .NODE[rw_real] %;

Routine SETNOTFPARM : Novalue =
Begin
    Local
	A		: Integer,
	R		: Ref ITEM;

    A = .DTEMPS[stk_idx]+1;
    If .A Leq .DTEMPS[stk_max] Then
	Begin
	R = DTEMPS[stk_item(.A)];
	REOPEN(.R,.LON,.FON);
	CLOSELIST(.R,.LON)
	End
End;

!
! FUNCTION:
!	    MAKES SURE THAT CODE WILL BE GENERATED TO CLEAN UP THE STACK
!	    DOWN TO LEVEL 'NUM', AFTER CODING OF 'NODE'.
!
Routine KILLPDTEMPS(NODE : Ref GT,NUM : Integer) : Novalue =
Begin
    If .NODE<lex_type> Eql T_NODE Then
	Begin
	CLOSEDYTEMPS(.NUM);
	NODE[gt_dtdelete] = (.NUM+1)*2
	End
End;

!
! FUNCTION: EXIT ROUTINE FOR KILLDYTEMPS AND KILLFORKDYTEMPS
!	MAKES SURE APPROPRIATE SUBNODES PUT OUT STACK CLEANUP
!	CODE IF NECESSARY (I.E. IF THEY ARE LIKELY TO CAUSE
!	BRANCHES TO LABELS PAST THE NODE'S STACK CLEANUP CODE)
!
Routine KCLEANUP(ROUT,NODE : Ref GT) : Novalue =
Begin
    If .NODE[gt_code] Eql OP_COMPOUND Then
	Begin
	Bliss(.ROUT,.NODE[LASTOPERAND]);
	Return
	End;
    If Not FLOWRES Then
	Begin
	If Not ISRELOP(NODE) Then
	    Return;
	If .GT[.NODE[gt_arg1],gt_code] Neq OP_BIT And
				.GT[.NODE[gt_arg2],gt_code] Neq OP_BIT Then
	    Return
	End;
    If .NODE[gt_code] Eql OP_IF Then
	Begin
	Bliss(.ROUT,.NODE[gt_arg3]);
	Bliss(.ROUT,.NODE[gt_arg4]);
	Return
	End;
    If .NODE[gt_code] Eql OP_CASE Then
	Begin
	Incr I From 2 To .NODE[gt_argc]-2 Do
	    Bliss(.ROUT,.NODE[gt_argv(.I)]);
	Return
	End;

! AT THIS POINT, NODE MUST BE AND, OR, OR NOT

    Bliss(.ROUT,.NODE[gt_arg1]);
    If .NODE[gt_argc] Eql 2 Then
	Bliss(.ROUT,.NODE[gt_arg2])
End;

!
! FUNCTION:
!	    USED ON EACH BRANCH OF A FORK AFTER MINDTD. MAKES SURE THAT
!	    CODE TO CLEAN UP THE STACK IS GENERATED AFTER EACH BRANCH.
!
! called by ND_IF for THEN and ELSE part and by ND_CASE for each case

Routine KILLFORKDYTEMPS(NODE : Ref GT) : Novalue =
Begin
    Local
	P		: Ref ITEM;

    If .NODE<lex_type> Eql T_NODE Then
	Begin
	P = .stk_dtd[itm_rlink];
	NODE[gt_dtdelete] = (.P[stk_dtd_hi]+1)*2;
	KCLEANUP(KILLFORKDYTEMPS,.NODE)
	End
End;

! called by TL_CLASS, ND_AND, ND_OR, FLOOP, ND_IDLOOP, ND_SELECT

Routine KILLDYTEMPS(NODE : Ref GT) : Novalue =
Begin
    Local
	P		: Ref ITEM;

    If .NODE<lex_type> Eql T_NODE Then
	Begin
	P = .stk_dtd[itm_rlink];
	CLOSEDYTEMPS(.P[stk_dtd_lo]);
	NODE[gt_dtdelete] = (.P[stk_dtd_lo]+1)*2;
	KCLEANUP(KILLDYTEMPS,.NODE)
	End
End;


Macro
	TNSPAN(XTN)=
		Begin
		If .XTN Gtru 8 Then
		    Begin
		    XTN[tn_lon_lu] = .LON;
		    XTN[tn_fon_lu] = .FON
		    End
		End %,
	INITTNSPAN(XTN)=
		Begin
		If .XTN Gtru 8 Then
		    Begin
		    XTN[tn_fon_fu] = XTN[tn_fon_lu] = .FON;
		    XTN[tn_lon_fu] = XTN[tn_lon_lu] = .LON
		    End
		End %;


Routine SPAN(NODE : Ref GT,INC : Integer) : Novalue =
Begin
    Local
	TN		: Ref GT,
	N		: Integer;

    If .NODE<lex_type> Eql T_SYMBOL Then
	Begin
	If Not ONEOF(.NODE[gt_type],S_REGISTER,S_LOCAL,S_FORMAL) Then
	    Return
	End
    Else If .NODE<lex_type> Neq T_NODE Then
	Return
    Else If .NODE[gt_code] Eql OP_COMPOUND Then
	SPAN(.NODE[LASTOPERAND],.INC);
    TN = .NODE[gt_reg];
    If .TN Gtru 8 Then
	Begin
	If .TN[tn_v_lit] Then
	    Return;

! note first LON usage

	If .TN[tn_lon_fu] Gtr .LON Then
	    TN[tn_lon_fu] = .LON;

! note last LON usage

	If .TN[tn_lon_lu] Lss .LON Then
	    TN[tn_lon_lu] = .LON-.INC;

! note first FON usage

	If .TN[tn_fon_fu] Gtr .FON Then
	    TN[tn_fon_fu] = .FON;

! note last FON usage

	If .TN[tn_fon_lu] Lss .FON Then
	    TN[tn_fon_lu] = .FON-.INC;

! compute and note the loop depth

	N = .TN[tn_depth];
	If .NODE<lex_type> Eql T_NODE And .N Gtr .NODE[gt_depth] Then
	    N = .NODE[gt_depth];
	If .N Lss .LOOPDEPTH Then
	    LINK(TNREP(.TN),stk_loop[stk_item(.N)]);

! determine the greatest FON span for those TN's which will be sorted
! by TNSORTENTER

	If ONEOF(.TN[tn_request],NOREQDB,DECREQDB,RFREQDB) Then
	    Begin
	    N = .TN[tn_fon_lu] - .TN[tn_fon_fu];
	    If .MAXFONSPAN Lss .N Then
		MAXFONSPAN = .N
	    End;

! for memory and reg-or-forget TN's, also span what they are bound to

	Selectone .TN[tn_request] Of Set
	    [MEMREQDB]:
		NODE = .TN[gt_reg];
	    [RFREQDB]:
		NODE = .TN[gt_disp];
	    [Otherwise]:
		Return
	Tes;

! tempnames do not have a <lex_type> so we must use [gt_type] instead

	Selectone .NODE[gt_type] Of Set
	    [S_TEMPNAME]:
		0;

! how can a tempname reference a node?

	    [S_NODE]:
		SPAN(FASTLEXOUT(T_NODE,.NODE),.INC);
	    [Otherwise]:	! S_REGISTER, S_LOCAL, S_FORMAL
		SPAN(FASTLEXOUT(T_SYMBOL,.NODE),.INC)
	Tes
	End
End;

Routine SPAN_BINARY(NODE : Ref GT) : Novalue =
Begin
    Local
	TN		: Ref GT;

    SPAN(.NODE,0);
    If .NODE[gt_v_tpath] Then
	(TN = .NODE[gt_arg2]; SPAN(.NODE[gt_arg1],0))
    Else
	(TN = .NODE[gt_arg1]; SPAN(.NODE[gt_arg2],0));
    If .TN<lex_type> Eql T_LITERAL Or .TN[gt_len] Neq 1 Then
	SPAN(.TN,1)
    Else
	SPAN(.TN,0)
End;

Routine SPAN_AND_OR(NODE : Ref GT) : Novalue =
Begin
    If Not FLOWRES Then
	SPAN_BINARY(.NODE)
End;

Routine SPAN_REL(NODE : Ref GT) : Novalue =
Begin
    SPAN(.NODE,0);
    SPAN(.NODE[gt_arg1],0);
    SPAN(.NODE[gt_arg2],0)
End;

Routine SPAN_STORE(NODE : Ref GT) : Novalue =
Begin
    Local
	L		: Ref GT;
    Macro
	SC=	If Not REQ_RESULT Then
		    0
		Else If .L<lex_type> Neq T_NODE Then
		    1
		Else If .L[gt_code] Leq MAXOPERATOR Then
		    (.L[gt_len] Neq 1)
		Else
		    0 %;

    SPAN(.NODE,0);
    If .NODE[gt_v_tpath] Then
	(L = .NODE[gt_arg1]; SPAN(.NODE[gt_arg2],0))
    Else
	(L = .NODE[gt_arg2]; SPAN(.NODE[gt_arg1],0));
    SPAN(.L,SC)
End;

Routine SPAN_UNARY(NODE : Ref GT) : Novalue =
Begin
    SPAN(.NODE,0);
    SPAN(.NODE[gt_arg1],1)
End;

Routine SPAN_UXNARY(NODE : Ref GT) : Novalue =
Begin
    SPAN(.NODE,0);
    SPAN(.NODE[gt_arg1],0)
End;

Routine SPAN_UX(NODE : Ref GT) : Novalue =
Begin
    SPAN(.NODE,0)
End;

Routine SPAN_LOADNODE(NODE : Ref GT) : Novalue =
Begin
    Local
	OP		: Ref GT;

    SPAN(.NODE,0);
    OP = .NODE[gt_arg1];
    If .OP<lex_type> Eql T_SYMBOL Then
	SPAN(.OP,0)
    Else If .OP<lex_type> Neq T_LITERAL And .OP[gt_len] Eql 1 Then
	SPAN(.OP,0)
End;

Routine SPAN_INCR_DECR(NODE : Ref GT) : Novalue =
Begin
    SPAN(.NODE,0);
    SPAN(.NODE[gt_arg1],1);
    SPAN(.NODE[gt_arg3],1);
    SPAN(.NODE[gt_arg4],1)
End;

! called at the start of a loop to save the current state and
! setup for a loop.

Routine ENTLOOP : Novalue =
Begin
    SAVDTD;
    PUSHSTK(stk_loop);
    NEXTLON;
    NEXTFON;
    PUSHLS(stk_loop_lf,.LON,.FON);
    LOOPDEPTH = .LOOPDEPTH+1
End;

! called at the end of a loop

Routine XITLOOP : Novalue =
Begin
    Local
	L		: Integer,
	P		: Ref TNREPR,
	R		: Ref ITEM,
	TR		: Ref TNREPR,
	T		: Ref GT;

    RESETDTD;
    R = .stk_loop_lf[itm_rlink];
    P = stk_loop[stk_item(.stk_loop[stk_idx])];

! limit the LON/FON of all tempnames in this loop to the bounds of
! the loop

    TR = .P;
    Until (TR = .TR[itm_rlink]) Eqla .P Do
	Begin
	T = .TR[tnr_ptr];
	If .T[tn_lon_fu] Gtr .R[stk_exit_lon] Then
	    T[tn_lon_fu] = .R[stk_exit_lon];
	If .T[tn_lon_lu] Lssu .LON Then
	    T[tn_lon_lu] = .LON;
	If .T[tn_fon_fu] Gtr .R[stk_exit_fon] Then
	    T[tn_fon_fu] = .R[stk_exit_fon];
	If .T[tn_fon_lu] Lss .FON Then
	    T[tn_fon_lu] = .FON;

! update MAXFONSPAN for those TN's which will be sorted by TNSORTENTER

	If ONEOF(.T[tn_request],NOREQDB,DECREQDB,RFREQDB) Then
	    Begin
	    L = .T[tn_fon_lu] - .T[tn_fon_fu];
	    If .L Gtr .MAXFONSPAN Then
		MAXFONSPAN = .L
	    End
	End;

! restore the previous context

    LOOPDEPTH = .LOOPDEPTH-1;
    POPSTK(stk_loop);
    POPLS(stk_loop_lf)
End;

!
! FUNCTION:
!	    'NODE' IS A CSE. ASSIGN THE SAME TN TO
!	    ALL THE OCCURRENCES OF THE CSE.
!
Routine BINDUSES(NODE : Ref GT) : Novalue =
Begin
    Local
	PNODE		: Ref GT,
	T		: Ref GT;

    PNODE = .NODE[gt_csparent];
    PNODE[gt_v_bound] = TRUE;		! SAVES SOME TROUBLE FOR BOGUS NODES
    T = .NODE[gt_reg];
    If .T Lssu 8 Then
	Return;
    If .T[tn_request] Eqla 0 Then
	T[tn_request] = DECREQDB;	! TREAT CSE'S LIKE DECLARED TN'S
    Do
	Begin
	If .PNODE[rw_real_flow] Neq RFNONE Then
	    PNODE[gt_reg] = .T;

! if not delayed then this is a bogus node.  delay clobbered the bogus
! bit and 'delayed' serves as the new bogus bit

	If Not (.PNODE[gt_v_delayed] And .PNODE[gt_v_mustgencode]) Then
	    PNODE[gt_v_bound] = TRUE
	End
    Until (PNODE = .PNODE[gt_csthread]) Eqla 0
End;

!   B. - SPECIFIC ROUTINES
! ------------------------------------------------
!
!
!	THIS SECTION CONTAINS THE NODE-SPECIFIC TN ASSIGNMENT
!	ROUTINES. THE FLOW WITHIN THESE ROUTINES IS A BIT
!	INVOLUTED - A BIT OF EXPLANATION IS PROBABLY IN ORDER:
!
!	1) ASSIGNMENT IS DONE IN AN EXECUTION-ORDER TREE WALK.
!	EACH ROUTINE TENDS TO DO A BIT OF WORK AT A NODE THEN
!	CALL OTHER BINDERS TO WORK ON ITS SUBNODES, AND FINALLY
!	DOES A BIT MORE AT ITS OWN NODE BEFORE RETURNING.
!	
!	2) SINCE EACH TYPE OF NODE HAS A ROUTINE TO HANDLE
!	IT, THE ROUTINE 'TLA' ACTS AS A SWITCH TO CALL THE
!	APPROPRIATE ONE. THAT IS, EACH NODE CALLS 'TLA' ON ITS 
!	SUBNODES, AND TLA PROMPTLY SWITCHES OFF TO THE
!	SPECIFIC ROUTINE.
!
!	3) SINCE MANY OF THE ACTIONS OF BINDING ARE COMMON TO
!	EACH OF THE SPECIFIC ROUTINES, A SINGLE ROUTINE,
!	'TLCOMMON', HANDLES THESE IN MOST CASES. IN THESE
!	CASES, TLCOMMON CALLS ANOTHER ROUTINE TO PERFORM THE
!	NODE-SPECIFIC ACTIONS.  TLCOMMON ALSO CALLS THE SPAN ROUTINE
!	WHICH IS APPROPRIATE FOR THE SPECIFIC NODE.
!

Forward Routine
	TL_COMMON;

! note: OLDFIXLIST turns off the MUSTGENCODE bit for
!	alpha and omega list entries.  this turns it
!	back on temporarily for tempname assignment
!	purposes.

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

    L = .NODE[gt_v_mustgencode];
    NODE[gt_v_mustgencode] = TRUE;
    TLA(.NODE,0,0,0);
    BINDUSES(.NODE);
    NODE[gt_v_mustgencode] = .L
End;

Routine LOOPTLLIST(NODE : Ref GT,P) : Novalue =
Begin
    TLLIST(.NODE,.P);
    NODE = .NODE[gt_reg];
    If .NODE Gequ 8 And .NODE[tn_depth] Gtr .LOOPDEPTH Then
	NODE[tn_depth] = .LOOPDEPTH;
End;

Routine BINDLST(N : Ref ITEM) : Novalue =
Begin
    PULSELIST(TLLIST,.N,0);
    FIXLIST(.N<lex_addr>,.N<lex_type>)
End;

Routine LPBINDLST(N : Ref ITEM) : Novalue =
Begin
    PULSELIST(LOOPTLLIST,.N,0);
    FIXLIST(.N<lex_addr>,.N<lex_type>)
End;

Routine TL_INLINE(NODE : Ref GT,TX : Ref GT,LAB_T : Ref GT,LAB_F : Ref GT) =
Begin
    NOTEDTD;
    Return 0
End;


Routine ND_BINARY(NODE : Ref GT,TX : Ref GT,LAB_T : Ref GT,LAB_F : Ref GT) =
Begin
    Local
	LOP		: Ref GT,
	ROP		: Ref GT,
	OP1		: Ref GT,
	TEMP		: Ref GT;

    LOP = 0;
    ROP = 0;
    If .NODE[gt_v_tpath] Then
	(ROP = .TX;OP1 = .NODE[gt_arg2])
    Else
	(LOP = .TX;OP1 = .NODE[gt_arg1]);
    LOP = TLA(.NODE[gt_arg1],.LOP,0,0);
    ROP = TLA(.NODE[gt_arg2],.ROP,0,0);
    If .NODE[gt_v_tpath] Then
	LOP = .ROP;
    If Not REQ_RESULT Then
	Return .LOP;
    TEMP = 0;
    If .TX Eqla 0 Then
	If .OP1<ss_destroyable> Then
	    TX = .LOP
	Else
	    TEMP = .LOP;
    If TNNEEDED Then
	Begin
	FILLTX;
	WANTPREF(.TX,.TEMP)
	End;
    Return .TX
End;

Routine ND_UNARY(NODE : Ref GT,TX : Ref GT,LAB_T : Ref GT,LAB_F : Ref GT) =
Begin
    Return TLA(.NODE[gt_arg1],.TX,.LAB_T,.LAB_F)
End;

Routine ISBIT(NODE : Ref GT) =
Begin
    If .NODE<lex_type> Eql T_NODE And .NODE[gt_code] Eql OP_BIT Then
	Return (TNNEEDED)^1 + 1;
    Return 0
End;

Routine ND_REL(NODE : Ref GT,TX : Ref GT,LAB_T : Ref GT,LAB_F : Ref GT) =
Begin
    Local
	LOP		: Ref GT,
	ROP		: Ref GT,
	LB1_T		: Ref GT,
	LB1_F		: Ref GT,
	LB2_T		: Ref GT,
	LB2_F		: Ref GT,
	BITLEFT		: Boolean,
	BITRIGHT	: Boolean;

! note whether the left and right operands are single bit compares

    BITLEFT  = ISBIT(.NODE[gt_arg1]);
    BITRIGHT = ISBIT(.NODE[gt_arg2]);
    If TNNEEDED Or .BITLEFT<1,1> Or .BITRIGHT<1,1> Then
	FILLTX
    Else
	TX = 0;
    LOP   = 0;
    ROP   = 0;
    LB1_T = 0;
    LB1_F = 0;
    LB2_T = 0;
    LB2_F = 0;
    If .BITLEFT Then
	Begin
	LOP   = .TX;
	LB1_T = .LAB_T;
	LB1_F = .LAB_F
	End
    Else If .BITRIGHT Then
	Begin
	ROP   = .TX;
	LB2_T = .LAB_T;
	LB2_F = .LAB_F
	End;
    LOP = TLA(.NODE[gt_arg1],.LOP,.LB1_T,.LB1_F);
    ROP = TLA(.NODE[gt_arg2],.ROP,.LB2_T,.LB2_F);
    If .BITLEFT Then
	WANTPREF(.TX,.LOP)
    Else If .BITRIGHT Then
	WANTPREF(.TX,.ROP);
    Return .TX
End;

! function store - store the result of a routine call

Routine ND_FSTO(NODE : Ref GT,TX : Ref GT,LAB_T : Ref GT,LAB_F : Ref GT) =
Begin
    Local
	UOP		: Ref GT;

! TLA the call itself

    UOP = TLA(.NODE[gt_arg1],0,0,0);

! if the result of the call is wanted then create a TN for it
! and preference the result to it

    If REQ_RESULT Then
	Begin
	FILLTX;
	WANTPREF(.TX,.UOP)
	End;
    Return .TX
End;

Routine ND_SWAB(NODE : Ref GT,TX : Ref GT,LAB_T : Ref GT,LAB_F : Ref GT) =
Begin
    Local
	P		: Ref GT,
	UOP		: Ref GT;

! TLA the operand

    UOP = TLA(.NODE[gt_arg1],.TX,0,0);

! if a result is wanted then if the operand is destroyable then
! use that otherwise create a new TN and preference the operand
! to it

    If REQ_RESULT Then
	Begin
	P = .NODE[gt_arg1];
	If .P<ss_destroyable> Then
	    TX = .UOP
	Else
	    Begin
	    FILLTX;
	    WANTPREF(.TX,.UOP)
	    End
	End;
    Return .TX
End;

Routine ND_FPAR(NODE : Ref GT,TX : Ref GT,LAB_T : Ref GT,LAB_F : Ref GT) =
Begin
    Local
	UOP		: Ref GT,
	PARM		: Ref GT;

! get the parameter and TLA it

    PARM = .NODE[gt_arg1];
    UOP = TLA(.PARM,0,0,0);

! if the top-of-stack is ok
! -and-
!	a TN was generated
! -and-
!	the parameter is a destroyable node


    If .NODE[gt_cs_compl] Leq MAGIC2 And .UOP Gtru 8 Then
	If .UOP[tn_request] Eqla 0 And .PARM<lex_type> Eql T_NODE Then
	    If .PARM<ss_destroyable> And .PARM[gt_mode] Eql GENREG Then
		Return .UOP;
    TX = GETTN();
    WANTPREF(.TX,.UOP);
    Return .TX
End;

Routine ND_LOADNODE(NODE : Ref GT,TX : Ref GT,LAB_T : Ref GT,LAB_F : Ref GT) =
Begin
    Local
	Q		: Ref GT,
	UOP		: Ref GT,
	OP1		: Ref GT;

! TLA the one argument

    OP1 = .NODE[gt_arg1];
    UOP = TLA(.OP1,0,0,0);
    Q = .NODE[gt_reg];
    If .q Gequ 8 And .Q[tn_type] Eql BNDNCSE Then
	Q[tn_depth] = .LOOPDEPTH;
    If REQ_RESULT Then
	Begin
	FILLTX;
	If .OP1<lex_type> Neq T_SYMBOL Then
	    WANTPREF(.TX,.UOP)
	End;
    Return .TX
End;

Routine ND_ADDSUB(NODE : Ref GT,TX : Ref GT,LAB_T : Ref GT,LAB_F : Ref GT) =
Begin
    Local
	LOP		: Ref GT,
	ROP		: Ref GT,
	OP1		: Ref GT,
	TN		: Ref GT,
	TEMP		: Ref GT;

    LOP = 0;
    ROP = 0;
    If .NODE[gt_v_tpath] Then
	(ROP = .TX;OP1 = .NODE[gt_arg2])
    Else
	(LOP = .TX;OP1 = .NODE[gt_arg1]);
    LOP = TLA(.NODE[gt_arg1],.LOP,0,0);
    ROP = TLA(.NODE[gt_arg2],.ROP,0,0);

! get the target path tempname

    If .NODE[gt_v_tpath] Then
	LOP = .ROP;
    If Not REQ_RESULT Then
	Return .LOP;
    TN = 0;
    TEMP = 0;

! if the target path is destroyable then use the target path as
! the destination otherwise save it

    If .OP1<ss_destroyable> Then
	TN = .LOP
    Else
	TEMP = .LOP;

! if we have a tempname then use it

    If .TN Gequ 8 Then
	TX = .TN

! we don't have one.  if we really need one...

    Else If TNNEEDED Then
	Begin
	If Not (.NODE[rc_mov_target] And Not .NODE[gt_v_old_rcmt]) Then
	    If Not .NODE[rc_mov_offset] Then
		TX = .TEMP;
	FILLTX;
	WANTPREF(.TX,.TEMP)
	End;
    Return .TX
End;

Routine TL_DOT(NODE : Ref GT,TX : Ref GT,LAB_T : Ref GT,LAB_F : Ref GT) =
Begin
    Local
	PAR		: Ref GT;

    If ISCSEUSE(NODE) Then
	Begin
	PAR = .NODE[gt_csparent];
	If Not .PAR[gt_v_bound] Then
	    Begin
	    If Not .PAR[gt_v_delayed] Then		! PAR IS A BOGUS NODE
		UNBOGUS(PAR);
	    If .PAR Neqa .NODE<lex_addr> Then
		TLLIST(FASTLEXOUT(T_NODE,.PAR),0)
	    End
	End
    Else
	Begin
	TX = TLA(.NODE[gt_arg1],.TX,.LAB_T,.LAB_F);
	If .NODE[gt_reg] Eqla 0 Then
	    NODE[gt_reg] = .TX;
	If ISCSECREATION(NODE) Then
	    BINDUSES(.NODE)
	End;
    NOTEDTD;
    UPDATELONFON;
    NODE[gt_v_bound] = TRUE;
    ASSIGNLABELS;
    SPAN_UXNARY(.NODE);
    Return .NODE[gt_reg]
End;

! bind tempname 'ROP' to lexeme 'LOP'

Routine BINDSTORE(LOP : Ref GT,ROP : Ref GT) : Novalue =
Begin
    Local
	SVLON		: Integer,
	SVFON		: Integer;

    If .ROP Lequ 7 Then
	Return;
    If .ROP[tn_request] Neqa 0 Then
	Return;
    ROP[tn_request] = MEMREQDB;
    If .LOP<lex_type> Eql T_LITERAL Then
	Begin
	ROP[tn_v_lit]   = TRUE;
	ROP[tn_literal] = .LOP;
	ROP[tn_type]    = 0;
	Return
	End;
    ROP[gt_reg] = .LOP;
    UPDATE(.LOP,.ROP[tn_min_complexity]/(.LOOPDEPTH+1),
		.ROP[tn_max_complexity]/(.LOOPDEPTH+1));
    SVLON = .LON;
    SVFON = .FON;
    LON   = .ROP[tn_lon_fu];
    FON   = .ROP[tn_fon_fu];
    SPAN(.LOP,0);
    LON   = .SVLON;
    FON   = .SVFON
End;

Routine FINDLEX(LEX : Ref GT,TREE : Ref GT) =
Begin
    Macro
	FINDNCSE(NODE)=
		Begin
		If .NODE[gt_reg] Lequ 7 Then
		    Return FALSE;
		If .GT[.NODE[gt_reg],tn_type] Neq BNDNCSE Then
		    Return FALSE;
		NODE = .GT[.NODE[gt_reg],gt_disp];
		If .NODE[gt_type] Eql S_NODE Then
		    Return FALSE;
		NODE<lex_type> = T_SYMBOL
		End %;

    If .LEX<lex_type> Eql T_NODE Then
	FINDNCSE(LEX);
    If .TREE<lex_part> Eqla .LEX<lex_part> Then
	Return TRUE;
    If .TREE<lex_type> Eql T_NODE Then
	If .TREE[gt_code] Eql OP_FAKE_CSE Then
	    Begin
	    FINDNCSE(TREE);
	    Return FINDLEX(.LEX,.TREE)
	    End
	Else
	    Incr I From 0 To .TREE[gt_argc]-1 Do
		If FINDLEX(.LEX,.TREE[gt_argv(.I)]) Then
		    Return TRUE;
    Return FALSE
End;

Routine FINDLEFT(LN : Ref GT,RN : Ref GT)=
Begin
    Local
	X		: Integer,
	Y		: Integer;

    If .RN<lex_type> Neq T_NODE Then
	Return 0;
    If .RN[gt_code] Eql OP_DOT Then
	Return (.RN[gt_arg1] Eqla .LN);
    If Not (ONEOF(.RN[gt_code],OP_ADD,OP_SUB,OP_AND,OP_OR,OP_SWAB)
		Or ONEOF(.RN[gt_code]-2,OP_SHIFT-2,OP_ROT-2,
			OP_MAX-2,OP_MIN-2,OP_EQV-2,OP_XOR-2)) Then
	Return 0;
    If .RN[gt_v_tpath] Then
	(X = .RN[gt_arg2];Y = .RN[gt_arg1])
    Else
	(Y = .RN[gt_arg2];X = .RN[gt_arg1]);
    If .RN[gt_argc] Eql 2 Then
	If FINDLEX(.LN,.Y) Then
	    Return 0;
    Y = FINDLEFT(.LN,.X);
    If .Y Neq 0 Then
	Return .Y+1
    Else
	Return 0
End;

Routine ISNEGNOT(LN : Ref GT,RN : Ref GT) =
Begin
    Local
	LRN		: Ref GT,
	LLRN		: Ref GT;

    If .RN<lex_type> Neq T_NODE Then
	Return 0;
    If .RN[gt_code] Neq OP_NEG Then
	If .RN[gt_code] Neq OP_NOT Then
	    Return 0;
    LRN = .RN[gt_arg1];
    If .LRN<lex_type> Neq T_NODE Then
	Return 0;
    If .LRN[gt_code] Neq OP_DOT Then
	Return 0;
    LLRN = .LRN[gt_arg1];
    If EQLPOSSIZE(.LN,.LLRN) Then
	Return 1;
    Return 0
End;

!
! A "SIMPLE" STORE IS, BY DEFINITION, ONE WHICH DOES NOT
! NEED A SPECIAL TEMPORARY FOR THE RHS.
!
! VALUE RETURNED:
!	-1 :: WE HAVE A STORE OF THE FORM
!		(EXPR1)  =  .(EXPR1) OP (EXPR2),
!	      OR (EXPR1)  =  NOT .(EXPR1)
!	      OR (EXPR1)  =  - .(EXPR2);
!		THE 'RCMTF' BIT OF THE 'OP' (OR 'NOT' OR '-') NODE
!		SHOULD BE TURNED OFF.
!	 1 :: WE HAVE SOME OTHER KIND OF SIMPLE STORE, E.G.
!		VAR1  =  .VAR2 + 3;
!		THE 'RCMTF' BIT OF THE 'OP' NODE SHOULD BE LEFT AS IS.
!	 0 :: THE STORE WE ARE DEALING WITH IS NOT SIMPLE.
!
Routine SIMPLESTORE(LN : Ref GT,RN : Ref GT) =
Begin
    Macro
	ADDORSUB=ONEOF(.RN[gt_code],OP_ADD,OP_SUB) %,
	ANDORIOR=ONEOF(.RN[gt_code],OP_AND,OP_OR) %,
	SPECIALCASES= Not ONEOF(.RN[gt_code],OP_LOAD_NODE,OP_XOR,OP_EQV,
			OP_GTR,OP_LEQ,OP_LSS,OP_GEQ,OP_EQL,OP_NEQ,
			OP_GTRU,OP_LEQU,OP_LSSU,OP_GEQU,OP_EQLU,OP_NEQU) %;
    Local
	LRN		: Ref GT,
	LLRN		: Ref GT,
	RRN		: Ref GT;
    Literal
	SIMPLEVAL	= 3;

    Routine SIMPLOP(NODE : Ref GT) =
    Begin
	If .NODE[gt_code] Leq MAXOPERATOR Or .NODE[gt_code] Eql OP_FAKE_CSE Then
	    Return TRUE
	Else If .NODE[gt_code] Eql OP_STORE Then
	    Return SIMPLOP(If .NODE[gt_v_tpath]
				Then .NODE[gt_arg1]
				Else .NODE[gt_arg2])
	Else
	    Return FALSE
	End;

    Routine ISPSOK(LN : Ref GT,RN : Ref GT) =
    Begin
    Local
	SSP;

! truth table:
!
!	LRN	RRN	CODE	result
!	N	N	and	0
!	N	Y	or	0
!	N	N	or	1
!	N	Y	and	1
!	Y	N	and	2
!	Y	Y	or	2
!	Y	N	or	3
!	Y	Y	and	3

    Macro
	ISBISORBIC=
		Begin
		If ANDORIOR Then
		    Begin
		    Local
			RRN	: Ref GT,
			LRN	: Ref GT;

		    If .RN[gt_v_tpath] Then
			(LRN = .RN[gt_arg2]; RRN = .RN[gt_arg1])
		    Else
			(LRN = .RN[gt_arg1]; RRN = .RN[gt_arg2]);
		    (1 And (.RRN<ss_complemented> Eqv (.RN[gt_code] Eql OP_AND)))
				+ .LRN<ss_complemented>*2
		    End
		Else
		    0
		End %;

    Macro
	ISINCORDEC=
		Begin
		If ADDORSUB And Abs(.RN[gt_disp_16]) Eql 1 Then
		    (.RN[rc_add_offset] Or .RN[rc_sub_offset])
		Else
		    FALSE
		End %;

    Macro
	ISCOMORNEG= (.RN[gt_code] Eql OP_LOAD_NODE And
				(.RN[rc_complement] Or .RN[rc_negate])) %;

! start of ISPSOK

	SSP = .LN<ss_ptr_state>;
	If .SSP Leq PF016 Then
	    Return TRUE
	Else If .SSP Leq PF08 Then
	    Begin
	    If ISINCORDEC Then
		Return TRUE
	    Else If ISCOMORNEG Then
		Return TRUE
	    Else
		Return ISBISORBIC
	    End
	Else
	    Return (ISBISORBIC Eql 1)
    End;

    Label
	aaa,bbb;
    Local
	X		: Integer;

! start of simple store

    If .RN<lex_type> Neq T_NODE Then
	Return 0;
    If .LN<lex_type> Eql T_NODE Then
	aaa: Begin
	If .LN[gt_code] Eql OP_POINTER Then
	    If ISPSOK(.LN,.RN) Then
		Leave aaa;
	If Not SIMPLOP(.LN) Then
	    Return 0
	End;
    If .LN<lex_type> Eql T_SYMBOL Then
	Begin
	If .LN<lex_part> Eqla .PCREG Then
	    Return 0;

! LATER THIS WILL BE EXTENDED TO ALL VOLATILE LOCATIONS.

	If Not ISPSOK(.LN,.RN) Then
	    Return 0;
	X = FINDLEFT(.LN,.RN);
	If .X Neq 0 Then
	    If .X Leq (SIMPLEVAL+1)/(1+(.LN[gt_mode] Neq GENREG)) Then
		Return -1
	End;
    If .RN[gt_code] Eql OP_LOAD_NODE Then
	Begin
	If .RN[gt_occ] Eql 1 Then
	    If .RN[gt_cs_compl] Eql 0 Then
		Return 1
	    Else If ISNEGNOT(.LN,.RN[gt_arg1]) Then
		Return -1
	    Else
		Return 0
	End;
    If .RN[gt_code] Eql OP_FSTORE Then
	Return 1;
    If .RN[gt_code] Leq MAXOPERATOR Then
	If .RN[gt_code] Eql OP_DOT Then
	    Return 0
	Else If .RN[gt_code] Eql OP_SWAB Then
	    Return 1
	Else If .RN[gt_argc] Eql 2 Then
	    bbb: Begin
	    If .RN[gt_v_tpath] Then
		(LRN = .RN[gt_arg2]; RRN = .RN[gt_arg1])
	    Else
		(LRN = .RN[gt_arg1]; RRN = .RN[gt_arg2]);
	    If .RN[gt_reg] Eqla .LRN[gt_reg] Then
		If .RN[gt_cs_compl] Gtr SIMPLEVAL Then
		    Leave bbb;
	    If FINDLEX(.LN,.LRN) Then
		If SPECIALCASES Then
		    Leave bbb
		Else
		    Return 0;
	    If .LN<ss_ptr_state> Gtr PF016 Then
		Leave bbb;
	    If .LRN<lex_type> Eql T_NODE Then
		If .LRN[gt_code] Eql OP_FSTORE Then
		    Return 0;
	    Return 1 - FINDLEX(.LN,.RRN)
	    End;
    If
		Begin
		Macro TRUNC(X)=(X-MAXOPERATOR) %;

		ONEOF(TRUNC(.RN[gt_code]),TRUNC(OP_IF),TRUNC(OP_CASE),
			TRUNC(OP_SELECT),TRUNC(OP_LABEL))
		End Then
	Return 1
    Else If .RN[gt_code] Leq MAXOPERATOR Then
	Begin
	LRN = (If .RN[gt_v_tpath] Then .RN[gt_arg2] Else .RN[gt_arg1]);
	If .LRN<lex_type> Neq T_NODE Then
	    Return 0;
	If .LRN[gt_code] Eql OP_DOT Then
	    Begin
	    LLRN = .LRN[gt_arg1];
	    If .LLRN Eqla .LN Then
		Return -(SPECIALCASES)
	    Else If EQLPOSSIZE(.LLRN,.LN) Then
		If SPECIALCASES Then
		    Begin
		    LRN[gt_v_coded] = 1;
		    LRN[gt_mode] = 0;
		    LRN[gt_reg] = .RN[gt_reg];
		    Return -1
		    End
	    End
	End;
    Return 0
End;

Routine TRYSIMPLESTORE(NODE : Ref GT,LN : Ref GT,RN : Ref GT) : Novalue =
Begin
    While TRUE Do
	Begin
	Macro
	    DOBIND=
			Begin
			Local SMPL;
			SMPL = SIMPLESTORE(.LN,.RN);
			If .SMPL Then
			    Begin
			    BINDSTORE(.LN,.RN[gt_reg]);
			    If .SMPL Lss 0 Then
				RN[rc_mov_target] = FALSE;
			    TRUE
			    End
			Else
			    FALSE
			End %;

	If .RN<lex_type> Neq T_NODE Then
	    Return;
	If .RN[gt_code] Leq MAXOPERATOR Then
	    Begin
	    DOBIND;
	    Return
	    End;
	Selectone .RN[gt_code] Of Set
	    [OP_IF]:
		Begin
		If DOBIND Then
		    Begin
		    TRYSIMPLESTORE(.NODE,.LN,.RN[gt_arg3]);
		    TRYSIMPLESTORE(.NODE,.LN,.RN[gt_arg4])
		    End;
		Return
		End;

	    [OP_CASE]:
		Begin
		If DOBIND Then
		    Incr I From 2 To .RN[gt_argc]-2 Do
			TRYSIMPLESTORE(.NODE,.LN,.RN[gt_argv(.I)]);
		Return
		End;

	    [OP_SELECT]:
		Begin
		If DOBIND Then
		    Incr I From 2 To .RN[gt_argc]-3 By 2 Do
			TRYSIMPLESTORE(.NODE,.LN,.RN[gt_argv(.I)]);
		Return
		End;

	    [OP_COMPOUND]:
		RN = .RN[gt_argv(.RN[gt_argc]-1)];

	    [OP_LABEL,OP_FSTORE]:
		Begin
		DOBIND;
		Return
		End;

	    [Otherwise]:
		Return
	Tes
	End
End;

Routine ND_STORE(NODE : Ref GT,TX : Ref GT,LAB_T : Ref GT,LAB_F : Ref GT) =
Begin
    Local
	LOP		: Ref GT,
	ROP		: Ref GT,
	TEMP		: Ref GT;

    If .NODE[gt_v_tpath] Then
	(LOP = .NODE[gt_arg2]; ROP = .NODE[gt_arg1])
    Else
	(LOP = .NODE[gt_arg1]; ROP = .NODE[gt_arg2]);
    If .TX Lssu 8 Then
	Begin
	If REQ_RESULT And Not .NODE[gt_v_copied] Then
	    NODE[gt_reg] = TX = GETTN()
	End
    Else
	Begin
	If .TX[tn_request] Eql MEMREQDB And .TX[gt_reg] Eqla .ROP<lex_addr> Then
	    TX = 0
	End;
    If Not REQ_RESULT Then
	TX = 0;
    If .NODE[gt_v_tpath] Then
	TEMP = TLA(.ROP,.TX,0,0);
    TLA(.LOP,0,0);
    If Not .NODE[gt_v_tpath] Then
	TEMP = TLA(.ROP,.TX,0,0);
    WANTPREF(.NODE[gt_reg],.TEMP);
    If .TX Eqla 0 Then
	TRYSIMPLESTORE(.NODE,.LOP,.ROP);
    Return .TX
End;

Routine SPAN_PARMS : Novalue =
Begin
    Local
	P		: Ref TNREPR,
	TR		: Ref TNREPR,
	T		: Ref GT;

    Decr I From .stk_call[stk_idx] To 0 Do
	Begin
	P = stk_call[stk_item(.I)];
	TR = .P;
	Until (TR = .TR[itm_rlink]) Eqla .P Do
	    Begin
	    T = .TR[itm_rlink];
	    If .T[tn_lon_lu] Lssu .LON Then
		T[tn_lon_lu] = .LON;
	    If .T[tn_fon_lu] Lssu .FON Then
		T[tn_fon_lu] = .FON
	    End
	End
End;

Routine TL_CALL(NODE : Ref GT,TX : Ref GT,LAB_T : Ref GT,LAB_F : Ref GT) =
Begin
    Local
	LNAME		: Ref ST,
	SUBNODE		: Ref GT,
	TN		: Ref GT,
	LNKGD		: Ref GT,
	OLON		: Integer,
	OFON		: Integer,
	N		: Integer,
	PARMNO		: Integer,
	PT		: Integer,
	PL		: Integer,
	FSP		: Boolean,
	S		: Ref GT,
	Z		: Ref GT;
   Label
	aaa;

! 1ST, BIND THE ROUTINE NAME

    TLA(.NODE[gt_arg2],0,0,0);

    LNAME = .NODE[gt_arg1];
    LNKGD = .LNAME[st_lnk_desc];
    PARMNO = 0;
    FSP = TRUE;
    If .NODE[gt_argc] Gtr 2 Then
	Begin
	PUSHSTK(stk_call);

! loop for each parameter

	Incr I From 2 To .NODE[gt_argc]-1 Do
	    Begin

! get the next parmeter descriptor

	    PARMNO = .PARMNO + 1;
	    If .PARMNO Gtr .LNKGD[parm_size] Then
		PT = PARM_STACK
	    Else
		Begin
		PT = .LNKGD[parm_type(.PARMNO)];
		PL = .LNKGD[parm_loc(.PARMNO)]
		End;
	    SUBNODE = .NODE[gt_argv(.I)];
	    OLON = .LON+1;
	    OFON = .FON+1;
	    TN = TLA(.SUBNODE,0,0,0);
	    SPAN(.SUBNODE,0);

! note the call

	    LINK(TNREP(.SUBNODE[gt_reg]),
			stk_call[stk_item(.stk_call[stk_idx])]);
	    SPAN_PARMS();
	    Case .PT From LO_PARM_TYPE To HI_PARM_TYPE Of Set

		[PARM_STACK]:
		    aaa: Begin
			Local
			    D : Integer;

! if the first stack parameter...

		    If .FSP Then
			Begin
			FSP = FALSE;
			D = .GT[.stk_dtd[itm_rlink],stk_dtd_lo];
			N = .DTEMPS[stk_idx];
			SAVDTD;
			If .DTEMPS[stk_idx] Neq .D
					Or .NODE[gt_argc] Eql 3
					Or .NODE[gt_argc] Eql 5 Then
			    If TRYSPDYTEMP(.TN,.N) Then
				Begin
				TN[tn_request] = MEMREQDB;
				Leave aaa
				End
			End;
		    N = .N + 1;
		    If Not TRYSPDYTEMP(.TN,.N) Then
			OPENDYTEMP(.TN,.OLON,.OFON);
		    GT[.stk_dtd[itm_rlink],stk_dtd_lo] = .N;
		    TN[tn_request] = MEMREQDB
		    End;

		[PARM_REGISTER]:
		    Begin
		    Local
			SUBSUB : Ref GT;

		    SUBSUB = .SUBNODE[gt_arg1];
		    If .SUBSUB<lex_type> Eql T_NODE And .SUBSUB[gt_reg] Gequ 8 Then
			TN[tn_permit] = .SUBSUB[gt_reg];
		    TN[tn_request] = SRREQDB;
		    TN[gt_reg]     = .PL
		    End;

		[PARM_LITERAL]:
		    Begin
		    TN[tn_v_lit]   = TRUE;
		    TN[tn_literal] = LITLEXEME(.PL);
		    TN[tn_request] = MEMREQDB
		    End;

		[PARM_MEMORY]:
		    Begin
		    TN[gt_reg]     = .PL;
		    TN[tn_request] = MEMREQDB
		    End

	    Tes;
	    If Not .FSP Then
		KILLPDTEMPS(.SUBNODE,
			(If .DTEMPS[stk_idx] Eql .N Or .I Eql .NODE[gt_argc]-1
				Then .N
				Else .N+1))
	    End;
	POPSTK(stk_call)
	End;
    NOTEDTD;
    If Not .FSP Then
	POPDTD;
    If .DTEMPS[stk_idx] Geq (STKSIZE-.MAXPARMS) Then
	KILLDYTEMPS(.NODE);

! GET A NEW TN FOR THE VALUE OF THE CALL AND MAKE IT THE VALUE REGISTER

    If .LNAME[st_lnk_type] Neq LNK_INTERRUPT Then
	Begin
	NODE[gt_reg] = TN = Z = GETTN();
	S = .NODE[gt_arg2];
	If .S<lex_part> Eqla .LXHALT Then
	    BINDSTORE(LITLEXEME(%o'177570'),.TN)
	Else
	    Begin
	    TN[tn_request] = SRREQDB;
	    TN[gt_reg] = VREGNUM
	    End
	End
    Else
	TN = Z = 0;
    UPDATELONFON;
    NODE[gt_v_bound] = TRUE;
    ASSIGNLABELS;
    SPAN(.NODE,0); 
    SPAN(.NODE[gt_arg2],1);
    Return .Z
End;

Routine LOADR0(NODE : Ref GT) =
Begin
    Local
	TX		: Ref GT;

    NODE[gt_reg]     = TX = GETTN();
    TX[tn_type]      = BNDREG;
    TX[tn_request]   = SRREQDB;
    TX[gt_reg]       = VREGNUM;
    TX[tn_bind_list] = REGS[VREGNUM];
    If EMPTY(REGS[VREGNUM]) Then
	OPENREG(VREGNUM);
    Return .TX
End;


Routine TL_ROUTINE(NODE : Ref GT,TX : Ref GT,LAB_T : Ref GT,LAB_F : Ref GT) =
Begin
    Local
	RNAME		: Ref ST,
	LNAME		: Ref ST,
	LDESC		: Ref ST,
	TN		: Ref GT,
	TL		: Ref GT;

    RNAME = .NODE[gt_arg2];
    RNAME[st_retlab] = .NODE;
    LNAME = .RNAME[st_var_linkage];
    LDESC = .LNAME[st_lnk_desc];
    If Not .flg_enable Then
	Begin
	Decr I From 5 To 0 Do
	    NULLLST(REGS[.I]);
	Incr I From 1 To .LDESC[parm_size] Do
	    If .LDESC[parm_type(.I)] Eql PARM_REGISTER Then
		OPENREG(.LDESC[parm_loc(.I)]);
	End;
    If Not EMPTY(.RNAME[st_var_reg_list]) Then
	Begin
	Local
	    L		: Ref LSTHDR,
	    I		: Ref ITEM;

	I = L = .RNAME[st_var_reg_list];
	Until (I = .I[itm_rlink]) Eqla .L Do
	    Begin
	    TL = GETTN();
	    TL[tn_bind_list] = REGS[.I[itm_ldata(1)]];
	    TL[tn_request]   = MEMREQDB;
	    TL[gt_reg]       = .I[itm_ldata(1)];
	    WANTPREF(.TL,.GT[.I[itm_rdata(1)],gt_reg]);
	    UPDATE(.I[itm_rdata(1)],1,2)
	    End
	End;

    If .LNAME[st_lnk_type] Neq LNK_INTERRUPT Then
	TN = LOADR0(.NODE)
    Else
	TN = 0;
    TL = TLA(.NODE[gt_arg1],0,0,0);
    UPDATELONFON;
    SPAN_UNARY(.NODE);
    WANTPREF(.TL,.TN);
    NODE[gt_reg] = .TN;
    Return .TN
End;


Routine ND_AND(NODE : Ref GT,TX : Ref GT,LAB_T : Ref GT,LAB_F : Ref GT) =
Begin
    Local
	LOP		: Ref GT,
	ROP		: Ref GT,
	OP1		: Ref GT,
	L_T		: Ref GT,
	L_F		: Ref GT,
	TEMP		: Ref GT,
	P		: Ref ITEM;
    Bind
	LEX2=NODE[gt_arg2]	: Ref GT;

    L_T = .NODE[gt_arg2];
    L_F = .LAB_F;
    If .LEX2<lex_type> Eql T_LITERAL Then
	If .LEX2<lex_value> Then
	    Begin
	    L_T = .LAB_T;
	    L_F = .LAB_F
	    End
	Else
	    Begin
	    L_T = .LAB_F;
	    L_F = .LAB_F
	    End;
    LOP = 0;
    ROP = 0;
    If .NODE[gt_v_tpath] Then
	(ROP = .TX;OP1 = .NODE[gt_arg2])
    Else
	(LOP = .TX;OP1 = .NODE[gt_arg1]);
    LOP = TLA(.NODE[gt_arg1],.LOP,.L_T,.L_F);
    If FLOWRES Then
	SAVDTD;
    ROP = TLA(.NODE[gt_arg2],.ROP,.LAB_T,.LAB_F);
    If .NODE[gt_v_tpath] Then
	LOP = .ROP;
    If FLOWRES Then
	Begin
	P = .stk_dtd[itm_rlink];
	If .DTEMPS[stk_idx] Neq .P[stk_dtd_lo] Then
	    Begin
	    KILLDYTEMPS(.NODE[gt_arg2]);
	    SETNOTFPARM()
	    End;
	POPDTD;
	Return 0
	End;
    If Not REQ_RESULT Then
	Return .LOP;
    TEMP = 0;
    If .TX Eqla 0 Then
	If .OP1<ss_destroyable> Then
	    TX = .LOP
	Else
	    TEMP = .LOP;
    FILLTX;
    WANTPREF(.TX,.TEMP);
    Return .TX
End;

Routine ND_OR(NODE : Ref GT,TX : Ref GT,LAB_T : Ref GT,LAB_F : Ref GT) =
Begin
    Local
	LOP		: Ref GT,
	ROP		: Ref GT,
	OP1		: Ref GT,
	L_T		: Ref GT,
	L_F		: Ref GT,
	P		: Ref ITEM,
	TEMP		: Ref GT;
    Bind
	LEX2=NODE[gt_arg2]	: Ref GT;

    L_T = .LAB_T;
    L_F = .NODE[gt_arg2];
    If .LEX2<lex_type> Eql T_LITERAL Then
	If .LEX2<lex_value> Then
	    Begin
	    L_T = .LAB_T;
	    L_F = .LAB_T
	    End
	Else
	    Begin
	    L_T = .LAB_T;
	    L_F = .LAB_F
	    End;
    LOP = 0;
    ROP = 0;
    If .NODE[gt_v_tpath] Then
	(ROP = .TX;OP1 = .NODE[gt_arg2])
    Else
	(LOP = .TX;OP1 = .NODE[gt_arg1]);
    LOP = TLA(.NODE[gt_arg1],.LOP,.L_T,.L_F);
    If FLOWRES Then
	SAVDTD;
    ROP = TLA(.NODE[gt_arg2],.ROP,.LAB_T,.LAB_F);
    If .NODE[gt_v_tpath] Then
	LOP = .ROP;
    If FLOWRES Then
	Begin
	P = .stk_dtd[itm_rlink];
	If .DTEMPS[stk_idx] Neq .P[stk_dtd_lo] Then
	    Begin
	    KILLDYTEMPS(.NODE[gt_arg2]);
	    SETNOTFPARM()
	    End;
	POPDTD;
	Return 0
	End;
    If Not REQ_RESULT Then
	Return .LOP;
    TEMP = 0;
    If .TX Eqla 0 Then
	If .OP1<ss_destroyable> Then
	    TX = .LOP
	Else
	    TEMP = .LOP;
    FILLTX;
    WANTPREF(.TX,.TEMP);
    Return .TX
End;

Routine TL_NOT(NODE : Ref GT,TX : Ref GT,LAB_T : Ref GT,LAB_F : Ref GT) =
Begin

! NOT is like any other operator except we switch the labels

    Return TL_COMMON(.NODE,.TX,.LAB_F,.LAB_T)
End;

Routine ND_COMP(NODE : Ref GT,TX : Ref GT,LAB_T : Ref GT,LAB_F : Ref GT) =
Begin
    Incr I From 0 To .NODE[gt_argc]-2 Do
	TLA(.NODE[gt_argv(.I)],0,0,0);
    TX = TLA(.NODE[LASTOPERAND],.TX,.LAB_T,.LAB_F);
    If REQ_RESULT Then
	Return .TX
    Else
	Return 0
End;

Routine ND_IF(NODE : Ref GT,TX : Ref GT,LAB_T : Ref GT,LAB_F : Ref GT) =
Begin
    Local
	DTUNEVEN	: Boolean,
	TT3		: Boolean,
	TT4		: Boolean,
	P		: Ref ITEM,
	TTHEN		: Ref GT,
	TELSE		: Ref GT;

    BINDLST(.NODE[gt_arg1]);
    TLA(.NODE[gt_arg2],0,.NODE[gt_arg3],.NODE[gt_arg4]);
    SAVFON;
    SAVDTD;
    If REQ_RESULT Then
	FILLTX;
    TTHEN = .NODE[gt_arg3];
    TELSE = .NODE[gt_arg4];
    TT3 = (.TTHEN[gt_cs_compl] Leq MAGIC3);
    TT4 = (.TELSE[gt_cs_compl] Leq MAGIC3);
    TTHEN = TLA(.TTHEN,If .TT3 And .TT4 Then .TX Else 0,.LAB_T,.LAB_F);
    RESETFON;
    RESETDTD;
    TELSE = TLA(.TELSE,If .TT4 Then .TX Else 0,.LAB_T,.LAB_F);
    MAXFON;
    P = .stk_dtd[itm_rlink];
    DTUNEVEN = (.DTEMPS[stk_idx] Neq .P[stk_dtd_hi]);
    MINDTD;
    If .DTUNEVEN Then
	Begin
	KILLFORKDYTEMPS(.NODE[gt_arg3]);
	KILLFORKDYTEMPS(.NODE[gt_arg4]);
	SETNOTFPARM()
	End;
    POPDTD;
    If REQ_RESULT Then
	Begin
	WANTPREF(.TX,.TTHEN);
	WANTPREF(.TX,.TELSE)
	End;
    BINDLST(.NODE[gt_arg5]);
    Return .TX
End;

Routine ND_CASE(NODE : Ref GT,TX : Ref GT,LAB_T : Ref GT,LAB_F : Ref GT) =
Begin
    Local
	T		: Ref GT,
	RES		: Integer,
	DTUNEVEN	: Boolean,
	P		: Ref ITEM,
	SUBNODE		: Ref GT;

    DTUNEVEN = FALSE;
    BINDLST(.NODE[gt_arg1]);
    TLA(.NODE[gt_arg2],0,0,0);
    If (RES = REQ_RESULT) Then
	FILLTX
    Else
	TX = 0;
    SAVFON;
    SAVDTD;
    Incr I From 2 To .NODE[gt_argc]-2 Do
	Begin
	SUBNODE = .NODE[gt_argv(.I)];
	T = TLA(.SUBNODE,0,.LAB_T,.LAB_F);
	If .RES Then
	    WANTPREF(.T,.TX);
	P = .stk_dtd[itm_rlink];
	If .I Geq 3 And .DTEMPS[stk_idx] Neq .P[stk_dtd_hi] Then
	    DTUNEVEN = 1;
	If .I Neq .NODE[gt_argc]-2 Then
	    RESETDTD
	Else
	    MINDTD;
	RESETFON
	End;
    If .DTUNEVEN Then
	Begin
	Incr I From 2 To .NODE[gt_argc]-2 Do
	    KILLFORKDYTEMPS(.NODE[gt_argv(.I)]);
	SETNOTFPARM()
	End;
    POPDTD;
    MAXFON;
    BINDLST(.NODE[gt_argv(.NODE[gt_argc]-1)]);
    Return .TX
End;

! TLA FOR WHILE-DO, UNTIL-DO, DO-WHILE, AND DO-UNTIL CASES 0 THROUGH 3 OF TYPE

Routine FLOOP(NODE : Ref GT,TX : Ref GT,LAB_T : Ref GT,LAB_F : Ref GT,TYPE) =
Begin
    Local
	L1_T		: Ref GT,
	L1_F		: Ref GT,
	L2_T		: Ref GT,
	L2_F		: Ref GT,
	OP4		: Ref GT;

    LPBINDLST(.NODE[gt_arg1]);
    LPBINDLST(.NODE[gt_arg2]);
    L1_T = 0;
    L1_F = 0;
    L2_T = 0;
    L2_F = 0;
    Case .TYPE From 0 To 3 Of Set
	[0]:
	    Begin
	    L1_T = .NODE[gt_arg4];
	    L1_F = .NODE[gt_arg5]
	    End;
	[1]:
	    Begin
	    L1_T = .NODE[gt_arg5];
	    L1_F = .NODE[gt_arg4]
	    End;
	[2]:
	    Begin
	    L2_T = .NODE[gt_arg3];
	    L2_F = .NODE[gt_arg5]
	    End;
	[3]:
	    Begin
	    L2_T = .NODE[gt_arg5];
	    L2_F = .NODE[gt_arg3]
	    End
    Tes;

! save the current dynamic temp depth, lon/fon, and start a
! new loop level.

    ENTLOOP();
    TLA(.NODE[gt_arg3],0,.L1_T,.L1_F);
    OP4 = .NODE[gt_arg4];
    If Not .TYPE<1,1> Or
			.OP4<lex_type> Neq T_NODE Or
			.OP4[rw_real_flow] Eql RFFLOW Or
			ISRELOP(OP4) Then
	Begin
	RESETDTD;
	KILLDYTEMPS(.NODE[gt_arg3])
	End;
    TLA(.OP4,0,.L2_T,.L2_F);
    XITLOOP();
    KILLDYTEMPS(.OP4);
    KILLDYTEMPS(.NODE);
    POPDTD;
    If TNNEEDED Then
	FILLTX;
    Return .TX
End;

Routine ND_WHILE_DO(NODE : Ref GT,TX : Ref GT,LAB_T : Ref GT,LAB_F : Ref GT) =
Begin
    Return FLOOP(.NODE,.TX,.LAB_T,.LAB_F,0)
End;

Routine ND_UNTIL_DO(NODE : Ref GT,TX : Ref GT,LAB_T : Ref GT,LAB_F : Ref GT) =
Begin
    Return FLOOP(.NODE,.TX,.LAB_T,.LAB_F,1)
End;

Routine ND_DO_WHILE(NODE : Ref GT,TX : Ref GT,LAB_T : Ref GT,LAB_F : Ref GT) =
Begin
    Return FLOOP(.NODE,.TX,.LAB_T,.LAB_F,2)
End;

Routine ND_DO_UNTIL(NODE : Ref GT,TX : Ref GT,LAB_T : Ref GT,LAB_F : Ref GT) =
Begin
    Return FLOOP(.NODE,.TX,.LAB_T,.LAB_F,3)
End;

Routine ND_IDLOOP(NODE : Ref GT,TX : Ref GT,LAB_T : Ref GT,LAB_F : Ref GT) =
Begin
    Local
	L		: Ref GT,
	CV		: Ref GT;

! TLA the initialial value

    L = TLA(.NODE[gt_arg2],0,0,0);

! TLA the FROM and TO parts

    TLA(.NODE[gt_arg3],0,0,0);
    TLA(.NODE[gt_arg4],0,0,0);

! pulse the Chi and Rho lists

    LPBINDLST(.NODE[gt_arg5]);
    LPBINDLST(.NODE[gt_arg6]);

! span the initialize value

    SPAN(.NODE[gt_arg2],0);

! separate the initial value from the control variable so
! preferencing will work.

    NEXTLON;
    NEXTFON;

! get and span the control variable at this, its first reference

    CV = .NODE[gt_arg1];
    SPAN(.CV,0);

! prefer that any initial value calculation be put into
! the control variable

    WANTPREF(.L,.CV[gt_reg]);

! save the current dynamic stack temp level and the lon/fon and
! setup for a new loop level.

    ENTLOOP();

! TLA the loop body

    TLA(.NODE[gt_arg7],0,0,0);
    XITLOOP();

! generate any stack adjustments

    KILLDYTEMPS(.NODE[gt_arg7]);
    POPDTD;

! if a result is wanted, make sure there is a TN

    If TNNEEDED Then
	FILLTX;
    Return .TX
End;

Routine TL_LABEL(NODE : Ref GT,TX : Ref GT,LAB_T : Ref GT,LAB_F : Ref GT) =
Begin
    If REQ_RESULT Then
	Begin
	If .TX Lssu 8 Then
	    TX = GETTN()
	End
    Else
	TX = 0;
    NODE[gt_reg] = .TX;
    WANTPREF(TL_COMMON(.NODE,0,.LAB_T,.LAB_F),.TX);
    KILLPDTEMPS(.NODE,.DTEMPS[stk_idx]);
    SETNOTFPARM();
    Return .TX
End;

Routine TL_LEAVE(NODE : Ref GT,TX : Ref GT,LAB_T : Ref GT,LAB_F : Ref GT) =
Begin
    Local
	S		: Ref GT;

! point to the label node

    S = .ST[.NODE[gt_arg2],st_lab_node];

! TLA the block

    TX = TLA(.NODE[gt_arg1],0,.LAB_T,.LAB_F);

! we prefer the result of this leave to be placed in the same
! location as the label result

    WANTPREF(.S[gt_reg],.TX);
    NOTEDTD;
    Return .TX
End;

Routine TL_RETURN(NODE : Ref GT,TX : Ref GT,LAB_T : Ref GT,LAB_F : Ref GT) =
Begin
    Local
	S		: Ref GT;

! a return is just like a leave of a routine so why is it different?
! should not LON/FON be updated above and NODE[gt_reg] be zeroed
! out also?

    S = .GT[.NODE[gt_arg2],st_retlab];
    TX = TLA(.NODE[gt_arg1],0,.LAB_T,.LAB_F);
    WANTPREF(.S[gt_reg],.TX);
    NOTEDTD;
    UPDATELONFON;
    NODE[gt_reg] = 0;
    Return 0
End;

Routine TL_FAKECSE(NODE : Ref GT,TX : Ref GT,LAB_T : Ref GT,LAB_F : Ref GT) =
Begin
    Local
	PAR		: Ref GT;

    PAR = .NODE[gt_csparent];
    If Not .PAR[gt_v_bound] Then
	Begin
	If Not .PAR[gt_v_delayed] Then
	    UNBOGUS(PAR);
	If .PAR Neqa .NODE<lex_addr> Then
	    TLLIST(FASTLEXOUT(T_NODE,.PAR),0)
	End;
    NOTEDTD;
    UPDATELONFON;
    ASSIGNLABELS;
    SPAN(.NODE,0);
    Return .NODE[gt_reg]
End;

Routine ND_SELECT(NODE : Ref GT,TX : Ref GT,LAB_T : Ref GT,LAB_F : Ref GT) =
Begin
    Local
	OTHEREND	: Integer,
	DTUNEVEN	: Boolean,
	SAVDTC		: Integer,
	L		: Ref GT,
	OP		: Ref GT,
	OTHERTN		: Ref GT;

    DTUNEVEN = FALSE;
    If REQ_RESULT Then
	FILLTX
    Else
	TX = 0;
    INITTNSPAN(TX);
    L = .NODE[LASTOPERAND];
    OTHEREND = .L<lex_value>;
    If .OTHEREND Eql 0 Then
	OTHERTN = 0
    Else
	Begin
	OTHERTN = GETTN();
	NODE[gt_argv(.NODE[gt_argc]-2)] = LEXOUT(T_TEMP,.OTHERTN)
	End;
    TLA(.NODE[gt_arg1],0,0,0);
    INITTNSPAN(OTHERTN);
    Incr I From 1 To .NODE[gt_argc]-3 Do
	Begin
	L = .NODE[gt_argv(.I)];
	If .I Then		!LEFT PART
	    Begin
	    If .L<lex_type> Neq T_SELECT Then
		Begin
		TLA(.L,0,0,0);
		SPAN(.NODE[gt_arg1],0)
		End
	    End
	Else			!RIGHT PART
	    Begin
	    If .I Eql 2 Then
		SAVDTC = .DTEMPS[stk_idx];
	    SAVDTD;
	    TLA(.L,.TX,0,0,0);
	    If .DTEMPS[stk_idx] Neq .SAVDTC Then
		DTUNEVEN = TRUE;
	    RESETDTD;
	    KILLDYTEMPS(.L);
	    POPDTD
	    End;
	If .I Leq .OTHEREND Then
	    TNSPAN(OTHERTN)
	End;
    If .OTHERTN Neqa 0 Then
	Begin
	L = .OTHERTN[tn_fon_lu]-.OTHERTN[tn_fon_fu];
	If .L Gtr .MAXFONSPAN Then
	    MAXFONSPAN = .L
	End;
    If .DTUNEVEN Then
	SETNOTFPARM()
    Else
	Incr I From 2 To .NODE[gt_argc]-3 By 2 Do
	    Begin
	    OP = .NODE[gt_argv(.I)];
	    If .OP<lex_type> Eql T_NODE Then
		OP[gt_dtdelete] = DTDONTCARE
	    End;
    Return .TX
End;

Routine TL_ENABLE(NODE : Ref GT,TX : Ref GT,LAB_T : Ref GT,LAB_F : Ref GT) =
Begin
    NODE[gt_v_bound] = TRUE;
    LOADR0(.NODE);
    NOTEDTD;
    UPDATELONFON;

! for most nodes, the arguments are TLA'd first.   here, we span first

    SPAN_UX(.NODE);
    TLA(.NODE[gt_arg1],0,0,0);
    Return .NODE[gt_reg]
End;


Routine ND_SIGNAL(NODE : Ref GT,TX : Ref GT,LAB_T : Ref GT,LAB_F : Ref GT) =
Begin
    Local
	TL		: Ref GT;

    TL = TLA(.NODE[gt_arg1],0,0,0);
    TX = LOADR0(.NODE);
    TX[tn_request] = IGREQDB;
    WANTPREF(.TL,.TX);
    Return .TX
End;

!   C. - DRIVER FOR TEMP NAME/LABEL ASSIGNMENT
! ------------------------------------------------
!
!
!	THIS PLIT IS USED TO SWITCH TO SPECIFIC ROUTINES TO DO
!	TLA PROCESSING FOR A NODE, NODE-SPECIFIC PROCESSING FOR
!	NODES WHICH USE TL_COMMON AS THEIR TLA ROUTINE, AND
!	SPANNING FOR NODES WHICH USE TL_COMMON.
!
!

Literal
	TLAR=0,		!INDEX FOR NODE'S TLA ROUTINE
	NODER=1,	!INDEX FOR "COMMON" NODE'S NODE-SPECIFIC ROUTINE
	SPANR=2;	!INDEX FOR "COMMON" NODE'S SPAN ROUTINE

Bind
    TLPLIT = Uplit Long (
	TL_COMMON,	ND_ADDSUB,	SPAN_BINARY,	! +
	TL_COMMON,	ND_SWAB,	SPAN_UNARY,	! SWAB
	TL_COMMON,	ND_BINARY,	SPAN_BINARY,	! /
	TL_DOT,		0,		0,		! .
	TL_COMMON,	ND_ADDSUB,	SPAN_BINARY,	! - (BINARY)
	TL_COMMON,	ND_BINARY,	SPAN_BINARY,	! MOD
	TL_COMMON,	ND_BINARY,	SPAN_BINARY,	! *
	TL_COMMON,	ND_UNARY,	SPAN_UNARY,	! - (UNARY)
	TL_COMMON,	ND_LOADNODE,	SPAN_LOADNODE,	! LOADNODE
	TL_COMMON,	ND_BINARY,	SPAN_BINARY,	! ^
	TL_COMMON,	ND_REL,		SPAN_REL,	! BIT
	TL_COMMON,	ND_REL,		SPAN_REL,	! GTR
	TL_COMMON,	ND_REL,		SPAN_REL,	! LEQ
	TL_COMMON,	ND_REL,		SPAN_REL,	! LSS
	TL_COMMON,	ND_REL,		SPAN_REL,	! GEQ
	TL_COMMON,	ND_REL,		SPAN_REL,	! EQL
	TL_COMMON,	ND_REL,		SPAN_REL,	! NEQ
	TL_NOT,		ND_UNARY,	SPAN_UNARY,	! NOT
	TL_COMMON,	ND_BINARY,	SPAN_BINARY,	! EQV
	TL_COMMON,	ND_AND,		SPAN_AND_OR,	! AND
	TL_COMMON,	ND_OR,		SPAN_AND_OR,	! OR
	TL_COMMON,	ND_BINARY,	SPAN_BINARY,	! XOR
	TL_COMMON,	ND_REL,		SPAN_REL,	! GTRU
	TL_COMMON,	ND_REL,		SPAN_REL,	! LEQU
	TL_COMMON,	ND_REL,		SPAN_REL,	! LSSU
	TL_COMMON,	ND_REL,		SPAN_REL,	! GEQU
	TL_COMMON,	ND_REL,		SPAN_REL,	! EQLU
	TL_COMMON,	ND_REL,		SPAN_REL,	! NEQU
	TL_COMMON,	ND_BINARY,	SPAN_BINARY,	! ROT
	TL_COMMON,	ND_BINARY,	SPAN_BINARY,	! MAX
	TL_COMMON,	ND_BINARY,	SPAN_BINARY,	! MIN
	TL_COMMON,	PUNT,		SPAN_UNARY,	! CARRY
	TL_COMMON,	PUNT,		SPAN_UNARY,	! OVERFLOW
	TL_COMMON,	ND_STORE,	SPAN_STORE,	!  = 
	0,		0,		0,		! ERROR OPERATOR
	TL_COMMON,	ND_CASE,	SPAN_UX,	! CASE
	TL_COMMON,	ND_FSTO,	SPAN_UX,	! CALL-PARM
	TL_COMMON,	ND_FSTO,	SPAN_UX,	! CALL-STORE
	TL_COMMON,	ND_WHILE_DO,	SPAN_UX,	! WHILE-DO
	TL_COMMON,	ND_UNTIL_DO,	SPAN_UX,	! UNTIL-DO
	TL_ROUTINE,	0,		0,		! ROUTINE DEFN
	TL_COMMON,	ND_COMP,	SPAN_UX,	! COMPOUND
	TL_COMMON,	ND_IDLOOP,	SPAN_INCR_DECR,	! INCR
	TL_COMMON,	ND_IDLOOP,	SPAN_INCR_DECR,	! DECR
	TL_COMMON,	ND_IF,		SPAN_UX,	! IF
	TL_COMMON,	ND_DO_WHILE,	SPAN_UX,	! D0-WHILE
	TL_COMMON,	ND_DO_UNTIL,	SPAN_UX,	! DO-UNTIL
	0,		0,		0,		! CREATE
	0,		0,		0,		! EXCHJ
	TL_COMMON,	ND_SELECT,	SPAN_UX,	! SELECT
	0,		0,		0,		! EXITLOOP
	TL_LABEL,	ND_UNARY,	SPAN_UNARY,	! LABEL PLACEMENT
	0,		0,		0,		! MODULE
	0,		0,		0,		! PLIT
	TL_CALL,	0,		0,		! CALL
	TL_DOT,		0,		0,		! POINTER
	0,		0,		0,		! [
	TL_LEAVE,	0,		0,		! LEAVE
	TL_RETURN,	0,		0,		! RETURN
	TL_FAKECSE,	0,		0,		! FAKE_CSE
	TL_INLINE,	0,		0,		! INLINE
	TL_ENABLE,	0,		0,		! ENABLE
	TL_COMMON,	ND_SIGNAL,	SPAN_UNARY,	! SIGNAL
	TL_COMMON,	ND_UNARY,	SPAN_UXNARY,	! MFPI, ETC.
	0,		0,		0,
	0,		0,		0
	) : Vector[,Long];


Routine TL_COMMON(NODE : Ref GT,TX : Ref GT,LAB_T : Ref GT,LAB_F : Ref GT) =
Begin
!
! THIS IS THE COMMON ROUTINE WHICH PERFORMS TN ASSIGNMENT
! FOR MOST BINARY (ARITHMETIC) OPERATORS.
!
    Local
	TN		: Ref GT,
	LOP		: Ref GT,
	ROP		: Ref GT,
	TEMP		: Ref GT,
	PAR		: Ref GT;

    If ISCSEUSE(NODE) Then
	Begin
	PAR = .NODE[gt_csparent];
	If Not .PAR[gt_v_bound] Then
	    Begin

! delay creamed the bogus bit but this is another way to test for it

	    If Not .PAR[gt_v_delayed] Then
		UNBOGUS(PAR);
	    If .PAR Neqa .NODE<lex_addr> Then
		TLLIST(FASTLEXOUT(T_NODE,.PAR),0)
	    End
	End

! this is a CSE creation

    Else If Not .NODE[gt_v_bound] Then
	Begin
	NODE[gt_v_bound] = TRUE;

! get the existing TN and set to 0 if not an address

	TN = .NODE[gt_reg];
	If .TN Lssa 8 Then
	    TN = 0;

! use caller specified if there is none and we don't require our own TN

	If .TN Eqla 0 And Not ISCSECREATION(NODE) Then
	    TN = .TX;

! call the node specific TLA routine

	TN = Bliss(.TLPLIT[.NODE[gt_code]*3+NODER],.NODE,.TN,.LAB_T,.LAB_F);

! set the TN for this node

	If .NODE[gt_reg] Eqla 0 Then
	    NODE[gt_reg] = .TN;

! and bind that TN to all uses if this is a CSE

	If ISCSECREATION(NODE) Then
	    BINDUSES(.NODE)
	End;
    NOTEDTD;
    UPDATELONFON;
    ASSIGNLABELS;

! call the node specific SPAN routine

    Bliss(.TLPLIT[.NODE[gt_code]*3+SPANR],.NODE);
    Return .NODE[gt_reg]
End;

! THIS ROUTINE IS THE COMMON DRIVER THROUGH WHICH ALL
! TEMP-LABEL-ASSIGNMENT ROUTINES ARE CALLED.
!
Routine TLA(NODE : Ref GT,TN : Ref GT,LAB_T : Ref GT,LAB_F : Ref GT) =
Begin

! only symbols and nodes are TLA'd

    If .NODE<lex_type> Eql T_LITERAL Then
	Return 0;

! only symbols of type LOCAL, REGISTER, and formal parameter
! have a tempname.  return this.

    If ONEOF(.NODE[gt_type],S_LOCAL,S_REGISTER,S_FORMAL) Then
	If .NODE[gt_reg] Gtru 7 Then
	    Return .NODE[gt_reg];
    If .NODE[gt_type] Neq S_NODE Then
	Return 0;

! call the TLA routine specific to this node

    TN = Bliss(.TLPLIT[.NODE[gt_code]*3+TLAR],.NODE,.TN,.LAB_T,.LAB_F);

! perform cost calculations for this node

    KOST(.NODE);
    NODE[gt_label] = 0;
    Return .TN
End;


! II.(A)  ESTIMATING NUMBER OF TEMPS NEEDED
! -----------------------------------------
!
!
!  THIS CODE DOES A LINEAR SCAN OVER THE (UNRANKED) TEMP NAMES AND
!  ATTEMPS TO GET A ROUGH ESTIMATE OF THE NUMBER OF ACTUAL TEMP
!  LOCATIONS THAT WILL BE REQUIRED.
!
! Notes:
!	the estimate is made by finding the maximum number of
!	overlapping TN's.  this number is approximately the
!	number of registers needed at that time.  this
!	algorithm relies upon TN's being created in an
!	in-out order.

Routine ESTIMATE =
Begin
    Local
	MD		: Integer,
	MDS		: Integer,
	FU		: Integer,
	LU		: Integer,
	R		: Ref TNREPR,
	T		: Ref GT;
    Label
	aaa;

    MD  = 0;
    MDS = 0;
    LU  = 0;
    FU  = %x'7fffffff';

! examine all the tempnames

    R   = TNCHAIN;
    While (R = .R[itm_llink]) Neqa TNCHAIN Do
	aaa: Begin
	T = .R[tnr_ptr];

! if a point tempname then ignore it.

	If .T[tn_lon_fu] Geq .T[tn_lon_lu] Then
	    Leave aaa;

! if a potential register

	If ONEOF(.T[tn_request],MEMREQDB,SLREQDB,IGREQDB) Then
	    Leave aaa;

! if the span of this tempname is outside the current span then
! note the highest tempname nesting depth and start a new depth

	If .t[tn_lon_lu] Lss .FU Or .t[tn_fon_fu] Gtr .LU Then
	    Begin
	    If .MD Gtr .MDS Then
		MDS = .MD;
	    MD = 1;
	    FU = .T[tn_lon_fu];
	    LU = .T[tn_lon_lu]
	    End
	Else
	    Begin

! there is an overlap of some sort between this tempname's span
! and the current span.  bump the nesting level and adjust the
! new span

	    If .T[tn_lon_fu] Gtr .FU Then
		FU = .T[tn_lon_fu];
	    If .T[tn_lon_lu] Lss .LU Then
		LU = .T[tn_lon_lu];
	    MD = .MD + 1
	    End
	End;
    Return Max(.MD,.MDS)
End;


! III. - RANKING TEMP NAMES
! ------------------------------------------------
!
!
!	THE ACTION OF RANKING IS STRAIGHT-FORWARD AND SHOULD
!	PRESENT NO PROBLEMS. NOTE, HOWEVER:
!
!	1) RANKING IS BASED ON THE 'MAX' COST -- THIS IS DONE
!	SO THAT THE WORST CASE COST IS MINIMIZED.
!
!	2) CERTAIN TN'S MUST BE IN A REGISTER, OR IN A SPECIFIC
!	REGISTER, IN A LOCAL, ETC. THESE TN'S ARE SEGREGATED
!	ONTO SEPERATE LISTS AT THIS POINT. IN THE PACKING
!	ALGORITHM THESE TN'S ARE TREATED FIRST IN ORDER
!	TO INSURE THAT THEIR NEEDS ARE SATISFIED.
!
!
!   B. - SORTING OF TEMP NAMES
! ------------------------------------------------

Routine LOG2(N : Integer) =
Begin
    Incr I From 0 To 63 Do
	If 1^.I Geq .N Then
	    Return .I;
    Return 64
End;

Routine TNSORTENTER(TN : Ref GT) : Novalue =
Begin

! the FON span cost favers those TN's with a shorter span.

    Macro
	FS=(.MAXFONSPAN-LOG2(.TN[tn_fon_lu]-.TN[tn_fon_fu])) %;
    Local
	T		: Ref GT,
	TR		: Ref TNREPR,
	L		: Ref TNLSTHDR,
	LCOST		: Integer,
	LMAX		: Integer;

! min_complexity is now the number of extra memory references needed to
! access a tempname if stored in memory as opposed to sotring it in a register

    TN[tn_min_complexity] = .TN[tn_max_complexity] - .TN[tn_min_complexity];

! compute the cost and maximum possible cost.  note that there may be
! (and most likely not be) any TN's with this maximum cost.  TN's with
! a high complexity usually require a wider span than those of lower
! complexity.

    LCOST = .TN[tn_min_complexity] * FS;
    LMAX = .MAXKOST                * .MAXFONSPAN + 1;

! complexity is now the cost, truncated to avoid overflow.

    TN[tn_max_complexity] = .LCOST Mod .LMAX;

! place the TN on the usual list in sorted order.

    L = ULST[.LCOST * SZ_ULST / .LMAX];
    TR = .L;
    T = 0;
    Until (TR = .TR[itm_rlink]) Eqla .L Do
	Begin
	T = .TR[tnr_ptr];
	If .T[tn_max_complexity] Lss .TN[tn_max_complexity] Then
	    Exitloop
	End;
    LINK(TNREP(.TN),.TR[itm_llink])
End;

! place a TN on a static local list

Routine LONORDER(TN : Ref GT,L : Ref TNLSTHDR) : Novalue =
Begin
    Local
	T		: Ref GT,
	TR		: Ref TNREPR,
	TF		: Ref TNREPR;

    TF = TNREP(.TN);

! only consider the first branch of a choice.  TN's on other branches go to
! the end of the list.  this is to avoid these TN's from competing with
! the TN's on the first branch and so reduces the number of static locals
! created.

    If .TN[tn_lon_fu] Nequ .TN[tn_fon_fu] Then
	Begin
	LINK(.TF,.L[itm_llink]);
	Return
	End;
    TR = .L;
    Until (TR = .TR[itm_rlink]) Eqla .L Do
	Begin
	T = .TR[tnr_ptr];
	If .T[tn_lon_fu] Eqlu .T[tn_fon_fu] Then
	    If .T[tn_lon_fu] Gtru .TN[tn_lon_fu] Then
		Exitloop
	End;
    LINK(.TF,.TR[itm_llink])
End;


!   C. - DRIVER FOR RANKING
! ------------------------------------------------

Routine TRANK : Novalue =
Begin
    Local
	TR		: Ref TNREPR,
	T		: Ref GT;

! initialize

! take the log of the maximum FON span.  the FON span is multiplied by
! the register use complexity to come up with a cost estimate.  to avoid
! generating large numbers, the log of the FON is used in the calculation
! and this also reduces the cost value of the FON span vs. the register
! use complexity.

    MAXFONSPAN = LOG2(.MAXFONSPAN) + 1;
    NULLLST(SRLST);
    NULLLST(ARLST);
    NULLLST(SLLST);
    Decr I From SZ_ULST-1 To 0 Do
	NULLLST(ULST[.I]);

! loop, ranking each tempname

    TR = TNCHAIN;
    Until (TR = .TR[itm_rlink]) Eqla TNCHAIN Do
	Begin
	T = .TR[tnr_ptr];
	If .T[tn_lon_fu] Lequ .T[tn_lon_lu] Then
	    Case .T[tn_request] From LO_REQD_TYPE To HI_REQD_TYPE Of Set
		[ NOREQDB ]:
		    TNSORTENTER(.T);
		[ MEMREQDB ]:
		    0;
		[ SLREQDB ]:
		    LONORDER(.T,SLLST);
		[ ARREQDB ]:
		    LINK(TNREP(.T),ARLST);
		[ SRREQDB ]:
		    LINK(TNREP(.T),SRLST);
		[ IGREQDB ]:
		    0;
		[ DECREQDB ]:
		    TNSORTENTER(.T);
		[ RFREQDB ]:
		    TNSORTENTER(.T)
	    Tes
	End
End;

! IV. - PACKING
! ------------------------------------------------
!
!
!	THIS, THE LAST PHASE, TAKES THE ORDERED LIST OF TN'S
!	AND ATTEMPTS A 'BEST-FIT' PACKING INTO THE AVAILABLE
!	REGISTERS, LOCALS, ETC. THE UTILITIES DEFINE VARIOUS
!	PRIMITIVES. THE MAIN WORK, AND THE IMPLEMENTATION
!	OF THE PACKING POLICY, IS CONTAINED IN THE ROUTINE 'TPACK'.
!
!
!   A. - UTILITIES
! ------------------------------------------------

!	1. - PREFERENCES
!
!		IN A FEW CASES WE 'PREFER' THAT TWO TEMP NAMES
!		BE PACKED INTO THE SAME LOCATION. THIS SECTION
!		PROVIDES THE MECHANISM FOR DOING THIS. THE 'TL'
!		ROUTINES ARE CHARGED WITH THE RESPONSIBILITY
!		OF NOTING THAT SUCH BINDING IS DESIRABLE.
!

! PUT A PREFREP ON THE PREFCHAIN
!
! note:
!	preference chains are lists of tempnames which would
!	like to be stored in the same location.  There is no
!	single head for these chains but rather each tn_pref
!	field acts like the head for each TN.
!	all these TNREP's are chained together onto a single
!	list headed by 'PREFLST'.  this list is later scanned
!	down and all the TNREP's released.  I would think that
!	you could scan all the TN's on 'TNCHAIN' and release
!	all non-null 'tn_pref' fields.

Routine PREFLINK(T : Ref GT) =
Begin
    Local
	TR		: Ref TNREPR;

    TR            = TNREP(.T);
    T[tn_pref]    = .TR;
    TR[tnr_pref]  = .PREFLST;
    PREFLST       = .TR;
    Return .TR
End;

Routine WANTPREF(T : Ref GT,TW : Ref GT) : Novalue =
Begin
    Local
	P		: Ref TNREPR,
	P1		: Ref TNREPR;

    If .TW Lssu 8 Then
	Return;
    If .T Lssu 8 Then
	Return;
    If .T Eqla .TW Then
	Return;
    P = .TW[tn_pref];
    If .P Eqla 0 Then
	P = PREFLINK(.TW);
    P1 = .T[tn_pref];
    If .P1 Eqla 0 Then
	P1 = PREFLINK(.T);

! note: LINK has the behavior of merging lists together rather than
!	just inserting an element into a list.

    LINK(.P,.P1)
End;

! called when TPACK finds a tempname with a preference.

Routine TRYPREF(TN : Ref GT) =
Begin
    Macro
	OK=
		Begin
		TN[gt_reg] = .T;
		TN[tn_request] = MEMREQDB;
		TN[tn_type] = BNDPREF;
		SUCCESS
		End %;
    Local
	OPENED		: Boolean,
	TRIED		: Boolean,
	REG		: Ref TNREPR,
	TEMP		: Integer,
	T		: Ref GT,
	L		: Ref TNREPR,
	TR		: Ref TNREPR,
	C		: Vector[SRCHWIDTH],
	CNT		: Integer;

! scan the preference list, trying to put this TN in the same register.
! this loop only considers TN's which are already bound to a register.
! note:  'L' is the TNREP for 'TN's preference.  the loop examines all
! but this TNREP to avoid binding to itself.

    L = .TN[tn_pref];
    TR = .L;
    Until (TR = .TR[itm_rlink]) Eqla .L Do
	Begin
	T = .TR[tnr_ptr];
	REG = .T[tn_bind_list];

! if it is a register then see if the TN will fit in it.  if not then
! temporarily make the TN the specific register desired and then try to
! reshuffle the registers to make it fit.

	If ISREGLST(.REG) Then
	    If TRYFIT(.TN,.REG) Then
		OK
	    Else If Not .swit_quick Then
		Begin
		TEMP = .T[tn_request];
		T[tn_request] = SRREQDB;
		CNT = COUNTCONFLICTS(.TN,.REG,C);
		If .CNT Leq SRCHWIDTH Then
		    If TRYALT(.TN,.CNT,.REG,C,SRCHDEPTH) Then
			Begin
			T[tn_request] = .TEMP;
			OK
			End;
		T[tn_request] = .TEMP
		End
	End;

! we could not move the preference into a specific register.

    If .swit_quick Then
	FAIL;

! scan the preference list again. this time, try opening an empty register
! to make room to move conflicts.  otherwise it is the same as the last loop.

    OPENED = FALSE;
    TRIED = .RESERVED;
    TR = .L;
    Until (TR = .TR[itm_rlink]) Eqla .L Do
	Begin
	T = .TR[tnr_ptr];
	REG = .T[tn_bind_list];
	If ISREGLST(.REG) Then
	    If Not .TRIED<(.REG-REGS)/8,1> Then
		Begin
		TRIED<(.REG-REGS)/8,1,0> = TRUE;
		TEMP = .T[tn_request];
		T[tn_request] = SRREQDB;
		CNT = COUNTCONFLICTS(.TN,.REG,C);
		If .CNT Leq SRCHWIDTH Then
		    Begin
		    If Not .OPENED Then
			Incr I From 0 To 5 Do
			    If EMPTY(REGS[.I]) Then
				Begin
				OPENREG(.I);
				OPENED = TRUE;
				Exitloop
				End;
		    If Not .OPENED Then
			Begin
			T[tn_request] = .TEMP;
			Exitloop
			End;
		    If TRYALT(.TN,.CNT,.REG,C,SRCHDEPTH) Then
			Begin
			T[tn_request] = .TEMP;
			OK
			End
		    End;
		T[tn_request] = .TEMP
		End
	End;

! from here on, we consider moving the tempname into a memory location.
! return if 'register-or-forget-it'

    If .TN[tn_request] Eql RFREQDB Then
	FAIL;

! if the difference between placing the TN in a register and placing it in
! memory is '6' then let TPACK try to find a difference location to store
! the variable, hopefully in a register.

    If .TN[tn_min_complexity] Gtr 6 Then
	FAIL;

! scan the preference list again.  this time, try to place it on
! the top of stack.

    TR = .L;
    Until (TR = .TR[itm_rlink]) Eqla .L Do
	Begin
	T = .TR[tnr_ptr];
	If MUSTBETOP(.TN,.T[tn_bind_list]) Then
	    If TRYFIT(.TN,.T[tn_bind_list]) Then
		OK
	End;

! scan the preference list one last time.  this time, try to place
! the TN on anyone's bind list.

    TR = .L;
    Until (TR = .TR[itm_rlink]) Eqla .L Do
	Begin
	T = .TR[tnr_ptr];
	If .T[tn_bind_list] Neqa 0 Then
	    If TRYFIT(.TN,.T[tn_bind_list]) Then
		OK
	End;
    FAIL
End;

!	NOW LOOK AT TRY.BLI FOR THE REST OF THE "PACKING" ROUTINES


!   E. - DRIVER FOR PACKING
! ------------------------------------------------
!
!	THE FOLLOWING ROUTINE, 'TPACK', DEFINES THE POLICY
!	BY WHICH TEMP NAMES ARE BOUND TO LOCATIONS. THAT POLICY
!	IS:
!
!	1) BIND THOSE TN'S WHICH MUST BE IN A SPECIFIC REGISTER.
!	2) BIND THOSE TN'S THAT MUST BE IN SOME REGISTER.
!	3) BIND THOSE TN'S THAT MUST BE IN SOME LOCAL.
!	4) BIND THE REMAINDER OF THE TN'S  - IN ORDER OF THEIR IMPORTANCE -.
!
!	WITHIN 4) THE ALGORITHM IS:
!
!	4A) TRY TO USE THE TN'S 'PREFERENCE', IF ANY.
!	4B) TRY AN OPEN REGISTER.
!	4C) IF THE DIFFERENCE BETWEEN THE TN'S MAX AND MIN COSTS
!		IS SUFFICIENTLY SMALL, THEN TRY AN OPEN LOCAL.
!	4D) TRY A CLOSED REGISTER.
!	4E) IF THE DIFFERENCE BETWEEN THE TN'S MAX AND MIN COSTS
!		PREVENTED THE ATTEMPT IN 4C), THEN TRY THE
!		OPEN LOCALS NOW.
!	4F) USE A CLOSED LOCAL ( THIS WILL ALWAYS WORK AS
!		A LAST RESORT).
!
!	NOTE THAT THE TN-REP LISTS ARE RELEASED AS WE GO
!	THROUGH ALL THIS.
!
!

Routine TPACK : Novalue =
Begin
    Local
	T		: Ref GT,
	TR		: Ref TNREPR,
	P		: Ref TNREPR,
	L		: Ref TNREPR,
	TEMP		: Ref TNREPR;
    Label
	aaa;

    INITSTK(STEMPS);

! pack the specific registers

    TR = SRLST;
    Until (TR = .TR[itm_rlink]) Eqla SRLST Do
	Begin
	T = .TR[tnr_ptr];
	TRYSPREG(.T,.T[gt_reg])
	End;

! pack the arbitrary registers

    TR = ARLST;
    Until (TR = .TR[itm_rlink]) Eqla ARLST Do
	Begin
	T = .TR[tnr_ptr];

! try first an open register

	If Not TRYOPREG(.T) Then

! try next to reshuffle the registers

	    If .swit_quick Or Not TRS(.T,SRCHDEPTH) Then

! try next a closed register

		If Not TRYCLREG(.T) Then 

! if everything fails then given an error and arbitrarily use R5

		    Begin
		    WARNEM (0,NOTENUFREGS);
		    T[tn_bind_list] = REGS[5];
		    T[tn_type]      = BNDREG;
		    T[gt_reg]       = 5
		    End
	End;

! estimate the number of registers needed

    If .ESTIM Gtr 1 Then
	Begin

! only 6 registers available

	If .ESTIM Gtr 6 Then
	    ESTIM = 6;

! try to make do with less

	If .ESTIM Gtr 2 Then
	    ESTIM = .ESTIM-1;

!!! following code missing in bliss-32 version and is wrong
!!! anyway.  DTEMPS does not have a stk_max field.

!!!	If .DTEMPS[stk_max] Geq 0 Then		! ??? STEMPS? stk_dtd?
!!!	    ESTIM = .ESTIM-1;

!!! end of missing code

! open all the reserved registers and count the already open registers

	Decr I From 5 To 0 Do
	    Begin
	    If .RESERVED<.I,1,0> Then
		OPENREG(.I)
	    Else If ISOPEN(REGS[.I]) Then
		ESTIM = .ESTIM-1
	    End;

! if any more registers estimated as being needed then open them

	If .ESTIM Gtr 0 Then
	    Incr I From 0 To 5 Do
		If EMPTY(REGS[.I]) Then
		    If (ESTIM = .ESTIM-1) Geq 0 Then
			OPENREG(.I)
		    Else
			Exitloop
	End;

! pack the other temp names.  note: ordered by complexity/FON span

    Decr I From SZ_ULST-1 To 0 Do
	Begin
	L = ULST[.I];
	TR = .L;
	Until (TR = .TR[itm_rlink]) Eqla .L Do
	    aaa: Begin
	    T = .TR[tnr_ptr];

! if this tempname has a preference, try to place it on its preference list

	    If .T[tn_pref] Neqa 0 Then
		If TRYPREF(.T) Then
		    Leave aaa;

! see if it will fit in an open register

	    If TRYOPREG(.T) Then
		Leave aaa;

! try reshuffling registers to make it fit

	    If Not .swit_quick Then
		If TRS(.T,SRCHDEPTH) Then
		    Leave aaa;

! see if we can open a new register

	    If TRYCLREG(.T) Then
		Leave aaa;

! if register or forget, restore it to its original memory address

	    If .T[tn_request] Eql RFREQDB Then
		Begin
		T[tn_request] = MEMREQDB;
		T[gt_reg]     = .T[gt_disp];
		T[gt_disp]    = 0
		End

! otherwise try making it a dynamic temp

	    Else If Not TRYDYTEMPS(.T) Then

! and if that failed, make it a simpe static local

	        LONORDER(.T,SLLST)
	    End;
	End;

! pack the static locals

    TR = SLLST;
    Until (TR = .TR[itm_rlink]) Eqla SLLST Do
	Begin
	T = .TR[tnr_ptr];

! try an existing open static.  if that failed, create a new static

	If Not TRYOPSTEMPS(.T) Then
	    TRYCLSTEMPS(.T)
	End
End;

!   F. - MARKING OF TNS AFTER PACKING

Routine TMARK : Novalue =
Begin
    Local
	L		: Ref TNREPR,
	TR		: Ref TNREPR,
	T		: Ref GT;

! mark all TN's on the register lists and bound to a register as bound to
! a register and set the register number unless bound to a preference.
! those with a bind preference use the register in the preference.

    Decr I From 5 To 0 Do
	Begin
	L = REGS[.I];
	TR = .L;
	Until (TR = .TR[itm_rlink]) Eqla .L Do
	    Begin
	    T = .TR[tnr_ptr];
	    If .T[tn_type] Neq BNDPREF Then
		Begin
		T[tn_type] = BNDREG;
		T[gt_reg] = .I
		End
	    End
	End;

! change all static tempnames to stack references.  for bind preference,
! [gt_reg] points to the TN bound to.

    STATICSIZE = (.STEMPS[stk_max]+1)*2;
    Decr I From .STEMPS[stk_max] To 0 Do
	Begin
	L = STEMPS[stk_item(.I)];
	TR = .L;
	Until (TR = .TR[itm_rlink]) Eqla .L Do
	    Begin
	    T = .TR[tnr_ptr];
	    If .T[tn_type] Neq BNDPREF Then
		Begin
		T[tn_type] = BNDLOCAL;
		T[gt_reg]  = SP;
		T[gt_mode] = INDEXED;
		T[gt_disp] = -(.MAXLOCALS+(.I+1)*2)
		End
	    End
	End;

! change all dynamic temporary to stack temporaries but of type push
! (unless a type already is set).
! bind-to-preference TN's are not considered.

    Decr I From .DTEMPS[stk_max] To 0 Do
	Begin
	L = DTEMPS[stk_item(.I)];
	TR = .L;
	Until (TR = .TR[itm_rlink]) Eqla .L Do
	    Begin
	    T = .TR[tnr_ptr];
	    If .T[tn_type] Neq BNDPREF Then
		Begin
		If .T[tn_type] Eql 0 Then
		    T[tn_type] = BNDPUSH;
		T[gt_reg]  = SP;
		T[gt_mode] = INDEXED;
		T[gt_disp] = -(.MAXLOCALS+.STATICSIZE+(.I+1)*2)
		End
	    End
	End
End;

! mark all symbols which are bound to a register

Routine MARKSYMBOLS : Novalue =
Begin
    Local
	S		: Ref ST,
	Q		: Ref ST,
	REG		: Integer,
	NODE		: Ref GT;
    Label
	aaa;

! loop for each symbol

    S = .PURGED;
    Until .S Eqla 0 Do
	aaa: Begin
	Q = .S;
	S = .S[st_next];

! only REGSITER, LOCAL, and possibly BIND symbols may be bound to
! a register.

	Selectone .Q[gt_type] Of Set
	    [S_REGISTER,S_LOCAL]:
		NODE = .Q;
	    [S_BIND]:
		Begin
		NODE = .Q[st_bind_data];
		If .NODE<lex_type> Neq T_NODE Then
		    Leave aaa
		End;
	    [Otherwise]:
		Leave aaa
	Tes;

! locate the register bound to and if SP, note the stack offset
! of the variable

	Until (REG = .NODE[gt_reg]) Lequ 7 Do
	    NODE = .REG;
	If .REG Eql SP Then
	    Q[gt_disp] = .NODE[gt_disp];
	Q[st_var_reg_index] = .REG
	End
End;

! V. - DRIVER FOR TNBIND MODULE

! create TN's for all the pre-defined registers

Routine INITPDTNS : Novalue =
Begin
    Local
	L		: Ref GT;

    Macro
	MAKEREG(NAME,REGNUM,IGNORE)=
		Begin
		L = NAME[gt_reg] = GETTN();
		L[gt_reg]     = REGNUM;
		L[tn_request] = IGNORE;
		L[tn_type]    = BNDREG;
		End %;

    MAKEREG(PCREG,PC,IGREQDB);
    MAKEREG(SPREG,SP,IGREQDB);
    MAKEREG(VVREG,VR,IGREQDB);
    MAKEREG(RR0,  0, SRREQDB);
    MAKEREG(RR1,  1, SRREQDB);
    MAKEREG(RR2,  2, SRREQDB);
    MAKEREG(RR3,  3, SRREQDB);
    MAKEREG(RR4,  4, SRREQDB);
    MAKEREG(RR5,  5, SRREQDB)
End;

Global Routine TNBIND(NODE : Ref GT) : Novalue =
Begin
    Local
	P		: Ref TNREPR,
	Q		: Ref TNREPR;
    External Routine
	PrintTnrepList	: Novalue,
	PrintTree	: Novalue;

! create TN's for all the pre-defined registers

    INITPDTNS();

! initialize all the lists and stacks

    PREFLST = 0;
    INITSTK(DTEMPS);
    INITSTK(stk_loop);
    INITLS(stk_loop_lf);
    INITSTK(stk_call);
    INITLS(stk_fon);
    INITLS(stk_dtd);

! if this is not a routine (e.g. the module body) or there are
! any ENABLE declarations then open all registers for use.

    If .NODE<lex_type> Neq T_NODE Or
		.NODE[gt_code] Neq OP_ROUTINE Or .flg_enable Then
	Decr I From 5 To 0 Do
	    Begin
	    NULLLST(REGS[.I]);
	    OPENREG(.I)
	    End;

! initialize the LON/FON and cost information

    LON = 1;
    FON = 1;
    MAXFONSPAN = 0;
    MAXKOST = 0;
    SAVDTD;

! TLA the expression

    TLA(.NODE,0,0,0);
    POPDTD;

! release some of the stacks

    RELEASESPACE(.stk_loop,STKSIZE);
    RELEASESPACE(.stk_call,STKSIZE);

! get a rough estimate of the number of registers needed

    ESTIM = ESTIMATE();

! sort out all the tempnames

    TRANK();

! bind all the tempnames to register/memory locations

    TPACK();

! now mark all tempnames as to type and request

    TMARK();

! mark the symbols as well for the debugger

    If .swit_debug Then
	MARKSYMBOLS();

! for debugging purposes...

    If .swit_dump_tnbind Then
	Begin
	Print(AZ('\n\n==== after tnbind ===\n\n'));
	PrintTree(.NODE,2);
	Print(AZ('\n--- SRLST\n'));
	PrintTnrepList(SRLST);
	Print(AZ('\n--- ARLST\n'));
	PrintTnrepList(ARLST);
	Print(AZ('\n--- SLLST\n'));
	PrintTnrepList(SLLST);
	Incr i From 0 To SZ_ULST-1 Do
	    Begin
	    Print(AZ('\n--- ULST[%d]\n'),.i);
	    PrintTnrepList(ULST[.I])
	    End
    End;

! release all the TN's created now.

    RELTNREPLST(SRLST);
    RELTNREPLST(ARLST);
    RELTNREPLST(SLLST);
    Decr I From SZ_ULST-1 To 0 Do
	RELTNREPLST(ULST[.I]);
    P = .PREFLST;
    While .P Neqa 0 Do
	Begin
	Q = .P[tnr_pref];
	RELTNREP(.P);
	P = .Q
	End
End;

End
Eludom