Subversion Repositories tendra.SVN

/*

    		 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.

*/

/*

			    VERSION INFORMATION

			    ===================

--------------------------------------------------------------------------

$Header: /u/g/release/CVSROOT/Source/src/installers/sparc/common/needscan.c,v 1.3 1998/03/11 11:03:57 pwe Exp $

--------------------------------------------------------------------------

$Log: needscan.c,v $

 * Revision 1.3  1998/03/11  11:03:57  pwe

 * DWARF optimisation info

 *

 * Revision 1.2  1998/02/11  16:56:43  pwe

 * corrections

 *

 * Revision 1.1.1.1  1998/01/17  15:55:55  release

 * First version to be checked into rolling release.

 *

 * Revision 1.41  1997/12/04  19:54:21  pwe

 * ANDF-DE V1.9

 *

 * Revision 1.40  1997/11/06  09:29:06  pwe

 * ANDF-DE V1.8

 *

 * Revision 1.39  1997/10/23  09:33:06  pwe

 * prep extra_diags

 *

 * Revision 1.38  1997/10/10  18:32:44  pwe

 * prep ANDF-DE revision

 *

 * Revision 1.37  1997/08/23  13:54:19  pwe

 * initial ANDF-DE

 *

 * Revision 1.36  1997/05/05  07:51:17  pwe

 * correct offset_mult (val * val)

 *

 * Revision 1.35  1997/03/26  13:04:36  pwe

 * general proc compatibility

 *

 * Revision 1.34  1997/02/18  11:48:08  pwe

 * NEWDIAGS for debugging optimised code

 *

 * Revision 1.33  1996/11/04  12:55:14  pwe

 * protect callee regs from caller call

 *

 * Revision 1.32  1996/10/03  08:51:16  pwe

 * PIC global/large offset, and PIC case guardregs

 *

 * Revision 1.31  1996/09/18  12:03:52  pwe

 * fixed PIC_code

 *

 * Revision 1.30  1996/09/10  16:24:26  pwe

 * patch to prevent ass spin on tight loop

 *

 * Revision 1.29  1996/09/09  12:32:43  pwe

 * protect result during postlude

 *

 * Revision 1.28  1996/09/06  16:50:18  pwe

 * fix outpar doubles for postlude

 *

 * Revision 1.27  1996/09/04  15:47:51  pwe

 * name change to avoid cc confusion

 *

 * Revision 1.26  1996/08/30  17:00:17  pwe

 * ensure space available for struct return

 *

 * Revision 1.25  1996/08/28  11:47:45  pwe

 * correct postlude with calls

 *

 * Revision 1.24  1996/06/19  15:38:26  john

 * Changed env_offset

 *

 * Revision 1.23  1996/06/17  16:12:08  john

 * Fix to offset_mult optimisation

 *

 * Revision 1.22  1996/02/29  17:39:38  john

 * Fix to shift op

 *

 * Revision 1.21  1995/12/15  10:25:51  john

 * Changed current_env

 *

 * Revision 1.20  1995/11/23  12:47:32  john

 * Fix for general procs

 *

 * Revision 1.19  1995/11/17  16:21:03  john

 * Fix to general proc call

 *

 * Revision 1.18  1995/11/10  10:11:42  john

 * Fixed scan of prof_tag

 *

 * Revision 1.17  1995/11/09  17:24:51  john

 * the result of inlining a function is no longer stored in

 * a t reg.

 *

 * Revision 1.16  1995/11/07  09:41:34  john

 * Changed parameter passing for general procs

 *

 * Revision 1.15  1995/10/31  12:47:26  john

 * Change to needs for dynamic callees

 *

 * Revision 1.14  1995/10/27  10:50:49  john

 * Fix to general procs

 *

 * Revision 1.13  1995/09/25  16:35:06  john

 * Fix for outpar

 *

 * Revision 1.12  1995/09/19  14:32:01  john

 * Added trap_tag

 *

 * Revision 1.11  1995/09/13  16:36:59  john

 * Added special_tag to scan

 *

 * Revision 1.10  1995/08/31  15:57:14  john

 * Fixed diagnostic bug & added fmax_tag

 *

 * Revision 1.9  1995/08/22  15:28:54  john

 * Change to compound_tag

 *

 * Revision 1.8  1995/08/04  15:46:12  john

 * Fix to maxneeds

 *

 * Revision 1.7  1995/07/17  16:44:16  john

 * New case

 *

 * Revision 1.6  1995/07/14  16:32:43  john

 * Various changes for new spec

 *

 * Revision 1.5  1995/06/21  14:29:21  john

 * Reformatting

 *

 * Revision 1.4  1995/06/14  15:35:11  john

 * Added support for give_stack_limit and set_stack_limit constructs.

 *

 * Revision 1.3  1995/05/26  12:59:59  john

 * Changes for new spec

 *

 * Revision 1.2  1995/04/20  08:06:12  john

 * Changed function definition

 *

 * Revision 1.1.1.1  1995/03/13  10:19:03  john

 * Entered into CVS

 *

 * Revision 1.12  1995/01/23  08:51:03  john

 * Modified case for allocating ident to t-reg.

 *

 * Revision 1.11  1994/12/21  12:09:38  djch

 * Added max_tag and min_tag, corrected offset_max_tag

 *

 * Revision 1.10  1994/12/20  14:46:25  djch

 * fixes to get the new cond scanning code working.

 *

 * Revision 1.9  1994/12/05  11:28:42  djch

 * To fix CR94_013:DR116.plum_err, added scan_cond from Ian's MIPS.

 *

 * Revision 1.8  1994/12/01  13:12:04  djch

 * Force envoffset'd idents to the stack.

 * Consider returning bottom as returning void.

 * Scan movecont with simplified version of apply_tag (for now)

 * Added goto_lv_tag and abs_tag

 *

 * Revision 1.7  1994/07/06  13:49:25  djch

 * After scan *e may not be the exp it was before, so use *(ptr_position(ste))

 * instead of *e.

 *

 * Revision 1.6  1994/06/22  09:53:21  djch

 * added div0 and rem0

 *

 * Revision 1.5  1994/05/24  08:10:23  djch

 * Moved addptr to call likediv, since it is not commutative..

 *

 * Revision 1.4  1994/05/19  08:20:43  djch

 * fixed chase not to distribute into exp with shape bottom (avoid field(goto))

 *

 * Revision 1.3  1994/05/13  13:05:10  djch

 * Incorporates improvements from expt version

 * moved declaratiosn inside long_double code.

 * removed two wrong parts of test to optimise test_tags

 * added decrements to keep ways there accurate

 * removed swap for val on lhs, added optimization for x &2^n ==0 -> x<<k is -ve

 * one fix from mips in neg_tag moving

 *

 * Revision 1.2  1994/05/03  15:08:59  djch

 * ifdefed out rscope_tag

 *

 * Revision 1.9  93/11/19  16:30:46  16:30:46  ra (Robert Andrews)

 * Declare long_to_al.

 * 

 * Revision 1.8  93/09/27  14:51:19  14:51:19  ra (Robert Andrews)

 * A number of changes to allow for long doubles.

 * 

 * Revision 1.7  93/08/27  11:34:07  11:34:07  ra (Robert Andrews)

 * A number of lint-like changes.  Use of pset and pnset to set properties.

 * 

 * Revision 1.6  93/08/18  11:16:20  11:16:20  ra (Robert Andrews)

 * Reformatted.

 * 

 * Revision 1.5  93/08/13  14:42:02  14:42:02  ra (Robert Andrews)

 * Removed a couple of comments.  Fixed maxtup to deal with the case when

 * the compound initialiser does not consist entirely of constants (doesn't

 * arise from C).

 * 

 * Revision 1.4  93/07/12  15:17:15  15:17:15  ra (Robert Andrews)

 * Some of the needs cases were nonsense.  offset_mult is like mult, not div.

 * offset_add etc should use likediv, not divneeds.

 * 

 * Revision 1.3  93/07/05  18:22:38  18:22:38  ra (Robert Andrews)

 * The test for return top was wrong - it should be checking the shape,

 * not looking for a return ( make_top ).

 * 

 * Revision 1.2  93/06/29  14:29:05  14:29:05  ra (Robert Andrews)

 * The ( x / fp_const ) -> ( 1.0 / fp_const ) * x optimisation only applies

 * if FBASE is 10.

 * 

 * Revision 1.1  93/06/24  14:58:54  14:58:54  ra (Robert Andrews)

 * Initial revision

 * 

--------------------------------------------------------------------------

*/

