Subversion Repositories tendra.SVN

Rev

Rev 2 | Go to most recent revision | Blame | Compare with Previous | Last modification | View Log | RSS feed

/*
                 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/locate.c,v 1.1.1.1 1998/01/17 15:55:54 release Exp $
--------------------------------------------------------------------------
$Log: locate.c,v $
 * Revision 1.1.1.1  1998/01/17  15:55:54  release
 * First version to be checked into rolling release.
 *
 * Revision 1.11  1997/08/23  13:53:55  pwe
 * initial ANDF-DE
 *
 * Revision 1.10  1997/02/18  11:47:54  pwe
 * NEWDIAGS for debugging optimised code
 *
 * Revision 1.9  1996/03/20  16:13:56  john
 * Reformatting
 *
 * Revision 1.8  1996/01/23  10:31:13  john
 * Fix to handle env_offset in locate
 *
 * Revision 1.7  1995/12/15  10:24:59  john
 * Changed env_offset calculation
 *
 * Revision 1.6  1995/11/24  11:41:22  john
 * Change to caller location
 *
 * Revision 1.5  1995/11/02  18:03:43  john
 * Stopped using local reg to access data
 *
 * Revision 1.4  1995/07/14  16:31:26  john
 * Minor change
 *
 * Revision 1.3  1995/06/14  15:34:08  john
 * Fixed error in calculating offset for local_reg based address.
 *
 * Revision 1.2  1995/05/26  12:59:16  john
 * Changes for new spec (3.1)
 *
 * Revision 1.1.1.1  1995/03/13  10:18:42  john
 * Entered into CVS
 *
 * Revision 1.5  1994/12/01  13:47:39  djch
 * Create boff_env_offset to get the stack offset of an ident. Needs to trace the
 * parent proc.
 *
 * Revision 1.4  1994/07/04  10:48:58  djch
 * Jun94 tape version
 *
 * Revision 1.3  1994/05/25  14:15:07  djch
 * Added CREATE_instore_bits to shut up tcc
 *
 * Revision 1.2  1994/05/13  12:34:45  djch
 * Incorporates improvements from expt version
 * Use of new macros in addrtypes.h
 *
 * Revision 1.1  1994/05/03  14:49:41  djch
 * Initial revision
 *
 * Revision 1.5  93/08/27  11:29:36  11:29:36  ra (Robert Andrews)
 * Added a couple of explicit integer casts.
 * 
 * Revision 1.4  93/08/13  14:38:14  14:38:14  ra (Robert Andrews)
 * Reformatted.
 * 
 * 
 * Revision 1.3  93/07/05  18:20:37  18:20:37  ra (Robert Andrews)
 * Reordered include files.
 * 
 * Revision 1.2  93/06/29  14:27:11  14:27:11  ra (Robert Andrews)
 * Changed failer to fail.
 * 
 * Revision 1.1  93/06/24  14:58:37  14:58:37  ra (Robert Andrews)
 * Initial revision
 * 
--------------------------------------------------------------------------
*/

#define SPARCTRANS_CODE
#include "config.h"
#include "common_types.h"
#include "myassert.h"
#include "addrtypes.h"
#include "expmacs.h"
#include "tags.h"
#include "inst_fmt.h"
#include "regmacs.h"
#include "sparcins.h"
#include "bitsmacs.h"
#include "exp.h"
#include "procrec.h"
#include "guard.h"
#include "eval.h"
#include "regexps.h"
#include "shapemacs.h"
#include "comment.h"
#include "getregs.h"
#include "move.h"
#include "regable.h"
#include "codehere.h"
#include "proc.h"
#include "locate.h"
#include "flags.h"
#include "translat.h"

int call_base_reg = R_SP;

/*
  DECODE x INTO A BASE REGISTER PLUS OFFSET
*/

