/* $Header:local.c 12.0$ */
/* $ACIS:local.c 12.0$ */
/* $Source: /ibm/acis/usr/src/lib/pcc_ca/RCS/local.c,v $ */
#ifndef lint
static char rcsid[] = "$Header:local.c 12.0$";
#endif
#ifdef unix
# include "mfile1.h"
#else
# include "doption h *"  /* circumvention for -D problem with preprocessor */
# include "mfile1 h *"
#endif
 
/* this file contains code which is dependent on the target machine */
 
int eprint();
NODE *
cast( p, t ) register NODE *p; register TWORD t; {
   /* cast node p to type t */
 
   p = buildtree( CAST, block( NAME, NIL, NIL, t, 0, (int)t ), p );
   p->in.left->in.op = FREE;
   p->in.op = FREE;
   return( p->in.right );
   }
 
extern int idebug;       /* added 12/16/83 by JEC */
 
NODE *
clocal(p) register NODE *p; {
 
   /* this is called to do local transformations on
   /* an expression tree preparitory to its being
   /* written out in intermediate code.
   /*
   /*
   /* the major essential job is rewriting the
   /* automatic variables and arguments in terms of
   /* REG and OREG nodes
   /* conversion ops which are not necessary are also clobbered here
   /* in addition, any special features (such as rewriting
   /* exclusive or) are easily handled here as well
    */
   register struct symtab *q;
   register NODE *r;
   register o;
   register m, ml;
extern xdebug;
 
#ifndef BUG0
   if( idebug>2 ){
       printf("clocal called with tree:\n");
       fwalk( p, eprint, 0 );
       }
#endif
 
   switch( o = p->in.op ){
 
   case NAME:
 
      if( p->tn.rval < 0 ) { /* already processed; ignore... */
         return(p);
         }
      q = &stab[p->tn.rval];
      switch( q->sclass ){
 
      case AUTO:
      case PARAM:
 
#ifndef BUG0
         if( idebug>2 ){
             printf("lval=%d, offset=%d, sclass=%d, size=%d, dim=%d.\n",
                 p->tn.lval, q->offset, q->sclass,
                 dimtab[q->sizoff], dimtab[q->dimoff] );
             }
#endif
 
         /* fake up a structure reference */
         r = block( REG, NIL, NIL, PTR+STRTY, 0, 0 );
         r->tn.lval = 0;
/*         r->tn.rval = 1; /* XXX WFA 7/7/85, (1=SP) used to be FPREG == 14 */
	 r->tn.rval = FPREG;
         p = stref( block( STREF, r, p, 0, 0, 0 ) );
 
         /* If this name is a PARM, (or a local! WFA 7/20/85)            */
         /*                          add a symbolic name into the offset */
         /* Beware the machine independent prtree/p2tree in trees.c      */
         /* Also, do not try to make ARGINIT zero, as the tree that is   */
         /* generated for the first parm has no + ICON subtree.          */
 
         if( (q->sclass == PARAM) ) 
/*             (q->sclass == AUTO) )	/* WFA 7/20/85 */
             if( (p->in.op == UNARY MUL) && (r = p->in.left) &&
                 (r->in.op == PLUS) && (r = r->in.right) &&
                 (r->in.op == ICON)
                ){ extern int parmlbl;
		   r->tn.rval = -parmlbl;
                 }
             else cerror("bad PARAM tree");
 
         break;
 
      case ULABEL:
      case LABEL:
      case STATIC:
         if( q->slevel == 0 ) break;

	 /* If this is an uninitialized local static, then it needs a name */
	 /* which doesn't look like a label...  --kas     		   */
	 if ( q->sflags&SNOINIT ) {
	     p->tn.name = tstr( "xxxxxxxxxx" );
	     sprintf( p->tn.name, "LCOM%d", q->offset );
	 }
         p->tn.lval = 0;
         p->tn.rval = -q->offset;
         break;
 
      case REGISTER:
         p->in.op = REG;
         p->tn.lval = 0;
         p->tn.rval = q->offset;
         break;
 
         }
      break;
 
   case PCONV:
      /* do pointer conversions for char and longs */
      ml = p->in.left->in.type;
/*
/*  Modified 4/10/84 by JEC. ibm032 load instruction converts chars (which are
/*  all unsigned on ibm032) and shorts to longs.  Type of left operand must be
/*  retained therefore, but the conversion is the same as for a scalar.
*/
      if( (ml==CHAR||ml==UCHAR||ml==SHORT||ml==USHORT)
          &&  p->in.left->in.op != ICON
        ){
          p->in.op = SCONV;
          break;
        }
 
      /* pointers all have the same representation; the type is inherited */
 
   inherit:
      p->in.left->in.type = p->in.type;
      p->in.left->fn.cdim = p->fn.cdim;
      p->in.left->fn.csiz = p->fn.csiz;
      p->in.op = FREE;
      return( p->in.left );
 
   case SCONV:
      m = (p->in.type == FLOAT || p->in.type == DOUBLE );
      ml = (p->in.left->in.type == FLOAT || p->in.left->in.type == DOUBLE );
      if      ( m ^ ml ) break;
      else if ( m && ml && p->in.type!=p->in.left->in.type ) break;
 
      /* now, look for conversions downwards */
 
      m = p->in.type;
      ml = p->in.left->in.type;
      if( p->in.left->in.op == ICON ){ /* simulate the conversion here */
         CONSZ val;
         val = p->in.left->tn.lval;
         switch( m ){
         case CHAR:
/*            p->in.left->tn.lval = (char) val;*/
            p->in.left->tn.lval = val & 0xFF;
            break;
         case UCHAR:
            p->in.left->tn.lval = val & 0XFF;
            break;
         case USHORT:
            p->in.left->tn.lval = val & 0XFFFFL;
            break;
         case SHORT:
            p->in.left->tn.lval = (short)val;
            break;
         case UNSIGNED:
            p->in.left->tn.lval = val & 0xFFFFFFFFL;
            break;
         case INT:
            p->in.left->tn.lval = (int)val;
            break;
            }
         p->in.left->in.type = m;
         }
      else {
         /* meaningful ones are conversion of int to char, int to short,
            and short to char, and unsigned version of them */
	 /* another meaningful conversion is unsigned char to int */
         if( m==CHAR || m==UCHAR ){
            if( ml!=CHAR && ml!= UCHAR ) break;
            }
         else if( m==SHORT || m==USHORT ){
            if( ml!=CHAR && ml!=UCHAR && ml!=SHORT && ml!=USHORT ) break;
            }
         else if( m==INT ) {
            if( ml!=INT ) break;
            }
         }
 
      /* clobber conversion */
      if( tlen(p) == tlen(p->in.left) ) goto inherit;
      p->in.op = FREE;
      return( p->in.left );  /* conversion gets clobbered */
 
   case PVCONV:
   case PMCONV:
      if( p->in.right->in.op != ICON ) cerror( "bad conversion", 0);
      p->in.op = FREE;
      return( buildtree( o==PMCONV?MUL:DIV, p->in.left, p->in.right ) );
   }
 
#ifndef BUG0
   if( idebug>2 ){
       printf("clocal returning tree:\n");
       fwalk( p, eprint, 0 );
       }
#endif
 
   return(p);
}
 
