/*
 * Copyright (c) 2002, The Tendra Project <http://www.ten15.org/>
 * All rights reserved.
 *
 * Redistribution and use in source and binary forms, with or without
 * modification, are permitted provided that the following conditions
 * are met:
 * 1. Redistributions of source code must retain the above copyright
 *    notice unmodified, this list of conditions, and the following
 *    disclaimer.
 * 2. Redistributions in binary form must reproduce the above copyright
 *    notice, this list of conditions and the following disclaimer in the
 *    documentation and/or other materials provided with the distribution.
 *
 * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
 * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
 * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
 * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
 * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
 * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
 * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
 * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
 * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
 * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 *
 *
 *    		 Crown Copyright (c) 1997
 *
 *    This TenDRA(r) Computer Program is subject to Copyright
 *    owned by the United Kingdom Secretary of State for Defence
 *    acting through the Defence Evaluation and Research Agency
 *    (DERA).  It is made available to Recipients with a
 *    royalty-free licence for its use, reproduction, transfer
 *    to other parties and amendment for any purpose not excluding
 *    product development provided that any such use et cetera
 *    shall be deemed to be acceptance of the following conditions:-
 *
 *        (1) Its Recipients shall ensure that this Notice is
 *        reproduced upon any copies or amended versions of it;
 *
 *        (2) Any amended version of it shall be clearly marked to
 *        show both the nature of and the organisation responsible
 *        for the relevant amendment or amendments;
 *
 *        (3) Its onward transfer from a recipient to another
 *        party shall be deemed to be that party's acceptance of
 *        these conditions;
 *
 *        (4) DERA gives no warranty or assurance as to its
 *        quality or suitability for any purpose and DERA accepts
 *        no liability whatsoever in relation to any use to which
 *        it may be put.
 *
 * $TenDRA: tendra/src/installers/mips/common/needs_scan.c,v 1.6 2004/06/28 03:31:05 bp Exp $
 */


/******************************************************************
 *
 *		needs_scan.c
 *
 *	Defines the scan through a program which reorganises it so that all
 *arguments of operations are suitable for later code-production. The procedure
 *scan evaluates the register requirements of an exp. The exps are produced
 *from the decoding process and the various exp -> exp transformations  in
 *the proc independent (common to other  translators)

*************************************************************/

#include "config.h"
#include "common_types.h"
#include "exptypes.h"
#include "exp.h"
#include "expmacs.h"
#include "tags.h"
#include "procrectypes.h"
#include "bitsmacs.h"
#include "maxminmacs.h"
#include "regable.h"
#include "tempdecs.h"
#include "shapemacs.h"
#include "special.h"
#include "const.h"
#include "new_tags.h"
#include "flpt.h"
#include "install_fns.h"
#include "externs.h"
#include "extratags.h"
#include "frames.h"
#include "flags.h"
#include "main.h"
#include "basicread.h"
#include "check.h"
#include "me_fns.h"
#include "externs.h"
#include "needs_scan.h"
#include "oddtest.h"

int   maxfix,
	maxfloat;			/* the maximum number of t-regs */
static int   stparam, fixparam, floatparam;
/* used by scan to set initial parameter
 *						positions */

extern long notbranch[6];
extern bool do_tlrecursion;

static bool rscope_level = 0;
static bool nonevis = 1;
static int callerfortr;

bool gen_call;


/* declaration of scan.
 *	 needs is defined in procrectypes.h.
 * This is a structure which has two integers giving
 *the number of fixed and floating point registers required to contain live values
 *in the expression parameters. A further field prop is used for various
 *flags about certain forms of exp (mainly idents and procs). The maxargs
 *field gives the maximum size in bits for the parameters of all the procs
 *called in the exp. The needs of a proc body are preserved in the needs field
 *of the procrec (see procrectypes.h).
 */

/***************************************************************
 *		cca
 *
 *This procedure effectively inserts a new declaration into an exp. This
 *is used to stop a procedure requiring more than the available number of
 *registers.
 ****************************************************************/

void
cca(exp ** to, exp * x)
{
	if (x == (*to)) {
		exp def = * (x);
		/* replace by  Let tg = def In tg Ni */
		exp id = getexp (sh (def), bro (def), last (def), def, nilexp,
						 0, 1, ident_tag);
		exp tg = getexp (sh (def), id, 1, id, nilexp,
						 0, 0, name_tag);
		pt (id) = tg;		/* use of tag */
		bro (def) = tg;		/* bro(def) is body of Let = tg */
		clearlast (def);
		* (x) = id;		/* replace pointer to x by Let */
		return;
	}
	else {			/* replace by Let tg = def In ato/def = tg
					 *				   Ni */
		exp def = * (x);
		exp ato = * (*to);
		exp id = getexp (sh (ato), bro (ato), last (ato), def, nilexp,
						 0, 1, ident_tag);
		exp tg = getexp (sh (def), bro (def), last (def), id, nilexp,
						 0, 0, name_tag);
		pt (id) = tg;		/* use of tg */
		bro (def) = ato;		/* ato is body of Let */
		clearlast (def);
		bro (ato) = id;		/* its father is Let */
		setlast (ato);
		* (*to) = id;		/* replace pointer to 'to' by Let */
		* (x) = tg;		/* replace use of x by tg */
		if (name(def)==ident_tag) {
			tidy_ident(id);
			*to = ptr_position(ato);
			no(id)= 100; /*it has already been scanned */
		}
		else  *to = & bro(son(id));		/* later replacement to same 'to' will be
										 *				   at body of Let */
		return;
	}
}

needs onefix = {
	1, 0, 0, 0
};				/* needs one fix pt reg */
needs twofix = {
	2, 0, 0, 0
};				/* needs 2 fix pt regs */
needs threefix = {
	3, 0, 0, 0
};				/* needs 3 fix pt regs */
needs fourfix = {
	4, 0, 0, 0
};				/* needs 4 fix pt regs */
needs onefloat = {
	0, 1, 0, 0
};				/* needs 1 flt pt regs */
needs zeroneeds = {
	0, 0, 0, 0
};				/* has no needs */

bool
subvar_use(exp uses)
{ /* check to see if any uses of id is initialiser to subvar dec */
	for (;uses != nilexp; uses=pt(uses)) {
		if (last(uses) && name(bro(uses))==cont_tag) {
			exp c = bro(uses);
			if (!last(c) && last(bro(c)) && name(bro(bro(c))) == ident_tag) {
				exp id = bro(bro(c));
				if ((props(id) & subvar) != 0 && (props(id) & inanyreg) !=0) return 1;
			}
		}
	}
	return 0;
}


needs
shapeneeds(shape s)
{	/* this gives the needs for manipulating a
	 *				   value of shape s */
	if (is_floating (name (s)))
		return onefloat;
	else {
		if (valregable (s))
			return onefix;
		else {			/* if the shape does not fit into a reg,
						 *				   it may need up to four fixed regs for moving
						 */
			int al = shape_align(s);
			if (al == 1) {
				return threefix;
			}
			if (al == 8) {
				if (shape_size(s) < 16) return twofix;
				return fourfix;
			}
			else {
				int unitmv = min(al,32);
				if (shape_size(s)/unitmv < inlineassign) {
					return twofix;
				}
				else return fourfix;
			}
		}
	}
}

bool
complex(exp e)
{		/* these are basically the expressions
		 *				   which cannot be accessed by a simple
		 *				   load or store instruction */
	if (name (e) == name_tag ||
		(name (e) == cont_tag && name (son (e)) == name_tag &&
		 isvar (son (son (e))))
		|| name (e) == val_tag || name (e) == real_tag || name(e)==null_tag) {
		return 0;
	}
	else {
		return 1;
	}
}