#define SPARCTRANS_CODE

/*

  The functions in this file define 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 (common to other

  translators).

*/

#include "config.h"

#include "common_types.h"

#include "myassert.h"

#include "exptypes.h"

#include "exp.h"

#include "expmacs.h"

#include "tags.h"

#include "extra_tags.h"

#include "new_tags.h"

#include "check.h"

#include "proctypes.h"

#include "bitsmacs.h"

#include "maxminmacs.h"

#include "regable.h"

#include "tempdecs.h"

#include "shapemacs.h"

#include "special.h"

#include "const.h"

#include "flpt.h"

#include "install_fns.h"

#include "externs.h"

#include "regmacs.h"

#include "muldvrem.h"

#include "translat.h"

#include "comment.h"

#include "flags.h"

#include "me_fns.h"

#include "needscan.h"

#include "reg_defs.h"

#include "szs_als.h"

#include "makecode.h"

extern bool do_tlrecursion ;

extern prop notbranch[];

/*

  LOCAL VARIABLES

*/

static int stparam ;		/* Size of parameter list in bits */

static int fixparam ;		/* Next available place for param */

static int rscope_level = 0 ;

static bool nonevis = 1 ;

static bool specialext ;	/* for PIC_code, special globals require proc_uses_external */

static int callerfortr ;

