Logo Search packages:      
Sourcecode: tendra version File versions  Download package

proc.c

/*
             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/proc.c,v 1.2 1998/03/15 16:00:43 pwe Exp $
--------------------------------------------------------------------------
$Log: proc.c,v $
 * Revision 1.2  1998/03/15  16:00:43  pwe
 * regtrack dwarf dagnostics added
 *
 * Revision 1.1.1.1  1998/01/17  15:55:55  release
 * First version to be checked into rolling release.
 *
 * Revision 1.61  1998/01/09  14:59:42  pwe
 * prep restructure
 *
 * Revision 1.60  1997/11/06  09:29:13  pwe
 * ANDF-DE V1.8
 *
 * Revision 1.59  1997/10/28  10:19:05  pwe
 * extra diags
 *
 * Revision 1.58  1997/10/23  09:33:16  pwe
 * prep extra_diags
 *
 * Revision 1.57  1997/10/10  18:32:56  pwe
 * prep ANDF-DE revision
 *
 * Revision 1.56  1997/08/23  13:54:28  pwe
 * initial ANDF-DE
 *
 * Revision 1.55  1997/05/02  11:09:11  pwe
 * dwarf2 re return address offset
 *
 * Revision 1.54  1997/04/24  15:16:31  pwe
 * optim -O0 in tail_call
 *
 * Revision 1.53  1997/04/17  11:59:54  pwe
 * dwarf2 support
 *
 * Revision 1.52  1997/03/26  13:04:45  pwe
 * general proc compatibility
 *
 * Revision 1.51  1997/03/24  17:09:35  pwe
 * reorganise solaris/sunos split
 *
 * Revision 1.50  1997/02/18  11:48:17  pwe
 * NEWDIAGS for debugging optimised code
 *
 * Revision 1.49  1996/09/18  12:03:59  pwe
 * fixed PIC_code
 *
 * Revision 1.48  1996/09/10  14:36:48  pwe
 * fix diags - nested scope, param struct and leaf return
 *
 * Revision 1.47  1996/09/09  12:32:52  pwe
 * protect result during postlude
 *
 * Revision 1.46  1996/09/06  16:50:27  pwe
 * fix outpar doubles for postlude
 *
 * Revision 1.45  1996/09/04  12:41:37  pwe
 * untidy_call must not remove stacked callees
 *
 * Revision 1.44  1996/08/30  17:00:25  pwe
 * ensure space available for struct return
 *
 * Revision 1.43  1996/08/28  16:57:51  pwe
 * postlude with calls and no callers
 *
 * Revision 1.42  1996/08/28  11:47:54  pwe
 * correct postlude with calls
 *
 * Revision 1.41  1996/08/27  14:09:09  pwe
 * ensure all varargs are stored, and ptr is not64bit
 *
 * Revision 1.40  1996/08/22  16:47:10  pwe
 * correct accessing for double params
 *
 * Revision 1.39  1996/06/24  08:46:09  john
 * Removed aggregate initialisation
 *
 * Revision 1.38  1996/06/19  15:39:22  john
 * Fixed register allocation bug
 *
 * Revision 1.37  1996/05/24  10:46:08  john
 * Fixed discarded return for function returning struct/long double
 *
 * Revision 1.36  1996/03/20  15:39:49  john
 * Fix to  double & long double handling
 *
 * Revision 1.35  1996/03/18  09:02:03  john
 * Change to caller move
 *
 * Revision 1.34  1996/02/20  14:16:29  john
 * Fix for caller param lists containing structures.
 *
 * Revision 1.33  1996/01/17  10:29:59  john
 * Fix to stack space usage on tail call
 *
 * Revision 1.32  1996/01/10  17:23:00  john
 * Fix to check_stack
 *
 * Revision 1.31  1996/01/08  11:15:24  john
 * Fix to discarded function return when using out_pars
 *
 * Revision 1.30  1995/12/15  10:26:23  john
 * Changes stack error handling + fixes to postlude for general procs
 *
 * Revision 1.29  1995/11/27  09:22:54  john
 * Fixed register allocation
 *
 * Revision 1.28  1995/11/24  14:51:43  john
 * Fixed bug in register allocation
 *
 * Revision 1.27  1995/11/24  11:41:38  john
 * Fix for postludes
 *
 * Revision 1.26  1995/11/23  12:47:43  john
 * Fix for general procs
 *
 * Revision 1.25  1995/11/17  13:01:08  john
 * Fix to general proc call
 *
 * Revision 1.24  1995/11/16  17:23:43  john
 * Fix to same_callees
 *
 * Revision 1.23  1995/11/16  14:14:00  john
 * Fixed untidy return
 *
 * Revision 1.22  1995/11/16  14:03:28  john
 * Fixed register problems in general procs
 *
 * Revision 1.21  1995/11/07  09:42:09  john
 * Extensive changes to handling of callee parameters in general procs
 *
 * Revision 1.20  1995/11/01  16:13:59  john
 * Changed general proc definition
 *
 * Revision 1.19  1995/10/31  12:48:10  john
 * Change to dynamic callees
 *
 * Revision 1.18  1995/10/27  14:22:54  john
 * change to previous fix
 *
 * Revision 1.17  1995/10/27  10:51:41  john
 * Fix to general procs
 *
 * Revision 1.16  1995/10/25  17:13:18  john
 * Changed stack overflow test to unsigned
 *
 * Revision 1.15  1995/09/29  09:23:09  john
 * Fixed condition for setting Has_no_vcallers
 *
 * Revision 1.14  1995/09/27  13:35:27  john
 * Fix to tail_call
 *
 * Revision 1.13  1995/09/22  15:58:23  john
 * Fix to apply_general_proc
 *
 * Revision 1.12  1995/09/22  13:07:07  john
 * Fix to general procs
 *
 * Revision 1.11  1995/09/15  16:17:02  john
 * New exception handling
 *
 * Revision 1.10  1995/09/04  10:14:22  john
 * Fix to general procs
 *
 * Revision 1.9  1995/08/04  15:46:34  john
 * Fix to general procs
 *
 * Revision 1.8  1995/07/27  16:31:32  john
 * Fixed prototype
 *
 * Revision 1.7  1995/07/18  08:24:34  john
 * Fix to tail calls
 *
 * Revision 1.6  1995/07/14  16:33:23  john
 * Various changes for new spec
 *
 * Revision 1.5  1995/07/04  07:51:45  john
 * *** empty log message ***
 *
 * Revision 1.4  1995/06/30  08:29:35  john
 * Fixed bug in tail_call
 *
 * Revision 1.3  1995/06/14  15:35:44  john
 * Added support for trap error treatment and stack limits.  Also, some
 * reformatting
 *
 * Revision 1.2  1995/05/26  13:00:28  john
 * Changes for new spec (3.1)
 *
 * Revision 1.1.1.1  1995/03/13  10:18:51  john
 * Entered into CVS
 *
 * Revision 1.5  1995/01/17  15:32:24  john
 * Removed structure parameter check.
 *
 * Revision 1.4  1994/12/01  13:07:34  djch
 * with longjmp one can get procs of shape bottom. consider them as returning
 * void
 *
 * Revision 1.3  1994/07/07  16:11:33  djch
 * Jul94 tape
 *
 * Revision 1.2  1994/05/13  13:06:59  djch
 * Incorporates improvements from expt version
 * removed rscope related fns.
 * added RET_IN_CODE, not set -> return at end of leaf, not in middle...
 *
 * Revision 1.1  94/05/03  14:49:48  djch
 * Initial revision
 * 
 * Revision 1.8  94/02/21  16:12:49  16:12:49  ra (Robert Andrews)
 * reg_result now returns int, not bool.
 * 
 * Revision 1.7  93/09/27  14:53:49  14:53:49  ra (Robert Andrews)
 * In System V the __GLOBAL_OFFSET_TABLE_ starts with only one _.
 * 
 * Revision 1.6  93/08/27  11:35:12  11:35:12  ra (Robert Andrews)
 * A number of lint-like changes.
 * 
 * Revision 1.5  93/08/13  14:44:13  14:44:13  ra (Robert Andrews)
 * Reformatted.
 * 
 * Revision 1.4  93/07/14  11:21:26  11:21:26  ra (Robert Andrews)
 * Misprint when reformatting : .reserved should be .reserve.
 * 
 * Revision 1.3  93/07/05  18:23:46  18:23:46  ra (Robert Andrews)
 * Made distinction between the System V assembler and the System V ABI.
 * Added support for PIC (procedure prologue).
 * 
 * Revision 1.2  93/06/29  14:30:40  14:30:40  ra (Robert Andrews)
 * Changed an error message.
 * 
 * Revision 1.1  93/06/24  14:59:01  14:59:01  ra (Robert Andrews)
 * Initial revision
 * 
--------------------------------------------------------------------------
*/

/*
  This file contains functions which handle the various aspects
  of procedure definition and invocation.
*/


#define SPARCTRANS_CODE
#include "config.h"
#include "common_types.h"
#include "myassert.h"
#include "addrtypes.h"
#include "tags.h"
#include "expmacs.h"
#include "installtypes.h"
#include "exp.h"
#include "exptypes.h"
#include "maxminmacs.h"
#include "shapemacs.h"
#include "basicread.h"
#include "proctypes.h"
#include "eval.h"
#include "move.h"
#include "comment.h"
#include "getregs.h"
#include "guard.h"
#include "locate.h"
#include "codehere.h"
#include "inst_fmt.h"
#include "sparcins.h"
#include "bitsmacs.h"
#include "labels.h"
#include "regexps.h"
#include "regmacs.h"
#include "regable.h"
#include "flags.h"
#include "special.h"
#include "translat.h"
#include "makecode.h"
#include "out.h"
#include "proc.h"
#include "szs_als.h"
#include "externs.h"
#include "sparctrans.h"

