Subversion Repositories tendra.SVN

/*

 * Copyright (c) 2002-2005 The TenDRA Project <http://www.tendra.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,

 *    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.

 * 3. Neither the name of The TenDRA Project nor the names of its contributors

 *    may be used to endorse or promote products derived from this software

 *    without specific, prior written permission.

 *

 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``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 COPYRIGHT HOLDERS OR

 * CONTRIBUTORS 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.

 *

 * $Id$

 */

/*

    Copyright (c) 1993 Open Software Foundation, Inc.

    All Rights Reserved

    Permission to use, copy, modify, and distribute this software

    and its documentation for any purpose and without fee is hereby

    granted, provided that the above copyright notice appears in all

    copies and that both the copyright notice and this permission

    notice appear in supporting documentation.

    OSF DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING

    ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A

    PARTICULAR PURPOSE.

    IN NO EVENT SHALL OSF BE LIABLE FOR ANY SPECIAL, INDIRECT, OR

    CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM

    LOSS OF USE, DATA OR PROFITS, WHETHER IN ACTION OF CONTRACT,

    NEGLIGENCE, OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION

    WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.

*/

/*

    		 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.

*/

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

$Author: release $

$Date: 1998/02/04 15:48:56 $

$Revision: 1.2 $

$Log: makecode.c,v $

 * Revision 1.2  1998/02/04  15:48:56  release

 * Added OSF copyright message.

 *

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

 * First version to be checked into rolling release.

 *

 * Revision 1.5  1996/11/18  15:50:18  pwe

 * correct alias with bitfields, and case odds

 *

 * Revision 1.4  1996/10/15  15:59:19  pwe

 * local_alloc_check with unused result

 *

 * Revision 1.3  1996/10/14  17:31:51  pwe

 * include called callees in env_size

 *

 * Revision 1.2  1996/10/04  16:02:16  pwe

 * add banners and mod for PWE ownership

 *

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

#include "config.h"

#include "memtdf.h"

#include "codegen.h"

#include "geninst.h"

#include "myassert.h"

#include "maxminmacs.h"

#include "comment.h"

#include "muldvrem.h"

#include "proc.h"

#include "flags.h"

#include "translat.h"

#include "eval.h"

#include "makecode.h"

#include "frames.h"

#include "stack.h"

#include "label_ops.h"

#include "instruct.h"

#include "installglob.h"

#include "externs.h"

#include "tempdecs.h"

#include "diag_fns.h"

#include "oprators.h"

#include "record_bit.h"

#include "mask.h"

#include "error.h"

#include "f64.h"

#ifdef DEBUG_POWERTRANS

#include "pp.h"

#endif

bool cr0_set;

where nowhere;	/* no particular destination, init in translat.c */

/* Function declarations */

void move_dlts PROTO_S ((int,int,int,int));/* Used by movecont_tag */

void move_dgts PROTO_S ((int,int,int,int));/* Used by movecont_tag */

int regfrmdest(where *,space);

freg fregfrmdest(bool,where *,space);

static int get_next_mlv_number(void);

void adjust_to_size(int,int,int,int,int);

/* branch table, branch code to instruction */

static Instruction_P branch_tab[] ={

  &INSTRUCTION_I_NIL,  /* not used */

  &INSTRUCTION_i_ble,  /* 1 */

  &INSTRUCTION_i_blt,  /* 2 */

  &INSTRUCTION_i_bge,  /* 3 */

  &INSTRUCTION_i_bgt,  /* 4 */

  &INSTRUCTION_i_bne,  /* 5 */

  &INSTRUCTION_i_beq   /* 6 */

};

#define branches(i)	(branch_tab[i])

						    /*  1  2  3  4  5  6 */

/* used to invert TDF tests */			    /* le lt ge gt ne eq */

prop notbranch[] =

{

  0,				/* NOT USED */

  4,				/* opposite of le is gt */

  3,				/* opposite of lt is ge */

  2,				/* opposite of ge is lt */

  1,				/* opposite of gt is le */

  6,				/* opposite of ne is eq */

  5				/* opposite of eq is ne */

};

						    /*  1  2  3  4  5  6 */

/* used to change TDF test when args commuted */    /* le lt ge gt ne eq */

prop combranch[] =

{

  0,				/* NOT USED */

  3,				/* reverse of le is ge */

  4,				/* reverse of lt is gt */

  1,				/* reverse of ge is le */

  2,				/* reverse of gt is lt */

  5,				/* reverse of ne is ne */

  6				/* reverse of eq is eq */

};

static void testsigned(int r, long lower, long upper, long lab)