int maxfix, maxfloat ;		/* The maximum numbers of t-regs */

static bool gen_call;   /* true if the scan is within a general proc */

static bool v_proc;     /* true if the scan is within a general proc with vcallees */

#ifdef GENCOMPAT

static bool trad_proc;	/* true if the scan is within a proc with no callees */

#endif

/*

  THE TYPE DESCRIBING REGISTER NEEDS

  The type needs is defined in proctypes.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 proctypes.h).

*/

/*

  FIND A POINTER TO EXPRESSION POINTING TO e

*/

exp *ptr_position 

    PROTO_N ( ( e ) )

    PROTO_T ( exp e ){

  exp *res ;

  exp dad = father ( e ) ;

  exp sib = son ( dad ) ;

  if ( sib == e ) {

    res = &son ( dad ) ;

  } 

  else {

    while ( bro ( sib ) != e ) {

      sib = bro ( sib ) ;

    }	

    res = &bro ( sib ) ;

  }

  return ( res ) ;

}

/*

  INSERT A NEW DECLARATION

  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 

    PROTO_N ( ( to, x ) )

    PROTO_T ( exp ** to X exp * x ){

#ifndef NEWDIAGS

  if (name((**to))==diagnose_tag){

    *to = &(son((**to)));  

  }

#endif

  if ( x == ( *to ) ) {

    /* replace by Let tg = def In tg Ni */

    exp def = *x ;

    exp id = getexp ( sh ( def ), bro ( def ), ( int ) last ( def ),

		      def, nilexp, 0, 1, ident_tag ) ;

    exp tg = getexp ( sh ( def ), id, 1, id, nilexp, 0, 0, name_tag ) ;

    /* use of tag */

    pt ( id ) = tg ;

    /* bro ( def ) is body of Let = tg */

    bro ( def ) = tg ;

    clearlast ( def ) ;

    /* replace pointer to x by Let */

    *x = id ;

#ifdef NEWDIAGS

    if (diagnose) {

      dgf(id) = dgf(bro(son(id)));

      dgf(bro(son(id))) = nildiag;

    }

#endif

    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 ), ( int ) last ( ato ),

		      def, nilexp, 0, 1, ident_tag ) ;

    exp tg = getexp ( sh ( def ), bro ( def ), ( int ) last ( def ),

		      id, nilexp, 0, 0, name_tag ) ;

    /* use of tg */

    pt ( id ) = tg ;

    /* ato is body of Let */

    bro ( def ) = ato ;

    clearlast ( def ) ;

    /* its father is Let */

    bro ( ato ) = id ;

    setlast ( ato ) ;

    /* replace pointer to 'to' by Let */

    *( *to ) = id ;

    /* replace use of x by tg */

    *x = tg ;

    /* later replacement to same 'to' will be at body of Let */

    *to = &bro ( def ) ;

#ifdef NEWDIAGS

    if (diagnose) {

      dgf(id) = dgf(bro(son(id)));

      dgf(bro(son(id))) = nildiag;

    }

#endif

  }

  return ;

}