int
scan_cond(exp * e, exp outer_id)
{
	
	exp ste = *e;
	exp first = son (ste);
	exp labst = bro (first);
	exp second = bro (son (labst));
	
	Assert(name(ste)==cond_tag);
	
	if (name(second)==top_tag && name(sh(first))==bothd && no(son(labst))==1
		&& name(first)==seq_tag && name(bro(son(first))) == goto_tag){
		/* cond is { ... test(L); ? ; goto X | L:make_top}
		 *			if ? empty can replace by seq { ... not-test(X); make_top }
		 */
		exp l = son(son(first));
		while (!last(l)) { l = bro(l); }
		while (name(l)==seq_tag) { l = bro(son(l)); }
		if (name(l)==test_tag && pt(l)==labst) {
			settest_number(l, notbranch[test_number(l)-1]);
			pt(l) = pt(bro(son(first)));
			bro(son(first)) = second;
			bro(second) = first; setlast(second);
			bro(first) = bro(ste);
			if (last(ste)) { setlast(first);} else { clearlast(first); }
			*e = first;
			return 1;
		}
		else return 0;
	}
	
	
	if (name (first) == seq_tag && name (second) == cond_tag
	    && no(son(labst)) == 1
	    && name (son (son (first))) == test_tag
		&& pt (son (son (first))) == labst
	    && name (son (second)) == seq_tag
	    && name (son (son (son (second)))) == test_tag) {
		/* cond is (seq (test to L;....|
		 *				   L:cond(seq(test;...),...)) ..... */
		exp test1 = son (son (first));
		exp test2 = son (son (son (second)));
		exp op11 = son(test1);
		exp op21 = bro(op11);
		exp op12 = son(test2);
		exp op22 = bro(op12);
		bool c1 = complex (op11);
		bool c2 = complex (op21);
		
		if (c1 && eq_exp (op11, op12)) {
			/* ....if first operands of tests are
			 *				   same, identify them */
			exp newid = getexp (sh (ste), bro (ste), last (ste), op11, nilexp,
								0, 2, ident_tag);
			exp tg1 = getexp (sh (op11), op21, 0, newid, nilexp, 0, 0, name_tag);
			exp tg2 = getexp (sh (op12), op22, 0, newid, nilexp, 0, 0, name_tag);
			
			pt (newid) = tg1;
			pt (tg1) = tg2;	/* uses of newid */
			bro (op11) = ste; clearlast (op11);/* body of newid */
			/* forget son test2 = son test1 */
			bro (ste) = newid;
			setlast (ste);	/* father body = newid */
			son (test1) = tg1;
			son (test2) = tg2;	/* relace 1st operands of test */
			if (!complex(op21)) {
				/* if the second operand of 1st test is simple, then identification
				 *			could go in a t-teg (!!!NB overloading of inlined flag!!!).... */
				setinlined(newid);
			}
			kill_exp(op12, op12);
			* (e) = newid;
			if (scan_cond (&bro(son(labst)), newid) == 2 && complex(op22)) {
				/* ... however a further use of identification means that
				 *		   the second operand of the second test must also be simple */
				clearinlined(newid);
			}
			return 1;
		}
		else
			if (c2 && eq_exp (op21, op22)) {
				/* ....if second operands of tests are
				 *				   same, identify them */
				
				exp newid = getexp (sh (ste), bro (ste), last (ste), op21,
									nilexp, 0, 2, ident_tag);
				exp tg1 = getexp (sh (op21), test1, 1,
								  newid, nilexp, 0, 0, name_tag);
				exp tg2 = getexp (sh (op22), test2, 1, newid, nilexp,
								  0, 0, name_tag);
				
				pt (newid) = tg1;
				pt (tg1) = tg2;	/* uses of newid */
				bro (op21) = ste; clearlast (op21);
				/* body of newid */
				/* forget bro son test2 = bro son test1 */
				bro (ste) = newid;
				setlast (ste);	/* father body = newid */
				bro (op11) = tg1;
				bro (op12) = tg2;
				if (!complex(op11)) { setinlined(newid); }
				kill_exp(op22, op22);
				/* relace 2nd operands of test */
				* (e) = newid;
				if (scan_cond (&bro(son(labst)), newid) == 2 && complex(op12)) {
					clearinlined(newid);
				}
				return 1;
			}
			else
				if (name (op12) != name_tag
					&& name (op11) == name_tag
					&& son (op11) == outer_id
					&& eq_exp (son (outer_id), op12)
					) {		/* 1st param of test1 is already identified with
							 *				   1st param of  test2 */
					exp tg = getexp (sh (op12), op22, 0, outer_id,
									 pt (outer_id), 0, 0, name_tag);
					pt (outer_id) = tg;
					no (outer_id) += 1;
					if (complex(op21)){ clearinlined(outer_id); }
					/* update usage of ident */
					son (test2) = tg;
					kill_exp(op12, op12);
					if (scan_cond (&bro(son(labst)), outer_id) == 2 && complex(op22)) {
						clearinlined(outer_id);
					}
					return 2;
				}
		
		
	}
	return 0;
}




needs
likeplus(exp * e, exp ** at)
{
	/* does the scan on commutative and
	 *				   associative operations and may perform
	 *				   various transformations allowed by
	 *				   these properties */
	needs a1;
	needs a2;
	prop pc;
	exp * br  = &son(*e);
	exp prev;
	bool commuted = 0;
	exp dad = * (e);
	
	a1 = scan (br, at);
	/* scan the first operand - won't be a val_tag */
	
	do {
		exp * prevbr;
		prevbr = br;
		prev = * (br);
		br = &bro(prev);
		a2 = scan (br, at);
		/* scan the next operand ... */
		if (name (* (br)) != val_tag) {
			a1.floatneeds = max (a1.floatneeds, a2.floatneeds);
			pc = a2.propsneeds & hasproccall;
			if (a2.fixneeds < maxfix && pc == 0) {
				/* ... its evaluation  will not disturb
				 *				 the accumulated result */
				if (a2.fixneeds<=a1.fixneeds || commuted ||
					a1.fixneeds >= maxfix || (a1.propsneeds & hasproccall) != 0) {
					a1.fixneeds = max (a1.fixneeds, a2.fixneeds + 1);
				}
				else { /* ... needs more regs so put it first to reduce
						*			 register usage */
					exp op1 = son (dad);
					exp cop = * (br);
					bool lcop = last (cop);
					bro (prev) = bro (cop);
					if (lcop)
						setlast (prev);
					bro (cop) = op1;
					clearlast (cop);
					son (dad) = cop;
					br = (prev==op1) ? &bro(cop):prevbr;
					a1.fixneeds = max (a2.fixneeds, a1.fixneeds + 1);
				}
				a1.propsneeds |= a2.propsneeds;
			}
			else
				if (a1.fixneeds < maxfix &&
					(a1.propsneeds & hasproccall) == 0 && !commuted) {
					/* ...its evaluation will call a proc, so
					 *				   put it first  */
					exp dad = * (e);
					exp op1 = son (dad);
					exp cop = * (br);
					bool lcop = last (cop);
					bro (prev) = bro (cop);
					if (lcop)
						setlast (prev);
					bro (cop) = op1;
					clearlast (cop);
					son (dad) = cop;
					br = (prev==op1) ? &bro(cop):prevbr;
					commuted = 1;
					a1.fixneeds = max (a2.fixneeds, a1.fixneeds + 1);
					a1.propsneeds |= a2.propsneeds;
					a1.maxargs = max (a1.maxargs, a2.maxargs);
				}
			
				else {			/* ... its evaluation would disturb
								 *				   accumulated result, so replace it by a
								 *				   newly declared tag */
					cca (at, br);
					a1.fixneeds = max (a1.fixneeds, 2);
					a1.propsneeds = a1.propsneeds | morefix | (pc << 1);
					a1.maxargs = max (a1.maxargs, a2.maxargs);
				}
		}
	} while (!last (* (br)));
	if (!optop(*(e))) {
		if (a1.fixneeds <4) a1.fixneeds = 4;
	}
	return a1;
}

needs
likediv(exp * e, exp ** at)
{
	/* scan non-commutative fix pt operation
	 */
	needs l;
	needs r;
	prop pc;
	exp * arg = &son(*e);
	l = scan (arg, at);
	/* scan 1st operand */
	arg = &bro(*arg);
	r = scan (arg, at);
	/* scan second operand ... */
	l.floatneeds = max (l.floatneeds, r.floatneeds);
	pc = r.propsneeds & hasproccall;
	if (r.fixneeds < maxfix && pc == 0) {/* ...it fits into registers */
		l.fixneeds = max (l.fixneeds, r.fixneeds + 1);
		l.propsneeds = l.propsneeds | r.propsneeds;
	}
	else {			/* ...it requires new declaration of
					 *				   second operand */
		cca (at, arg);
		l.fixneeds = max (l.fixneeds, 1);
		l.propsneeds = l.propsneeds | morefix | (pc << 1);
		l.maxargs = max (l.maxargs, r.maxargs);
	}
	
	if (name(*e) != test_tag &&
		(!optop(*(e)) || name(*e)== div1_tag || name(*e)==mod_tag)) {
		if (l.fixneeds <4) l.fixneeds = 4;
	}
	return l;
}

needs
fpop(exp * e, exp ** at)
{
	/* scans diadic floating point operation  */
	needs l;
	needs r;
	exp op = *(e);
	prop pcr, pcl;
	exp * arg = &son(op);
	bool withert = !(optop(*e));
	
	l = scan (arg, at);
	arg = &bro(*arg);
	r = scan (arg, at);
	l.fixneeds = max (l.fixneeds, r.fixneeds);
	pcr = r.propsneeds & hasproccall;
	pcl = l.propsneeds & hasproccall;
	
	if (r.floatneeds <= l.floatneeds && r.floatneeds < maxfloat && pcr==0) {
	    l.floatneeds = max (2, max (l.floatneeds, r.floatneeds + 1));
	    l.propsneeds = l.propsneeds | r.propsneeds;
	    ClearRev(op);
	}
	else
		if (pcl == 0 && l.floatneeds <= r.floatneeds && l.floatneeds < maxfloat) {
			l.floatneeds = max (2, max (r.floatneeds, l.floatneeds + 1));
			l.propsneeds = l.propsneeds | r.propsneeds;
			SetRev(op);
		}
		else
			if (r.floatneeds < maxfloat && pcr == 0) {
				l.floatneeds = max (2, max (l.floatneeds, r.floatneeds + 1));
				l.propsneeds = l.propsneeds | r.propsneeds;
				ClearRev(op);
			}
			else {
				cca (at, arg);
				ClearRev(op);
				l.floatneeds = max (l.floatneeds, 2);
				l.propsneeds = l.propsneeds | morefloat | (pcr << 1);
				l.maxargs = max (l.maxargs, r.maxargs);
			}
	if (withert && l.fixneeds < 2) l.fixneeds = 2;
	return l;
}

/**********************************************************************
 *	maxneeds
 *
 *Calculates a needs value. Each element of which is the maximum of the
 *corresponding elements in the two parameter needs
 **********************************************************************/

needs
maxneeds(needs a, needs b)
{
	needs an;
	an.fixneeds = max (a.fixneeds, b.fixneeds);
	an.floatneeds = max (a.floatneeds, b.floatneeds);
	an.maxargs = max (a.maxargs, b.maxargs);
	an.propsneeds = a.propsneeds | b.propsneeds;
	return an;
}

/**********************************************************************
 *	maxsequence

**********************************************************************/

needs
maxtup(exp e, exp ** at)
{	/* calculates the needs of a tuple of
	 *				   expressions; any new declarations
	 *				   required by a component expression will
	 *				   replace the component expression */
	exp * stat = &son(e);
	needs an;
	
	an = zeroneeds;
	if (*stat == nilexp) return an;
	while (an = maxneeds (an, scan (stat, at)), !last(*stat)) {
		stat = &bro(*stat);
	}
	return an;
}