{

  int creg1=next_creg();

  int creg2=next_creg();

  cmp_ri_ins(i_cmp,r,lower,creg1);

  bc_ins(i_blt,creg1,lab,UNLIKELY_TO_JUMP);

  cmp_ri_ins(i_cmp,r,upper,creg2);

  bc_ins(i_bgt,creg2,lab,UNLIKELY_TO_JUMP);

  return;

}

static void testusigned(int r, long maxval, long lab)

{

  int creg=next_creg();

  cmp_ri_ins(i_cmpl,r,maxval,creg);

  bc_ins(i_bgt,creg,lab,UNLIKELY_TO_JUMP);

  return;

}

/* find the last test in sequence e which is a branch to second, if any, otherwise nil */

static exp testlast(exp e, exp second)

{

  if (name(e) == test_tag && pt(e) == second)

  {

    return(e);

  }

  if (name(e) == seq_tag)

  {

    if (name(bro(son(e))) == test_tag && pt(bro(son(e))) == second)

    {

      /* is the last one of the sequence a test_tag pointing to second */

      return bro(son(e));

    }

    else if (name(bro(son(e))) == top_tag)

    {

      exp list = son(son(e));

      /* find the penultimate exp of the seq_tag */

      for (;;)

      {

	if (last(list))

	{

	  if (name(list) == test_tag && pt(list) == second)

	  {

	    return list;

	  }

	  else

	  {

	    return 0;

	  }

	}

	else

	{

	  list = bro(list);

	}

      }

    }

  }

  return 0;

}

/* Does e, or components of e contain a bitfield? */

/* +++ should detect this earlier and record in props(e) once-and-for-all */

static int has_bitfield(exp e)

{

  if (e == nilexp)

    return 0;

  switch (name(e))

  {

  case compound_tag:

    {

      /*

       * (compound_tag <offset> <initialiser> ... )

       */

      /* look at alignment of initialisers */

      e = bro(son(e));

      while (1)

      {

	if (has_bitfield(e))

	  return 1;		/* found bitfield */

	if (last(e))

	  return 0;		/* all done, no bitfield */

	e = bro(bro(e));	/* try next initialiser */

      }

      /*NOTREACHED*/

  default:

      {

	shape s = sh(e);

	FULLCOMMENT4("has_bitfield: compound field sz=%d als=%d,%d,%d",

		shape_size(s), shape_align(s), al1(s), al2(s));

	return shape_size(s)!= 0 && (shape_align(s) == 1 || al1(s) == 1 || al2(s) == 1);

      }

    }

  }

  /*NOTREACHED*/

}

/* Convert all NON-bitfields from byte-offsets back to bit-offsets, so

 * the compound can be output correctly by eval().

 * Permanently undoes the needscan.c:scan() case val_tag:.

 *

 * NB must do this EXACTLY ONCE.

 */

static void fix_nonbitfield(exp e)

{

  if (name(e) == compound_tag)

  {

    e = son(e);

    while (1)

    {

      if (name(e) == val_tag && name(sh(e)) == offsethd && al2(sh(e)) >= 8)

	  no(e) = no(e) << 3;	/* fix it */

      fix_nonbitfield(bro(e));	/* recursively fix the rest of the struct */

      if (last(bro(e)))

	  return;		/* all done */

      e = bro(bro(e));		/* next offset */

    }

  }

  /*NOTREACHED*/

}

/*

 * Some functions to build and maintain a queue of conditional branch

 * instuctions, so the generation of these instructions can be delayed.

 * This is so the compare instruction will not immediately follow

 * compare, thus reducing RS/6000 compare..branch delays.

 * No side effecting instructions should be emitted while

 * branches are queued.  Currently only used with case_tag.

 */

/* params of bc_ins() */

typedef struct

{

  Instruction_P branch;

  int	creg;

  int	lab;

} bc_info;

#define	NQUEUE			3	/* any number < nmumber

					 * next_creg() manages (0,1,6,7) */

#if !do_case_transforms

static bc_info bqueue[NQUEUE];

static int bqueuepos;		/* next free slot in queue */

static void clear_branch_queue(void)

{

  int i;

  bqueuepos = 0;

  for (i = 0; i < NQUEUE; i++)

  {

    bqueue[i].branch = I_NIL;

    bqueue[i].creg = -1;

  }

}

static void issue_bc_ins(int i)

{

  ASSERT(i >= 0 && i < NQUEUE);

  bc_ins(bqueue[i].branch, bqueue[i].creg, bqueue[i].lab,LIKELY_TO_JUMP);

}

static void queue_bc_ins(Instruction_P ins, int creg, int lab)