#ifdef NEWDIAGS
#include "dg_globs.h"
#endif

#ifdef NEWDWARF
#include "dw2_config.h"
#include "dw2_info.h"
#include "dw2_basic.h"
#include "dw2_extra.h"
#endif

/*
  CODE GENERATION STATE FOR THE CURRENT PROCEDURE
*/

static void alloc_space PROTO_S((int,int));
static void alloc_reg_space PROTO_S((int,int));

extern int call_base_reg;


struct proc_state proc_state ;
static exp current_proc;

bool Has_vcallees = 0;
bool Has_no_vcallers = 0;
bool in_general_proc = 0;
#ifdef GENCOMPAT
bool May_have_callees = 0;
#endif


static bool in_postlude = 0;

extern char * proc_name;
int local_reg = R_I5;

int callee_start_reg = R_I5;   /* will point to start of callee params */

int callee_end_reg = R_I4;     /* will point to end of callee params.  Only
                          used for variable or dynamic parameter
                          lists */
int callee_start_reg_out = R_O5;
int callee_end_reg_out = R_O4;


static int vc_call = 0;

int aritherr_lab = 0;

int stackerr_lab = 0;
int local_stackerr_lab = 0;

#define is64(X) ((name(X)==u64hd)||(name(X)==s64hd))


void call_tdf_main 
    PROTO_Z () {
  outs("\tcall\t___TDF_main\n");
  outs("\tnop\n");
  return;
}

  


/*
  FIND TEMPORARY MEMORY
  This is a temporary location in the stack frame callee parameter 
  save area that can be used in short instruction sequences, such 
  as moving between float and fixed registers.  It is initialised 
  in the procedure prelude.
*/

baseoff mem_temp 
    PROTO_N ( ( byte_offset ) )
    PROTO_T ( int byte_offset ){
  baseoff b ;
  b = proc_state.mem_temp0 ;
  /* only 2 words of temp allocated */
  assert ( byte_offset >= 0 && byte_offset < 8 ) ;
  b.offset += byte_offset ;
  return ( b ) ;
}



/*
  Postlude chaining function 
*/
static postlude_chain * old_postludes;

void update_plc 
    PROTO_N ( ( chain, maxargs ) )
    PROTO_T ( postlude_chain* chain X int maxargs ) {

  while(chain) {
    exp pl = chain->postlude;
    while(name(pl) == ident_tag) {
      if (name(son(pl)) == caller_name_tag)
      no(pl) += (maxargs<<1);
      pl = bro(son(pl));
    }
    chain = chain->outer;
  }
  return;
}


/*
  ENCODE A PROCEDURE DEFINITION
*/