extern int iclass;       /* added 12/16/83 by JEC */
 
andable( p ) register NODE *p; { 
			/* modified 12/16/83 by JEC so that names may be    */
                        /* treated as icon's when used as operands of data  */
                        /* constants, but may not be treated as icons when  */
                        /* used as instruction operands (as relocation of   */
                        /* addresses requires that all four bytes of the    */
                        /* address be contiguous in storage.                */
                        /* XXX Changed, WFA 7/16/85, to allow bali NAME     */
			/*     Changed, EF  11/6/85, to allow bali NAME ONLY*/
#ifndef BUG0
     if( idebug ) {
       printf("andable( %o ) iclass=%d\n", p, iclass );
       fwalk( p, eprint, 0 );
     }
#endif
/* (ef) 11/20/85 -- see if we can move this logic so ONLY balix is affected */
     if ( ISFTN(p->tn.type) ) return( 1 );
     else                     return(iclass==STATIC || iclass==EXTDEF);
     }
 
cendarg(){ /* at the end of the arguments of a ftn, set the automatic offset */
     autooff = AUTOINIT;
     }
 
	/* is an automatic variable of type t OK for a register variable */
cisreg( t ) register TWORD t; { 
 
     if( t==INT || t==UNSIGNED || t==LONG || t==ULONG /* tbl */
       || t==CHAR || t==UCHAR || t==SHORT || t==USHORT /* tbl */
       || ISPTR(t)) return(1);   /* tbl */
     return(0);
     }
 
NODE *
offcon( off, t, d, s ) register OFFSZ off; register TWORD t; register d,s; {
 
     /* return a node, for structure references, which is suitable for
        being added to a pointer of type t, in order to be off bits offset
        into a structure */
 
     register NODE *p;
 
     /* t, d, and s are the type, dimension offset, and sizeoffset */
     /* in general they  are necessary for offcon, but not on H'well */
 
     p = bcon(0);
     p->tn.lval = off/SZCHAR;
     return(p);
 
     }
 