{

  int i;

  COMMENT2("queue_bc_ins(%s,%d,lab)",(int)ins, creg);

#ifdef DO_ASSERT

  /* check there is not a queued instruction using same creg (now corrupted) */

  for (i = 0; i < NQUEUE; i++)

    ASSERT(bqueue[i].creg != creg);

#endif

  i = bqueuepos;

  ASSERT(i >= 0 && i < NQUEUE);

  /* if queue full, clear one entry */

  if (bqueue[i].branch != I_NIL)

    issue_bc_ins(i);

  bqueue[i].branch = ins;

  bqueue[i].creg = creg;

  bqueue[i].lab = lab;

  bqueuepos++;

  if (bqueuepos == NQUEUE)

    bqueuepos = 0;		/* roll around to zero */

}

static void flush_branch_queue(void)

{

  int i;

  i = bqueuepos;

  do

  {

    if (bqueue[i].branch != I_NIL)

      issue_bc_ins(i);

    i++;

    if (i == NQUEUE)

      i = 0;			/* roll around to zero */

  } while (i != bqueuepos);

  clear_branch_queue();

}

#endif

#if do_case_transforms

static void case_tag_code(int caseint_reg, exp e, space sp)

{

  long u;

  long l;

  long n;

  exp z=bro(son(e));

  exp zt=z;

  int endlab = new_label();	/* +++ often another jump at endlab */

  int veclab = next_data_lab();

  char *veclabname;

  baseoff zeroveclab;

  int mr = getreg(sp.fixed);	/* no need to guardreg(caseint_reg) as mr not

				 * used until after lase use of caseint_reg */

  l=no(zt);

  while (bro(zt)!=nilexp)

  {

    zt=bro(zt);

  }

  u = (son(zt) ==nilexp)? no(zt): no(son(zt));

  zeroveclab.offset = 0;

  zeroveclab.base = veclab;

  if (l >= 0 && l <= 4)

  {

    /* between 0 and 4 dummy table entries used to avoid subtract */

    rir_ins(i_sl, caseint_reg, 2, mr);

    n = 0;

  }

  else

  {

    /* subtract to index jump vector */

    rir_ins(i_a, caseint_reg,-l, mr);

    rir_ins(i_sl, mr, 2, mr);

    n = l;

  }

  /* delayed branch */

  set_ins(zeroveclab, R_TMP0);

  ld_rr_ins(i_l, mr, R_TMP0, mr);

  rrr_ins(i_a, mr, R_TMP0, mr);

  mt_ins(i_mtctr, mr);

  z_ins(i_bctr);

  /* .toc entry for veclab */

  fprintf(as_file, "\t.toc\n");

  veclabname = ext_name(veclab);

  fprintf(as_file, "T.%s:\t.tc\t%s[TC],%s\n", veclabname, veclabname, veclabname);

  fprintf(as_file, "\t.csect\t[PR]\n");

  /* build the jump vector, can be to .text or .data */

  fprintf(as_file, "%s:\n", veclabname);

  for (;;)

  {

    for (; no(z)!= n; n++)

    {

      fprintf(as_file, "\t.long\tL.%d-%s\n", endlab, veclabname);

    }

    u = (son(z) == nilexp)? n : no(son(z));

    for (; u+1 != n; n++)	/* comparison independent of sign */

    {

	fprintf(as_file, "\t.long\tL.%d-%s\n", no(son(pt(z))), veclabname);

      }

    if (last(z))

    {

      break;

    }

    z = bro(z);

  }

  set_label(endlab);

  return;

}

#else

static void case_tag_code(int caseint_reg, exp e, space sp)