/*

  BASIC REGISTER NEEDS

  This represent the requirements, one fixed point register, 

  two fixed point registers, one floating point register and 

  no registers respectively.

*/

needs onefix = { 1, 0, 0, 0 } ;

needs twofix = { 2, 0, 0, 0 } ;

needs onefloat = { 0, 1, 0, 0 } ;

needs zeroneeds = { 0, 0, 0, 0 } ;

#if 0

/*

  CHECK IF ANY USES OF id ARE AS AN INITIALISER FOR A DECLARATION

*/

bool subvar_use 

    PROTO_N ( ( uses ) )

    PROTO_T ( exp uses )

{

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

}

#endif

/*

  WORK OUT REGISTER NEEDS FOR A GIVEN SHAPE

*/

needs shapeneeds 

    PROTO_N ( ( s ) )

    PROTO_T ( 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, needs two fixed

	 regs for moving */

      return ( twofix ) ;

    }

  }

  /* NOT REACHED */

}

/*

  Transform a non-bit offset into a bit offset.

  (borrowed from trans386)

*/

static void make_bitfield_offset 

    PROTO_N ( ( e, pe, spe, sha ) )

    PROTO_T ( exp e X exp pe X int spe X shape sha ){

  exp omul;

  exp val8;

  if (name(e) == val_tag){

    no(e) *= 8;

    return;

  }

  omul = getexp (sha, bro(e), (int)(last (e)), e, nilexp, 0, 0, offset_mult_tag);

  val8 = getexp (slongsh, omul, 1, nilexp, nilexp, 0, 8, val_tag);

  clearlast(e);

  setbro(e, val8);

  if(spe) {

    son(pe) = omul;

  }

  else{

    bro(pe) = omul;

  }

  return;

}

/*

  IS AN EXPRESSSION COMPLEX?

  An expression is complex if, basically, it cannot be accessed by a

  simple load or store instruction.

*/

bool complex 

    PROTO_N ( ( e ) )

    PROTO_T ( exp e ){

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

  }

  /* NOT REACHED */

}

int scan_cond 

    PROTO_N ( ( e, outer_id ) )

    PROTO_T ( exp* e X 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[(int)test_number(l)]);

      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;

}

/*

  WORK OUT REGISTER NEEDS FOR PLUS-LIKE OPERATIONS

  The operation will be n-ary, commutative and associative.

*/

needs likeplus 

    PROTO_N ( ( e, at ) )

    PROTO_T ( exp * e X exp ** at ){

  needs a1 ;

  needs a2 ;

  prop pc ;

  exp *br = &son ( *e ) ;

  exp dad = *e ;

  exp prev ;

  bool commuted = 0 ;

  /* scan the first operand - won't be a val_tag */

  a1 = scan ( br, at ) ;

  /* likeplus exp with 1 operand should never occur */

  assert ( !( last ( *br ) ) ) ;

  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_OF ( a1.floatneeds, a2.floatneeds ) ;

      pc = ( prop ) ( a2.prps & hasproccall ) ;

      if ( a2.fixneeds < maxfix && pc == 0 ) {

	/*... its evaluation will not disturb the accumulated result */

	a1.fixneeds = MAX_OF ( a1.fixneeds, a2.fixneeds + 1 ) ;

	a1.prps = ( prop ) ( a1.prps | a2.prps ) ;

      } 

      else if ( a1.fixneeds < maxfix &&

		pntst ( a1, hasproccall ) == 0 &&

		!commuted ) {

	/* ...its evaluation will call a proc, so put it first */

	exp op1 = son ( dad ) ;

	exp cop = *br ;

	bool lcop = ( bool ) 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_OF ( a2.fixneeds, a1.fixneeds + 1 ) ;

	pnset ( a1, a2.prps ) ;

	a1.maxargs = MAX_OF ( a1.maxargs, a2.maxargs ) ;

      } 

      else {

	/* evaluation would disturb accumulated result, so replace

	   it by a newly declared tag */

	cca ( at, br ) ;

	a1.fixneeds = MAX_OF ( a1.fixneeds, 2 ) ;

	pnset ( a1, morefix | ( pc << 1 ) ) ;

	a1.maxargs = MAX_OF ( a1.maxargs, a2.maxargs ) ;

      }

    } else {

      /* nothing */

    }

  } while ( !last ( *br ) ) ;