baseoff boff 
    PROTO_N ( ( e ) )
    PROTO_T ( exp e ){
  int n = no ( e ) ;
  int b = REG_PART(n);
  baseoff an ;
  if ( isglob ( e ) ) {
    /* bro is index in main_globals */
    dec *gl = brog ( e ) ;
    long sno = gl->dec_u.dec_val.sym_number ;
    an.base = ( int ) ( -( sno + 1 ) ) ;
    an.offset = 0 ;
  } 
  else if ( isparam ( e ) && name(son(e)) != formal_callee_tag) {
    /* parameter, positive offset from %fp */
    /* assert ( name ( son ( e ) ) == clear_tag ) ;*/
    an.base = R_FP ;
    an.offset = BITS2BYTES( no ( son ( e ) ) + proc_state.params_offset );
    assert ( an.offset >= BITS2BYTES(proc_state.params_offset) ) ;
  } 
  else if (isparam(e) && name(son(e)) == formal_callee_tag){
    an.base = R_SP;
    an.offset = BITS2BYTES(no(son(e)));
#if 1
    if(Has_vcallees){
      an.base = local_reg;
      an.base = callee_start_reg;
      an.offset = BITS2BYTES(no(son(e)));
    }
    else{
/*
      an.base = R_FP;
      an.offset = BITS2BYTES(no(son(e)) - proc_state.callee_size);
*/
      an.base = callee_start_reg;
      an.offset = BITS2BYTES(no(son(e)));
    }
#endif
  }
  else if(name(son(e)) == caller_name_tag){
    /* caller name tag is located at [%sp+paramsoffset] */
    an.base = R_SP;
     an.base = call_base_reg;
    an.offset = BYTE_OFFSET_PART(n) + BITS2BYTES(PARAMS_OFFSET) ;
    
  }     
  else if ( b == R_FP ) {
    /* locally declared things, negative offset from %fp */
    an.base = R_FP ;
    an.offset = -( BITS2BYTES(proc_state.locals_space)) +
      BYTE_OFFSET_PART(n) + BITS2BYTES(proc_state.locals_offset) /*-
      BITS2BYTES(proc_state.callee_size)*/;
    assert ( an.offset <= 0 ) ;
    assert ( an.offset >= -(BITS2BYTES(proc_state.locals_space /*+ 
                                       proc_state.callee_size*/))) ;
  } 
  else if ( b == R_SP ) {
    /* on stack temps */
    an.base = R_SP ;
    an.offset = BYTE_OFFSET_PART(n) ;
  } 
#if 0
  else if (b == local_reg && Has_vcallees){
    an.base = b;
    an.offset = -( BITS2BYTES(proc_state.locals_space)) +
      BYTE_OFFSET_PART(n) + BITS2BYTES(proc_state.locals_offset);
  }     
#endif
  else if ( b <= 31 ) {
    /* other base register and offset */
    an.base = b ;
    an.offset = BYTE_OFFSET_PART(n) ;
  }     

#if 1
  /* obsolete */
  else if ( b == 32 ) {
    /* global names */
    an.base = - ADDR_PART(n) ;
    an.offset = 0 ;
  } 
  else if ( b == 33 ) {
    /* local data label : LDNNNN */
    an.base = ADDR_PART(n) ;
    an.offset = 0 ;
  }
#endif
  else {
    fail ( "not a baseoff in boff" ) ;
  }
  return ( an ) ;
}

int boff_env_offset 
    PROTO_N ( ( e ) )
    PROTO_T ( exp e ){
  /* used ONLY for envoffsets as init values for globals. 
   cf make_proc_tag_code */
  int n = no ( e ) ;
  /*int b = REG_PART(n);*/
  int offset = 0x7fffffff;/* if not set should be outside stack seg */
  /*int this_callee_size = 0;*/
  exp x = e;
  assert (! isglob ( e ));
  /*assert (b == R_FP);*/

#define VAL_params_offset ( ( 16 + 1 ) * 32 )
#define VAL_locals_offset (0)
  while (name(x) != proc_tag && name(x)!=general_proc_tag){
    x = father(x);
    assert (x != nilexp);
  }
  if ( isparam ( e ) ) {
    /* parameter, positive offset from %fp */
    /*    assert ( name ( son ( e ) ) == clear_tag ) ;*/
    if(name(son(e)) == formal_callee_tag) {
      offset =  no(son(e))>>3;
    }
    else {
      offset = BITS2BYTES( no ( son ( e ) ) + VAL_params_offset );
      assert ( offset >= BITS2BYTES(VAL_params_offset) ) ;
    }
  } 
  else {
  /* locally declared things, negative offset from %fp */
  /* Now we need the stack size from the procrec, so find the proc */
    long locals_space;
    
    locals_space = procrecs[no(x)].spacereqproc.stack;
    locals_space = (locals_space +63) &~63; /* 8 byte aligned */
    offset = -( BITS2BYTES(locals_space)) +
      BYTE_OFFSET_PART(n) + BITS2BYTES(VAL_locals_offset) ;
    assert ( offset < 0 ) ;
    assert ( offset >= -(BITS2BYTES(locals_space))) ;
  }
  return ( offset ) ;
}       