{

  mm lims;

  exp z = bro(son(e));

  exp zt = z;

  long n;

  long l;

  long u = 0x80000000;

  unsigned long approx_range;	/* max(u-l, 0x7fffffff) avoiding overflow */

  bool use_jump_vector;

  ASSERT(name(e) == case_tag);

  /* calculate crude criterion for using jump vector or branches */

  l = no(zt);

  for (n = 1;; n++)

  {

    if (u + 1 != no(zt) && son(zt)!= nilexp)

    {

      n++;

    }

    if (last(zt))

    {

      u = (son(zt)!= nilexp)? no(son(zt)): no(zt);

      break;

    }

    if (son(zt)!= nilexp)

    {

      u = no(son(zt));

    }

    else

    {

      if (u + 1 == no(zt))

	u += 1;

    }

    zt = bro(zt);

  }

  /* now l is lowest controlling value, u is highest and n is number of cases */

  if (u - l < 0)

    approx_range = 0x7fffffff;	/* u-l overflowed into -ve, use huge */

  else

    approx_range = (unsigned long)(u - l);

  if (approx_range < 16)

  {

    /* small jump vector needed, decide on instuctions executed only */

#define	MTCR_B_DELAY		4	/* fixed point mtctr..bctr delay */

#define	BR_TAKEN_DELAY		3	/* fixed point branch taken delay */

    unsigned jump_vector_cnt = ((l >= 0 && l <= 4)? 8 + MTCR_B_DELAY : 9 + MTCR_B_DELAY);

    unsigned cmp_jmp_step_cnt = 2 + (!IMM_SIZE(l)) + (!IMM_SIZE(u));

    /* cmp & jmp, delay slot filled plus possibly load of large consts */

    /* +++ assume default used as often as case, is this good ??? */

    unsigned default_weight = 1;/* likelyhood of default against single case */

    unsigned total_case_test_chain_cnt =

	((((n + 1)* cmp_jmp_step_cnt)* n) / 2) + BR_TAKEN_DELAY;

    unsigned default_test_chain_cnt =

	(n * cmp_jmp_step_cnt);

    unsigned average_test_chain_cnt =

	(total_case_test_chain_cnt + (default_test_chain_cnt * default_weight)) / (n + default_weight);

    use_jump_vector = jump_vector_cnt <= average_test_chain_cnt;

    FULLCOMMENT2("case_tag small jump vector: jump_vector_cnt=%d average_test_chain_cnt=%d",

		 jump_vector_cnt, average_test_chain_cnt);

  }

  else

  {

    /*

     * space-time product criterion for jump vector instead of tests and

     * branches

     */

    unsigned long range_factor = approx_range + 9;

    unsigned long n_factor = ((unsigned long)n * n) / 2;

    use_jump_vector = range_factor <= n_factor;

  }

  COMMENT4("case_tag: n=%d l,u=%d,%d approx_range=%d", n, l, u, approx_range);

  if (is_signed(sh(son(e)))) {

    ASSERT(l <= u);

  } else {

    ASSERT((unsigned long)l <= (unsigned long)u);

  }

  ASSERT(n >= 0);

  if (use_jump_vector)

  {

    /* use jump vector */

    int endlab = new_label();	/* +++ often another jump at endlab */

    int veclab = next_data_lab();

    char *veclabname;

    baseoff zeroveclab;

    int creg = next_creg();

    int mr = getreg(sp.fixed);	/* no need to guardreg(caseint_reg) as mr not

				 * used until after lase use of caseint_reg */

    zeroveclab.offset = 0;

    zeroveclab.base = veclab;

    if (l >= 0 && l <= 4)

    {

      /* between 0 and 4 dummy table entries used to avoid subtract */

      cmp_ri_ins(i_cmpl, caseint_reg, u + 1, creg);

      /* branch later, to reduce compare..barnch delay */

      rir_ins(i_sl, caseint_reg, 2, mr);

      n = 0;

    }

    else

    {

      /* subtract to index jump vector */

      rir_ins(i_a, caseint_reg,-l, mr);

      cmp_ri_ins(i_cmpl, mr, u - l + 1, creg);

      /* branch later, to reduce compare..branch taken delay */

      rir_ins(i_sl, mr, 2, mr);

      n = l;

    }

    /* delayed branch */

    bc_ins(i_bge, creg, endlab,UNLIKELY_TO_JUMP);

    set_ins(zeroveclab, R_TMP0);

    ld_rr_ins(i_l, mr, R_TMP0, mr);

    rrr_ins(i_a, mr, R_TMP0, mr);

    mt_ins(i_mtctr, mr);

    z_ins(i_bctr);

    /* .toc entry for veclab */

    fprintf(as_file, "\t.toc\n");

    veclabname = ext_name(veclab);

    fprintf(as_file, "T.%s:\t.tc\t%s[TC],%s\n", veclabname, veclabname, veclabname);

    fprintf(as_file, "\t.csect\t[PR]\n");

    /* build the jump vector, can be to .text or .data */

    fprintf(as_file, "%s:\n", veclabname);

    for (;;)

    {

      for (; no(z)!= n; n++)

      {

	fprintf(as_file, "\t.long\tL.%d-%s\n", endlab, veclabname);

      }

      u = (son(z) == nilexp)? n : no(son(z));

      for (; u+1 != n; n++)

      {

	fprintf(as_file, "\t.long\tL.%d-%s\n", no(son(pt(z))), veclabname);

      }

      if (last(z))

	break;

      z = bro(z);

    }

    set_label(endlab);

    return;

  }

  else

  if (is_signed(sh(son(e)))) {

    /* use branches - tests are ordered */

    int endlab = 0;

    lims = maxmin(sh(son(e)));

    clear_branch_queue();

    for (;;)

    {

      int lab = no(son(pt(z)));

      int creg = next_creg();

      long l = no(z);

      if (son(z) == nilexp)

      {

	/* only single test required */

	cmp_ri_ins(i_cmp, caseint_reg, l, creg);

	queue_bc_ins(i_beq, creg, lab);

	if (l == lims.maxi)

	  lims.maxi -= 1;

	else if (l == lims.mini)

	  lims.mini += 1;

      }

      else if (u = no(son(z)), l > lims.mini)

      {

	if (u >= lims.maxi)

	{

	  /* have already tested lower */

	  cmp_ri_ins(i_cmp, caseint_reg, l, creg);

	  queue_bc_ins(i_bge, creg, lab);

	  lims.maxi = l - 1;

	}

	else

	{

	  int creg2;

	  if (endlab == 0)

	    endlab = new_label();

	  cmp_ri_ins(i_cmp, caseint_reg, l, creg);

	  queue_bc_ins(i_blt, creg, endlab);

	  /*

	   * Note, must queue first bc_ins before second cmp_ins,

	   * which may use a creg already in the queue.

	   */

	  creg2 = next_creg();

	  cmp_ri_ins(i_cmp, caseint_reg, u, creg2);

	  queue_bc_ins(i_ble, creg2, lab);

	  lims.mini = u + 1;

	}

      }

      else if (u < lims.maxi)

      {

	/* lower is <= lower limit of shape */

	cmp_ri_ins(i_cmp, caseint_reg, u, creg);

	queue_bc_ins(i_ble, creg, lab);

	lims.mini = u + 1;

      }

      else

      {

	/* upper is >= upper limit of shape */

	flush_branch_queue();

	uncond_ins(i_b, lab);

      }

      if (last(z))

      {

	flush_branch_queue();

	if (endlab != 0)

	{

	  set_label(endlab);

	}

	return;

      }

      z = bro(z);

    }

  }

  else {

    /* unsigned, use branches - tests are ordered */

    int endlab = 0;

    unsigned long maxi;

    unsigned long mini;

    lims = maxmin(sh(son(e)));

    maxi = (unsigned)lims.maxi;

    mini = (unsigned)lims.mini;

    clear_branch_queue();

    for (;;)

    {

      int lab = no(son(pt(z)));

      int creg = next_creg();

      unsigned long l = no(z);

      if (son(z) == nilexp)

      {

	/* only single test required */

	cmp_ri_ins(i_cmpl, caseint_reg, l, creg);

	queue_bc_ins(i_beq, creg, lab);

	if (l == maxi)

	  maxi -= 1;

	else if (l == mini)

	  mini += 1;

      }

      else if (u = no(son(z)), l > mini)

      {

	if (u >= maxi)

	{

	  /* have already tested lower */

	  cmp_ri_ins(i_cmpl, caseint_reg, l, creg);

	  queue_bc_ins(i_bge, creg, lab);

	  maxi = l - 1;

	}

	else

	{

	  int creg2;

	  if (endlab == 0)

	    endlab = new_label();

	  cmp_ri_ins(i_cmpl, caseint_reg, l, creg);

	  queue_bc_ins(i_blt, creg, endlab);

	  /*

	   * Note, must queue first bc_ins before second cmp_ins,

	   * which may use a creg already in the queue.

	   */

	  creg2 = next_creg();

	  cmp_ri_ins(i_cmpl, caseint_reg, u, creg2);

	  queue_bc_ins(i_ble, creg2, lab);

	  mini = u + 1;

	}

      }

      else if (u < maxi)

      {

	/* lower is <= lower limit of shape */

	cmp_ri_ins(i_cmpl, caseint_reg, u, creg);

	queue_bc_ins(i_ble, creg, lab);

	mini = u + 1;

      }

      else

      {

	/* upper is >= upper limit of shape */

	flush_branch_queue();

	uncond_ins(i_b, lab);

      }

      if (last(z))

      {

	flush_branch_queue();

	if (endlab != 0)

	{

	  set_label(endlab);

	}

	return;

      }

      z = bro(z);

    }

  }

}

#endif

/*

 * Evaluate and generate the compare instruction for a test_tag,

 * and return a bcinfo describing the conditional branch required.

 */

static bc_info make_test_tag_cmp(exp e, space sp)

{

  exp l = son(e);

  exp r = bro(l);

  shape shl = sh(l);

  bc_info bcinfo;

  bcinfo.lab = (ptno(e) < 0)? -ptno(e): no(son(pt(e)));

					/* see frig in cond_tag */

  /* generate compare */

  if (is_floating(name(sh(l))))