bool
unchanged(exp usedname, exp ident)
{
	/* finds if usedname is only used in cont
	 *				   operation or as result of ident i.e.
	 *				   value of name is unchanged over its
	 *				   scope */
	exp uses = pt (usedname);
	while (uses != nilexp) {
		if (intnl_to (ident, uses)) {
			if (!last (uses) || name (bro (uses)) != cont_tag) {
				exp z = uses;
				while (z != ident) {
					if (!last (z) ||
						(name (bro (z)) != seq_tag && name (bro (z)) != ident_tag)) {
						return 0;
					}
					z = bro (z);
				}
			}
		}
		uses = pt (uses);
	}
	return 1;
}



exp
absbool(exp id /* declaration */)
{			/* check if e  is (let a = 0 in
			 *                               cond(inttest(L)=result; a=1 | L:top); a
			 *                               ni) This will be compiled later using
			 *                               set instructions instead of branches */
	if (isvar (id) && name (son (id)) == val_tag && no (son (id)) == 0
		&& no (id) == 2 /* name initially 0 only used twice */) {
		exp bdy = bro (son (id));
		if (name (bdy) == seq_tag && name (bro (son (bdy))) == cont_tag &&
			name (son (bro (son (bdy)))) == name_tag &&
			son (son (bro (son (bdy)))) == id
			/* one use is result  of sequence body */) {
			exp c = son (son (bdy));
			if (last (c) && name (c) == cond_tag /* seq is cond=c; id */) {
				exp first = son (c);
				exp second = bro (son (c));
				if (no (son (second)) == 1 /* only one jump to else */ &&
					name (bro (son (second))) == top_tag
					&& name (first) == seq_tag /* cond is (seq= first | L: top) */) {
					exp s = son (son (first));
					exp r = bro (son (first));
					if (name (r) == ass_tag && name (son (r)) == name_tag &&
						son (son (r)) == id && name (bro (son (r))) == val_tag &&
						no (bro (son (r))) == 1 /* last of seq is id = 1 */ &&
						last (s) && name (s) == test_tag && pt (s) == second
						&& !is_floating (name (sh (son (s))))
						/**t of seq is int test jumping to
						 *				   second */
						) {
						return s;
					}
				}
				
			}
			
		}
		
		
	}
	return 0;
}

exp *
ptr_position(exp e)
{
	exp * a;
	exp dad = father(e);
	if (son(dad)==e) {
		a = &son(dad);
	}
	else {
		exp sib = son(dad);
		while (bro(sib)!=e) { sib = bro(sib); }
		a = &bro(sib);
	}
	return a;
}

void
change_to_var(exp e)
{	/* change identity to variable definition */
	exp p = pt(e);
	shape ns;
	Assert(name(e)==ident_tag && !isvar(e));
	setvar(e);
	setcaonly(e);
	ns = f_pointer(f_alignment(sh(son(e))));
	while (p != nilexp) {
		exp * pos = ptr_position(p);
		exp ncont = getexp(sh(p), bro(p), last(p), p, nilexp, 0, 0,
						   cont_tag);
		bro(p) = ncont; setlast(p);
		sh(p) = ns;
		*pos = ncont;
		p = pt(p);
	}
}

void
change_names(exp f, exp t, exp except)
{	/* replace uses of ident f (!= except) to uses of t */
	exp py = pt(f);
	Assert(name(f)==ident_tag && name(t)==ident_tag && name(except)==name_tag);
	while (py != nilexp) {
		exp ppy = pt(py);
		if (py != except) {
			son(py) = t; /* change f to t */
			pt(py) = pt(t);
			pt(t) = py;
			no(t)++;  /* maintain usage */
		}
		py = ppy;
	}
}


void
tidy_ident(exp e)
{
	/* replace Var/Id x = Var y = e1 in { e2; contents(y)} in e3;
	 *	   by Var x = e1 in { e2/(y=>x); e3}
	 *	   replace Var/Id x = Id y = e1 in {e2; y} in e3
	 *           by Var/Id x = e1 in { e2/y=>(cont)x; e3}
	 */
	exp init; exp bdyinit; exp idy;
	exp e1;
	exp e3;
	Assert(name(e)==ident_tag);
	init = son(e);
	e3 = bro(init);
	if (name(init) != ident_tag || isparam(e)) { return ;}
	tidy_ident(init);
	e1 = son(init);
	bdyinit = bro(e1);
	if (!isvar(init)) {
		if (name(bdyinit) == seq_tag) {
	    	exp idy = bro(son(bdyinit));
			exp broe3;
			bool laste3;
			if (name(idy) != name_tag || son(idy) != init ||
				no(idy) !=0 ||
				shape_size(sh(idy)) != shape_size(sh(e1)) ||
				shape_align(sh(idy)) != shape_align(sh(e1))) {
				return;
			}
			if (isvar(e)) {
				change_to_var(init);
			}
			change_names(init, e, idy);
			
			broe3 = bro(e3);
			laste3 = last(e3);
			bro(son(bdyinit)) = e3;
			bro(e3) = bdyinit; setlast(bdyinit);
			/* bdyinit is now { e2/(y=>x); e3} */
			bro(bdyinit) = broe3;
			if (laste3) { setlast(bdyinit); }
			else { clearlast(bdyinit); }
			son(e) = e1;  /* bro(e1) is bdyinit */
			return;
		}
		else
			if (name(bdyinit)== name_tag && (idy = son(bdyinit))==init
				&& no(bdyinit)==0 &&
				shape_size(sh(idy)) == shape_size(sh(e1)) &&
				shape_align(sh(idy)) == shape_align(sh(e1))) {
				/* form is Var/Id x = Id y = e1 in y in e3
				 *			=> Var x = e1 in e3 */
				bro(e1) = e3;
				son(e) = e1;
			}
			else return;
	}
	else {
		if (name(bdyinit) == seq_tag) {
			exp cy = bro(son(bdyinit));
			exp broe3;
			bool laste3;
			if (name(cy) != cont_tag) return;
			
			idy = son(cy);
			if (name(idy) != name_tag || no(idy) != 0 ||
				son(idy) != init ||
				shape_size(sh(cy)) != shape_size(sh(e1)) ||
				shape_align(sh(cy)) != shape_align(sh(e1))) {
				return;
			}
			if (!isvar(e)) {
				change_to_var(e);
				e3 = bro(init);
				if (isvis(init)) { setvis(e); }
				if (!iscaonly(init)) { ClearCaonly(e); }
			}
			
			change_names(init,e,idy);
			
			broe3 = bro(e3);
			laste3 = last(e3);
			bro(son(bdyinit)) = e3;
			bro(e3) = bdyinit; setlast(bdyinit);
			/* bdyinit is now { e2/(y=>x); e3} */
			bro(bdyinit) = broe3;
			if (laste3) { setlast(bdyinit); }
			else { clearlast(bdyinit); }
			son(e) = e1;  /* bro(e1) is bdyinit */
			return;
		}
		else
			if (name(bdyinit) == cont_tag) {
				exp cy =  bro(son(bdyinit));
				idy = son(cy);
				if (name(idy) != name_tag || no(idy) != 0 ||
					son(idy) != init ||
					shape_size(sh(cy)) != shape_size(sh(e1)) ||
					shape_align(sh(cy)) != shape_align(sh(e1))) {
					return;
				}
				/* form is Var x = Var y = e1 in cont(y) in e3
				 *			=> Var x = e1 in e3 */
				if (!isvar(e)) {
					change_to_var(e);
					e3 = bro(init);
					if (isvis(init)) { setvis(e); }
					if (!iscaonly(init)) { ClearCaonly(e); }
				}
				bro(e1) = e3;
				son(e) = e1;
			}
			else return;
	}
	
}


bool
chase(exp sel, exp * e)
{
	/* distribute selection throughout compound expressions */
	bool b = 0;
	exp * one;
	switch (name(*e)) {
	case ident_tag:
	case seq_tag:
	case rep_tag:
	case labst_tag: {
		b = chase(sel, &bro(son(*e)));
		break;
	}
	case solve_tag:
	case cond_tag: {
		one = &son(*e);
		for (;;)  {
    	    b |= chase(sel, one);
    	    if (last(*one)) break;
    	    one = &bro(*one);
		}
		break;
	}
	case field_tag: {
		if (chase(*e, &son(*e))) {
    	  	/* inner field has been distributed */
    	  	exp stare = *e;
    	  	exp ss = son(stare);
    	  	if (!last (stare)) clearlast (ss);
			bro (ss) = bro (stare);
			sh (ss) = sh (stare);
			*e = ss;
			return chase(sel, e);
		} /* ... continue to default */
	}
	default: {
		if (son(sel)!= *e && name(sh(*e)) != bothd) {
			/* only change if not outer */
    	    exp stare = *e;
			exp newsel = getexp (sh (sel), bro (stare), last (stare), stare, nilexp,
								 props (sel), no (sel), name (sel));
			*e =  newsel;
			bro(stare)=newsel;  setlast(stare);
			b = 1;
		}
	}
	}
	if (b) sh(*e) = sh(sel);
	return b;
}

bool
use_not_rep(exp e)
{
	exp u;
	if (no(e) !=1) return 0;
	u = father(pt(e));
	while (u != e) {
		if (name(u) == rep_tag || name(u) == solve_tag) {
			return 0;
		}
		else { u = father(u); }
	}
	return 1;
}

/********************************************************************
 *		scan
 *
 *    This procedure works out register requirements of an exp. At each call
 *    the fix field of the needs is the number of fixpnt registers required to
 *    contain live values to evaluate this expression. This never exceeds
 *    maxfix because if it would have, a new declaration is introduced in the
 *    exp tree (similarly for floating regs and maxfloat). In these cases the
 *    prop field will contain the bits morefix (or morefloat).
 *
 *    Scan also works out various things concerned with proc calls.  The
 *    maxargs field contains the max size in bits of the space required for
 *    the parameters of all the procedures called in the exp. An exp proc call
 *    produces a hasproccall bit in the prop field, if this is transformed as
 *    part of the definition of a new declaration the bit is replaced by a
 *    usesproccall. The distinction is only used in unfolding nested proc
 *    calls; MIPS requires this to be done statically. The condition that a
 *    proc exp is a leaf (i.e no proc calls) is that its prop contains neither
 *    bit.
 *
 *    If an ident exp is suitable, scan marks the props of ident with
 *    either inreg or infreg bits to indicate that a t reg may be used for
 *    this tag.
 *
 *    A thorough understanding of needs along with other procedures
 *    that do switch (name(exp)) requires a knowledge of the meaning of the
 *    fields of the exp in each case.

********************************************************************/


