home *** CD-ROM | disk | FTP | other *** search
/ minnie.tuhs.org / unixen.tar / unixen / PDP-11 / Trees / V7 / usr / src / cmd / f77 / put.c < prev    next >
Encoding:
C/C++ Source or Header  |  1979-01-10  |  4.8 KB  |  297 lines
  1. /*
  2.  * INTERMEDIATE CODE GENERATION PROCEDURES COMMON TO BOTH
  3.  * JOHNSON AND RITCHIE FAMILIES OF SECOND PASSES
  4. */
  5.  
  6. #include "defs"
  7.  
  8. #if FAMILY == SCJ
  9. #    include "scjdefs"
  10. #else
  11. #    include "dmrdefs"
  12. #endif
  13.  
  14. /*
  15. char *ops [ ] =
  16.     {
  17.     "??", "+", "-", "*", "/", "**", "-",
  18.     "OR", "AND", "EQV", "NEQV", "NOT",
  19.     "CONCAT",
  20.     "<", "==", ">", "<=", "!=", ">=",
  21.     " of ", " ofC ", " = ", " += ", " *= ", " CONV ", " << ", " % ",
  22.     " , ", " ? ", " : "
  23.     " abs ", " min ", " max ", " addr ", " indirect ",
  24.     " bitor ", " bitand ", " bitxor ", " bitnot ", " >> ",
  25.     };
  26. */
  27.  
  28. int ops2 [ ] =
  29.     {
  30.     P2BAD, P2PLUS, P2MINUS, P2STAR, P2SLASH, P2BAD, P2NEG,
  31.     P2OROR, P2ANDAND, P2EQ, P2NE, P2NOT,
  32.     P2BAD,
  33.     P2LT, P2EQ, P2GT, P2LE, P2NE, P2GE,
  34.     P2CALL, P2CALL, P2ASSIGN, P2PLUSEQ, P2STAREQ, P2CONV, P2LSHIFT, P2MOD,
  35.     P2COMOP, P2QUEST, P2COLON,
  36.     P2BAD, P2BAD, P2BAD, P2BAD, P2BAD,
  37.     P2BITOR, P2BITAND, P2BITXOR, P2BITNOT, P2RSHIFT
  38.     };
  39.  
  40.  
  41. int types2 [ ] =
  42.     {
  43.     P2BAD, P2INT|P2PTR, P2SHORT, P2LONG, P2REAL, P2DREAL,
  44. #if TARGET == INTERDATA
  45.     P2BAD, P2BAD, P2LONG, P2CHAR, P2INT, P2BAD
  46. #else
  47.     P2REAL, P2DREAL, P2LONG, P2CHAR, P2INT, P2BAD
  48. #endif
  49.     };
  50.  
  51.  
  52. setlog()
  53. {
  54. types2[TYLOGICAL] = types2[tylogical];
  55. }
  56.  
  57.  
  58. putex1(p)
  59. expptr p;
  60. {
  61. putx( fixtype(p) );
  62. templist = hookup(templist, holdtemps);
  63. holdtemps = NULL;
  64. }
  65.  
  66.  
  67.  
  68.  
  69.  
  70. putassign(lp, rp)
  71. expptr lp, rp;
  72. {
  73. putx( fixexpr( mkexpr(OPASSIGN, lp, rp) ));
  74. }
  75.  
  76.  
  77.  
  78.  
  79. puteq(lp, rp)
  80. expptr lp, rp;
  81. {
  82. putexpr( mkexpr(OPASSIGN, lp, rp) );
  83. }
  84.  
  85.  
  86.  
  87.  
  88. /* put code for  a *= b */
  89.  
  90. putsteq(a, b)
  91. expptr a, b;
  92. {
  93. putx( fixexpr( mkexpr(OPSTAREQ, cpexpr(a), cpexpr(b)) ));
  94. }
  95.  
  96.  
  97.  
  98.  
  99.  
  100. struct addrblock *realpart(p)
  101. register struct addrblock *p;
  102. {
  103. register struct addrblock *q;
  104.  
  105. q = cpexpr(p);
  106. if( ISCOMPLEX(p->vtype) )
  107.     q->vtype += (TYREAL-TYCOMPLEX);
  108. return(q);
  109. }
  110.  
  111.  
  112.  
  113.  
  114. struct addrblock *imagpart(p)
  115. register struct addrblock *p;
  116. {
  117. register struct addrblock *q;
  118. struct constblock *mkrealcon();
  119.  
  120. if( ISCOMPLEX(p->vtype) )
  121.     {
  122.     q = cpexpr(p);
  123.     q->vtype += (TYREAL-TYCOMPLEX);
  124.     q->memoffset = mkexpr(OPPLUS, q->memoffset, ICON(typesize[q->vtype]));
  125.     }
  126. else
  127.     q = mkrealcon( ISINT(p->vtype) ? TYDREAL : p->vtype , 0.0);
  128. return(q);
  129. }
  130.  
  131. struct addrblock *putconst(p)
  132. register struct constblock *p;
  133. {
  134. register struct addrblock *q;
  135. struct literal *litp, *lastlit;
  136. int i, k, type;
  137. int litflavor;
  138.  
  139. if( ! ISCONST(p) )
  140.     fatal1("putconst: bad tag %d", p->tag);
  141.  
  142. q = ALLOC(addrblock);
  143. q->tag = TADDR;
  144. type = p->vtype;
  145. q->vtype = ( type==TYADDR ? TYINT : type );
  146. q->vleng = cpexpr(p->vleng);
  147. q->vstg = STGCONST;
  148. q->memno = newlabel();
  149. q->memoffset = ICON(0);
  150.  
  151. /* check for value in literal pool, and update pool if necessary */
  152.  
  153. switch(type = p->vtype)
  154.     {
  155.     case TYCHAR:
  156.         if(p->vleng->const.ci > XL)
  157.             break;    /* too long for literal table */
  158.         litflavor = 1;
  159.         goto loop;
  160.  
  161.     case TYREAL:
  162.     case TYDREAL:
  163.         litflavor = 2;
  164.         goto loop;
  165.  
  166.     case TYLOGICAL:
  167.         type = tylogical;
  168.     case TYSHORT:
  169.     case TYLONG:
  170.         litflavor = 3;
  171.  
  172.     loop:
  173.         lastlit = litpool + nliterals;
  174.         for(litp = litpool ; litp<lastlit ; ++litp)
  175.             if(type == litp->littype) switch(litflavor)
  176.                 {
  177.             case 1:
  178.                 if(p->vleng->const.ci != litp->litval.litcval.litclen)
  179.                     break;
  180.                 if(! eqn( (int) p->vleng->const.ci, p->const.ccp,
  181.                     litp->litval.litcval.litcstr) )
  182.                         break;
  183.  
  184.             ret:
  185.                 q->memno = litp->litnum;
  186.                 frexpr(p);
  187.                 return(q);
  188.  
  189.             case 2:
  190.                 if(p->const.cd[0] == litp->litval.litdval)
  191.                     goto ret;
  192.                 break;
  193.  
  194.             case 3:
  195.                 if(p->const.ci == litp->litval.litival)
  196.                     goto ret;
  197.                 break;
  198.                 }
  199.         if(nliterals < MAXLITERALS)
  200.             {
  201.             ++nliterals;
  202.             litp->littype = type;
  203.             litp->litnum = q->memno;
  204.             switch(litflavor)
  205.                 {
  206.                 case 1:
  207.                     litp->litval.litcval.litclen = p->vleng->const.ci;
  208.                     cpn( (int) litp->litval.litcval.litclen,
  209.                         p->const.ccp,
  210.                         litp->litval.litcval.litcstr);
  211.                     break;
  212.  
  213.                 case 2:
  214.                     litp->litval.litdval = p->const.cd[0];
  215.                     break;
  216.  
  217.                 case 3:
  218.                     litp->litval.litival = p->const.ci;
  219.                     break;
  220.                 }
  221.             }
  222.     default:
  223.         break;
  224.     }
  225.  
  226. preven(typealign[ type==TYCHAR ? TYLONG : type ]);
  227. prlabel(asmfile, q->memno);
  228.  
  229. k = 1;
  230. switch(type)
  231.     {
  232.     case TYLOGICAL:
  233.     case TYSHORT:
  234.     case TYLONG:
  235.         prconi(asmfile, type, p->const.ci);
  236.         break;
  237.  
  238.     case TYCOMPLEX:
  239.         k = 2;
  240.     case TYREAL:
  241.         type = TYREAL;
  242.         goto flpt;
  243.  
  244.     case TYDCOMPLEX:
  245.         k = 2;
  246.     case TYDREAL:
  247.         type = TYDREAL;
  248.  
  249.     flpt:
  250.         for(i = 0 ; i < k ; ++i)
  251.             prconr(asmfile, type, p->const.cd[i]);
  252.         break;
  253.  
  254.     case TYCHAR:
  255.         putstr(asmfile, p->const.ccp, p->vleng->const.ci);
  256.         break;
  257.  
  258.     case TYADDR:
  259.         prcona(asmfile, p->const.ci);
  260.         break;
  261.  
  262.     default:
  263.         fatal1("putconst: bad type %d", p->vtype);
  264.     }
  265.  
  266. frexpr(p);
  267. return( q );
  268. }
  269.  
  270. /*
  271.  * put out a character string constant.  begin every one on
  272.  * a long integer boundary, and pad with nulls
  273.  */
  274. putstr(fp, s, n)
  275. FILEP fp;
  276. char *s;
  277. ftnint n;
  278. {
  279. int b[SZSHORT];
  280. int i;
  281.  
  282. i = 0;
  283. while(--n >= 0)
  284.     {
  285.     b[i++] = *s++;
  286.     if(i == SZSHORT)
  287.         {
  288.         prchars(fp, b);
  289.         i = 0;
  290.         }
  291.     }
  292.  
  293. while(i < SZSHORT)
  294.     b[i++] = '\0';
  295. prchars(fp, b);
  296. }
  297.