/*** Begin code taken from the MIT 68000 compiler 12/27/83 by JEC ***/
 
static inwd;       /* current bit offsed in word */
static long word;  /* word being built from fields */
extern int lflag;  /* Should we print line numbers on assembly file? --kas */
 
incode( p, sz ) register NODE *p; register sz; {
 
       /* generate initialization code for assigning a constant c
               to a field of width sz */
       /* we assume that the proper alignment has been obtained */
       /* inoff is updated to have the proper final value */
       /* we also assume sz  < SZINT */
 
       if((sz+inwd) > SZINT) cerror("incode: field > int");
       word |= (p->tn.lval & ((1 << sz) -1)) << (SZINT - sz - inwd);
       inwd += sz;
       inoff += sz;
       if (( lflag ) && (inwd >= 16))
          lineid( lineno, ftitle );
       while (inwd >= 16) {
         printf( " .byte 0x%lx,0x%lx\n", (word>>24)&0xFFL, (word>>16)&0xFFL );
/***     printf( " .short 0x%lx\n", (word>>16)&0xFFFFL );
***/     word <<= 16;
         inwd -= 16;
       }
}
 
/*** End code taken from the MIT 68000 compiler 12/27/83 by JEC ***/
#ifdef ONVAX 
double frexp(),
       ldexp();
 
fincode( d, sz ) double d; register sz; {		/* lmb */

/*	Output code to initialize space of size sz to the value d 
	in IEEE single or double floating format. 
	The proper alignment has been obtained.
	inoff is updated to have the proper final value.
	Until we can trust assembler .double conversion, output the value 
	as hexadecimal integers. 
	This routine is intended to execute correctly on any machine 
	(vax, 370, ieee) but has been tested only on a vax.
 */
 
    register unsigned long h,l;
    register int i, s=0;
    double ds=d;

	if ( lflag )
	   lineid( lineno, ftitle );
	if (d==0.0) {
	    i= -1023;		/* force single or double 0 */
	} else {
	    if (d<0.0) {
		s=1;
		ds = -d;
	    }
	    ds = frexp(ds,&i);
	    if (ds<1.0) {	/* some frexp's are buggy;  */
		ds += ds;	/* ds might be == 1 already */
		i--;
	    }
	    ds = ds-1.0;	/* remove leading mantissa bit */
	}
	if( sz == SZDOUBLE ){   /* double precision; no support for
				   overflow or subnormals.          */
	    h=ds=ds*1048576.0;	/*high 21 mantissa bits, w/o lead 1 */
	    if (ds<h) h--;	/* assure truncation, not rounding */
	    l=(ds-h)*4294967296.0;
	    h=(s<<31) | (((i+1023)&0x7ff)<<20) | h;
	    printf("   .long 0x%08x,0x%08x\t# .double %.16g\n",h,l,d);
        }else{
				/* single precision, with support for
				   overflow (-> infinity) and subnormals.  */
	if (i>=-126) {
	    h=ds=ds*8388608.0;	 /* 24 mantissa bits without leading 1 bit */
	    h+=(ds-h>=0.5 ?1:0); /* round to single precision --     
				    unnecessary but harmless if machine's
				    double-to-int conversion rounds.
				    Mantissa carry simply bumps exponent --	
			   	    a remarkable feature of 754	*/
	    if (i+(int)(h>>23) > 127) h= 0x7f800000; /* signed infinity */
	    else h+=(i+127)<<23;	
	}
	else {				/* create a subnormal or 0	*/
	    h=ds=ldexp(ds+1.0,i+149);
	    h+=(ds-h)>=0.5 ?1:0;	/* round to single precision --	   */
	    				/* mantissa carry becomes exponent */
	}
	printf("   .long 0x%08x\t # .float %.9g\n",h|(s<<31),d);
     }
     inoff += sz;
}
#else	/* not ONVAX */

fincode( d, sz ) double d; register sz; {			/* lmb */

/*	Output code to initialize space of size sz to the value d 
	in IEEE single or double floating format. 
	The proper alignment has been obtained.
	inoff is updated to have the proper final value.
	Until we can trust assembler .double conversion, output the value 
	as hexadecimal integers. 
 */
 
union Double {
	double d;
	float f;
	unsigned long ul[2];
	}
    ds;

	if ( lflag )
	   lineid( lineno, ftitle );
	if( sz == SZDOUBLE ){   
	    ds.d = d;
	    printf("   .long 0x%08x,0x%08x\t# .double 0d%-1.17e\n",
		ds.ul[0],ds.ul[1],ds.d);
        }else{
	    ds.f = d;
	    printf("   .long 0x%08x\t # .float 0f%.9e\n",ds.ul[0],ds.f);
         }
     inoff += sz;
}
 