/*
  AUXILLIARY LOCATION ROUTINE

  Finds the address of the expression e using shape s.  sp gives the
  available t-registers for any inner evaluation.  dreg is 
  historical.
*/

where locate1 
    PROTO_N ( ( e, sp, s, dreg ) )
    PROTO_T ( exp e X space sp X shape s X int dreg ){
  ash a ;
  ans aa ;
  where wans ;
  a = ashof ( s ) ;

  switch ( name ( e ) ) {
    case name_tag : {
      /* this a locally declared name ... */
      exp dc = son ( e ) ;
      bool var = ( bool ) isvar ( dc ) ;
      if ( props ( dc ) & defer_bit ) {
        /* ... it has been identified with a simple expression
           which is better evaluated every time */
        where w ;
        w = locate ( son ( dc ), sp, sh ( son ( dc ) ), dreg ) ;
        if ( no ( e ) == 0 ) {
          aa = w.answhere ;
        } 
        else {
          instore is ;
          switch ( discrim ( w.answhere ) ) {
            case notinreg : {
              is = insalt ( w.answhere ) ;
              is.b.offset += ( no ( e ) / 8 ) ;
              break ;
            }
            default : {
              fail ( "name not deferable" ) ;
            }
          }
          setinsalt ( aa, is ) ;
        }
      } 
      else if ( props ( dc ) & inreg_bits ) {
        /* ... it has been allocated in a fixed point register */
        if ( var ) {
          setregalt ( aa, no ( dc ) ) ;
        } 
        else {
          instore b ;
          b.b.base = no ( dc ) ;
          b.b.offset = 0 ;
          b.adval = 1 ;
          setinsalt ( aa, b ) ;
        }
      } 
      else if ( props ( dc ) & infreg_bits ) {
        /* ... it has been allocated in a floating point register */
        freg fr ;
        fr.fr = no ( dc ) ;
        fr.dble = ( bool ) ( ( a.ashsize == 64 ) ? 1 : 0 ) ;
        setfregalt ( aa, fr ) ;
      } 
      else {
        /* ... it is in memory */
        instore is ;
        if ( var || ( name ( sh ( e ) ) == prokhd &&
                      ( son ( dc ) == nilexp ||
                        name ( son ( dc ) ) == proc_tag ||
                        name(son(dc)) == general_proc_tag) ) ) {
          is.adval = 1 ;
        } 
        else {
          is.adval = 0 ;
        }
        is.b = boff ( dc ) ;
        is.b.offset += BITS2BYTES(no(e));
        setinsalt(aa,is);
      }
      wans.answhere = aa ;
      wans.ashwhere = a ;
      return ( wans ) ;
    }
    case addptr_tag : {
      exp sum = son ( e ) ;
      where wsum ;
      int addend ;
      space nsp ;
      int reg ;
      int ind = R_NO_REG ;
      instore is ;
      ans asum ;
    
      wsum = locate ( sum, sp, sh ( sum ), 0 ) ;
      asum = wsum.answhere ;
    
      /* answer is going to be wsum displaced by integer result of
       evaluating bro ( sum ) */
      switch ( discrim ( asum ) ) {
        case notinreg : {
          is = insalt ( asum ) ;
          if ( is.adval ) {
            /* wsum is a literal address in store ... */
            baseoff b ;
            b = is.b ;
            if ( !IS_FIXREG ( b.base ) ) {
              /* ... it is not a base-offset, so make it one */
              reg = getreg ( sp.fixed ) ;
              set_ins ( b, reg ) ;
              keepreg ( sum, reg ) ;
              b.base = reg ;
              b.offset = 0 ;
            }
            nsp = guardreg ( b.base, sp ) ;
            addend = reg_operand ( bro ( sum ), nsp ) ;
        
            /* evaluate the displacement ... */
            if ( dreg == 0 ) dreg = getreg ( nsp.fixed ) ;
            rrr_ins ( i_add, b.base, addend, dreg ) ;
            clear_reg ( dreg ) ;
        
            /* ... add it to the base register into new reg */
            b.base = dreg ;
            is.b = b ;
            setinsalt ( aa, is ) ;
            wans.answhere = aa ;
            wans.ashwhere = a ;
        
            /* ...and use it as base a literal base-offset result */
            keepexp ( e, aa ) ;
            return ( wans ) ;
          } 
          else {
            /* wsum represents an actual pointer in store ... */
            /* ... so load it into a good register */
            ind = getreg ( sp.fixed ) ;
            ld_ins ( i_ld, is.b, ind ) ;
          }
          break ;
        }
        case inreg : {
          /* wsum is already in reg */
          ind = regalt ( asum ) ;
          break ;
        }
        default : {
          fail ( "locate ? reg" ) ;
        }
      }
    /*register ind contains the evaluation of 1st operand of addptr*/
      if ( name ( bro ( sum ) ) == env_offset_tag || 
           name (bro(sum)) == general_env_offset_tag) {
        is.b.base = ind;
        is.b.offset = boff_env_offset(son(bro(sum)));
      }
      nsp = guardreg ( ind, sp ) ;
      addend = reg_operand ( bro ( sum ), nsp ) ;
      /* evaluate displacement, add it to ind in new reg */
      if ( dreg == 0 ) dreg = getreg ( nsp.fixed ) ;
      rrr_ins ( i_add, ind, addend, dreg ) ;
      clear_reg ( dreg ) ;
      is.b.base = dreg ;
      is.b.offset = 0 ;
      is.adval = 1 ;
      setinsalt ( aa, is ) ;
      wans.answhere = aa ;
      wans.ashwhere = a ;
      /* ... and deliver literal base_offset */
      keepexp ( e, aa ) ;
      return ( wans ) ;
    }
    case subptr_tag : {
      /* shouldn't occur */
      exp sum = son ( e ) ;
      int ind = reg_operand ( sum, sp ) ;
      instore isa ;
      isa.adval = 1 ;
      sum = bro ( sum ) ;
      if ( name ( sum ) == val_tag ) {
        isa.b.base = ind ;
        isa.b.offset = -no ( e ) ;
        setinsalt ( aa, isa ) ;
      } 
      else {
        if ( dreg == 0 ) dreg = getreg ( sp.fixed ) ;
        rrr_ins ( i_sub, ind,
                  reg_operand ( sum, guardreg ( ind, sp ) ), dreg ) ;
        isa.b.base = dreg ;
        isa.b.offset = 0 ;
      }
      setinsalt ( aa, isa ) ;
      wans.answhere = aa ;
      wans.ashwhere = a ;
      keepexp ( e, aa ) ;
      return ( wans ) ;
    }
    case reff_tag : {
      /* answer is going to be wans displaced by no ( e ) */
      wans = locate ( son ( e ), sp, sh ( son ( e ) ), 0 ) ;
      switch ( discrim ( wans.answhere ) ) {
        case notinreg : {
          instore isa;
          isa = insalt ( wans.answhere ) ;
          if ( !isa.adval ) {
            /* wans is an actual pointer in store, so make it
               into a literal address ...  */
            int reg = getreg ( sp.fixed ) ;
            ld_ins ( i_ld, isa.b, reg ) ;
            isa.b.offset = 0 ;
            isa.b.base = reg ;
            isa.adval = 1 ;
          }
          /* ... and add appropriate displacement to give result */
          isa.b.offset += BITS2BYTES(no ( e )) ;
          setinsalt ( wans.answhere, isa ) ;
          keepexp ( e, wans.answhere ) ;
          break ;
        }
        case inreg : {
          /* wans is a pointer in a register */
          instore isa;
      
          isa.b.base = regalt ( wans.answhere ) ;
          isa.adval = 1 ;
          isa.b.offset = BITS2BYTES(no ( e )) ;
          setinsalt ( wans.answhere, isa ) ;
          break ;
        }
        default : {
          fail ( "locate ? reg " ) ;
        }
      }
      wans.ashwhere = a ;
      return ( wans ) ;
    }
    case cont_tag :
    case contvol_tag : {
      exp se = son ( e ) ;
      ans ason ;
      instore isa ;
      int reg ;
      where fc ;
      /* answer is contents of address represented by fc */
      fc = locate ( se, sp, sh ( e ), 0 ) ;
      ason = fc.answhere ;
      switch ( discrim ( ason ) ) {
        case notinreg : {
          isa = insalt ( ason ) ;
          if ( isa.adval ) {
            /* literal store address, make it a direct one */
            isa.adval = 0 ;
            setinsalt ( aa, isa ) ;
          } 
          else {
            /* actual pointer in store so load it into reg and
               deliver direct base-offset ( reg, 0 ) */
            reg = getreg ( sp.fixed ) ;
            ld_ins ( i_ld, isa.b, reg ) ;
            isa.b.base = reg ;
            isa.b.offset = 0 ;
            setinsalt ( aa, isa ) ;
            if ( name ( e ) != contvol_tag &&
                 fc.ashwhere.ashalign != 1 ) {
              keepexp ( e, aa ) ;
            }
          }
          goto breakson ;
        }
        case inreg : {
          /* this one is fraught - it depends on only being used
             in lh-value positions from vars - take care */
          isa.b.base = regalt ( ason ) ;
          isa.b.offset = 0 ;
          isa.adval = 1 ;
          setinsalt ( aa, isa ) ;
          /* fc is in register, so deliver literal base-offset */
          goto breakson ;
        }
        case infreg : {
          /* ditto caveat above */
          aa = ason ;
          goto breakson ;
        }
        default : {
          fail ( "locate ? reg" ) ;
        }
      }
      breakson :
        wans.answhere = aa ;
      wans.ashwhere = a ;
      return ( wans ) ;
    }
    case top_tag : {
      /* does this ever happen? */
      setregalt ( aa, 0 ) ;
      wans.answhere = aa ;
      wans.ashwhere = a ;
      return ( wans ) ;
    }
    case field_tag : {
      /* answer is wans displace literally by no ( e ) ; it should
         always be a literal store address */
      wans = locate ( son ( e ), sp, sh ( son ( e ) ), 0 ) ;
      switch ( discrim ( wans.answhere ) ) {
        case notinreg : {
          instore isa;
          isa = insalt ( wans.answhere ) ;
          isa.b.offset += BITS2BYTES(no ( e )) ;
          setinsalt(wans.answhere,isa);
          break ;
        }
        default : {
          fail ( "field should be transformed" ) ;
        }
      }
      wans.ashwhere = a ;
      return ( wans ) ;
    }
    default : {
      /* general catch all ; evaluate e into register and deliver
         it as a literal store address */
      int r = reg_operand ( e, sp ) ;
      instore is ;
      /* Is this needed on SPARC??? */
      if ( r == R_O0 ) {
        /* guard possible result from proc - can do better */
        r = getreg ( sp.fixed ) ;
        if ( r != R_O0 ) rr_ins ( i_mov, R_O0, r ) ;
      }
      is.b.base = r ;
      is.b.offset = 0 ;
      is.adval = 1 ;
      setinsalt ( aa, is ) ;
      wans.answhere = aa ;
      wans.ashwhere = a ;
      return ( wans ) ;
    }
  }
}


/*
  MAIN LOCATION ROUTINE

  This is similar to locate1, but firstly checks if e is kept in a
  register.
*/

where locate 
    PROTO_N ( ( e, sp, s, dreg ) )
    PROTO_T ( exp e X space sp X shape s X int dreg ){
  ans ak ;
  where w ;
  ak = iskept ( e ) ;
  if ( discrim ( ak ) == inreg && regalt ( ak ) == 0 ) {
    w = locate1 ( e, sp, s, dreg ) ;
  } 
  else {
    w.answhere = ak ;
    w.ashwhere = ashof ( s ) ;
  }
  return ( w ) ;
}