#if 1

  /* exception handling regs (from mips) */

  if ( !optop ( *e ) ) {

    if ( a1.fixneeds < 4 ) a1.fixneeds = 4 ;

  }

#endif

  return ( a1 ) ;

}

/*

  WORK OUT REGISTER NEEDS FOR DIVIDE-LIKE OPERATIONS

  The operation will be binary and non-commutative.

*/

needs likediv 

    PROTO_N ( ( e, at ) )

    PROTO_T ( exp * e X exp ** at ){

  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_OF ( l.floatneeds, r.floatneeds ) ;

  pc = ( prop ) ( r.prps & hasproccall ) ;

  if ( r.fixneeds < maxfix && pc == 0 ) {

    /* fits into registers */

    l.fixneeds = MAX_OF ( l.fixneeds, r.fixneeds + 1 ) ;

    pnset ( l, r.prps ) ;

  } 

  else {

    /* requires new declaration of second operand */

    cca ( at, arg ) ;

    l.fixneeds = MAX_OF ( l.fixneeds, 1 ) ;

    pnset ( l, morefix | ( pc << 1 ) ) ;

    l.maxargs = MAX_OF ( l.maxargs, r.maxargs ) ;

  }

#if 1

  /* exception handling regs (from mips) */

  if ( !optop ( *e ) ) {

    if ( l.fixneeds < 4 ) l.fixneeds = 4 ;

  }

#endif

  return ( l ) ;

}

/*

  WORK OUT REGISTER NEEDS FOR FLOATING-POINT OPERATIONS

  The operation will be binary.

*/

needs fpop 

    PROTO_N ( ( e, at ) )

    PROTO_T ( exp * e X exp ** at ){

  needs l ;

  needs r ;

  exp op = *e ;

  prop pcr, pcl ;

  exp *arg = &son ( op ) ;

  l = scan ( arg, at ) ;

  arg = &bro ( *arg ) ;

  r = scan ( arg, at ) ;

  l.fixneeds = MAX_OF ( l.fixneeds, r.fixneeds ) ;

  pcr = ( prop ) ( r.prps & hasproccall ) ;

  pcl = ( prop ) ( l.prps & hasproccall ) ;

#if use_long_double

  if ( name ( sh ( son ( op ) ) ) == doublehd ) {

    ClearRev ( op ) ;

    arg = &son ( op ) ;

    if ( !is_o ( name ( *arg ) ) || pcl ) cca ( at, arg ) ;

    arg = &bro ( son ( op ) ) ;

    if ( !is_o ( name ( *arg ) ) || pcr ) cca ( at, arg ) ;

    l.floatneeds = MAX_OF ( l.floatneeds, r.floatneeds ) ;

    l.maxargs = MAX_OF ( l.maxargs, r.maxargs ) ;

    pnset ( l, hasproccall ) ;

    return ( l ) ;

  }

#endif

  if ( r.floatneeds <= l.floatneeds &&

       r.floatneeds < maxfloat && pcr == 0 ) {

    l.floatneeds = MAX_OF ( l.floatneeds, r.floatneeds + 1 ) ;

    l.floatneeds = MAX_OF ( 2, l.floatneeds ) ;

    pnset ( l, r.prps ) ;

    ClearRev ( op ) ;

  } 

  else if ( pcl == 0 && l.floatneeds <= r.floatneeds &&

	    l.floatneeds < maxfloat ) {

    l.floatneeds = MAX_OF ( r.floatneeds, l.floatneeds + 1 ) ;

    l.floatneeds = MAX_OF ( 2, l.floatneeds ) ;

    pnset ( l, r.prps ) ;

    SetRev ( op ) ;

  } 

  else if ( r.floatneeds < maxfloat && pcr == 0 ) {

    l.floatneeds = MAX_OF ( l.floatneeds, r.floatneeds + 1 ) ;

    l.floatneeds = MAX_OF ( 2, l.floatneeds ) ;

    pnset ( l, r.prps ) ;

    ClearRev ( op ) ;

  } 

  else {

    cca ( at, arg ) ;

    ClearRev ( op ) ;

    l.floatneeds = MAX_OF ( l.floatneeds, 2 ) ;

    pnset ( l, morefloat | ( pcr << 1 ) ) ;

    l.maxargs = MAX_OF ( l.maxargs, r.maxargs ) ;

  }

  return ( l ) ;

}