makeans make_proc_tag_code 
    PROTO_N ( ( e, sp, dest, exitlab ) )
    PROTO_T ( exp e X space sp X where dest X int exitlab ){
  procrec *pr = &procrecs [ no ( e ) ] ;
  needs *ndpr = &pr->needsproc ;
  spacereq *sppr = &pr->spacereqproc ;
  long pprops = ( long ) ( ndpr->prps ) ;
  bool leaf = ( bool ) ( ( pprops & anyproccall ) == 0 ) ;  /* LINT */
  long maxargs = ndpr->maxargs ;/* maxargs of proc body in bits */
  long st = sppr->stack ;           /* space for locals in bits */
  struct proc_state old_proc_state ;
  makeans mka ;
  exp par ;
  old_postludes = (postlude_chain*)NULL;
  current_proc = e;
  Has_vcallees = (name(e) == general_proc_tag) && (proc_has_vcallees(e));
  Has_no_vcallers = (name(e) == proc_tag) || (!proc_has_vcallers(e));
  in_general_proc = (name(e) == general_proc_tag);
#ifdef GENCOMPAT
  May_have_callees = proc_may_have_callees(e);
#endif
  /* save & reinstate proc_state for nested procs */
  old_proc_state = proc_state ;
  mka.lab = exitlab ;
  mka.regmove = NOREG ;
#ifdef GENCOMPAT
  if (May_have_callees) {
#else
  if(in_general_proc) {
#endif
    sp = guardreg(callee_start_reg,sp);
  }
  
  if(Has_vcallees) {
    sp = guardreg(callee_end_reg,sp);
    outs("\t.optim\t\"-O0\"\n"); /* as -O2 optimises out some moves 
                            from %sp to other registers */
  }
  
  /* this is a procedure definition */
  assert ( name ( e ) == proc_tag || name(e) == general_proc_tag) ;
  
  /* set global flag for res_tag */
  proc_state.leaf_proc = leaf ;

  /* maxargs is the maxargs in bits of any proc called, not this proc */

  /* SPARC reserved stack area */
  if ( leaf ) {
    /* reg window dump area */
    assert ( maxargs == 0 ) ;
    maxargs = ( 16 ) * 32 ;
  } 
  else {
    assert ( maxargs >= 0 ) ;
    /* at least reg param dump for calls */
    if ( maxargs < ( 6 ) * 32 ) maxargs = ( 6 ) * 32 ;
    /* plus reg window dump area + hidden struct return param */
    maxargs += ( 16 + 1 ) * 32 ;
  }
  
  /* use space we are allowing for called procs */
  proc_state.mem_temp0.base = R_SP ;
  proc_state.mem_temp0.offset = ( 16 + 1 + 1 ) * 4 ;

  /* double word aligned */
  assert ( ( proc_state.mem_temp0.offset & 7 ) == 0 ) ;
  
  /* make sure mem_temp () is allowed for */
  if ( proc_state.mem_temp0.base == R_SP &&
       maxargs < ( ( proc_state.mem_temp0.offset + 8 ) << 3 ) ) {
    /* ie, a leaf proc */
    assert ( leaf ) ;
    maxargs = ( proc_state.mem_temp0.offset + 8 ) << 3 ;
    }
  
  /* align to 64 bit boundaries */
  maxargs = ( maxargs + 63 ) & ~63 ;
  st = ( st + 63 ) & ~63 ;
  /* -----------------------WARNING--------------------------- */
  /* if you alter these then please check boff_env_offset, 'cos 
     they're effectively reproduced there..... */
  proc_state.locals_space = st ;
  proc_state.locals_offset = 0 ;
  /*proc_state.params_offset = ( 16 + 1 ) * 32 ;*/
  proc_state.params_offset = PARAMS_OFFSET;
  proc_state.callee_size = ndpr->callee_size;
  /* beyond register window save area and hidden param of 
     caller's frame */
  
  proc_state.frame_size = maxargs + st ;
  proc_state.maxargs = maxargs ;
  
  st = proc_state.frame_size >> 3 ;

#ifdef NEWDWARF
  if (dwarf2) {
    START_BB ();
    dw2_start_fde(current_proc);
  }
#endif

  if(name(e) == general_proc_tag){
    if(proc_has_checkstack(e) && (st > 64)) {
      rir_ins(i_save,R_SP,-64,R_SP);
    }
    else {
      rir_ins(i_save,R_SP,-st,R_SP);
    }
#ifdef NEWDWARF
    if (dwarf2)
      dw2_fde_save();
#endif
#ifdef GENCOMPAT
    if (May_have_callees)
#endif
    {
      int entry_lab = new_label();
      uncond_ins(i_b,entry_lab);
      /*rir_ins(i_save,R_SP,0,R_SP);*/

      if(st>64) {
      rir_ins(i_sub,R_SP, st - 64,R_SP);
      }
      set_label(entry_lab);
    }
  }
  else{
    rir_ins ( i_save, R_SP, -st, R_SP ) ;
#ifdef NEWDWARF
    if (dwarf2)
      dw2_fde_save();
#endif
    /* more here about fp */
  }
  
  /* position independent code */
  if ( PIC_code && proc_uses_external ( e ) ) {
    char *g = "__GLOBAL_OFFSET_TABLE_" ;
    if ( sysV_assembler ) g++ ;
    outs ( "1:\n" ) ;
    outs ( "\tcall\t2f\n" ) ;
    outf ( "\tsethi\t%%hi(%s+(.-1b)),%%l7\n", g ) ;
    outs ( "2:\n" ) ;
    outf ( "\tor\t%%l7,%%lo(%s+(.-1b)),%%l7\n", g ) ;
    outs ( "\tadd\t%l7,%o7,%l7\n" ) ;
#ifdef NEWDWARF
    if (dwarf2)
      lost_count_ins();
#endif
  }

  local_stackerr_lab = 0;
  stackerr_lab = 0;
  if(name(e) == general_proc_tag){
    if(proc_has_checkstack(e)){
      baseoff b;
      int rtmp;
      int rt;
      if (st > 64) {
      rt = getreg(sp.fixed);
      rir_ins(i_sub,R_SP,(st - 64),rt);
      }
      else {
      rt = R_SP;
      }
      b = find_tag(TDF_STACKLIM);
      stackerr_lab = new_label();
      rtmp = getreg(guardreg(rt,sp).fixed);
      ld_ins(i_ld,b,rtmp);
      condrr_ins(i_bgtu,rtmp,R_SP,stackerr_lab);
      if(rt != R_SP) {
      rr_ins(i_mov,rt,R_SP);
      }
    }

    /* Here we make a local copy of the callees */
    if(Has_vcallees) {
      baseoff b;
      int copy_lab = new_label();
      int end_copy_lab = new_label();
      /* copy callees to new space (pointed to by reg rdest) */
      int rsize = getreg(sp.fixed);
      int rdest = getreg(guardreg(rsize,sp).fixed);
      int rt = getreg(guardreg(rdest,sp).fixed);
      rrr_ins(i_sub,callee_end_reg,callee_start_reg,rsize);
      condrr_ins(i_be,rsize,R_G0,end_copy_lab);
      alloc_reg_space(rsize,rdest);
      b.offset = 0;
      set_label(copy_lab);
      b.base = callee_start_reg;
      ld_ro_ins(i_ld,b,rt);
      b.base = rdest;
      st_ro_ins(i_st,rt,b);
      rir_ins(i_add,callee_start_reg,PTR_SZ>>3,callee_start_reg);
      rir_ins(i_add,rdest,PTR_SZ>>3,rdest);
      condrr_ins(i_bne,callee_start_reg,callee_end_reg,copy_lab);
      /* now set up the new callee pointers */
      rr_ins(i_mov,rdest,callee_end_reg);
      rrr_ins(i_sub,rdest,rsize,callee_start_reg);
      set_label(end_copy_lab);
    }
#ifdef GENCOMPAT
    else
    if (May_have_callees) {
#else
    else {
#endif
      baseoff b;
      int size = proc_state.callee_size/8;
      int rdest = getreg(sp.fixed);
      int el;
      int rt = getreg(guardreg(rdest,sp).fixed);
      alloc_space(size,rdest);
      b.offset = 0;
      for(el = proc_state.callee_size/8;el>0;el -= (PTR_SZ>>3)) {
      b.base = callee_start_reg;
      b.offset = el - (PTR_SZ>>3);
      ld_ro_ins(i_ld,b,rt);
      b.base = rdest;
      st_ro_ins(i_st,rt,b);
      }
      /* now deallocate old storage.  This is needs for outpars to be 
       accessed properly from postludes. */
#if 0
      rir_ins(i_add,callee_start_reg,((proc_state.callee_size>>3)+7)&~7,callee_start_reg);
      rir_ins(i_sub,callee_start_reg,96,R_FP);
#endif
      rr_ins(i_mov,rdest,callee_start_reg);

    }
  }
  if ( do_profile ) {
      /* implement -p option, call mcount */
    static int p_lab = 0 ;
    p_lab++ ;
    if ( sysV_assembler ) {
      outs ( "\t.reserve\tLP." ) ;
      outn ( p_lab ) ;
      outs ( ",4,\".bss\",4\n" ) ;
      } 
    else {
      outs ( "\t.reserve\tLP." ) ;
      outn ( p_lab ) ;
      outs ( ",4,\"bss\",4\n" ) ;
    }
    insection ( text_section ) ;
    outs ( "\tset\tLP." ) ;
    outn ( p_lab ) ;
    outs ( ",%o0\n" ) ;
#ifdef NEWDWARF
    if (dwarf2)
      lost_count_ins();
#endif
    extj_special_ins ( i_call, "mcount", 1 ) ;
  }

    /* Move params if necessary */
  par = son ( e ) ;
  while ( name ( par ) == ident_tag ) {
    if ( isparam ( par ) ) {
      /* Got a parameter ident */
      int r = ( int ) props ( son ( par ) ) ;
      /* ( r == 0 ) ? ( on stack ) : ( input reg no ) */
/*    assert ( name ( son ( par ) ) == clear_tag ) ;*/

      if ( r != 0 ) {
      /* Parameter in register */
      assert ( R_I0 <= r && r <= R_I5 ) ;
      
      if ( no ( par ) != 0 ) {
        if ( no ( par ) == R_NO_REG ) {
          /* struct/union parameter, on stack aleady,
             nothing useful in reg */
          assert ( !fixregable ( par ) &&
                 !floatregable ( par ) ) ;
        } 
        else if ( no ( par ) == r ) {
          if ( name ( sh ( son ( par ) ) ) == ucharhd ) {
            rir_ins ( i_and, r, 255, no ( par ) ) ;
          } 
          else if ( name ( sh ( son ( par ) ) ) == uwordhd ) {
            rir_ins ( i_and, r, 65535, no ( par ) ) ;
          } 
        } 
        else {
          if ( name ( sh ( son ( par ) ) ) == ucharhd ) {
            rir_ins ( i_and, r, 255, no ( par ) ) ;
          } 
          else if ( name ( sh ( son ( par ) ) ) == uwordhd ) {
            rir_ins ( i_and, r, 65535, no ( par ) ) ;
          } 
          else {
            rr_ins ( i_mov, r, no ( par ) ) ;
          }
        }
      } 
      else {
        /* Parameter in reg move to stack */
        baseoff stackpos ;
        long size = shape_size ( sh ( son ( par ) ) ) ;
        int offs = ( int ) ( ( no ( son ( par ) ) +
                         proc_state.params_offset ) >> 3 ) ;
        stackpos.base = R_FP ;
        stackpos.offset =offs ;

        switch ( size ) {
          case 8 : {
            st_ro_ins ( i_stb, r, stackpos ) ;
            break ;
          }
          case 16 : {
            st_ro_ins ( i_sth, r, stackpos ) ;
            break ;
          }
          case 32 : {
            st_ro_ins ( i_st, r, stackpos ) ;
            break ;
          }
          case 64 : {
            /* A double can be passed first word in reg
             (R_I5) and second word on stack. Must only
             store out first word in this case  */
            st_ro_ins ( i_st, r, stackpos ) ;
            if ( r != R_I5 ) {
            /* float point double passed in fixed
               point reg pair */
            stackpos.offset += 4 ;
            st_ro_ins ( i_st, r + 1, stackpos ) ;
            }
            break ;
          }
          default : {
            fail ( "bad size in make_proc_tag_code" ) ;
            break ;
          }
        }
      }
      } 
      else {
      /* Param on stack, no change */
      }
    }
    par = bro ( son ( par ) ) ;
  }

  clear_all () ;
  
    
    if ( ( pprops & long_result_bit ) != 0 ) {
      /* structure or union result, address of space to [ %fp+64 ] */
      instore is ;
      /* [%fp+64] as per call convention */
      is.adval = 0 ;
      is.b.base = R_FP ;
      is.b.offset = ( 16 * 4 ) ;
      setinsalt ( proc_state.procans, is ) ;
    } 
    else if ( ( pprops & realresult_bit ) != 0 ) {
      /* proc has real result */
      freg frg ;
      frg.fr = 0 ;
      frg.dble = ( bool ) ( ( pprops & longrealresult_bit ) ? 1 : 0 ) ;
      setfregalt ( proc_state.procans, frg ) ;
    } 
    else if ( ( pprops & has_result_bit ) != 0 ) {
      setregalt ( proc_state.procans, R_I0 ) ;
    } 
    else {
      /* no result */
      setregalt ( proc_state.procans, R_G0 ) ;
    }

    proc_state.rscope_level = 0 ;
    proc_state.result_label = 0 ;

    /* code for body of proc */
#if 1
    if(!sysV_abi && do_dynamic_init && !strcmp(proc_name,"_main")) {
      call_tdf_main();
    }
#endif    
    (void) code_here ( son ( e ), sp, nowhere ) ;
    clear_all () ;
    if (stackerr_lab){
      set_label(stackerr_lab);
      fprintf ( as_file, "\t%s\n", i_restore ) ;     
      if(local_stackerr_lab) {
      set_label(local_stackerr_lab);
      }
      
      /*rir_ins(i_add,R_SP,proc_state.frame_size>>3,R_SP);*/
      do_exception(f_stack_overflow);
    }
    if (aritherr_lab != 0){
      set_label(aritherr_lab);
      do_exception(f_overflow);
    }
    
#ifndef RET_IN_CODE
    if (proc_state.result_label !=0){
      set_label ( proc_state.result_label ) ;
#ifdef NEWDWARF
      if (dwarf2)
        dw2_return_pos (0);
#endif
      ret_restore_ins () ;
    }
#endif      
#ifdef NEWDWARF
    if (dwarf2)
      dw2_complete_fde ();
#endif    
    proc_state = old_proc_state ;
    return ( mka ) ;
}



/*
  ENCODE A PROCEDURE RESULT
*/

makeans make_res_tag_code 
    PROTO_N ( ( e, sp, dest, exitlab ) )
    PROTO_T ( exp e X space sp X where dest X int exitlab ){
  where w ;
  makeans mka ;
  mka.lab = exitlab ;
  mka.regmove = NOREG ;
  assert ( name ( e ) == res_tag || name(e) == untidy_return_tag) ;
  w.answhere = proc_state.procans ;
  w.ashwhere = ashof ( sh ( son ( e ) ) ) ;
  ( void ) code_here ( son ( e ), sp, w ) ;
  assert(proc_state.rscope_level == 0);
                        /* procedure return */
  switch ( discrim ( w.answhere ) ){
    case notinreg : {
      instore isw ;
      isw = insalt ( w.answhere ) ;
      /* [%fp+64] as per call convention */
      if ( isw.adval == 0 && isw.b.base == R_FP &&
         isw.b.offset == ( 16 * 4 ) ) {
      /* struct or union result */
#ifdef NEWDWARF
      if (dwarf2)
        dw2_return_pos (0);
#endif
      stret_restore_ins () ;
      break ;
      }     
         /* FALL THROUGH */
    }
    default : 
    {
      /* not struct or union result */
      if ( proc_state.leaf_proc && name(e) == res_tag && !sysV_assembler
#ifdef NEWDIAGS
            && !diag_visible) {
#else
            && !diagnose) {
#endif
      /* Use only one return per proc, as this is necessary
         for the peep-hole assembler 'as -O' to recognise
         leaf procs (not applicable in SunOS
         5 assembler).  Empirical tests show that using last
         return is very slightly faster for SPECint tests
            - but beware of confusing diagnostic info */
      if ( proc_state.result_label == 0 ) {
        /* first return in proc, generate return */
        proc_state.result_label = new_label () ;
        /* first return in a leaf proc is ret_restore,
           others branch here */
#if RET_IN_CODE
        set_label ( proc_state.result_label ) ;
        {
          baseoff b;
          b.base = R_FP;
#if 0
          if(Has_vcallees){
            baseoff b;
            b.base = R_FP;
            b.offset = -4 * PTR_SZ>>3;
            ld_ro_ins(i_ld,b,local_reg);
          }
#endif
        }
#ifdef NEWDWARF
        if (dwarf2)
          dw2_return_pos (0);
#endif
        if(name(e) == res_tag) {
          ret_restore_ins () ;
        }
        else {
          fprintf ( as_file, "\t%s\n", i_ret );
#ifdef NEWDWARF
          if (dwarf2)
            count_ins(1);
#endif
          rir_ins(i_restore,R_SP,-proc_state.maxargs>>3,R_SP);
        }
      
#else
        uncond_ins ( i_b, proc_state.result_label ) ;
#endif
      } 
      else {
        /* jump to the return for this proc */
        uncond_ins ( i_b, proc_state.result_label ) ;
      }
      } 
      else {
      baseoff b;
      b.base = R_FP;
#if 0
      if(Has_vcallees){
        baseoff b;
        b.base = R_FP;
        b.offset = -4 * PTR_SZ>>3;
        ld_ro_ins(i_ld,b,local_reg);
      }
#endif
      /* return here, avoiding cost of branch to return */
#ifdef NEWDWARF
      if (dwarf2)
        dw2_return_pos (0);
#endif
      if(name(e) == res_tag) {
        ret_restore_ins () ;
      }
      else {
        fprintf ( as_file, "\t%s\n", i_ret );
#ifdef NEWDWARF
        if (dwarf2)
          count_ins(1);
#endif
        rir_ins(i_restore,R_SP,-proc_state.maxargs>>3,R_SP);
        /*fprintf ( as_file, "\t%s,\%sp,0,\%sp\n", i_restore ) ;*/
      }
      /*      ret_restore_ins () ;*/
      }
    }
  }
  /* regs invalid after return (what about inlining?) */
  clear_all () ;  
  return ( mka ) ;
}


/*
  ENCODE A PROCEDURE CALL
*/
extern int reg_result PROTO_S ( ( shape ) ) ;

makeans make_apply_tag_code 
    PROTO_N ( ( e, sp, dest, exitlab ) )
    PROTO_T ( exp e X space sp X where dest X int exitlab ){
  exp fn = son ( e ) ;
  exp par = bro ( fn ) ;
  exp list = par ;
  int hda = ( int ) name ( sh ( e ) ) ;
  int special ;
  int param_reg = R_O0 ;       /* next param reg to use */
  int param_regs_used ;  /* how many were used */
  ash ansash ;
  space nsp ;
  int void_result = (( name ( sh ( e ) ) == tophd ) ||
                 ( name ( sh ( e ) ) == bothd));
    
  int reg_res = reg_result ( sh ( e ) ) ;
  int guarded_dest_reg = R_NO_REG ;/* reg used to address tuple result */
  makeans mka ;

  exp dad = father ( e ) ;
  bool tlrecurse = ( bool ) ( proc_state.rscope_level == 0 &&
                        name ( dad ) == res_tag && props ( dad ) ) ;

  nsp = sp ;

  mka.lab = exitlab ;
  mka.regmove = NOREG ;
  assert ( name ( e ) == apply_tag ) ;

  /* first see if it is a special to be handled inline */
  if ( ( special = specialfn ( fn ) ) > 0 ) {
    /* eg function is strlen */
    mka.lab = specialmake ( special, list, sp, dest, exitlab ) ;
    return ( mka ) ;
  }

  ansash = ashof ( sh ( e ) ) ;

  if ( !reg_res && !void_result ) {
    /* structure or union result, address of space to [%sp+64] 
     must do this before evaluating args as dest may use param reg */
    instore is ;
    baseoff stack_struct_ret_addr ;

    /* [%sp+64] as per call convention */
    stack_struct_ret_addr.base = R_SP ;
    stack_struct_ret_addr.offset = ( 16 * 4 ) ;

    assert ( discrim ( dest.answhere ) == notinreg ) ;
    if(discrim(dest.answhere) != notinreg){     /* should be redundant */
      is.b = mem_temp(0);
      is.adval = 1;
    }
    else{
      is = insalt ( dest.answhere ) ;
    }
    if ( is.adval ) {
      /* generate address of dest */
      if ( IS_FIXREG ( is.b.base ) ) {
      if ( is.b.offset == 0 ) {
        st_ro_ins ( i_st, is.b.base, stack_struct_ret_addr ) ;
      } 
      else {
        rir_ins ( i_add, is.b.base, is.b.offset, R_TMP ) ;
        st_ro_ins ( i_st, R_TMP, stack_struct_ret_addr ) ;
      }
      guarded_dest_reg = is.b.base ;      /* can be guarded */
      } 
      else {
      set_ins ( is.b, R_TMP ) ;
      st_ro_ins ( i_st, R_TMP, stack_struct_ret_addr ) ;
      }
    } 
    else {
      /* load dest */
      ld_ins ( i_ld, is.b, R_TMP ) ;
      st_ro_ins ( i_st, R_TMP, stack_struct_ret_addr ) ;
    }
  }


  /* evaluate params to param reg or stack */
  if ( !last ( fn ) ) {
    int param_offset = ( 16 + 1 ) * 32 ;
    /* beyond reg window save area and hidden param of caller's frame */

    /* evaluate parameters in turn */
    for ( ; ; ) {
      ash ap ;
      where w ;
      shape a = sh ( list ) ;
      int hd = ( int ) name ( a ) ;
      ap = ashof ( a ) ;
      w.ashwhere = ap ;

      if ( 0 /*struct_par*/ ) {
      /* non-ABI construct being used - give stronger warning */
      if ( sysV_abi ) fail ( "Structure parameter passed by value" ) ;
      }

      if ( is_floating ( hd ) && param_reg <= R_O5 ) {
      /* Float point. Copy to stack as if stack parameter,
         then recover words as needed into fixed point regs */
      instore is ;
      /* Locations we offer may not be aligned for doubles.  We
         assume 'move' can cope with this */
      is.b.base = R_SP ;
      is.b.offset = param_offset >> 3 ;
      is.adval = 1 ;

      setinsalt ( w.answhere, is ) ;
      ( void ) code_here ( list, nsp, w ) ;
      ld_ro_ins ( i_ld, is.b, param_reg ) ;
      nsp = guardreg ( param_reg, nsp ) ;
      param_reg++ ;     
      param_offset += 32 ;

      if ( hd != shrealhd ) {
        /* double */
        if ( param_reg <= R_O5 ) {
          /* double whose second word can go in reg */
          is.b.offset += 4 ;
          ld_ro_ins ( i_ld, is.b, param_reg ) ;
          nsp = guardreg ( param_reg, nsp ) ;
          param_reg++ ;
        }
        param_offset += 32 ;
      }
      } 
      else if ( valregable ( sh ( list ) ) && param_reg <= R_O5 ) {
      /* fixed point parameter in a single reg */
      nsp = guardreg ( param_reg, nsp ) ;
      reg_operand_here ( list, nsp, param_reg ) ;
      param_reg++ ;     
      param_offset += 32 ;
      } 
      else {
      /* stack parameter */
      instore is ;
      /* Locations we offer may not be aligned for doubles.
         We assume 'move' can cope with this  */
      is.b.base = R_SP ;
      is.b.offset = param_offset >> 3 ;
      is.adval = 1 ;
      if ( valregable ( sh ( list ) ) &&
           ( ap.ashsize == 8 || ap.ashsize == 16 ) ) {
        /* Byte or 16bit scalar parameter - convert to integer.
           We must pass a full word to conform with SPARC ABI,
           so have to expand source to full word.  We do this
           by loading into a reg */
        int r = reg_operand ( list, nsp ) ;
        ans op ;
        setregalt ( op, r ) ;
        /* round down to word boundary */
        is.b.offset &= ~0x3 ;
        ap.ashsize = ap.ashalign = 32 ;
        w.ashwhere = ap ;
        setinsalt ( w.answhere, is ) ;
        ( void ) move ( op, w, guardreg ( r, nsp ).fixed, 1 ) ;
      } 
      else {
        setinsalt ( w.answhere, is ) ;
        ( void ) code_here ( list, nsp, w ) ;
      }
      param_offset = ( int ) ( param_offset + ap.ashsize ) ;
      }

      if ( last ( list ) ) break ;
      list = bro ( list ) ;
    }
  }

  assert ( param_reg >= R_O0 && param_reg <= R_O5 + 1 ) ;
  param_regs_used = param_reg - R_O0 ;

  if ( special != 0 ) {
    extj_special_ins ( i_call, special_call_name ( special ),
                   param_regs_used ) ;
  } 
  else if ( name ( fn ) == name_tag &&
            name ( son ( fn ) ) == ident_tag &&
            ( son ( son ( fn ) ) == nilexp ||
            (name ( son ( son ( fn ) ) ) == proc_tag || 
             name(son(son(fn))) == general_proc_tag)) ) {
    baseoff b ;
    b = boff ( son ( fn ) ) ;
    if ( !tlrecurse ) {
#ifdef NEWDWARF
      if (current_dg_info) {
      current_dg_info->data.i_call.brk = set_dw_text_label ();
      current_dg_info->data.i_call.p.k = WH_CODELAB;
      current_dg_info->data.i_call.p.u.l = b.base;
      current_dg_info->data.i_call.p.o = b.offset;
      }
#endif
      extj_ins ( i_call, b, param_regs_used ) ;
    } 
    else {
      assert ( !tlrecurse ) ;
    }
  } 
  else {
    int r = reg_operand ( fn, nsp ) ;
#ifdef NEWDWARF
    if (current_dg_info) {
      current_dg_info->data.i_call.brk = set_dw_text_label ();
      current_dg_info->data.i_call.p.k = WH_REG;
      current_dg_info->data.i_call.p.u.l = r;
    }
#endif
    extj_reg_ins ( i_call, r, param_regs_used ) ;
  }

  if ( !reg_res && !void_result ) {
    /* Generate unimp instruction, as per structure result call
       convention.  Argument is low-order 12 bits of structure size,
       see section D.4 of * SPARC architecture manual */
    unimp_ins ( ( long ) ( ( ansash.ashsize / 8 ) & 0xfff ) ) ;
  }

#ifdef NEWDWARF
  if (dwarf2)
    START_BB ();
#endif

  /* grab clobbered %g and %o regs, as safety test for bad code */
  {
    int r ;
    space gsp ;
    gsp = sp ;

    /* %g1..%g_reg_max, %o0..%o7 */
    for ( r = R_G1 ; r < R_O7 + 1 ;
                 r = ( ( r == R_G0 + g_reg_max ) ? R_O0 : r + 1 ) ) {
      /* skip R_O0 as often used in result-reg optimisation */
      if ( !( r == R_TMP || r == R_O0 || r == R_SP ||
            r == guarded_dest_reg ) ) {
      /* not special regs */
      gsp = needreg ( r, gsp ) ;
      }
    }
  }
  clear_all () ;  /* ??? not %i0..%l7 that may be t-regs */

  if ( reg_res ) {
    ans aa ;
    if ( is_floating ( hda ) ) {
      freg frg ;
      frg.fr = 0 ;
      frg.dble = ( bool ) ( hda != shrealhd ) ;
      setfregalt ( aa, frg ) ;
      /* move floating point result of application to destination */
      ( void ) move ( aa, dest, sp.fixed, 1 ) ;
    } 
    else {
      setregalt ( aa, R_O0 ) ;
      if ( discrim ( dest.answhere ) == inreg ) {
      int r = regalt ( dest.answhere ) ;
      if ( r == R_G0 ) {
        /* void result */
      }
      else if ( r != R_O0 ) {
        /* move result from %o0 */
        ( void ) move ( aa, dest, sp.fixed, 1 ) ;
      } 
      else {
        /* no move required */
      }
      mka.regmove = R_O0 ;
      } 
      else {
      ( void ) move ( aa, dest, sp.fixed, 1 ) ;
      }
    }
  } 
  else {
    /* not register result */
  }
  return ( mka ) ;
}


static space do_callers 
    PROTO_N ( ( list, sp, param_reg, trad_call ) )
    PROTO_T ( exp list X space sp X int* param_reg X bool trad_call ){
  int param_offset = (16+1)*32; /* beyond reg window save area & 
                         hidden param of callers frame */
  int last_reg;
#ifdef GENCOMPAT
  if (!trad_call) {
#else
  if(in_general_proc) {
#endif
    if(vc_call) {
      last_reg = R_O3;
    }
    else {
      last_reg = R_O4;
    }
  }
  else {
    last_reg = R_O5;
  }
  
  for(;;){
    ash ap;
    where w;
    shape a = sh(list);
    int hd = (int)name(a);
    exp par = (name(list) == caller_tag)?son(list) : list;
    ap = ashof(a);
    w.ashwhere = ap;
    if(is_floating(hd) && *param_reg <= last_reg){
      /* floating pt.  Copy to stack as if stack param then recover
       into fixed point reg */
      instore is;
      is.b.base = R_SP;
      is.b.offset = param_offset>>3;
      is.adval = 1;
      setinsalt(w.answhere,is);
      (void)code_here ( par, sp, w ) ;
      if(hd == doublehd){
      rir_ins(i_add,is.b.base,is.b.offset,*param_reg);
      }
      else {
      ld_ro_ins ( i_ld, is.b, *param_reg ) ;
      }
      sp = guardreg ( *param_reg, sp ) ;
      (*param_reg)++ ;     
      param_offset += 32 ;
      if ( hd == realhd ) {
      /* double */
      if ( *param_reg <= last_reg ) {
        /* double whose second word can go in reg */
        is.b.offset += 4 ;
        ld_ro_ins ( i_ld, is.b, *param_reg ) ;
        sp = guardreg (* param_reg, sp ) ;
        (*param_reg)++ ;
      }
      param_offset += 32 ;
      }
    } 
    else if ( valregable ( sh ( list ) ) && *param_reg <= last_reg ) {
      /* fixed point parameter in a single reg */
      sp = guardreg ( *param_reg, sp ) ;
      reg_operand_here ( list, sp, *param_reg ) ;
      (*param_reg)++ ;     
      param_offset += 32 ;
    } 
    else {
      /* stack parameter */
      instore is ;
      /* Locations we offer may not be aligned for doubles.
       We assume 'move' can cope with this  */
      is.b.base = R_SP ;
      is.b.offset = param_offset >> 3 ;
      is.adval = 1 ;
      if ( valregable ( sh ( list ) ) &&
         ( ap.ashsize == 8 || ap.ashsize == 16 ) ) {
      /* Byte or 16bit scalar parameter - convert to integer.
         We must pass a full word to conform with SPARC ABI,
         so have to expand source to full word.  We do this
         by loading into a reg */
      int r = reg_operand ( list, sp ) ;
      ans op ;
      setregalt ( op, r ) ;
      /* round down to word boundary */
      is.b.offset &= ~0x3 ;
      ap.ashsize = ap.ashalign = 32 ;
      w.ashwhere = ap ;
      setinsalt ( w.answhere, is ) ;
      (void)move ( op, w, guardreg ( r, sp ).fixed, 1 ) ;
      } 
      else{
      setinsalt ( w.answhere, is ) ;
      (void)code_here ( par, sp, w ) ;
      }
      if ( *param_reg <= last_reg ) {
      /* Copy back into the correct param regs */
      int start_offset = is.b.offset;
      int block_size = w.ashwhere.ashsize;
      baseoff curr_pos;
      curr_pos.base = R_SP;
      curr_pos.offset = start_offset;
      if(is64(sh(list)) || (name(sh(list)) == cpdhd) || 
         (name(sh(list)) == nofhd)){
        rir_ins(i_add,curr_pos.base,curr_pos.offset,*param_reg);
        (*param_reg)++;
        block_size -=32;
        }
      else {
        while (*param_reg <= last_reg && block_size>0) {
          ld_ro_ins(i_ld,curr_pos,*param_reg);
          ++(*param_reg);
          curr_pos.offset += 4;
          block_size -= 32;
        }
      }
      }
      param_offset = ( int ) ( param_offset + ap.ashsize ) ;
    }
    if ( last ( list ) ) return sp;
    list = bro ( list ) ;
  }

  return sp;
}

/*
  Give the first parameter par_base, find parameter 'num'
*/
exp get_param 
    PROTO_N ( ( par_base, num ) )
    PROTO_T ( exp par_base X int num ) {
  exp res_exp = par_base;
  int current_par;
  if(num == 1) return par_base;
  for(current_par = 2;current_par<=num;++current_par) {
    res_exp = bro(res_exp);
  }
  return res_exp;
}

  
  

/*
  Move the caller parameters up the stack from their current position
  by %size_reg bytes.  The function assumes that there will always be at 
  least one parameter.
*/
static void move_parameters 
    PROTO_N ( ( callers, size_reg, sp ) )
    PROTO_T ( exp callers X int size_reg X space sp ) {
  int param_offset;   /* offset of first parameter */
  int newbase;
  baseoff b;
  int last_caller = 0;
  int has_callers = 0;
  exp current_caller = son(callers);
  int rtmp = getreg(sp.fixed);
  int rtop = getreg(guardreg(rtmp,sp).fixed);
  int i;
  
  param_offset = 64;
  for(i=0;i<no(callers);++i){
    if (shape_size(sh(current_caller)) > 32)
      param_offset += 8;
    else
      param_offset += 4;
    current_caller = bro(current_caller);
  }
  current_caller = son(callers);
  

  /* top is sp + param_offset + callers * num */
  while(!last_caller) {
    last_caller = last(current_caller);
    if(name(current_caller) == caller_tag) {
      has_callers = 1;
    }
    current_caller = bro(current_caller);
  }
  current_caller = son(callers);
  last_caller = 0;

  if(!has_callers) return;
  rir_ins(i_add,R_SP,param_offset /*+ (no(callers))*/,rtop);
  
  
  b.offset = param_offset;
  b.offset = 0;
  if (size_reg == R_NO_REG)
    newbase = rtop;
  else {
    newbase = getreg(guardreg(rtop,sp).fixed);
    rrr_ins(i_add,rtop,size_reg,newbase);
  }
  assert(current_caller != (exp)NULL);

  for(i=no(callers);i>0;--i) {
    exp par = get_param(son(callers),i);
    if(name( par ) == caller_tag) {
      /* move it up the stack */
      b.base = rtop;
      ld_ro_ins(i_ld,b,rtmp);
      b.base = newbase;
      st_ro_ins(i_st,rtmp,b);
      if(shape_size(sh(par)) > 32) {
      b.base = rtop;
      b.offset = -4;
      ld_ro_ins(i_ld,b,rtmp);
      b.base = newbase;
      st_ro_ins(i_st,rtmp,b);
      }
      b.offset -= 4;
    }
    else
      b.offset -= (shape_size(sh(par)) > 32 ? 8 : 4);
  }
  return;
}

      

makeans make_apply_general_tag_code 
    PROTO_N ( ( e, sp, dest, exitlab ) )
    PROTO_T ( exp e X space sp X where dest X int exitlab ){
  exp fn = son(e);
  exp callers = bro(fn);
  exp cllees = bro(callers);
  exp postlude = bro(cllees);
  int hda = (int)name(sh(e));
  int param_reg = R_O0;
  int param_regs_used;
  ash ansash;
  space nsp;
  int void_result = (( name ( sh ( e ) ) == tophd ) ||
                 ( name ( sh ( e ) ) == bothd));
    
  int reg_res = reg_result ( sh ( e ) ) ;
  int guarded_dest_reg = R_NO_REG; /* reg used to address tuple result */
  makeans mka ;
  exp dad = father ( e ) ;
  bool tlrecurse = ( bool ) ( proc_state.rscope_level == 0 &&
                        name ( dad ) == res_tag && props ( dad ) ) ;
  bool trad_call = 0;
  ansash = ashof(sh(e));
  nsp = sp;
  mka.lab = exitlab ;
  mka.regmove = NOREG ;
  if((call_has_vcallees(cllees)!= 0)) {
    outs("\t.optim\t\"-O0\"\n"); 
  }

  param_regs_used = param_reg - R_O0;

#ifdef GENCOMPAT
  if ((call_has_vcallees(cllees)== 0)) {
    if (name(cllees) == make_callee_list_tag) {
      if (no(cllees) == 0)
      trad_call = 1;
    }
    else if (name(cllees) == make_dynamic_callee_tag) {
      if (name(bro(son(cllees))) == val_tag && no(bro(son(cllees))) == 0)
      trad_call = 1;
    }
    else {  /* same callees */
      if (!May_have_callees)
      trad_call = 1;
    }
  }
#endif
  if (!trad_call)
    (void)make_code(cllees,nsp,nowhere,0);

  if(!reg_res && !void_result){
    /* structure result */
        instore is ;
    baseoff stack_struct_ret_addr ;

    /* [%sp+64] as per call convention */
    stack_struct_ret_addr.base = R_SP ;
    stack_struct_ret_addr.offset = ( 16 * 4 ) ;

    assert ( discrim ( dest.answhere ) == notinreg ) ;
    if(discrim(dest.answhere) != notinreg){     /* should be redundant */
      discrim(dest.answhere) = notinreg;
      is.b.base = R_SP;
      is.b.offset = (4*16);
      /* is.b = mem_temp(0);   not compatible with out_pars */
      is.adval = 1;
      dest.answhere.val.instoreans = is;
    }
    else{
      is = insalt ( dest.answhere ) ;
    }
    if ( is.adval ) {
      /* generate address of dest */
      if ( IS_FIXREG ( is.b.base ) ) {
      if ( is.b.offset == 0 ) {
        st_ro_ins ( i_st, is.b.base, stack_struct_ret_addr ) ;
      } 
      else {
        rir_ins ( i_add, is.b.base, is.b.offset, R_TMP ) ;
        st_ro_ins ( i_st, R_TMP, stack_struct_ret_addr ) ;
      }
      guarded_dest_reg = is.b.base ;      /* can be guarded */
      } 
      else {
      set_ins ( is.b, R_TMP ) ;
      st_ro_ins ( i_st, R_TMP, stack_struct_ret_addr ) ;
      }
    } 
    else {
      /* load dest */
      ld_ins ( i_ld, is.b, R_TMP ) ;
      st_ro_ins ( i_st, R_TMP, stack_struct_ret_addr ) ;
    }
  }


#ifdef GENCOMPAT
  if (!trad_call)
#endif
  {
    /*rr_ins(i_mov,callee_start_reg,R_O5);*/ 
    nsp = guardreg(R_O5,nsp);
    if(call_has_vcallees(cllees)) {
      /*rr_ins(i_mov,callee_end_reg,R_O4);*/
      nsp = guardreg(R_O4,nsp);
    }
  }

  if(no(callers) != 0){
    int tmp = in_general_proc;
    in_general_proc = 1;
    vc_call = (call_has_vcallees(cllees)!=0);
    nsp = do_callers(son(callers),nsp,&param_reg, trad_call);
    vc_call = 0;
    in_general_proc = tmp;
  }
  call_base_reg = R_SP;
  
  if ( name ( fn ) == name_tag && name ( son ( fn ) ) == ident_tag &&
       ( son ( son ( fn ) ) == nilexp ||
       (name ( son ( son ( fn ) ) ) == proc_tag ||
        name(son(son(fn))) == general_proc_tag)) ) {
    baseoff b;
    b = boff(son(fn));
    if(!tlrecurse){
      /* don't tell the assembler how many parameters are being used, as
       it optimises away changes to "unused" parameter registers which,
       in general procs, are needed to pass callees.
       */
#ifdef NEWDWARF
      if (current_dg_info) {
      current_dg_info->data.i_call.brk = set_dw_text_label ();
      current_dg_info->data.i_call.p.k = WH_CODELAB;
      current_dg_info->data.i_call.p.u.l = b.base;
      current_dg_info->data.i_call.p.o = b.offset;
      }
#endif
      extj_ins(i_call,b,-1 /*param_regs_used*/);
    }
    else{
      assert(!tlrecurse);
    }
  }
  else{
    int r = reg_operand(fn,nsp);
#ifdef NEWDWARF
    if (current_dg_info) {
      current_dg_info->data.i_call.brk = set_dw_text_label ();
      current_dg_info->data.i_call.p.k = WH_REG;
      current_dg_info->data.i_call.p.u.l = r;
    }
#endif
    extj_reg_ins(i_call,r,-1 /*param_regs_used*/);
  }
  if(!reg_res && !void_result){
    /* Generate unimp instruction, as per structure result call
         convention.  Argument is low-order 12 bits of structure size,
         see section D.4 of * SPARC architecture manual */
    unimp_ins ( ( long ) ( ( ansash.ashsize / 8 ) & 0xfff ) ) ;
  }

#ifdef NEWDWARF
  if (dwarf2)
    START_BB ();
#endif

  /* free the space used to generate the callee parameters and, if in
     a postlude, move the caller outpars up the stack to a correct parameter 
     offset from the new stack pointer */

  clear_all();
  {
    int size_reg;
    space nsp;
    nsp = guardreg(R_O0,sp);
#ifdef GENCOMPAT
    if (trad_call)
      size_reg = R_NO_REG;
    else
#endif
    {
      if(name(cllees) == make_callee_list_tag) {
      size_reg = getreg(nsp.fixed);
      ir_ins(i_mov,((no(cllees)>>3)+23)&~7,size_reg);
      }
      else if(name(cllees) == make_dynamic_callee_tag) {
      size_reg = reg_operand(bro(son(cllees)),nsp);
      rir_ins(i_add,size_reg,4*(PTR_SZ>>3)+7,size_reg);
      rir_ins(i_and,size_reg,~7,size_reg);
      }
      else {      /* same callees */
      size_reg = getreg(nsp.fixed);
      if(Has_vcallees) {
        rrr_ins(i_sub,callee_end_reg,callee_start_reg,size_reg);
      }
      else {
        ir_ins(i_mov,proc_state.callee_size/8,size_reg);
      }
      }
      nsp = guardreg(size_reg,nsp);
    }
    if(no(callers)/* && (in_postlude || postlude_has_call(e))*/) {
      move_parameters(callers,size_reg,nsp); /* move all outpars into 
                                        correct positions */
    }
    if(!call_is_untidy(cllees) && size_reg != R_NO_REG) {
      if(!sysV_assembler) {
      /* with -O2 SunOS removes [add %sp,X,%sp] statements. */
      outs("\t.optim\t\"-O0\"\n"); 
      }
      rrr_ins(i_add,R_SP,size_reg,R_SP);
    }
  }
  
  

  /* grab clobbered %g and %o regs, as safety test for bad code */
  {
    int r ;
    space gsp ;
    gsp = sp ;

    /* %g1..%g_reg_max, %o0..%o7 */
    for ( r = R_G1 ; r < R_O7 + 1 ;
                 r = ( ( r == R_G0 + g_reg_max ) ? R_O0 : r + 1 ) ) {
      /* skip R_O0 as often used in result-reg optimisation */
      if ( !( r == R_TMP || r == R_O0 || r == R_SP ||
            r == guarded_dest_reg ) ) {
      /* not special regs */
      gsp = needreg ( r, gsp ) ;
      }
    }
  }
  clear_all () ;  /* ??? not %i0..%l7 that may be t-regs */

  if ( reg_res ) {
    ans aa ;
    if ( is_floating ( hda ) ) {
      freg frg ;
      frg.fr = 0 ;
      frg.dble = ( bool ) ( hda != shrealhd ) ;
      setfregalt ( aa, frg ) ;
      /* move floating point result of application to destination */
      ( void ) move ( aa, dest, sp.fixed, 1 ) ;
    } else {
      setregalt ( aa, R_O0 ) ;
      if ( discrim ( dest.answhere ) == inreg ) {
      int r = regalt ( dest.answhere ) ;
      if ( r == R_G0 ) {
        /* void result */
      } 
      else if ( r != R_O0 ) {
        /* move result from %o0 */
        ( void ) move ( aa, dest, sp.fixed, 1 ) ;
      } 
      else {
        /* no move required */
        assert (name(postlude) == top_tag);
      }
      mka.regmove = R_O0 ;
      } 
      else {
      ( void ) move ( aa, dest, sp.fixed, 1 ) ;
      }
    }
  } 
  else {
    /* not register result */
  }
#if 0
  if(Has_vcallees){
    baseoff b;
    b.base = R_FP;
    b.offset = -3 * (PTR_SZ>>3);
    ld_ro_ins(i_ld,b,local_reg);
  }
#endif
            
  if(call_is_untidy(cllees)) {
    /*    rir_ins(i_sub,R_SP,proc_state.maxargs>>3,R_SP);*/
    /*assert(name(bro(cllees)) == top_tag);*/
  }
  else if(postlude_has_call(e)){
    exp x = son(callers);
    postlude_chain p;
    
    if (x != nilexp) {
      for(;;) {
      if(name(x) == caller_tag) {
        no(x) += proc_state.maxargs;
#if 0
        if(name(sh(x)) == realhd){
          no(x) -=32;
        }
#endif
      }
      if(last(x))break;
      x = bro(x);
      }
    }
    mka.regmove = NOREG;
    update_plc(old_postludes,proc_state.maxargs);
    p.postlude = postlude;
    p.outer = old_postludes;
    old_postludes = &p;
    rir_ins(i_sub,R_SP,proc_state.maxargs>>3,R_SP);

    in_postlude = 1;
    (void)make_code(postlude,sp,nowhere,0);
    in_postlude = 0;
    rir_ins(i_add,R_SP,proc_state.maxargs>>3,R_SP);
    old_postludes = p.outer;
    update_plc(old_postludes,-proc_state.maxargs);
  }
  else {
    (void)make_code(postlude,sp,nowhere,0);
  }

  return mka;
}


/*
  Allocate an amount of space on the stack corresponding to the value
  held in register size_reg, and store a pointer to the resulting area
  in register ptr_reg.
*/
static void alloc_reg_space 
    PROTO_N ( ( size_reg, ptr_reg ) )
    PROTO_T ( int size_reg X int ptr_reg ) {
  
  int maxargbytes = (int)proc_state.maxargs/8;
  rir_ins(i_add,size_reg,7,R_TMP);   
  rir_ins(i_and,R_TMP,~7,R_TMP);      /* make the size a multiple of 8 */
  rrr_ins(i_sub,R_SP,R_TMP,R_SP);
  rir_ins(i_add,R_SP,maxargbytes,ptr_reg);
  return;
}

  
/* 
   As alloc_reg_space, but with a constant size.
*/
static void alloc_space 
    PROTO_N ( ( size, ptr_reg ) )
    PROTO_T ( int size X int ptr_reg ) {
  int maxargbytes = (int)proc_state.maxargs/8;
  size = (size+7)&~7;
  rir_ins(i_sub,R_SP,size,R_SP);
  rir_ins(i_add,R_SP,maxargbytes,ptr_reg);
  return;
}


makeans make_make_callee_list_tag 
    PROTO_N ( ( e, sp, dest, exitlab ) )
    PROTO_T ( exp e X space sp X where dest X int exitlab ){
  int size = ((no(e)>>3) + 23)&~7;
  makeans mka;
  bool vc = call_has_vcallees(e);
  exp list = son(e);
  where w;
  instore is;
  baseoff b;
  int disp = 0;
  ash ap;
  space nsp;
  int rdest;
  
  nsp = guardreg(R_O5,sp);
  nsp = guardreg(R_O4,nsp);
  mka.regmove = R_G0;
  mka.lab = 0;
  /* perform an alloca */
  call_base_reg = getreg((nsp.fixed|PARAM_TREGS));
  nsp = guardreg(call_base_reg,nsp);
  rr_ins(i_mov,R_SP,call_base_reg);
  rdest  = getreg(nsp.fixed);
  nsp = guardreg(rdest,nsp);
  alloc_space(size,rdest); /* */
    
  b.base = rdest;
  b.offset = size - (PTR_SZ>>3);
  st_ro_ins(i_st,R_FP,b);
  if(no(e)){
    int lastpar = 0;
    for(;!lastpar;list = bro(list)){
      ap = ashof(sh(list));
      disp = rounder(disp,ap.ashalign);
      is.b.offset = disp>>3;
      is.b.base = rdest;
      is.adval = 1;
      w.ashwhere = ap;
      setinsalt(w.answhere,is);
      code_here(list,guard(w,nsp),w);
      disp = rounder(disp+ap.ashsize,PTR_SZ);
      lastpar = last(list);
    }
  }
  rr_ins(i_mov,rdest,callee_start_reg_out);/* Not before, as the construction 
                                    of the callees may require that 
                                    we access some of the old 
                                    callees */
  if(vc){
    rir_ins(i_add,callee_start_reg_out,size,callee_end_reg_out);
    /*rir_ins(i_add,R_FP,size,R_FP);*/
  }
  return mka;
}


  
/*
  Construct a copy of the current callees for use in a new procedure
  call.  This writes the callee pointer(s) to the output registers o4 and 
  o5, so a tail call will have to copy back to i4,i5.
*/
makeans make_same_callees_tag 
    PROTO_N ( ( e, sp, dest, exitlab ) )
    PROTO_T ( exp e X space sp X where dest X int exitlab ){
  baseoff b;
  bool vc = call_has_vcallees(e);
  makeans mka;
  space nsp;
  mka.regmove = R_G0;
  if(Has_vcallees) {
    /* copy from [callee_start_reg ... callee_end_reg] into newly allocated
       area, then set callee_start reg to start of area and, if the call
       also has vcallees, set callee_end_reg to the end of the area.
       */
    int rsize; /* register to contain the size of the 
                             callee parameters area */
    int rsrc,rdest;               /* registers containing pointers to where 
                             to copy from and to */
    int rtmp;                     /* temporary register used in copying */
    
    int end_copy_lab = new_label();   /* marks end of copy loop */
    int start_copy_lab = new_label(); /* marks start of copy loop */
    nsp = guardreg(R_O4,sp);
    nsp = guardreg(R_O5,nsp);
    call_base_reg = getreg((nsp.fixed|PARAM_TREGS));
    nsp = guardreg(call_base_reg,sp);
    rsize = getreg(nsp.fixed);
    nsp = guardreg(rsize,sp);
    rsrc = getreg(nsp.fixed);
    nsp = guardreg(rsrc,nsp);
    rdest = getreg(nsp.fixed);
    nsp = guardreg(rdest,nsp);
    rrr_ins(i_sub,callee_end_reg,callee_start_reg,rsize);
    rr_ins(i_mov,R_SP,call_base_reg);
    alloc_reg_space(rsize,rdest); /* */
    rrr_ins(i_add,rdest,rsize,rdest);
        
    /* now do top-down copy of parameters */
    rir_ins(i_sub,callee_end_reg, 4*(PTR_SZ>>3), rsrc);
    rir_ins(i_sub,rdest, 4*(PTR_SZ>>3), rdest);
    /*condrr_ins(i_be,rdest,rsrc,end_copy_lab);*/
    set_label(start_copy_lab);
    b.base = rsrc;
    b.offset = -(PTR_SZ>>3);
    rtmp = getreg(nsp.fixed);
    ld_ro_ins(i_ld,b,rtmp);
    b.base = rdest;
    st_ro_ins(i_st,rtmp,b);
    rir_ins(i_sub,rsrc,PTR_SZ>>3,rsrc);
    rir_ins(i_sub,rdest,PTR_SZ>>3,rdest);
    condrr_ins(i_bne,rsrc,callee_start_reg,start_copy_lab);
    set_label(end_copy_lab);
    /* callee_start_reg will now be rdest */
    rr_ins(i_mov,rdest,callee_start_reg_out);
    
    if(vc) {
      rrr_ins(i_add,callee_start_reg_out,rsize,callee_end_reg_out);
    }
  }
  else {
    int size_of_callees = proc_state.callee_size/8;
    int rdest;
    int el;
    int rsrc;
    space nsp;
    int tmpreg ;
    nsp = guardreg(R_O4,sp);
    nsp = guardreg(R_O5,nsp);
    call_base_reg = getreg((nsp.fixed|PARAM_TREGS));
    nsp = guardreg(call_base_reg,sp);
    rdest = getreg(nsp.fixed);
    nsp = guardreg(rdest,sp);
    tmpreg = getreg(nsp.fixed);
    nsp = guardreg(tmpreg,nsp);
    rr_ins(i_mov,R_SP,call_base_reg);
    alloc_space(size_of_callees,rdest); /* */
    b.base = rdest;
    b.offset = size_of_callees - (PTR_SZ>>3);
    st_ro_ins(i_st,R_FP,b);
    rsrc = getreg(nsp.fixed);
    rir_ins(i_add,callee_start_reg,size_of_callees,rsrc);
    /*rir_ins(i_add,rdest,size_of_callees,rdest);*/
    for(el=(size_of_callees-4*(PTR_SZ>>3));el>0;el-=(PTR_SZ>>3)){
      b.base = rsrc;
      b.offset = el - size_of_callees - (PTR_SZ>>3);
      ld_ro_ins(i_ld,b,tmpreg);
      b.base = rdest;
      b.offset = el - (PTR_SZ>>3);
      st_ro_ins(i_st,tmpreg,b);
    }
    /* callee_start_reg will no be rdest */
    if(vc) {
      rir_ins(i_add,rdest,size_of_callees,callee_end_reg_out);
      /*rr_ins(i_mov,rdest,callee_end_reg_out);*/
    }
    rr_ins(i_mov,rdest,callee_start_reg_out);
    /*rir_ins(i_sub,rdest,size_of_callees,callee_start_reg_out);*/
  }
  return mka;
}


/* 
   Produce code to dynamically construct a new set of callee params.  The
   parameters are placed in a specially allocated piece of the current stack, 
   and pointed to by callee_start_reg and callee_end_reg.
*/
makeans make_make_dynamic_callee_tag 
    PROTO_N ( ( e, sp, dest, exitlab ) )
    PROTO_T ( exp e X space sp X where dest X int exitlab ){
  /* bool vc = call_has_vcallees(e); */
  int rptr,rsize,rdest,r_true_size;
  int copy_start_lab = new_label();
  int copy_end_lab = new_label();
  space nsp;
  baseoff b;
  makeans mka;
  mka.regmove = R_G0;
  mka.lab = exitlab;
  nsp = guardreg(R_O5,sp);
  nsp = guardreg(R_O4,nsp);
  call_base_reg = getreg((nsp.fixed|PARAM_TREGS));
  nsp = guardreg(call_base_reg,nsp);
  rptr = getreg(nsp.fixed);
  nsp = guardreg(rptr,nsp);
  load_reg(son(e),rptr,nsp);    /* rptr now contains a pointer to the start of
                         the callees */
  rsize = getreg(nsp.fixed);
  nsp = guardreg(rsize,nsp);
  load_reg(bro(son(e)),rsize,nsp); /* rsize now contains the size of the 
                              callees */
  rdest = getreg(nsp.fixed);
  nsp = guardreg(rdest,nsp);
  r_true_size = getreg(nsp.fixed);
  nsp = guardreg(r_true_size,nsp);
  /*rdest = callee_start_reg_out;*/ /*getreg(nsp.fixed);*/
  rir_ins(i_add,rsize,4*(PTR_SZ>>3)+7,r_true_size);
  rir_ins(i_and,r_true_size,~7,r_true_size);
  rr_ins(i_mov,R_SP,call_base_reg);
  
  alloc_reg_space(r_true_size,rdest); /* */
  rrr_ins(i_add,rdest,r_true_size /*rsize*/,R_TMP);
  /*rrr_ins(i_sub,rdest,r_true_size,rdest);*/
  b.base = R_TMP;
  b.offset = -(PTR_SZ>>3);
  st_ro_ins(i_st,R_FP,b);
  rr_ins(i_mov,rdest,callee_start_reg_out);
  /*if(vc)*/ rr_ins(i_mov,R_TMP,callee_end_reg_out);
  
  /* Now copy from rptr to rdest */
  condrr_ins(i_ble,rsize,R_G0,copy_end_lab);  /* make shure size > 0 */
  b.offset = 0;
  set_label(copy_start_lab);
  b.base = rptr;
  ld_ro_ins(i_ld,b,R_TMP);
  b.base = rdest;
  st_ro_ins(i_st,R_TMP,b);
  rir_ins(i_add,rptr,PTR_SZ>>3,rptr);
  rir_ins(i_add,rdest,PTR_SZ>>3,rdest);
  rir_ins(i_sub,rsize,PTR_SZ>>3,rsize);
  condrr_ins(i_bgt,rsize,R_G0,copy_start_lab);
  set_label(copy_end_lab);
  return mka;
}

  
  
  
/*
  This generates code for a tail_call tag.  The target of the call MUST be 
  a general proc.
*/
makeans make_tail_call_tag 
    PROTO_N ( ( e, sp, dest, exitlab ) )
    PROTO_T ( exp e X space sp X where dest X int exitlab ){
  exp fn = son(e);
  exp cllees = bro(fn);
  exp bdy = son(current_proc);
  space nsp;
  bool vc = call_has_vcallees(cllees);
  int callee_size = proc_state.callee_size;
  makeans mka;
  baseoff bproc;
  bool glob = ((name(fn) == name_tag) && (name(son(fn)) == ident_tag) &&
             ((son(son(fn)) == nilexp) || (name(son(son(fn))) == proc_tag)
            || (name(son(son(fn))) == general_proc_tag)));
  bool trad_proc = 0;
#ifdef GENCOMPAT
  if (!vc) {
    if (name(cllees) == make_callee_list_tag) {
      if (no(cllees) == 0)
      trad_proc = 1;
    }
    else if (name(cllees) == make_dynamic_callee_tag) {
      if (name(bro(son(cllees))) == val_tag && no(bro(son(cllees))) == 0)
      trad_proc = 1;
    }
    else {  /* same callees */
      if (!May_have_callees)
      trad_proc = 1;
    }
  }
#endif

  mka.lab = exitlab;
  mka.regmove = R_G0;
  nsp = sp;
  nsp.fixed |= PARAM_TREGS;
  if(name(cllees) != same_callees_tag){
    code_here(cllees,sp,nowhere);
  }
#ifndef NEWDIAGS
  for(;name(bdy) == diagnose_tag;bdy=son(bdy));
#endif

  while(name(bdy) == ident_tag && isparam(bdy)){
    exp sbdy = son(bdy);
    baseoff b;
    b.base = R_FP;
    b.offset = (no(sbdy)>>3) + (proc_state.params_offset>>3);

    if (name(sbdy) == formal_callee_tag) {
      if((props(bdy) & inanyreg)!=0) {
      b.offset -= (proc_state.callee_size>>3);
      if(isvar(bdy)) {
        if(is_floating(name(sh(bdy)))) {
          stf_ins(i_st,no(bdy)<<1,b);     /* add case for long double */
        }
        else {
          st_ro_ins(i_st,no(bdy),b);
        }
      }
      }
    }
    else if(props(sbdy)== 0 && ((props(bdy) & inanyreg)!=0)){
      /* move from reg to store */
      if(isvar(bdy)){
      if(is_floating(name(sh(sbdy)))){
        stf_ins(i_stf,no(bdy)<<1,b);
      }
      else{
        assert( IS_IN_REG(props(sbdy)));
/*      props(sbdy) = (props(sbdy)-R_I0)+R_O0;*/
        st_ro_ins(i_st,no(bdy),b);
      }
      }
    }
    else if(props(sbdy)!=0 && ((props(bdy)&inanyreg) == 0)){
      /* move from store to reg */
      int par_reg = props(sbdy);
      int last_reg = (shape_size(sh(sbdy)) > 32 ? par_reg+1 : par_reg);
      int past_reg = ((trad_proc) ? R_I5+1 : (vc)?R_I4:R_I5);
                                /* registers i4 & i5 are reserved
                                     in general procs for handling
                                     of callee parameters */
      assert( IS_IN_REG(par_reg));
/*    props(sbdy) = (props(sbdy)-R_I0)+R_O0;*/
      if ((last_param(bdy) && isvis(bdy) && !Has_no_vcallers)
            || last_reg >= past_reg)
      last_reg = past_reg - 1;
      while(par_reg <= last_reg) {
      ld_ro_ins(i_ld,b,par_reg);
      ++par_reg;
      b.offset += 4;
      }
    }
    else if(props(sbdy) != 0 && (props(sbdy) != no(bdy))){
      if(is_floating(name(sh(sbdy)))){
      freg fr;
      fr.fr = no(bdy);
      fr.dble = (name(sh(sbdy)) == realhd);
      stf_ins ( i_st, fr.fr<<1, mem_temp ( 0 ) ) ;
      ld_ro_ins ( i_ld, mem_temp ( 0 ), props(sbdy) ) ;
      if ( fr.dble ) {
        stf_ins ( i_st, ( fr.fr << 1 ) + 1,
                mem_temp ( 4 ) ) ;
        ld_ro_ins ( i_ld, mem_temp ( 4 ), props(sbdy)+ 1 ) ;
      }
      }
      else{
      assert( IS_IN_REG(props(sbdy)));
/*    props(sbdy) = (props(sbdy)-R_I0)+R_O0;*/
      rr_ins(i_mov,no(bdy),props(sbdy));
      }
    }
    bdy = bro(sbdy);
  }

  bproc = boff(son(fn));
  assert(bproc.offset == 0);
#ifdef GENCOMPAT
  if (trad_proc) {
    int r = getreg(nsp.fixed);
    if (glob) {
      set_ins(bproc,r);
    }
    else{
      load_reg(fn,r,nsp);
    }
    if(!sysV_assembler) {
      /* with -O2 SunOS corrupts unusual jmp/restore combination. */
      outs("\t.optim\t\"-O0\"\n"); 
    }
#ifdef NEWDWARF
    if (current_dg_info) {
      current_dg_info->data.i_lj.brk = set_dw_text_label ();
      current_dg_info->data.i_lj.j.k = WH_REG;
      current_dg_info->data.i_lj.j.u.l = r;
    }
#endif
    extj_reg_ins_no_delay(i_jmp,r,-1);
    fprintf ( as_file, "\t%s\n", i_restore ) ;  /* delay slot */
#ifdef NEWDWARF
    if (dwarf2)
      count_ins(1);
#endif
  }
  else
#endif
  {
    bproc.offset = 12;
    if(name(cllees)!= same_callees_tag) {
      rr_ins(i_mov,callee_start_reg_out,callee_start_reg);
      if(vc) rr_ins(i_mov,callee_end_reg_out,callee_end_reg);
    }
    if(name(cllees) == same_callees_tag && (vc && !Has_vcallees)) {
      rir_ins(i_add,callee_start_reg,callee_size>>3,callee_end_reg);
    }
  
    {
      int r = getreg(nsp.fixed);
      if(glob){
      set_ins(bproc,r);
#ifdef NEWDWARF
      if (current_dg_info) {
        current_dg_info->data.i_lj.brk = set_dw_text_label ();
        current_dg_info->data.i_lj.j.k = WH_REG;
        current_dg_info->data.i_lj.j.u.l = r;
      }
#endif
      extj_reg_ins(i_jmp,r,-1);
      }
      else{
      load_reg(fn,r,nsp);
      rir_ins(i_add,r,12,r);
#ifdef NEWDWARF
      if (current_dg_info) {
        current_dg_info->data.i_lj.brk = set_dw_text_label ();
        current_dg_info->data.i_lj.j.k = WH_REG;
        current_dg_info->data.i_lj.j.u.l = r;
      }
#endif
      extj_reg_ins(i_jmp,r,-1);
      }
    }
  }
  clear_all();
  return mka;
}     





Generated by  Doxygen 1.6.0   Back to index