home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / f2csrc.zip / f2csrc / src / put.c < prev    next >
C/C++ Source or Header  |  1994-02-25  |  11KB  |  452 lines
  1. /****************************************************************
  2. Copyright 1990, 1991, 1993, 1994 by AT&T Bell Laboratories and Bellcore.
  3.  
  4. Permission to use, copy, modify, and distribute this software
  5. and its documentation for any purpose and without fee is hereby
  6. granted, provided that the above copyright notice appear in all
  7. copies and that both that the copyright notice and this
  8. permission notice and warranty disclaimer appear in supporting
  9. documentation, and that the names of AT&T Bell Laboratories or
  10. Bellcore or any of their entities not be used in advertising or
  11. publicity pertaining to distribution of the software without
  12. specific, written prior permission.
  13.  
  14. AT&T and Bellcore disclaim all warranties with regard to this
  15. software, including all implied warranties of merchantability
  16. and fitness.  In no event shall AT&T or Bellcore be liable for
  17. any special, indirect or consequential damages or any damages
  18. whatsoever resulting from loss of use, data or profits, whether
  19. in an action of contract, negligence or other tortious action,
  20. arising out of or in connection with the use or performance of
  21. this software.
  22. ****************************************************************/
  23.  
  24. /*
  25.  * INTERMEDIATE CODE GENERATION PROCEDURES COMMON TO BOTH
  26.  * JOHNSON (PORTABLE) AND RITCHIE FAMILIES OF SECOND PASSES
  27. */
  28.  
  29. #include "defs.h"
  30. #include "names.h"        /* For LOCAL_CONST_NAME */
  31. #include "pccdefs.h"
  32. #include "p1defs.h"
  33.  
  34. /* Definitions for   putconst()   */
  35.  
  36. #define LIT_CHAR 1
  37. #define LIT_FLOAT 2
  38. #define LIT_INT 3
  39.  
  40.  
  41. /*
  42. char *ops [ ] =
  43.     {
  44.     "??", "+", "-", "*", "/", "**", "-",
  45.     "OR", "AND", "EQV", "NEQV", "NOT",
  46.     "CONCAT",
  47.     "<", "==", ">", "<=", "!=", ">=",
  48.     " of ", " ofC ", " = ", " += ", " *= ", " CONV ", " << ", " % ",
  49.     " , ", " ? ", " : "
  50.     " abs ", " min ", " max ", " addr ", " indirect ",
  51.     " bitor ", " bitand ", " bitxor ", " bitnot ", " >> ",
  52.     };
  53. */
  54.  
  55. /* Each of these values is defined in   pccdefs   */
  56.  
  57. int ops2 [ ] =
  58. {
  59.     P2BAD, P2PLUS, P2MINUS, P2STAR, P2SLASH, P2BAD, P2NEG,
  60.     P2OROR, P2ANDAND, P2EQ, P2NE, P2NOT,
  61.     P2BAD,
  62.     P2LT, P2EQ, P2GT, P2LE, P2NE, P2GE,
  63.     P2CALL, P2CALL, P2ASSIGN, P2PLUSEQ, P2STAREQ, P2CONV, P2LSHIFT, P2MOD,
  64.     P2COMOP, P2QUEST, P2COLON,
  65.     1, P2BAD, P2BAD, P2BAD, P2BAD,
  66.     P2BITOR, P2BITAND, P2BITXOR, P2BITNOT, P2RSHIFT,
  67.     P2BAD, P2BAD, P2BAD, P2BAD, P2BAD, P2BAD, P2BAD, P2BAD, P2BAD,
  68.     P2BAD, P2BAD, P2BAD, P2BAD,
  69.     1,1,1,1,1, /* OPNEG1, OPDMIN, OPDMAX, OPASSIGNI, OPIDENTITY */
  70.     1,1,1,1    /* OPCHARCAST, OPDABS, OPMIN2, OPMAX2 */
  71. };
  72.  
  73.  
  74.  void
  75. setlog(Void)
  76. {
  77.     typesize[TYLOGICAL] = typesize[tylogical];
  78.     typealign[TYLOGICAL] = typealign[tylogical];
  79. }
  80.  
  81.  
  82.  void
  83. #ifdef KR_headers
  84. putexpr(p)
  85.     expptr p;
  86. #else
  87. putexpr(expptr p)
  88. #endif
  89. {
  90. /* Write the expression to the p1 file */
  91.  
  92.     p = (expptr) putx (fixtype (p));
  93.     p1_expr (p);
  94. }
  95.  
  96.  
  97.  
  98.  
  99.  
  100.  expptr
  101. #ifdef KR_headers
  102. putassign(lp, rp)
  103.     expptr lp;
  104.     expptr rp;
  105. #else
  106. putassign(expptr lp, expptr rp)
  107. #endif
  108. {
  109.     return putx(fixexpr((Exprp)mkexpr(OPASSIGN, lp, rp)));
  110. }
  111.  
  112.  
  113.  
  114.  
  115.  void
  116. #ifdef KR_headers
  117. puteq(lp, rp)
  118.     expptr lp;
  119.     expptr rp;
  120. #else
  121. puteq(expptr lp, expptr rp)
  122. #endif
  123. {
  124.     putexpr(mkexpr(OPASSIGN, lp, rp) );
  125. }
  126.  
  127.  
  128.  
  129.  
  130. /* put code for  a *= b */
  131.  
  132.  expptr
  133. #ifdef KR_headers
  134. putsteq(a, b)
  135.     Addrp a;
  136.     Addrp b;
  137. #else
  138. putsteq(Addrp a, Addrp b)
  139. #endif
  140. {
  141.     return putx( fixexpr((Exprp)
  142.         mkexpr(OPSTAREQ, cpexpr((expptr)a), cpexpr((expptr)b))));
  143. }
  144.  
  145.  
  146.  
  147.  
  148.  Addrp
  149. #ifdef KR_headers
  150. mkfield(res, f, ty)
  151.     register Addrp res;
  152.     char *f;
  153.     int ty;
  154. #else
  155. mkfield(register Addrp res, char *f, int ty)
  156. #endif
  157. {
  158.     res -> vtype = ty;
  159.     res -> Field = f;
  160.     return res;
  161. } /* mkfield */
  162.  
  163.  
  164.  Addrp
  165. #ifdef KR_headers
  166. realpart(p)
  167.     register Addrp p;
  168. #else
  169. realpart(register Addrp p)
  170. #endif
  171. {
  172.     register Addrp q;
  173.  
  174.     if (p->tag == TADDR
  175.      && p->uname_tag == UNAM_CONST
  176.      && ISCOMPLEX (p->vtype))
  177.         return (Addrp)mkrealcon (p -> vtype + TYREAL - TYCOMPLEX,
  178.             p->user.kludge.vstg1 ? p->user.Const.cds[0]
  179.                 : cds(dtos(p->user.Const.cd[0]),CNULL));
  180.  
  181.     q = (Addrp) cpexpr((expptr) p);
  182.     if( ISCOMPLEX(p->vtype) )
  183.         q = mkfield (q, "r", p -> vtype + TYREAL - TYCOMPLEX);
  184.  
  185.     return(q);
  186. }
  187.  
  188.  
  189.  
  190.  
  191.  expptr
  192. #ifdef KR_headers
  193. imagpart(p)
  194.     register Addrp p;
  195. #else
  196. imagpart(register Addrp p)
  197. #endif
  198. {
  199.     register Addrp q;
  200.  
  201.     if( ISCOMPLEX(p->vtype) )
  202.     {
  203.         if (p->tag == TADDR && p->uname_tag == UNAM_CONST)
  204.             return mkrealcon (p -> vtype + TYREAL - TYCOMPLEX,
  205.                 p->user.kludge.vstg1 ? p->user.Const.cds[1]
  206.                 : cds(dtos(p->user.Const.cd[1]),CNULL));
  207.         q = (Addrp) cpexpr((expptr) p);
  208.         q = mkfield (q, "i", p -> vtype + TYREAL - TYCOMPLEX);
  209.         return( (expptr) q );
  210.     }
  211.     else
  212.  
  213. /* Cast an integer type onto a Double Real type */
  214.  
  215.         return( mkrealcon( ISINT(p->vtype) ? TYDREAL : p->vtype , "0"));
  216. }
  217.  
  218.  
  219.  
  220.  
  221.  
  222. /* ncat -- computes the number of adjacent concatenation operations */
  223.  
  224.  int
  225. #ifdef KR_headers
  226. ncat(p)
  227.     register expptr p;
  228. #else
  229. ncat(register expptr p)
  230. #endif
  231. {
  232.     if(p->tag==TEXPR && p->exprblock.opcode==OPCONCAT)
  233.         return( ncat(p->exprblock.leftp) + ncat(p->exprblock.rightp) );
  234.     else    return(1);
  235. }
  236.  
  237.  
  238.  
  239.  
  240. /* lencat -- returns the length of the concatenated string.  Each
  241.    substring must have a static (i.e. compile-time) fixed length */
  242.  
  243.  ftnint
  244. #ifdef KR_headers
  245. lencat(p)
  246.     register expptr p;
  247. #else
  248. lencat(register expptr p)
  249. #endif
  250. {
  251.     if(p->tag==TEXPR && p->exprblock.opcode==OPCONCAT)
  252.         return( lencat(p->exprblock.leftp) + lencat(p->exprblock.rightp) );
  253.     else if( p->headblock.vleng!=NULL && ISICON(p->headblock.vleng) )
  254.         return(p->headblock.vleng->constblock.Const.ci);
  255.     else if(p->tag==TADDR && p->addrblock.varleng!=0)
  256.         return(p->addrblock.varleng);
  257.     else
  258.     {
  259.         err("impossible element in concatenation");
  260.         return(0);
  261.     }
  262. }
  263.  
  264. /* putconst -- Creates a new Addrp value which maps onto the input
  265.    constant value.  The Addrp doesn't retain the value of the constant,
  266.    instead that value is copied into a table of constants (called
  267.    litpool,   for pool of literal values).  The only way to retrieve the
  268.    actual value of the constant is to look at the   memno   field of the
  269.    Addrp result.  You know that the associated literal is the one referred
  270.    to by   q   when   (q -> memno == litp -> litnum).
  271. */
  272.  
  273.  Addrp
  274. #ifdef KR_headers
  275. putconst(p)
  276.     register Constp p;
  277. #else
  278. putconst(register Constp p)
  279. #endif
  280. {
  281.     register Addrp q;
  282.     struct Literal *litp, *lastlit;
  283.     int k, len, type;
  284.     int litflavor;
  285.     double cd[2];
  286.     ftnint nblanks;
  287.     char *strp;
  288.     char cdsbuf0[64], cdsbuf1[64], *ds[2];
  289.  
  290.     if (p->tag != TCONST)
  291.         badtag("putconst", p->tag);
  292.  
  293.     q = ALLOC(Addrblock);
  294.     q->tag = TADDR;
  295.     type = p->vtype;
  296.     q->vtype = ( type==TYADDR ? tyint : type );
  297.     q->vleng = (expptr) cpexpr(p->vleng);
  298.     q->vstg = STGCONST;
  299.  
  300. /* Create the new label for the constant.  This is wasteful of labels
  301.    because when the constant value already exists in the literal pool,
  302.    this label gets thrown away and is never reclaimed.  It might be
  303.    cleaner to move this down past the first   switch()   statement below */
  304.  
  305.     q->memno = newlabel();
  306.     q->memoffset = ICON(0);
  307.     q -> uname_tag = UNAM_CONST;
  308.  
  309. /* Copy the constant info into the Addrblock; do this by copying the
  310.    largest storage elts */
  311.  
  312.     q -> user.Const = p -> Const;
  313.     q->user.kludge.vstg1 = p->vstg;    /* distinguish string from binary fp */
  314.  
  315.     /* check for value in literal pool, and update pool if necessary */
  316.  
  317.     k = 1;
  318.     switch(type)
  319.     {
  320.     case TYCHAR:
  321.         if (halign) {
  322.             strp = p->Const.ccp;
  323.             nblanks = p->Const.ccp1.blanks;
  324.             len = p->vleng->constblock.Const.ci;
  325.             litflavor = LIT_CHAR;
  326.             goto loop;
  327.             }
  328.         else
  329.             q->memno = BAD_MEMNO;
  330.         break;
  331.     case TYCOMPLEX:
  332.     case TYDCOMPLEX:
  333.         k = 2;
  334.         if (p->vstg)
  335.             cd[1] = atof(ds[1] = p->Const.cds[1]);
  336.         else
  337.             ds[1] = cds(dtos(cd[1] = p->Const.cd[1]), cdsbuf1);
  338.     case TYREAL:
  339.     case TYDREAL:
  340.         litflavor = LIT_FLOAT;
  341.         if (p->vstg)
  342.             cd[0] = atof(ds[0] = p->Const.cds[0]);
  343.         else
  344.             ds[0] = cds(dtos(cd[0] = p->Const.cd[0]), cdsbuf0);
  345.         goto loop;
  346.  
  347.     case TYLOGICAL1:
  348.     case TYLOGICAL2:
  349.     case TYLOGICAL:
  350.         type = tylogical;
  351.         goto lit_int_flavor;
  352.     case TYLONG:
  353.         type = tyint;
  354.     case TYSHORT:
  355.     case TYINT1:
  356. #ifdef TYQUAD
  357.     case TYQUAD:
  358. #endif
  359.  lit_int_flavor:
  360.         litflavor = LIT_INT;
  361.  
  362. /* Scan the literal pool for this constant value.  If this same constant
  363.    has been assigned before, use the same label.  Note that this routine
  364.    does NOT consider two differently-typed constants with the same bit
  365.    pattern to be the same constant */
  366.  
  367.  loop:
  368.         lastlit = litpool + nliterals;
  369.         for(litp = litpool ; litp<lastlit ; ++litp)
  370.  
  371. /* Remove this type checking to ensure that all bit patterns are reused */
  372.  
  373.             if(type == litp->littype) switch(litflavor)
  374.             {
  375.             case LIT_CHAR:
  376.                 if (len == (int)litp->litval.litival2[0]
  377.                 && nblanks == litp->litval.litival2[1]
  378.                 && !memcmp(strp, litp->cds[0], len)) {
  379.                     q->memno = litp->litnum;
  380.                     frexpr((expptr)p);
  381.                     q->user.Const.ccp1.ccp0 = litp->cds[0];
  382.                     return(q);
  383.                     }
  384.                 break;
  385.             case LIT_FLOAT:
  386.                 if(cd[0] == litp->litval.litdval[0]
  387.                 && !strcmp(ds[0], litp->cds[0])
  388.                 && (k == 1 ||
  389.                     cd[1] == litp->litval.litdval[1]
  390.                     && !strcmp(ds[1], litp->cds[1]))) {
  391. ret:
  392.                     q->memno = litp->litnum;
  393.                     frexpr((expptr)p);
  394.                     return(q);
  395.                     }
  396.                 break;
  397.  
  398.             case LIT_INT:
  399.                 if(p->Const.ci == litp->litval.litival)
  400.                     goto ret;
  401.                 break;
  402.             }
  403.  
  404. /* If there's room in the literal pool, add this new value to the pool */
  405.  
  406.         if(nliterals < maxliterals)
  407.         {
  408.             ++nliterals;
  409.  
  410.             /* litp   now points to the next free elt */
  411.  
  412.             litp->littype = type;
  413.             litp->litnum = q->memno;
  414.             switch(litflavor)
  415.             {
  416.             case LIT_CHAR:
  417.                 litp->litval.litival2[0] = len;
  418.                 litp->litval.litival2[1] = nblanks;
  419.                 q->user.Const.ccp = litp->cds[0] =
  420.                     memcpy(gmem(len,0), strp, len);
  421.                 break;
  422.  
  423.             case LIT_FLOAT:
  424.                 litp->litval.litdval[0] = cd[0];
  425.                 litp->cds[0] = copys(ds[0]);
  426.                 if (k == 2) {
  427.                     litp->litval.litdval[1] = cd[1];
  428.                     litp->cds[1] = copys(ds[1]);
  429.                     }
  430.                 break;
  431.  
  432.             case LIT_INT:
  433.                 litp->litval.litival = p->Const.ci;
  434.                 break;
  435.             } /* switch (litflavor) */
  436.         }
  437.         else
  438.             many("literal constants", 'L', maxliterals);
  439.  
  440.         break;
  441.     case TYADDR:
  442.         break;
  443.     default:
  444.         badtype ("putconst", p -> vtype);
  445.         break;
  446.     } /* switch */
  447.  
  448.     if (type != TYCHAR || halign)
  449.         frexpr((expptr)p);
  450.     return( q );
  451. }
  452.