00001 /****************************************************************
00002 Copyright 1990, 1991, 1993, 1994, 1996 by AT&T, Lucent Technologies and Bellcore.
00003 
00004 Permission to use, copy, modify, and distribute this software
00005 and its documentation for any purpose and without fee is hereby
00006 granted, provided that the above copyright notice appear in all
00007 copies and that both that the copyright notice and this
00008 permission notice and warranty disclaimer appear in supporting
00009 documentation, and that the names of AT&T, Bell Laboratories,
00010 Lucent or Bellcore or any of their entities not be used in
00011 advertising or publicity pertaining to distribution of the
00012 software without specific, written prior permission.
00013 
00014 AT&T, Lucent and Bellcore disclaim all warranties with regard to
00015 this software, including all implied warranties of
00016 merchantability and fitness.  In no event shall AT&T, Lucent or
00017 Bellcore be liable for any special, indirect or consequential
00018 damages or any damages whatsoever resulting from loss of use,
00019 data or profits, whether in an action of contract, negligence or
00020 other tortious action, arising out of or in connection with the
00021 use or performance of this software.
00022 ****************************************************************/
00023 
00024 /*
00025  * INTERMEDIATE CODE GENERATION PROCEDURES COMMON TO BOTH
00026  * JOHNSON (PORTABLE) AND RITCHIE FAMILIES OF SECOND PASSES
00027 */
00028 
00029 #include "defs.h"
00030 #include "names.h"              /* For LOCAL_CONST_NAME */
00031 #include "pccdefs.h"
00032 #include "p1defs.h"
00033 
00034 /* Definitions for   putconst()   */
00035 
00036 #define LIT_CHAR 1
00037 #define LIT_FLOAT 2
00038 #define LIT_INT 3
00039 
00040 
00041 /*
00042 char *ops [ ] =
00043         {
00044         "??", "+", "-", "*", "/", "**", "-",
00045         "OR", "AND", "EQV", "NEQV", "NOT",
00046         "CONCAT",
00047         "<", "==", ">", "<=", "!=", ">=",
00048         " of ", " ofC ", " = ", " += ", " *= ", " CONV ", " << ", " % ",
00049         " , ", " ? ", " : "
00050         " abs ", " min ", " max ", " addr ", " indirect ",
00051         " bitor ", " bitand ", " bitxor ", " bitnot ", " >> ",
00052         };
00053 */
00054 
00055 /* Each of these values is defined in   pccdefs   */
00056 
00057 int ops2 [ ] =
00058 {
00059         P2BAD, P2PLUS, P2MINUS, P2STAR, P2SLASH, P2BAD, P2NEG,
00060         P2OROR, P2ANDAND, P2EQ, P2NE, P2NOT,
00061         P2BAD,
00062         P2LT, P2EQ, P2GT, P2LE, P2NE, P2GE,
00063         P2CALL, P2CALL, P2ASSIGN, P2PLUSEQ, P2STAREQ, P2CONV, P2LSHIFT, P2MOD,
00064         P2COMOP, P2QUEST, P2COLON,
00065         1, P2BAD, P2BAD, P2BAD, P2BAD,
00066         P2BITOR, P2BITAND, P2BITXOR, P2BITNOT, P2RSHIFT,
00067         P2BAD, P2BAD, P2BAD, P2BAD, P2BAD, P2BAD, P2BAD, P2BAD, P2BAD,
00068         P2BAD, P2BAD, P2BAD, P2BAD,
00069         1,1,1,1,1, /* OPNEG1, OPDMIN, OPDMAX, OPASSIGNI, OPIDENTITY */
00070         1,1,1,1,   /* OPCHARCAST, OPDABS, OPMIN2, OPMAX2 */
00071         1,1,1,1,1  /* OPBITTEST, OPBITCLR, OPBITSET, OPQBIT{CLR,SET} */
00072 };
00073 
00074 
00075  void
00076 #ifdef KR_headers
00077 putexpr(p)
00078         expptr p;
00079 #else
00080 putexpr(expptr p)
00081 #endif
00082 {
00083 /* Write the expression to the p1 file */
00084 
00085         p = (expptr) putx (fixtype (p));
00086         p1_expr (p);
00087 }
00088 
00089 
00090 
00091 
00092 
00093  expptr
00094 #ifdef KR_headers
00095 putassign(lp, rp)
00096         expptr lp;
00097         expptr rp;
00098 #else
00099 putassign(expptr lp, expptr rp)
00100 #endif
00101 {
00102         return putx(fixexpr((Exprp)mkexpr(OPASSIGN, lp, rp)));
00103 }
00104 
00105 
00106 
00107 
00108  void
00109 #ifdef KR_headers
00110 puteq(lp, rp)
00111         expptr lp;
00112         expptr rp;
00113 #else
00114 puteq(expptr lp, expptr rp)
00115 #endif
00116 {
00117         putexpr(mkexpr(OPASSIGN, lp, rp) );
00118 }
00119 
00120 
00121 
00122 
00123 /* put code for  a *= b */
00124 
00125  expptr
00126 #ifdef KR_headers
00127 putsteq(a, b)
00128         Addrp a;
00129         Addrp b;
00130 #else
00131 putsteq(Addrp a, Addrp b)
00132 #endif
00133 {
00134         return putx( fixexpr((Exprp)
00135                 mkexpr(OPSTAREQ, cpexpr((expptr)a), cpexpr((expptr)b))));
00136 }
00137 
00138 
00139 
00140 
00141  Addrp
00142 #ifdef KR_headers
00143 mkfield(res, f, ty)
00144         register Addrp res;
00145         char *f;
00146         int ty;
00147 #else
00148 mkfield(register Addrp res, char *f, int ty)
00149 #endif
00150 {
00151     res -> vtype = ty;
00152     res -> Field = f;
00153     return res;
00154 } /* mkfield */
00155 
00156 
00157  Addrp
00158 #ifdef KR_headers
00159 realpart(p)
00160         register Addrp p;
00161 #else
00162 realpart(register Addrp p)
00163 #endif
00164 {
00165         register Addrp q;
00166 
00167         if (p->tag == TADDR
00168          && p->uname_tag == UNAM_CONST
00169          && ISCOMPLEX (p->vtype))
00170                 return (Addrp)mkrealcon (p -> vtype + TYREAL - TYCOMPLEX,
00171                         p->user.kludge.vstg1 ? p->user.Const.cds[0]
00172                                 : cds(dtos(p->user.Const.cd[0]),CNULL));
00173 
00174         q = (Addrp) cpexpr((expptr) p);
00175         if( ISCOMPLEX(p->vtype) )
00176                 q = mkfield (q, "r", p -> vtype + TYREAL - TYCOMPLEX);
00177 
00178         return(q);
00179 }
00180 
00181 
00182 
00183 
00184  expptr
00185 #ifdef KR_headers
00186 imagpart(p)
00187         register Addrp p;
00188 #else
00189 imagpart(register Addrp p)
00190 #endif
00191 {
00192         register Addrp q;
00193 
00194         if( ISCOMPLEX(p->vtype) )
00195         {
00196                 if (p->tag == TADDR && p->uname_tag == UNAM_CONST)
00197                         return mkrealcon (p -> vtype + TYREAL - TYCOMPLEX,
00198                                 p->user.kludge.vstg1 ? p->user.Const.cds[1]
00199                                 : cds(dtos(p->user.Const.cd[1]),CNULL));
00200                 q = (Addrp) cpexpr((expptr) p);
00201                 q = mkfield (q, "i", p -> vtype + TYREAL - TYCOMPLEX);
00202                 return( (expptr) q );
00203         }
00204         else
00205 
00206 /* Cast an integer type onto a Double Real type */
00207 
00208                 return( mkrealcon( ISINT(p->vtype) ? TYDREAL : p->vtype , "0"));
00209 }
00210 
00211 
00212 
00213 
00214 
00215 /* ncat -- computes the number of adjacent concatenation operations */
00216 
00217  int
00218 #ifdef KR_headers
00219 ncat(p)
00220         register expptr p;
00221 #else
00222 ncat(register expptr p)
00223 #endif
00224 {
00225         if(p->tag==TEXPR && p->exprblock.opcode==OPCONCAT)
00226                 return( ncat(p->exprblock.leftp) + ncat(p->exprblock.rightp) );
00227         else    return(1);
00228 }
00229 
00230 
00231 
00232 
00233 /* lencat -- returns the length of the concatenated string.  Each
00234    substring must have a static (i.e. compile-time) fixed length */
00235 
00236  ftnint
00237 #ifdef KR_headers
00238 lencat(p)
00239         register expptr p;
00240 #else
00241 lencat(register expptr p)
00242 #endif
00243 {
00244         if(p->tag==TEXPR && p->exprblock.opcode==OPCONCAT)
00245                 return( lencat(p->exprblock.leftp) + lencat(p->exprblock.rightp) );
00246         else if( p->headblock.vleng!=NULL && ISICON(p->headblock.vleng) )
00247                 return(p->headblock.vleng->constblock.Const.ci);
00248         else if(p->tag==TADDR && p->addrblock.varleng!=0)
00249                 return(p->addrblock.varleng);
00250         else
00251         {
00252                 err("impossible element in concatenation");
00253                 return(0);
00254         }
00255 }
00256 
00257 /* putconst -- Creates a new Addrp value which maps onto the input
00258    constant value.  The Addrp doesn't retain the value of the constant,
00259    instead that value is copied into a table of constants (called
00260    litpool,   for pool of literal values).  The only way to retrieve the
00261    actual value of the constant is to look at the   memno   field of the
00262    Addrp result.  You know that the associated literal is the one referred
00263    to by   q   when   (q -> memno == litp -> litnum).
00264 */
00265 
00266  Addrp
00267 #ifdef KR_headers
00268 putconst(p)
00269         register Constp p;
00270 #else
00271 putconst(register Constp p)
00272 #endif
00273 {
00274         register Addrp q;
00275         struct Literal *litp, *lastlit;
00276         int k, len, type;
00277         int litflavor;
00278         double cd[2];
00279         ftnint nblanks;
00280         char *strp;
00281         char cdsbuf0[64], cdsbuf1[64], *ds[2];
00282 
00283         if (p->tag != TCONST)
00284                 badtag("putconst", p->tag);
00285 
00286         q = ALLOC(Addrblock);
00287         q->tag = TADDR;
00288         type = p->vtype;
00289         q->vtype = ( type==TYADDR ? tyint : type );
00290         q->vleng = (expptr) cpexpr(p->vleng);
00291         q->vstg = STGCONST;
00292 
00293 /* Create the new label for the constant.  This is wasteful of labels
00294    because when the constant value already exists in the literal pool,
00295    this label gets thrown away and is never reclaimed.  It might be
00296    cleaner to move this down past the first   switch()   statement below */
00297 
00298         q->memno = newlabel();
00299         q->memoffset = ICON(0);
00300         q -> uname_tag = UNAM_CONST;
00301 
00302 /* Copy the constant info into the Addrblock; do this by copying the
00303    largest storage elts */
00304 
00305         q -> user.Const = p -> Const;
00306         q->user.kludge.vstg1 = p->vstg; /* distinguish string from binary fp */
00307 
00308         /* check for value in literal pool, and update pool if necessary */
00309 
00310         k = 1;
00311         switch(type)
00312         {
00313         case TYCHAR:
00314                 if (halign) {
00315                         strp = p->Const.ccp;
00316                         nblanks = p->Const.ccp1.blanks;
00317                         len = p->vleng->constblock.Const.ci;
00318                         litflavor = LIT_CHAR;
00319                         goto loop;
00320                         }
00321                 else
00322                         q->memno = BAD_MEMNO;
00323                 break;
00324         case TYCOMPLEX:
00325         case TYDCOMPLEX:
00326                 k = 2;
00327                 if (p->vstg)
00328                         cd[1] = atof(ds[1] = p->Const.cds[1]);
00329                 else
00330                         ds[1] = cds(dtos(cd[1] = p->Const.cd[1]), cdsbuf1);
00331         case TYREAL:
00332         case TYDREAL:
00333                 litflavor = LIT_FLOAT;
00334                 if (p->vstg)
00335                         cd[0] = atof(ds[0] = p->Const.cds[0]);
00336                 else
00337                         ds[0] = cds(dtos(cd[0] = p->Const.cd[0]), cdsbuf0);
00338                 goto loop;
00339 
00340         case TYLOGICAL1:
00341         case TYLOGICAL2:
00342         case TYLOGICAL:
00343         case TYLONG:
00344         case TYSHORT:
00345         case TYINT1:
00346 #ifdef TYQUAD
00347         case TYQUAD:
00348 #endif
00349  lit_int_flavor:
00350                 litflavor = LIT_INT;
00351 
00352 /* Scan the literal pool for this constant value.  If this same constant
00353    has been assigned before, use the same label.  Note that this routine
00354    does NOT consider two differently-typed constants with the same bit
00355    pattern to be the same constant */
00356 
00357  loop:
00358                 lastlit = litpool + nliterals;
00359                 for(litp = litpool ; litp<lastlit ; ++litp)
00360 
00361 /* Remove this type checking to ensure that all bit patterns are reused */
00362 
00363                         if(type == litp->littype) switch(litflavor)
00364                         {
00365                         case LIT_CHAR:
00366                                 if (len == (int)litp->litval.litival2[0]
00367                                 && nblanks == litp->litval.litival2[1]
00368                                 && !memcmp(strp, litp->cds[0], len)) {
00369                                         q->memno = litp->litnum;
00370                                         frexpr((expptr)p);
00371                                         q->user.Const.ccp1.ccp0 = litp->cds[0];
00372                                         return(q);
00373                                         }
00374                                 break;
00375                         case LIT_FLOAT:
00376                                 if(cd[0] == litp->litval.litdval[0]
00377                                 && !strcmp(ds[0], litp->cds[0])
00378                                 && (k == 1 ||
00379                                     cd[1] == litp->litval.litdval[1]
00380                                     && !strcmp(ds[1], litp->cds[1]))) {
00381 ret:
00382                                         q->memno = litp->litnum;
00383                                         frexpr((expptr)p);
00384                                         return(q);
00385                                         }
00386                                 break;
00387 
00388                         case LIT_INT:
00389                                 if(p->Const.ci == litp->litval.litival)
00390                                         goto ret;
00391                                 break;
00392                         }
00393 
00394 /* If there's room in the literal pool, add this new value to the pool */
00395 
00396                 if(nliterals < maxliterals)
00397                 {
00398                         ++nliterals;
00399 
00400                         /* litp   now points to the next free elt */
00401 
00402                         litp->littype = type;
00403                         litp->litnum = q->memno;
00404                         switch(litflavor)
00405                         {
00406                         case LIT_CHAR:
00407                                 litp->litval.litival2[0] = len;
00408                                 litp->litval.litival2[1] = nblanks;
00409                                 q->user.Const.ccp = litp->cds[0] =
00410                                         memcpy(gmem(len,0), strp, len);
00411                                 break;
00412 
00413                         case LIT_FLOAT:
00414                                 litp->litval.litdval[0] = cd[0];
00415                                 litp->cds[0] = copys(ds[0]);
00416                                 if (k == 2) {
00417                                         litp->litval.litdval[1] = cd[1];
00418                                         litp->cds[1] = copys(ds[1]);
00419                                         }
00420                                 break;
00421 
00422                         case LIT_INT:
00423                                 litp->litval.litival = p->Const.ci;
00424                                 break;
00425                         } /* switch (litflavor) */
00426                 }
00427                 else
00428                         many("literal constants", 'L', maxliterals);
00429 
00430                 break;
00431         case TYADDR:
00432             break;
00433         default:
00434                 badtype ("putconst", p -> vtype);
00435                 break;
00436         } /* switch */
00437 
00438         if (type != TYCHAR || halign)
00439             frexpr((expptr)p);
00440         return( q );
00441 }