needs
scan(exp * e, exp ** at)
{
	/*  e is the expression to be scanned, at
	 *				   is the place to put any new decs . NB order of recursive
	 *				   calls with same at is critical */
	exp   ste = * (e);
	int   nstare = name (ste);
	
/*  while
 *    (nstare == diag_tag || nstare == cscope_tag || nstare == fscope_tag) {
 *    e = &son(ste);
 *    ste = * (e);
 *    nstare = name (ste);
 *  }
 */
	
	
	
	
	
	switch (nstare) {
    case 0: {
		return zeroneeds;
	};
		
		
		
    case compound_tag: case nof_tag:  case concatnof_tag: case ncopies_tag:
	{
		needs nl;
		bool cantdo;
		exp dad;
		if (name(ste)==ncopies_tag && name(son(ste)) !=name_tag
			&& name(son(ste)) != val_tag) {
			nl = scan(&son(*e), at);
			cca(at, &son(*e));
		}
		else nl = maxtup(*(e), at);
		
		dad = father(ste);
		if (name(dad)==compound_tag || name(dad) == nof_tag
			|| name(dad) == concatnof_tag) {
			cantdo=0;
		}
		else
			if (last(ste)){
				if (name(bro(ste)) == ass_tag) {
					exp a = son(bro(ste));
					cantdo = (name(a) != name_tag || !isvar(son(a)));
				}
				else cantdo = 1;
			}
			else
				if (last(bro(ste))) { cantdo = (name(bro(bro(ste))) != ident_tag) ;}
				else cantdo = 1;
		
		
		if (cantdo)  {
			/* can only deal with tuples in simple assignment or identity */
			int prps = (nl.propsneeds & hasproccall) << 1;
			cca(at, ptr_position(ste));
			nl = shapeneeds(sh(*(e)));
			nl.propsneeds |= morefix;
	      	nl.propsneeds |= prps;
		}
		
		if (nl.fixneeds <2) nl.fixneeds = 2;
		return nl;
	};
	
	
	
    case cond_tag:
	{
		exp t, f, v;
		
		
		if (oddtest(ste, & t, &f, &v)) {
			/* transform to f((absbool(t) <<1)-1)  */
			exp bc = bro(ste);
			bool lc = last(ste);
			exp ab = getexp(sh(v), nilexp, 0, t, nilexp, 0, 0, absbool_tag);
			exp shl = getexp(sh(v), nilexp, 0, ab, nilexp, 0, 0, shl_tag);
			exp v1 = getexp(sh(v), shl, 1, nilexp,nilexp, 0, 1, val_tag);
			exp p = getexp(sh(v), nilexp, 1, shl, nilexp, 0, 0, plus_tag);
			exp vm1 = getexp(sh(v), p, 1, nilexp,nilexp, 0, -1, val_tag);
			bro(ab) = v1;
			bro(shl) = vm1;
			bro(t) = ab; setlast(t);
			if (no(v)==-1) {settest_number(t, notbranch[test_number(t)-1]);}
			if (f==v) {
				*e = p;
			}
			else {
				son(bro(v)) = p;
				bro(p) = bro(v);
				*e = f;
			}
			bro(*e) = bc; if (lc) { setlast(*e); } else {clearlast(*e); }
			return scan(e, at);
		}
		
		if (is_maxlike(ste, &t)) {
			son(ste) = t;
			bro(t) = ste; setlast(t);
			setname(ste, maxlike_tag);
			return scan(&son(ste), at);
		}
		if (is_minlike(ste, &t)) {
			son(ste) = t;
			bro(t) = ste; setlast(t);
			setname(ste, minlike_tag);
			return scan(&son(ste), at);
		}
		if (is_abslike(ste, &t)) {
			son(ste) = t;
			bro(t) = ste; setlast(t);
			setname(ste, abslike_tag);
			return scan(&son(ste), at);
		}
		if (is_fabs(ste, &t)) {
			son(ste) = son(t);
			bro(son(t)) = ste; setlast(son(t));
			setname(ste, fabs_tag);
			return scan(&son(ste), at);
		}
		
		if (scan_cond(e, nilexp) !=0) {
			return scan(e, at);
		}			/* else goto next case */
	}
	
	
	
    case labst_tag:
    case rep_tag:
    case solve_tag:
	{
		exp * stat;
		exp * statat;
		needs an;
		stat = &son(*e);
		statat = stat;
		an = zeroneeds;
		while (an = maxneeds (an, scan (stat, &statat)),
			   
			   !last (* (stat))) {
			stat = &bro(*stat);
			statat = stat;
		}
		if ((an.propsneeds & usesproccall) != 0) {
			an.propsneeds |= hasproccall;
		}
		return an;
	}
	
/*********************************************************************
 *	ident
 *
 *shape of exp is body,
 *son is def, brother of son is body,
 *ptr of ident exp is chain of uses
 *********************************************************************/
	
    case ident_tag:
	{ tidy_ident(*e); /* remove nugatory idents in initialisation */
	}
	{
		
		needs bdy;
		needs def;
		exp stare = * (e);
		exp * arg = &bro(son(stare));
		exp t = pt (stare), s;
		bool fxregble;
		bool flregble;
		bool old_nonevis = nonevis;
		exp ab;
		
		if (isvar(stare) && !iscaonly(stare)) setvis(stare);
		
		
		
		
		if (!isvar (stare)  && !isvis(stare) && !isparam(stare)
	        && ((props(stare) & 0x10) !=0)
			&& use_not_rep(stare)) {
			/* remove declaration */
			/*only one use */
			exp u = pt(stare);
			exp init = son(stare);
			exp bdy = bro(init);
			exp * posu = ptr_position(u);
			bro(init) = bro(u);
			if (last(u)) { setlast(init);} else {clearlast(init); }
			*posu = init;
			bro(bdy)= bro(stare);
			if (last(stare)) { setlast(bdy);} else { clearlast(bdy); }
			*e = bdy;
			return scan(e, at);
		}
		
		
		if (isparam(stare)
			&& name(son(stare))!= formal_callee_tag) {
			exp def = son(stare);
			shape shdef = sh(def);
			long n = rounder(stparam, shape_align(shdef));
			long sizep = shape_size(shdef);
			
			Assert(name(def)==clear_tag);
			if (is_floating(name(shdef))) {
				if (n + sizep <= 128) {
					props(def) = floatparam++;
					maxfloat--;
				}
			}
			else
				if (sizep<=32  && stparam <=96 ) {
					props(def) = fixparam;
					maxfix--;
				}
				else props(def)=0;
			if (BIGEND && sizep <32 && valregable(shdef)) {
				/* characters are promoted to ints */
		     	int dn = (sizep==8)?24:16;
				exp pu = pt(stare);
				while (pu != nilexp) {
					no(pu)+= dn;
					pu = pt(pu);
				}
			}
			no(def) = n;
			stparam = rounder(n+sizep, 32);
			fixparam = 4 +(stparam>>5);
			
			
			if (!is_floating(name(shdef)) && !valregable(shdef))
				setvis(stare);
			/* now props(def) = pos parreg and no(def) = par stack address
			 */
		}
		else
			if (isparam(stare) && name(son(stare))== formal_callee_tag) {
				exp def = son(stare);
				shape shdef = sh(def);
				long sizep = shape_size(shdef);
				long alp = shape_align(shdef);
				long n = rounder(callee_size, alp);
				no(def) = n;
				callee_size = rounder(n+sizep, 32);
				
			}
		nonevis &= !isvis(stare);
		
		bdy = scan (arg, &arg);
		/* scan the body-scope */
		arg = &son(stare);
		def = scan (arg, &arg);
		/* scan the initialisation of tag */
		
		nonevis = old_nonevis;
		t = son (stare);
		s = bro (t);
		fxregble = fixregable (stare);
		flregble = floatregable (stare);
		
		if (isparam(stare)) {
			if (!isvis(stare) && !isoutpar(stare)
				&& name(son(stare)) != formal_callee_tag &&
				(bdy.propsneeds & anyproccall)==0  ) {
				/* leave pars in par regs or put in t-regs
				 *	             !! WHAT ABOUT TEMP DECS !!
				 */
				int x = props(son(stare));
				if (x != 0) {
					no(stare)= x;
					if (flregble) { props(stare)|= infreg_bits; }
					else { props(stare) |= inreg_bits; }
				}
				else
					if (fxregble &&
						bdy.fixneeds < maxfix && (bdy.propsneeds & morefix) == 0){
						no(stare) = 0;
						props(stare) |= inreg_bits;
						bdy.fixneeds+=1;
					}
					else
						if (flregble &&
							bdy.floatneeds < maxfloat &&
							(bdy.propsneeds & morefloat) == 0) {
							no(stare) = 0;
							props(stare) |= infreg_bits;
							bdy.floatneeds +=1;
						}
						else no(stare) = 100;
			}
			else no(stare) = 100;
			
		}
		else {
            if ((ab = absbool (stare)) != nilexp) {
				/* form is (let a = 0 in cond(test(L)=ab;
				 *                                     a=1 | L:top) ni replace declaration by
				 *                                     ABS */
				bro (ab) = stare;
				setlast (ab);       /* father => *e */
				son (stare) = ab;
				pt (stare) = nilexp;
				pt (ab) = nilexp;
				setname (stare, absbool_tag);
				return maxneeds (bdy, def);
            }
			
            if (!isvis (*e) && !isparam(*e) &&
				(bdy.propsneeds & (anyproccall | uses2_bit)) == 0
				&& (fxregble || flregble) &&
                (name (t) == apply_tag ||
				 (name (s) == seq_tag && name (bro (son (s))) == res_tag &&
				  name (son (bro (son (s)))) == cont_tag && isvar (stare) &&
				  name (son (son (bro (son (s))))) == name_tag &&
				  son (son (son (bro (son (s))))) == stare
					 )               /* Let a := ..; return cont a */
					)
				) {                 /* put tag in result reg if definition is
									 *                                     call of proc, or body ends with return
									 *                                     tag, provided result is not used other
									 *                                     wise */
				props (stare) |= (fxregble) ? inreg_bits : infreg_bits;
				bdy.propsneeds |= uses2_bit;
				no (stare) = 101;   /* identification  uses result reg in body
									 */
				if (fxregble) bdy.fixneeds+=1;
            }
			
            else
				if (!isvar (*e) && !isparam(*e) &&
					((name (t) == reff_tag && name (son (t)) == cont_tag &&
					  name (son (son (t))) == name_tag && isvar (son (son (son (t))))
					  && !isvis (son (son (son (t)))) && !isglob (son (son (son (t))))
					  && unchanged (son (son (son (t))), stare)
					  /* reff cont variable-not assigned to in
					   *				   scope */
						) ||
					 (name (t) == cont_tag && name (son (t)) == name_tag &&
					  isvar (son (son (t))) && !isvis (son (son (t))) && !isglob (son (son (t)))
					  && unchanged (son (son (t)), stare)
					  /* cont variable - not assigned to in
					   *				   scope */
						 )
						)
					) {
					props (stare) |= defer_bit;
					/* dont take space for this dec */
				}
				else
					if (!isvar (stare)  && !isvis(stare) &&
						((props (stare) & 0x10 /* forced in const */) == 0
						 && (name (t) == name_tag || name (t) == val_tag))) {
						props (stare) |= defer_bit;
						/* dont take space for this dec */
					}
					else
						if (fxregble && bdy.fixneeds < maxfix
							&& (isinlined(stare) ||
								((bdy.propsneeds & morefix) == 0 &&
								 ((bdy.propsneeds & anyproccall) == 0
								  || tempdec (stare, ((bdy.propsneeds & morefix) == 0 &&
													  bdy.fixneeds < 10)))
									))) {
                            /* put this tag in some  fixpt t-reg -
							 *                               which will be decided  in make_code */
							props (stare) |= inreg_bits;
							no (stare) = 0;
							bdy.fixneeds += 1;
						}
						else
							if (flregble && bdy.floatneeds < maxfloat
								&& (isinlined(stare) ||
									((bdy.propsneeds & morefloat) == 0
									 && ((bdy.propsneeds & anyproccall) == 0
										 || tempdec (stare, ((bdy.propsneeds & morefloat) == 0 &&
															 bdy.floatneeds < 6)))
										))) {
								/* put this tag in some  float t-reg -
								 *                             which will be decided  in make_code */
								props (stare) |= infreg_bits;
								no (stare) = 0;
								bdy.floatneeds += 1;
							}
							else {
								if (fxregble && (bdy.propsneeds & anyproccall) == 0) {
									SetPossParReg(stare);
								}
								no (stare) = 100;
								/* allocate either on stack or saved reg
								 */
							}
		}
		bdy = maxneeds (bdy, def);
		if ((bdy.propsneeds & usesproccall) != 0) {
			bdy.propsneeds |= hasproccall;
		}
		return bdy;
	}
	
/*********************************************************************
 *	sequence
 *
 *shape of exp is shape of end of sequence
 *son is sequence holder, son of this is list of voided statements.
 *********************************************************************/
	
    case seq_tag:
	{
		exp * arg = &bro(son(*e));
		needs an;
		exp * stat;
		exp * atsc = &son(son(*e));
		for (;;) {
			exp sc = *atsc;
			if (name(sc) == cond_tag && name(sh(son(sc)))==bothd
				&& name(bro(son(bro(son(sc))))) == top_tag) {
				/* sc is cond(... goto | make_top); can replace
				 *				make_top by next exp in sequence */
				exp lbst = bro(son(sc));
				exp mkt = bro(son(lbst));
				exp ne = (last(sc))? bro(son(*e)): bro(sc);
				exp bne = bro(ne);
				bool lne = last(ne);
				if (name(ne) != cond_tag) {
					/* only worthwhile eliding if ne is a cond */
					if (last(sc)) break;
					atsc = &bro(sc);
					continue;
				}
				sh(sc) = sh(ne);
				bro(ne) = lbst; setlast(ne);
				bro(son(lbst)) = ne;
				/* sc is now cond(... goto | next cond exp) */
				if (!last(sc)) { /* not last in seq - swallow next*/
					bro(sc) = bne;
					if (lne) { setlast(sc); } else { clearlast(sc);}
					no(son(*e))--; /* one less statement */
				}
				else
					if (no(son(*e)) != 1) { /* last but not only - replace by
											 *					make_top and put cond in res posn */
						bro(mkt) = bro(sc); setlast(mkt);
						*atsc = mkt;
						bro(sc) = bne;
						if (lne) { setlast(sc); } else { clearlast(sc);}
						*arg = sc;
						sc = mkt;
					}
					else { /* whole sequence can be replace by cond */
						bro(sc) = bro(*e);
						if (last(*e)) { setlast(sc); } else {clearlast(sc); }
						*e = sc;
						return scan(e, at);
					}
				
			}
			if (last(sc)) break;
			atsc = &bro(sc);
		}
		
		
		an = scan (arg, &arg);
		stat = &son(son(*e));
		
		arg = stat;
		for (;;) {
			needs stneeds;
			stneeds = scan (stat, &arg);
			/* initial statements voided */
			an = maxneeds (an, stneeds);
			if (last (* (stat))) {
				if ((an.propsneeds & usesproccall) != 0) {
					an.propsneeds |= hasproccall;
				}
				return an;
			}
			stat = &bro(*stat);
			arg = stat;
		}
		
	};
	
/********************************************************************
 *	goto
 *
 *shape is bottom
 *son is exp for value jumped with
 *ptr is labelled exp
 *********************************************************************/
	
    case goto_tag: case trap_tag:
	{
		return zeroneeds;
	};
	
    case ass_tag:
    case assvol_tag:
	{
		exp * lhs = &son(*e);
		exp * rhs = &bro(*lhs);
		needs nr;
		ash a;
		
		nr = scan (rhs, at);
		/* scan source */
		
		a = ashof (sh (* (rhs)));
		
		if (name (* (lhs)) == name_tag && (no(*lhs) < 8*32768 && no(*lhs) >= -8*32768) &&
			(isvar (son (* (lhs))) &&  /* can do better for regable rhs*/
			 ((nr.propsneeds & (hasproccall | morefix)) == 0
			  && nr.fixneeds < maxfix
				 )
				)
			) {			/* simple destination */
			return nr;
		}
		else {
			needs nl;
			prop prps = (nr.propsneeds & hasproccall) << 1;
			nl = scan (lhs, at);
			/* scan destination */
			if (name (* (rhs)) == apply_tag && nstare == ass_tag &&
				(nl.propsneeds & (uses2_bit | anyproccall)) == 0) {
				/* source is proc call, so assign result
				 *				   reg directly */
				;
			}
			else
				if (nr.fixneeds >= maxfix || prps != 0) {
					/* source and destination regs overlap, so
					 *				   identify source */
					cca (at, rhs);
					nl = shapeneeds (sh (* (rhs)));
					nl.propsneeds |= morefix;
					nl.propsneeds &= ~(prps >> 1);
					nl.propsneeds |= prps;
				}
			nr.fixneeds += 1;
			return maxneeds (nl, nr);
		}
	};
	
    case res_tag: case untidy_return_tag:
	{
		ash a;
		needs x;
		shape s;
		exp * arg = &son(*e);
		exp r, ss, t;
		s = sh (* (arg));
		a = ashof (s);
		props(*e) = 0; /* clear possibility of tlrecirsion; may be set later */
		x = scan (arg, at);
		/* scan result exp ... */
		if (is_floating (name (s))) {/* ... floating pt result */
			x.propsneeds |= realresult_bit;
			if (name (s) != shrealhd) {
				x.propsneeds |= longrealresult_bit;
			}
		}
		else {
			if (!valregable (s)) {/* .... result does not fit into reg */
				x.propsneeds |= long_result_bit;
			}
		}
		if (a.ashsize != 0) {	/* ...not a void result */
			x.propsneeds |= has_result_bit;
		}
		
		
		return x;
	};
	
    case apply_general_tag: {
		exp application = *(e);
		exp *fn = &son (application);
		exp cers = bro(*fn);
		exp *cerl = &son(cers);
		long stpar = 0;
		
		needs nds;
		needs plnds;
		int i;
		
		gen_call = 1;
		
		nds = scan(fn, at);
		if ((nds.propsneeds & hasproccall) != 0) {
			/* .... it must be identified */
			cca (at, fn);
			nds.propsneeds &= ~hasproccall;
			nds.propsneeds |= usesproccall;
			fn = &son(application);
		}
		
		for (i=0; i<no(cers); i++) {
			needs onepar;
			shape shonepar = sh(*cerl);
			exp * par = (name(*cerl)==caller_tag)?&son(*cerl):cerl;
			int n = rounder(stpar, shape_align(shonepar));
			onepar = scan(par,at);
	    	if ((i != 0 && (onepar.propsneeds & hasproccall) != 0) ||
				onepar.fixneeds+(stpar>>5) > maxfix) {
				/* if it isn't the first parameter, and it
				 *				   calls a proc, identify it */
				cca (at, par);
				nds.propsneeds |= usesproccall;
				nds = maxneeds (shapeneeds (sh (* (par))), nds);
				nds.maxargs = max (nds.maxargs, onepar.maxargs);
			}
			else {
				nds = maxneeds (onepar, nds);
			}
			if (name(*cerl)==caller_tag) { no(*cerl) = n; };
			n = n + shape_size(shonepar);
			stpar = rounder(n,32);
			cerl = &bro(*cerl);
		}
		nds.maxargs = max (nds.maxargs, stpar);
		nds = maxneeds(scan(&bro(bro(son(application))), at), nds);
		
		plnds = scan(&bro(bro(bro(son(application)))), at);
		
		
		
		
		if ((plnds.propsneeds & (anyproccall | uses2_bit)) != 0) {
			props(application) = 1;
			if (is_floating(name(sh(application)))
				|| valregable(sh(application))) {
				cca(at, ptr_position(application));
				plnds.propsneeds |= usesproccall;
			}
		}
		else { props(application) = 0; }
		
		nds = maxneeds(nds, plnds);
		nds.propsneeds |= hasproccall;
		return nds;
	}
		
	case make_callee_list_tag: {
		exp cees = *e;
		exp * par = &son(cees);
		needs nds;
		long stpar = 0;
		int i;
		nds = zeroneeds;
		for (i=0; i<no(cees); i++) {
			needs onepar;
			shape shonepar = sh(*par);
			int n = rounder(stpar, shape_align(shonepar));
			onepar = scan(par,at);
	    	if (((onepar.propsneeds & hasproccall) != 0) ||
				onepar.fixneeds+1 > maxfix) {
				/* if it calls a proc, identify it */
				cca (at, par);
				nds.propsneeds |= usesproccall;
				nds = maxneeds (shapeneeds (sh (* (par))), nds);
				nds.maxargs = max (nds.maxargs, onepar.maxargs);
			}
			else {
				nds = maxneeds (onepar, nds);
			}
			n = n + shape_size(shonepar);
			stpar = rounder(n,32);
			par = &bro(*par);
		}
		no(cees) = stpar;
		return nds;
	}
	case make_dynamic_callee_tag: {
		exp cees = *e;
		exp *ptr = &son(cees);
		needs ndsp;
		needs nds;
		nds = zeroneeds;
		ndsp = scan(ptr, at);
		if (((ndsp.propsneeds & hasproccall) != 0) ||
	  		ndsp.fixneeds+1 > maxfix) {
			cca (at, ptr);
			nds.propsneeds |= usesproccall;
			nds = maxneeds (shapeneeds (sh (* (ptr))), nds);
			nds.maxargs =  max(nds.maxargs, ndsp.maxargs);
		}
		else {
			nds = ndsp;
		}
		ndsp = scan(&bro(son(*e)), at);
		if (((ndsp.propsneeds & hasproccall) != 0) ||
	  		ndsp.fixneeds+2 > maxfix) {
			cca (at, &bro(son(cees)));
			nds.propsneeds |= usesproccall;
			nds = maxneeds (shapeneeds (sh (bro(son(*e)))), nds);
			nds.maxargs = max (nds.maxargs, ndsp.maxargs);
		}
		else {
			nds = maxneeds (ndsp, nds);
		}
        if (nds.fixneeds<8) nds.fixneeds = 8;
        return nds;
    }
		
    case same_callees_tag: {
    	needs nds;
    	nds = zeroneeds;
    	nds.fixneeds = 6;
    	return nds;
    }
		
    case tail_call_tag: {
		needs ndsp;
		needs nds;
		exp *fn = &son(*e);
		ndsp =  scan(fn, at);
		if (((ndsp.propsneeds & hasproccall) != 0) ||
	  		ndsp.fixneeds+1 > maxfix) {
			cca (at, fn);
			nds.propsneeds |= usesproccall;
			nds = maxneeds (shapeneeds (sh (* (fn))), nds);
			nds.maxargs =  max(nds.maxargs, ndsp.maxargs);
		}
		else {
			nds = ndsp;
		}
		gen_call = 1;
		
		ndsp = scan(&bro(son(*e)), at);
		nds = maxneeds(nds, ndsp);
		if (nds.fixneeds < 5) nds.fixneeds = 5;
		return nds;
	}
		
		
		
		
    case apply_tag:
	{
		exp application = *(e);
		exp fn = son (application);
		exp * par = &bro(fn);
		exp * fnexp = &son(*e);
		int   parsize =0;
		needs nds;
		bool tlrecpos = nonevis && callerfortr && (rscope_level == 0);
		int   i;
		
		if (BIGEND && !last(fn)) {
			/* ABI says that all int pars <32 bits are promoted to int*/
			for (;;) {
				shape s = sh(*par);
				if (shape_size(s) < 32 && valregable(s)) {
					exp cv = getexp((is_signed(s))?slongsh:ulongsh, bro(*par),
									last(*par), *par, nilexp, 0, 0, chvar_tag);
					bro(*par) = cv; setlast(*par);
					*par = cv;
				}
				if (last(*par)) break;
				par = &bro(*par);
			}
			par = &bro(fn);
		}
		
		
		nds = scan (fnexp, at);
		/* scan the function exp ... */
		if ((nds.propsneeds & hasproccall) != 0) {
			/* .... it must be identified */
			cca (at, fnexp);
			nds.propsneeds &= ~hasproccall;
			nds.propsneeds |= usesproccall;
			fn = son(application);
			par = &bro(fn);
		}
		
		if (name(fn) != name_tag ||
			(son(son(fn)) != nilexp && name(son(son(fn))) != proc_tag)) {
			tlrecpos = 0;
		}
		
		for (i = 1;!last(fn); ++i) {	/* scan parameters in turn ... */
			needs onepar;
			shape shpar = sh(*par);
			onepar = scan (par, at);
			
			parsize = rounder(parsize, shape_align(shpar));
			onepar.fixneeds += (parsize>>5);
			if ((i != 1 && (onepar.propsneeds & hasproccall) != 0) ||
				onepar.fixneeds > maxfix) {
				/* if it isn't the first parameter, and it
				 *				   calls a proc, identify it */
				cca (at, par);
				nds.propsneeds |= usesproccall;
				if (onepar.fixneeds !=0) nds.propsneeds |= morefix;
				if (onepar.floatneeds !=0) nds.propsneeds |= morefloat;
				nds = maxneeds (shapeneeds (sh (* (par))), nds);
				nds.maxargs = max (nds.maxargs, onepar.maxargs);
			}
			else {
				nds = maxneeds (onepar, nds);
			}
			
			parsize = rounder(parsize+shape_size(shpar), 32);
			if ((!valregable(shpar) && !is_floating(name(shpar))) || parsize > 128) {
				tlrecpos = 0;
			}
			if (last (* (par))) {
				break;
			};
			par = &bro(*par);
		}
		
		if ((i = specialfn (fn)) > 0) {/* eg strlen */
			nds = maxneeds (specialneeds (i), nds);
			return nds;
		}
		else
			if (i == -1) {	/* call of strcpy .... */
				/* TEST for constant string?????????????????
				 *	    exp par2 = * (par);
				 *	    if (name (par2) == eval_tag && name (son (par2)) == pack_tag
				 *		&& name (son (son (par2))) == string_tag) {
				 *
				 *	      setname (* (e), ass_tag);
				 *	      son (* (e)) = * (parlist);
				 *	      son (par2) = son (son (par2));
				 *	      sh (par2) = sh (son (par2));
				 *	      bro (par2) = * (e);
				 *	      bro(son(par2)) = par2;
				 *	      return maxneeds (nds, twofix);
				 *	    }
				 */
			}
		
		if (tlrecpos) {
			exp dad = father(application);
			if (name(dad)==res_tag) {
				props(dad) = 1; /* do a tl recursion*/
			}
		}
		nds.propsneeds |= hasproccall;
		nds.maxargs = max (nds.maxargs, parsize);
		return nds;
		
	};
	
    case val_tag: {
    	exp s = sh(*e);
    	if (name(s)==offsethd && al2(s) >= 8) {
    		/* express disps in bytes */
    		no(*e) = no(*e) >>3;
    	}
    	return shapeneeds (sh (* (e)));
    }
		
    case name_tag: {
		int n = no(*e);
		shape vs = sh(*e);
		if (n>= 8*32768 || n < -8*32786) { /* offset too big for assembler */
			shape  s = f_offset(al1_of(vs), al1_of(vs));
			exp v = me_shint(s, n);
			exp nm = me_obtain(son(*e));
			exp ao = me_b3(vs, nm, v, addptr_tag);
			bro(ao) = bro(*e);
			if (last(*e)){ setlast(ao);} else {clearlast(ao);}
			*e = ao;
			kill_exp(ste, ste);
			return scan(e, at);
		}
        return shapeneeds (sh (* (e)));
    }
    case null_tag:
    case real_tag:
    case string_tag:
    case env_offset_tag: case general_env_offset_tag:
    case current_env_tag: case make_lv_tag:
    case last_local_tag:
    case caller_name_tag: case give_stack_limit_tag:
    case env_size_tag:
	{
		return shapeneeds (sh (* (e)));
	};
	
    case prof_tag: {
		name(*e) = top_tag;
		return zeroneeds;
    };
    case clear_tag:
    case top_tag: case local_free_all_tag:
    case formal_callee_tag:
	{
		return zeroneeds;
	};
	
    case case_tag: {
		needs nds;
    	nds = scan(&son(*e), at);
		if (nds.fixneeds < 3) nds.fixneeds = 3;
		return nds;
    }
		
    case set_stack_limit_tag:
    case neg_tag:
    case not_tag: case abs_tag:
    case offset_negate_tag: case absbool_tag: case return_to_label_tag:
    case diagnose_tag:   case goto_lv_tag:
	{
		exp * arg = &son(*e);
		return scan (arg, at);
	};
    case fneg_tag: case fabs_tag:
    case chfl_tag: {
    	needs nds;
    	nds = scan(&son(*e), at);
    	if (!optop(*e) && nds.fixneeds <2) nds.fixneeds = 2;
    	return nds;
    }
		
	case alloca_tag: {
    	needs nds;
    	nds = scan(&son(*e), at);
    	if (nds.fixneeds <2) nds.fixneeds = 2;
    	return nds;
    }
    case bitf_to_int_tag:
	{
		exp * arg = &son(*e);
		needs nds;
		exp stararg;
		exp stare;
		int   sizeb;
		
		nds = scan (arg, at);
		stararg = *(arg);
		stare = * (e);
		sizeb = ashof (sh (stararg)).ashsize;
		if ((name(stararg)==name_tag &&
			 ((sizeb == 8 && (no (stararg) & 7) == 0)
			  || (sizeb == 16 && (no (stararg) & 15) == 0)
			  || (sizeb == 32 && (no(stararg) & 31)== 0)
				 )
				) || (name(stararg)==cont_tag &&
					  ((name(son(stararg)) != name_tag && name(son(stararg)) != reff_tag)
					   || (sizeb == 8 && (no (son(stararg)) & 7) == 0)
					   || (sizeb == 16 && (no (son(stararg)) & 15) == 0)
					   || (sizeb == 32 && (no(son(stararg)) & 31)== 0)
						  )
					)
			) {
			bool sgned = is_signed(sh(stare));
			shape ns = (sizeb==8)? ((sgned)?scharsh:ucharsh)
				: (sizeb==16) ?((sgned)?swordsh:uwordsh)
				: sh(stare);
			/*  can use short loads instead of bits extractions*/
			if (name(stararg)==cont_tag) {
				/* make the ptr shape consistent */
				sh(son(stararg)) = f_pointer(long_to_al(shape_align(ns)));
			}
			sh(stararg) = ns;
			setname(stare, chvar_tag);
		}
		return nds;
	}
	
    case int_to_bitf_tag:
	{
		exp * arg = &son(*e);
		return scan (arg, at);
	}
	
    case round_tag:
	{
		needs s;
		exp * arg = &son(*e);
		shape sres = sh(*e);
        if (shape_size(sres) != 32) {
			exp ch = getexp(sres, bro(*e), last(*e), *e, pt(*e), props(*e),
							0, chvar_tag);
			bro(*e) = ch; setlast(*e);
			sh(*e) = slongsh;
			*e = ch;
			return scan(e, at);
		}
		
		s = scan (arg, at);
		s.fixneeds = max (s.fixneeds, (optop(*e))?2:5);
		s.floatneeds = max (s.floatneeds, 2);
		return s;
	};
	
    case shl_tag:
    case shr_tag: case long_jump_tag:
	{
		exp * lhs = &son(*e);
		exp * rhs  = & bro(*lhs);
		needs nr;
        needs nl;
        prop prps;
		if (name(*rhs)==val_tag) {
			return scan (lhs, at);
		}
		
        nr = scan(rhs, at);
        nl = scan (lhs, at);
		rhs = &bro(*lhs);
        prps = (nr.propsneeds & hasproccall) << 1;
        if (nr.fixneeds >= maxfix || prps != 0) {
			/* if reg requirements overlap, identify
			 *                                 second operand */
			cca (at, rhs);
			nl = shapeneeds (sh (* (rhs)));
			nl.propsneeds |= morefix;
			nl.propsneeds &= ~(prps >> 1);
			nl.propsneeds |= prps;
        }
        nr.fixneeds += 1;
        return maxneeds (nl, nr);
		
	};
	
	
    case test_tag:
	{
		exp stare = *(e);
		exp l = son (stare);
		exp r = bro (l);
		exp dad = father(stare);
		bool xlike = (name(dad)==maxlike_tag || name(dad)==minlike_tag || name(dad)==abslike_tag);
		/* don't do various optimisations if xlike */
		
		if (!last (stare) && name (bro (stare)) == test_tag &&
			no (stare) == no (bro (stare)) &&
			props(stare)==props(bro(stare)) &&
			eq_exp (l, son (bro (stare))) && eq_exp (r, bro (son (bro (stare))))
			) {			/* same test following in seq list -
						 *				   remove second test */
			if (last (bro (stare)))
				setlast (stare);
			bro (stare) = bro (bro (stare));
		}
		
		if (last (stare) && name (bro (stare)) == 0/* seq holder */
			&& name (bro (bro (stare))) == test_tag &&
			name (bro (bro (bro (stare)))) == seq_tag &&
			no (stare) == no (bro (bro (stare))) &&
			props(stare)==props(bro(bro(stare))) &&
			eq_exp (l, son (bro (bro (stare))))
			&& eq_exp (r, bro (son (bro (bro (stare)))))
			) {			/* same test following in seq res - void
						 *				   second test */
			setname (bro (bro (stare)), top_tag);
			son (bro (bro (stare))) = nilexp;
			pt (bro (bro (stare))) = nilexp;
		}
		
		if (!xlike && name (l) == val_tag && (props (stare) == 5 || props (stare) == 6)) {
			/* commute  const = x */
			bro (l) = stare;
			setlast (l);
			bro (r) = l;
			clearlast (r);
			son (stare) = r;
			r = l;
			l = son (stare);
		}
		
		if (!xlike && name (r) == val_tag && (props (stare) == 5 || props (stare) == 6) &&
			no (r) == 0 &&
			name (l) == and_tag && name (bro (son (l))) == val_tag &&
			(no (bro (son (l))) & (no (bro (son (l))) - 1)) == 0
			) {			/* zero test  x & 2^n   -> neg test (x shl
						 *				   (31-n)) */
			long  n = no (bro (son (l)));
			int   x;
			for (x = 0; n > 0; x++) {
				n = n << 1;
			}
			if (x == 0) {		/* no shift required */
				bro (son (l)) = r;	/* zero there */
				son (stare) = son (l);/* x */
			}
			else {
				setname (l, shl_tag);
				no (bro (son (l))) = x;
			}
			props (stare) -= 3;	/* test for neg */
			sh (son (stare)) = slongsh;
			
		}
		if (name (l) == bitf_to_int_tag && name (r) == val_tag &&
			(props (stare) == 5 || props (stare) == 6) &&
			(name (son (l)) == cont_tag || name (son (l)) == name_tag)) {
			/* equality of bits against +ve consts
			 *				   doesnt need sign adjustment */
			long  n = no (r);
			switch (name (sh (l))) {
			case scharhd:
			{
				if (n >= 0 && n <= 127) {
					sh (l) = ucharsh;
				} break;
			}
			case swordhd:
			{
				if (n >= 0 && n <= 0xffff) {
					sh (l) = uwordsh;
				} break;
			}
			
			default:;
			}
		}
		else
			if (is_floating (name (sh (l)))) {
				return fpop (e, at);
			}
			else
				if (!xlike && name (r) == val_tag && no (r) == 1
					&& (props (stare) == 3 || props (stare) == 2)) {
					no (r) = 0;
					if (props (stare) == 3) {
						props (stare) = 4;/* branch >=1 -> branch > 0 */
					}
					else {
						props (stare) = 1;/* branch <1 -> branch <= 0 */
					}
				}
		
		return likediv (e, at);
		
	}
	
	
    case movecont_tag:{
        exp * d = &son(*e);
        exp * s = & bro(*d);
        exp * sz = &bro(*s);
		needs nd;
        needs ns;
        needs nsz;
        prop prps;
        nd = scan(d, at);
        ns = scan (s, at);
        nsz = scan(sz, at);
        prps = (ns.propsneeds & hasproccall) << 1;
        if (ns.fixneeds >= maxfix || prps != 0) {
			/* if reg requirements overlap, identify
			 *                                 second operand */
			cca (at, s);
			ns = shapeneeds (sh (* (s)));
			ns.propsneeds |= morefix;
			ns.propsneeds &= ~(prps >> 1);
			ns.propsneeds |= prps;
        }
        nd.fixneeds += 1;
        nd = maxneeds (nd, ns);
        prps= (nsz.propsneeds & hasproccall) << 1;
        if (nd.fixneeds +nsz.fixneeds >= maxfix || prps != 0) {
			/* if reg requirements overlap, identify
			 *                                 last operand */
			cca (at, sz);
			nsz = shapeneeds (sh (* (sz)));
			nsz.propsneeds |= morefix;
			nsz.propsneeds &= ~(prps >> 1);
			nsz.propsneeds |= prps;
        }
        nd.fixneeds+=1;
        nd = maxneeds(nd,nsz);
        if (nd.fixneeds < 4) nd.fixneeds = 3;
        return nd;
	}
		
		
		
		
    case plus_tag:
	{				/* replace any operands which are neg(..)
					 *				   by - ,if poss */
		exp sum = * (e);
		exp list = son (sum);
		bool someneg = 0;
		bool allneg = 1;
		for (;optop(sum);) {
			if (name (list) == neg_tag)
				someneg = 1;
			else
				allneg = 0;
			if (last (list))
				break;
			list = bro (list);
		}
		
		if (someneg) {		/* there are some neg() operands */
			if (allneg) {
				/* transform -..-... to -(..+.. +...) */
				exp x = son (sum);
				list = son (x);
				for (;;) {
					if (!last (x)) {
						bro (list) = son (bro (x));
						clearlast (list);
						list = bro (list);
						x = bro (x);
					}
					else {
						bro(list) = sum;
						setlast (list);
						son (sum) = son (son (sum));
						/* use existing exp */
						break;
					}
				}
				x = getexp (sh (sum), bro (sum), last (sum), sum, nilexp,
							0, 0, neg_tag);
				setlast(sum); bro(sum)=x; /* set father of sum to be negate */
				* (e) = x;
				
			}			/* end allneg */
			else {
				/* transform to  ((..(..+..) - ..) -..) */
				int   n = 0;
				exp brosum = bro (sum);
				bool lastsum = last (sum);
				exp x = son (sum);
				exp newsum = sum;
				list = nilexp;
				for (;;) {
					exp nxt = bro (x);
					bool final = last (x);
					if (name (x) == neg_tag) {
						bro (son (x)) = list;
						list = son (x);
					}
					else {
						bro (x) = newsum;
						newsum = x;
						if ((n++) == 0)
							setlast (newsum);
						else
							clearlast (newsum);
					}
					if (final)
						break;
					x = nxt;
				}
				
				if (n > 1) {
					son (sum) = newsum;
					newsum = sum;	/* use existing exp for add operations */
				}
				for (;;) {		/* introduce - operations */
					exp nxt = bro (list);
					bro (newsum) = list;
					clearlast (newsum);
					x = getexp (sh (sum), nilexp, 0, newsum, nilexp, 0, 0, minus_tag);
					
					bro (list) = x;
					setlast (list);
					newsum = x;
					if ((list = nxt) == nilexp)
						break;
				}
				bro (newsum) = brosum;
				if (lastsum) {
					setlast (newsum);
				}
				else {
					clearlast (newsum);
				}
				* (e) = newsum;
				
			}			/* end else allneg */
			
			return scan (e, at);
			
		}			/* end someneg  */
		return likeplus (e, at);
	}
	
	
	case addptr_tag:
    {
    	exp p = son(*e);
    	exp d = bro(p);
    	int fal = frame_al_of_ptr(sh(p));
    	if (fal!=0) {
    		int oal = frame_al1_of_offset(sh(d));
/*    		if (((oal-1)&oal) != 0) {
 *    			failer("can't cope with mixed frame offsets yet");
 *    		}
 *    		if ((oal & fal)==0) {
 *    			failer("frame-ptr and offset incompatible");
 *    		}
 */
    		if (includes_vcallees(fal) && l_or_cees(oal)) {
    			/* if oal = locals or callees relative to local reg
				 *    			   else relative to fp */
				exp ne = getexp(sh(p), d, 0, p, nilexp, 0, 0,
								locptr_tag);
				bro(p) = ne; setlast(p);
				son(*e) = ne;
    		}
    	}
    	/* ... and continue */
    }
    case mult_tag:
    case and_tag:
    case or_tag:
    case xor_tag:
	{
		return likeplus (e, at);
	};
	
	
	
    case reff_tag:
    case chvar_tag:
    case offset_pad_tag:
    case locptr_tag:
		
	{
		exp * arg = &son(*e);
		return maxneeds (scan (arg, at),
						 shapeneeds (sh (* (e))));
	};
	
    case float_tag:  {
		needs nds;
		exp * arg = &son(*e);
		nds = maxneeds (scan (arg, at), shapeneeds (sh (* (e))));
		if (name(sh(son(*(e)))) == ulonghd) {
			if (nds.floatneeds <2) nds.floatneeds =2;
		}
		return nds;
    }
		
    case cont_tag:
    case contvol_tag:
	{
		exp * arg = &son(*e);
		needs nds;
		
		nds = maxneeds (scan (arg, at), shapeneeds (sh (* (e))));
		nds.fixneeds = max (nds.fixneeds, 2);
		
		return nds;
	};
	
    case offset_mult_tag: case offset_div_tag: {
		exp op1 = son(*e);
    	exp op2 = bro(op1);
    	shape s = sh(op2);
    	if (name(op2)==val_tag  && name(s)==offsethd
			&& al2(s) >= 8) {
			int n = no(op2)/8;
			if (n == 1) {
				/* offset is one  byte */
				bro(op1) = bro(*e);
				if (last(*e)) { setlast(op1); } else {clearlast(op1); }
				*e = op1;
				return (scan(e, at));
			}
			else
				if (name(*e) == offset_mult_tag && n > 1 && (n&(n-1))== 0)
					if (name(op1) == and_tag
						&& name(son(op1))== shr_tag &&
						name(bro(son(op1)))==val_tag) {
						exp shexp = son(op1);
						exp ac = bro(shexp);
						exp shop1 = son(shexp);
						exp shop2 = bro(shop1);
						int na = no(ac);
						if ((na&(na+1))==0 && name(shop2)==val_tag) {
							int pn = 0;
							int ns = no(shop2);
							int i = n;
							while (i>1) { i >>= 1; pn++; }
							
							if (ns > pn) {
								/* can do transform:
								 *		       (((shop1>>ns) & na) * n) =>
								 *				    shop1>>(ns-pn) & (na*n)
								 */
								no(shop2) = ns-pn;
								no(ac) = na*n;
								bro(op1) = bro(*e);
								if (last(*e)) { setlast(op1); } else {clearlast(op1); }
								*e = op1;
								return (scan(e, at));
							}
						}
					}
					else { /* will do this by literal shift */
						no(op2) = n;
						return scan(&son(*e), at);
					}
    	}
		return likediv (e, at);
		
    }
		
    case offset_add_tag: {
		exp l = son(*e);
		exp r = bro(l);
		if (name(l) == val_tag) {
			sh(l) = sh(r);   /* both offsets will be treated the same */
			son(*e) = r; clearlast(r);
			bro(r) = l; setlast(l); bro(l) = *e;
			/* ... and put val last */
		}
        else
			if (al2(sh(l))>=8 && al2(sh(r)) <8) {
				return likediv (e, at);
			}
		setname(*e, plus_tag);
		
		return likeplus(e,at);
    }
		
    case offset_subtract_tag: {
		exp l = son(*e);
		exp r = bro(l);
		if (name(r)==val_tag) {
			sh(r) = sh(l);   /* both offsets will be treated the same */
		}
		else
			if (al2(sh(r))>=8 && al2(sh(l)) <8) {
				return likediv (e, at);
			}
		
		setname(*e, minus_tag);
		return likediv (e, at);
    }
    case div0_tag:
    case rem0_tag:
    case div2_tag:
    case minus_tag:
    case subptr_tag:
    case minptr_tag: case make_stack_limit_tag:
    case rem2_tag:
    case offset_div_by_int_tag:
    case component_tag:
	{
		return likediv (e, at);
	};
    case offset_max_tag: case max_tag: case min_tag: case local_free_tag:
	{ needs nd;
	nd = likediv(e, at);
	nd.fixneeds = max(nd.fixneeds, 3);
	return nd;
	}
    case div1_tag: {
    	if (!is_signed(sh(*e))) { setname(*e, div2_tag); }
    	return likediv(e,at);
    }
    case mod_tag: {
    	if (!is_signed(sh(*e))) { setname(*e, rem2_tag); }
    	return likediv(e,at);
    }
    case fdiv_tag:
/* THIS IS TOO ACCURATE FOR PLATFORM!
 *      {
 *	exp z = * (e);
 *	exp a2 = bro (son (z));
 *	if (name (a2) == real_tag) { replace X/const by X*const^-1
 *	  flt inverse;
 *	  flt unitflt;
 *	  str2flt ("1.0", &unitflt, (char **) 0);
 *	  if (flt_div (unitflt, flptnos[no (a2)], &inverse) == OKAY) {
 *				  a/const => a* (1.0/const)
 *	    int   f = new_flpt ();
 *	    flptnos[f] = inverse;
 *	    no (a2) = f;
 *	    setname (z, fmult_tag);
 *	  }
 *	}
 *      }
 */
		/* and continue to next case */
		
    case fplus_tag:
    case fminus_tag:
    case fmult_tag:
	{
        exp op = *(e);
        exp a2 = bro(son(op));
        if (!last(a2)) { /* + and * can have >2 parameters
						  *        		  - make them diadic - can do better
						  *        		  a+exp => let x = exp in a+x */
           	exp opn = getexp(sh(op), op, 0, a2, nilexp, 0, 0, name(op));
			/* dont need to transfer error treatment - nans */
        	exp nd = getexp(sh(op), bro(op), last(op), opn, nilexp, 0, 1,
							ident_tag);
        	exp id = getexp(sh(op), op, 1, nd, nilexp, 0, 0, name_tag);
        	pt(nd) = id;
        	bro(son(op)) = id;
        	setlast(op); bro(op) = nd;
        	while (!last(a2)) a2 = bro(a2);
        	bro(a2) = opn;
        	*(e) = nd;
        	return scan(e, at);
        }
		
		return fpop (e, at);
	};
	
    case field_tag:
	{
		needs str;
		exp * arg = &son(*e);
		if (chase(*e, arg)) { /* field has been distributed */
			exp stare = *e;
			exp ss = son (stare);
			if (!last (stare))
				clearlast (ss);
			bro (ss) = bro (stare);
			sh (ss) = sh (stare);
			*e = ss;
			return (scan (e, at));
		}
		str = scan (arg, at);
		return maxneeds (str, shapeneeds (sh (* (e))));
	};
	
/*********************************************************************
 *	load_proc
 *
 *
 *number is number of proc (useful for indexing)
 *********************************************************************/
	
    case proc_tag:
    case general_proc_tag:
	{
		exp * bexp;
		exp * bat;
		needs body;
		exp stare = *(e);
		
		callerfortr = do_tlrecursion && !proc_has_setjmp(stare) && !proc_has_alloca(stare) &&
			!proc_has_lv(stare) && !proc_uses_crt_env(stare);
		
		maxfix = (PIC_code)?15:16;
		/* ie $2-$15, $24 & $25 if not PIC */
		maxfloat = 10;
		gen_call = (name(stare)==general_proc_tag);
		callee_size = 0;
		stparam = 0;
		fixparam = 4;
		floatparam = 6;
		nonevis = 1;
		rscope_level = 0;
		
		bexp = & son(*e);
		bat = bexp;
		body = scan (bexp, &bat);
		/* scan the body of the proc */
        setframe_flags(*e, (body.propsneeds & anyproccall)==0);
        if (gen_call || Has_fp) callee_size+=128;
		
		return body;		/*  should never require this in reg in C */
		
	}
	
	
	
    default:
	{
		printf ("case %d not covered in needs scan\n", name (* e));
		/* NB should call failer */
		return zeroneeds;
	}
	
	}
}