#endif	/* ONVAX */
 
cinit( p, sz ) register NODE *p; register sz; {
     /* arrange for the initialization of p into a space of
     size sz */
     /* the proper alignment has been opbtained */
     /* inoff is updated to have the proper final value */
     ecode( p );
     inoff += sz;
     }
 
/*** Begin code taken from the MIT 68000 compiler 12/27/83 by JEC ***/
 
vfdzero( n ) register n; { /* define n bits of zeros in a vfd */
 
       if( n <= 0 ) return;
 
       inwd += n;
       inoff += n;
       if (( lflag )&&(inwd >= 16))
          lineid( lineno, ftitle );
       while (inwd >= 16) {
         printf( " .byte 0x%lx,0x%lx\n", (word>>24)&0xFFL, (word>>16)&0xFFL );
/***     printf( " .short 0x%lx\n", (word>>16)&0xFFFFL );
***/     word <<= 16;
         inwd -= 16;
       }
}
 
/*** End code taken from the MIT 68000 compiler 12/27/83 by JEC ***/
 
char *
exname( p ) register char *p; {
    /* make a name look like an external name in the local machine */
 
#ifndef FLEXNAMES
    static char text[NCHNAM+1];
#else
    static char text[BUFSIZ+1];
#endif
 
    register i;
 
    text[0] = '_';
#ifndef FLEXNAMES
    for( i=1; *p&&i<NCHNAM; ++i ){
#else
    for( i=1; *p; ++i ){
#endif
        text[i] = *p++;
        }
 
    text[i] = '\0';
#ifndef FLEXNAMES
    text[NCHNAM] = '\0';  /* truncate */
#endif
 
    return( text );
    }
  
char *
entryname( p ) char *p; {
    /* make a name look like a function entry point name (prepend "_.") */
 
#ifndef FLEXNAMES
    static char text[NCHNAM+1];
#else
    static char text[BUFSIZ+1];
#endif
 
    register i;
 
    text[0] = '_';
    text[1] = '.';
#ifndef FLEXNAMES
    for( i=2; *p&&i<NCHNAM; ++i ){
#else
    for( i=2; *p; ++i ){
#endif
        text[i] = *p++;
        }
 
    text[i] = '\0';
#ifndef FLEXNAMES
    text[NCHNAM] = '\0';  /* truncate */
#endif
 
    return( text );
    }
 
		/* map types which are not defined on the local machine */
ctype( type ) register type; { 
    switch( BTYPE(type) ){
 
    case LONG:
        MODTYPE(type,INT);
        break;
 
    case ULONG:
        MODTYPE(type,UNSIGNED);
        }
    return( type );
    }
 
noinit( t ) register t; { /* curid is a variable which is defined but
    is not initialized (and not a function );
    This routine returns the stroage class for an uninitialized declaration */
 
    return(EXTERN);
 
    }
 
			/* make a common declaration for id, if reasonable */
commdec( id ) register id; { 
    register struct symtab *q;
    register OFFSZ off;
    OFFSZ tsize();
 
    q = &stab[id];
    printf( " .comm %s,", exname( q->sname ) );
    off = tsize( q->stype, q->dimoff, q->sizoff );
    printf( CONFMT, off/SZCHAR );
    printf( "\n" );
    }
 
isitlong( cb, ce ) register cb, ce; { /* is lastcon to be long or short */
    /* cb is the first character of the representation, ce the last */
 
    if( ce == 'l' || ce == 'L' ||
        lastcon >= (1L << (SZINT-1) ) ) return (1);
    return(0);
    }
 
 
isitfloat( s ) register char *s; {
    double atof();
    dcon = atof(s);
    return( FCON );
    }
 
ecode( p ) register NODE *p; {
 
    /* walk the tree and write out the nodes.. */
 
    if( nerrors ) return;
    p2tree( p );
    p2compile( p );
    }
 
#ifndef ONEPASS
tlen(p) register NODE *p;
{
    switch(p->in.type) {
        case CHAR:
        case UCHAR:
            return(1);
 
        case SHORT:
        case USHORT:
            return(2);
 
        case DOUBLE:
            return(8);
 
        default:
            return(4);
        }
    }
#endif
