date and time created 86/01/11 11:00:53 by sam
authorSam Leffler <sam@ucbvax.Berkeley.EDU>
Sun, 12 Jan 1986 03:00:53 +0000 (19:00 -0800)
committerSam Leffler <sam@ucbvax.Berkeley.EDU>
Sun, 12 Jan 1986 03:00:53 +0000 (19:00 -0800)
SCCS-vsn: old/pcc/ccom.tahoe/local.c 1.1

usr/src/old/pcc/ccom.tahoe/local.c [new file with mode: 0644]

diff --git a/usr/src/old/pcc/ccom.tahoe/local.c b/usr/src/old/pcc/ccom.tahoe/local.c
new file mode 100644 (file)
index 0000000..da277a2
--- /dev/null
@@ -0,0 +1,480 @@
+#ifndef lint
+static char sccsid[] = "@(#)local.c    1.1 (Berkeley) %G%";
+#endif
+
+# include "mfile1"
+
+/*     this file contains code which is dependent on the target machine */
+
+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 int o;
+       register int m, ml;
+
+       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:
+                       /* fake up a structure reference */
+                       r = block( REG, NIL, NIL, PTR+STRTY, 0, 0 );
+                       r->tn.lval = 0;
+                       r->tn.rval = STKREG;
+                       p = stref( block( STREF, r, p, 0, 0, 0 ) );
+                       break;
+
+               case ULABEL:
+               case LABEL:
+               case STATIC:
+                       if( q->slevel == 0 ) break;
+                       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;
+#ifdef REG_CHAR
+                       m = p->in.type;
+                       if( m==CHAR || m==SHORT )
+                               p->in.type = INT;
+                       else if( m==UCHAR || m==USHORT )
+                               p->in.type = UNSIGNED;
+#endif
+                       break;
+
+                       }
+               break;
+
+       case LT:
+       case LE:
+       case GT:
+       case GE:
+               if( ISPTR( p->in.left->in.type ) || ISPTR( p->in.right->in.type ) ){
+                       p->in.op += (ULT-LT);
+                       }
+               break;
+
+       case PCONV:
+               /* do pointer conversions for char and longs */
+               ml = p->in.left->in.type;
+               if( ( ml==CHAR || ml==UCHAR || ml==SHORT || ml==USHORT ) && p->in.left->in.op != ICON ) 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;
+               ml = p->in.left->in.type;
+               if(m == FLOAT || m == DOUBLE) {
+                       if(p->in.left->in.op==SCONV &&
+                        (ml == FLOAT || ml == DOUBLE) &&
+                        p->in.left->in.left->in.type==m) {
+                               p->in.op = p->in.left->in.op = FREE;
+                               return(p->in.left->in.left);
+                       }
+                       if(p->in.left->in.op==FCON)
+                               goto inherit;
+                       break;
+               }
+               if(ml == FLOAT || ml == DOUBLE){
+                       if (p->in.left->in.op == FCON){
+                               p->in.left->in.op = FREE;
+                               p->in.op = ICON;
+                               p->tn.lval = p->in.left->fpn.dval;
+                               p->tn.rval = NONAME;
+                               return(p);
+                       }
+                       break;
+               }
+               /* now, look for conversions downwards */
+
+               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;
+                               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 versions thereof */
+                       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;
+                               }
+                       }
+
+               /* clobber conversion */
+               if( tlen(p) == tlen(p->in.left) ) goto inherit;
+               p->in.op = FREE;
+               return( p->in.left );  /* conversion gets clobbered */
+
+       case QUEST:     /* the right side should be COLON */
+               if((r = p->in.right)->in.op == SCONV) {
+                       p->in.right = r->in.left;
+                       p->in.type = r->in.left->in.type;
+                       r->in.left = p;
+                       return(r);
+               }
+               return(p);
+
+       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 ) );
+
+       case FLD:
+               /* make sure that the second pass does not make the
+                  descendant of a FLD operator into a doubly indexed OREG */
+
+               if( p->in.left->in.op == UNARY MUL
+                               && (r=p->in.left->in.left)->in.op == PCONV)
+                       if( r->in.left->in.op == PLUS || r->in.left->in.op == MINUS ) 
+                               if( ISPTR(r->in.type) ) {
+                                       if( ISUNSIGNED(p->in.left->in.type) )
+                                               p->in.left->in.type = UNSIGNED;
+                                       else
+                                               p->in.left->in.type = INT;
+                               }
+               break;
+               case FORTCALL: /* arg must be FLOAT */
+                       if((r = p->in.right)->in.type != FLOAT)
+                               p->in.right = clocal(makety(r, FLOAT, 0, FLOAT));
+                       return(p);
+               }
+
+       /* if both sides are FLOAT, so is the op */
+       if(optype(o)!=LTYPE && p->in.left->in.type==DOUBLE &&
+        (o==UNARY MINUS || optype(o)==BITYPE && p->in.right->in.type==DOUBLE)) {
+               r = p->in.left;
+               if(r->in.op==SCONV && r->in.left->in.type==FLOAT) {
+                       if(optype(o)==BITYPE) {
+                               r = p->in.right;
+                               if(r->in.op==SCONV && r->in.left->in.type==FLOAT) {
+                                       r->in.op = FREE;
+                                       p->in.right = r->in.left;
+                               } else if(r->in.op==FCON)
+                                       r->in.type = FLOAT;
+                               else
+                                       return(p);
+                       }
+                       r = p->in.left;
+                       p->in.left = r->in.left;
+               } else if(optype(o)==BITYPE && r->in.op==FCON) {
+                       r = p->in.right;
+                       if(!(r->in.op==SCONV && r->in.left->in.type==FLOAT))
+                               return(p);
+                       p->in.right = r->in.left;
+                       p->in.left->in.type = FLOAT;
+               } else
+                       return(p);
+               if(p->in.type==DOUBLE) {
+                       p->in.type = FLOAT;
+                       r->in.left = p;
+                       return(r);
+               } else {        /* usually logop */
+                       r->in.op = FREE;
+                       return(p);
+               }
+       }
+       return(p);
+}
+
+andable( p ) NODE *p; {
+       return(1);  /* all names can have & taken on them */
+       }
+
+cendarg(){ /* at the end of the arguments of a ftn, set the automatic offset */
+       autooff = AUTOINIT;
+       }
+
+cisreg( t ) TWORD t; { /* is an automatic variable of type t OK for a register variable */
+
+       if( t==INT || t==UNSIGNED || t==LONG || t==ULONG        /* tbl */
+#ifdef REG_CHAR
+               || t==CHAR || t==UCHAR || t==SHORT || t==USHORT         /* tbl */
+#endif
+               || ISPTR(t)) return (1);                        /* wnj */
+       return(0);
+       }
+
+NODE *
+offcon( off, t, d, s ) OFFSZ off; TWORD t; {
+
+       /* 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);
+
+       }
+
+
+static inwd    /* current bit offsed in word */;
+static CONSZ word      /* word being built from fields */;
+
+incode( p, sz ) register NODE *p; {
+
+       /* 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 */
+
+       inwd += sz;
+       if(inwd > SZINT) cerror("incode: field > int");
+       word |= (p->tn.lval&((1L<<sz)-1)) << (SZINT-inwd);
+       inoff += sz;
+       if(inoff%SZINT == 0) {
+               printf( "       .long   0x%08X\n", word);
+               word = inwd = 0;
+               }
+       }
+
+# ifdef PRTDCON
+prtdcon( p ) register NODE *p; {
+       int i;
+
+       if( p->in.op == FCON ){
+               if(p->fpn.dval == 0) {
+                       p->in.op = ICON;
+                       p->tn.rval = NONAME;
+                       return;
+               }
+               locctr( DATA );
+               defalign( ALDOUBLE );
+               deflab( i = getlab() );
+# ifndef SFCON
+               fincode( p->fpn.dval, p->in.type==DOUBLE ? SZDOUBLE : SZFLOAT);
+# else
+               p->in.type = fincode( p->fpn.dval, 0 );
+# endif
+               p->tn.lval = 0;
+               p->tn.rval = -i;
+               p->in.op = NAME;
+               }
+       }
+# endif
+
+fincode( d, sz ) double d; register int sz; {
+       /*
+        * output code to initialize space of size sz to the value d
+        * the proper alignment has been obtained
+        * inoff is updated to have the proper final value
+        * this code should be the same for PDP, VAX and Tahoe
+        * SFCON makes use of value to determine type - only where
+        * float<->double conversions are ignored.
+        */
+
+       register struct sh4 {
+               unsigned short sh[4];
+       } *x;
+# ifdef SFCON
+       register int type;
+# else
+       float f;
+
+       if(sz == SZFLOAT) {     /* force rounding */
+               f = d;
+               d = f;
+       }
+# endif
+
+       x = (struct sh4 *)&d;
+       printf("        .long   0x%04x%04x", x->sh[0], x->sh[1]);
+# ifdef SFCON
+       if(sz==0)
+               if(x->sh[2]==0 && x->sh[3]==0) {
+                       sz = SZFLOAT;
+                       type = FLOAT;
+               } else {
+                       sz = SZDOUBLE;
+                       type = DOUBLE;
+               }
+# endif
+       if(sz == SZDOUBLE) {
+               printf(", 0x%04x%04x", x->sh[2], x->sh[3]);
+               printf(" # .double %.17g\n", d);
+       } else
+               printf(" # .float %.8g\n", d);
+       inoff += sz;
+# ifdef SFCON
+       return type;
+# endif
+       }
+
+cinit( p, sz ) NODE *p; {
+       /* 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;
+       }
+
+vfdzero( n ){ /* define n bits of zeros in a vfd */
+
+       if( n <= 0 ) return;
+
+       inwd += n;
+       inoff += n;
+       if( inoff%ALINT ==0 ) {
+               printf( "       .long   0x%08X\n", word );
+               word = inwd = 0;
+               }
+       }
+
+char *
+exname( p ) 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 int 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 );
+       }
+
+ctype( type )TWORD type;{ /* map types which are not defined on the local machine */
+       switch( BTYPE(type) ){
+
+       case LONG:
+               MODTYPE(type,INT);
+               break;
+
+       case ULONG:
+               MODTYPE(type,UNSIGNED);
+               }
+       return( type );
+       }
+
+noinit() { /* 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);
+
+       }
+
+commdec( id ){ /* make a common declaration for id, if reasonable */
+       register struct symtab *q;
+       OFFSZ off, tsize();
+
+       q = &stab[id];
+       printf( "       .comm   %s,", exname( q->sname ) );
+       off = tsize( q->stype, q->dimoff, q->sizoff );
+       printf( "%d" /*CONFMT*/, off/SZCHAR );
+       printf( "\n" );
+       }
+
+
+isitfloat( s ) char *s; {
+       double atof();
+       dcon = atof(s);
+       return( FCON );
+       }
+
+ecode( p ) NODE *p; {
+
+       /* walk the tree and write out the nodes.. */
+
+       if( nerrors ) return;
+       p2tree( p );
+       p2compile( p );
+       }
+
+#ifndef ONEPASS
+tlen(p) 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