home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 8 / FreshFishVol8-CD2.bin / bbs / gnu / f2c-1993.04.28-src.lha / f2c-1993.04.28 / src / putpcc.c < prev    next >
C/C++ Source or Header  |  1993-04-28  |  40KB  |  1,842 lines
  1. /****************************************************************
  2. Copyright 1990, 1991, 1992, 1993 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. /* INTERMEDIATE CODE GENERATION FOR S. C. JOHNSON C COMPILERS */
  25. /* NEW VERSION USING BINARY POLISH POSTFIX INTERMEDIATE */
  26.  
  27. #include "defs.h"
  28. #include "pccdefs.h"
  29. #include "output.h"        /* for nice_printf */
  30. #include "names.h"
  31. #include "p1defs.h"
  32.  
  33. Addrp realpart();
  34. LOCAL Addrp intdouble(), putcx1(), putcxeq (), putch1 ();
  35. LOCAL putct1 ();
  36.  
  37. expptr putcxop();
  38. LOCAL expptr putcall (), putmnmx (), putcheq(), putcat ();
  39. LOCAL expptr putaddr(), putchcmp (), putpower(), putop();
  40. LOCAL expptr putcxcmp ();
  41. expptr imagpart();
  42. ftnint lencat();
  43.  
  44. #define FOUR 4
  45. extern int ops2[];
  46. extern int proc_argchanges, proc_protochanges;
  47. extern int krparens;
  48.  
  49. #define P2BUFFMAX 128
  50.  
  51. /* Puthead -- output the header information about subroutines, functions
  52.    and entry points */
  53.  
  54. puthead(s, class)
  55. char *s;
  56. int class;
  57. {
  58.     if (headerdone == NO) {
  59.         if (class == CLMAIN)
  60.             s = "MAIN__";
  61.         p1_head (class, s);
  62.         headerdone = YES;
  63.         }
  64. }
  65.  
  66. putif(p, else_if_p)
  67.  register expptr p;
  68.  int else_if_p;
  69. {
  70.     register int k;
  71.     int n;
  72.     long where;
  73.  
  74.     if (else_if_p) {
  75.         p1put(P1_ELSEIFSTART);
  76.         where = ftell(pass1_file);
  77.         }
  78.     if( !ISLOGICAL((k = (p = fixtype(p))->headblock.vtype )) )
  79.     {
  80.         if(k != TYERROR)
  81.             err("non-logical expression in IF statement");
  82.         }
  83.     else {
  84.         if (else_if_p) {
  85.             if (ei_next >= ei_last)
  86.                 {
  87.                 k = ei_last - ei_first;
  88.                 n = k + 100;
  89.                 ei_next = mem(n,0);
  90.                 ei_last = ei_first + n;
  91.                 if (k)
  92.                     memcpy(ei_next, ei_first, k);
  93.                 ei_first =  ei_next;
  94.                 ei_next += k;
  95.                 ei_last = ei_first + n;
  96.                 }
  97.             p = putx(p);
  98.             if (*ei_next++ = ftell(pass1_file) > where) {
  99.                 p1_if(p);
  100.                 new_endif();
  101.                 }
  102.             else
  103.                 p1_elif(p);
  104.             }
  105.         else {
  106.             p = putx(p);
  107.             p1_if(p);
  108.             }
  109.         }
  110.     }
  111.  
  112.  
  113. putout(p)
  114. expptr p;
  115. {
  116.     p1_expr (p);
  117.  
  118. /* Used to make temporaries in holdtemps available here, but they */
  119. /* may be reused too soon (e.g. when multiple **'s are involved). */
  120. }
  121.  
  122.  
  123.  
  124. putcmgo(index, nlab, labs)
  125. expptr index;
  126. int nlab;
  127. struct Labelblock *labs[];
  128. {
  129.     if(! ISINT(index->headblock.vtype) )
  130.     {
  131.         execerr("computed goto index must be integer", CNULL);
  132.         return;
  133.     }
  134.  
  135.     p1comp_goto (index, nlab, labs);
  136. }
  137.  
  138.  static expptr
  139. krput(p)
  140.  register expptr p;
  141. {
  142.     register expptr e, e1;
  143.     register unsigned op;
  144.     int t = krparens == 2 ? TYDREAL : p->exprblock.vtype;
  145.  
  146.     op = p->exprblock.opcode;
  147.     e = p->exprblock.leftp;
  148.     if (e->tag == TEXPR && e->exprblock.opcode == op) {
  149.         e1 = (expptr)mktmp(t, ENULL);
  150.         putout(putassign(cpexpr(e1), e));
  151.         p->exprblock.leftp = e1;
  152.         }
  153.     else
  154.         p->exprblock.leftp = putx(e);
  155.  
  156.     e = p->exprblock.rightp;
  157.     if (e->tag == TEXPR && e->exprblock.opcode == op) {
  158.         e1 = (expptr)mktmp(t, ENULL);
  159.         putout(putassign(cpexpr(e1), e));
  160.         p->exprblock.rightp = e1;
  161.         }
  162.     else
  163.         p->exprblock.rightp = putx(e);
  164.     return p;
  165.     }
  166.  
  167. expptr putx(p)
  168.  register expptr p;
  169. {
  170.     int opc;
  171.     int k;
  172.  
  173.     if (p)
  174.       switch(p->tag)
  175.     {
  176.     case TERROR:
  177.         break;
  178.  
  179.     case TCONST:
  180.         switch(p->constblock.vtype)
  181.         {
  182.         case TYLOGICAL1:
  183.         case TYLOGICAL2:
  184.         case TYLOGICAL:
  185. #ifdef TYQUAD
  186.         case TYQUAD:
  187. #endif
  188.         case TYLONG:
  189.         case TYSHORT:
  190.         case TYINT1:
  191.             break;
  192.  
  193.         case TYADDR:
  194.             break;
  195.         case TYREAL:
  196.         case TYDREAL:
  197.  
  198. /* Don't write it out to the p2 file, since you'd need to call putconst,
  199.    which is just what we need to avoid in the translator */
  200.  
  201.             break;
  202.         default:
  203.             p = putx( (expptr)putconst((Constp)p) );
  204.             break;
  205.         }
  206.         break;
  207.  
  208.     case TEXPR:
  209.         switch(opc = p->exprblock.opcode)
  210.         {
  211.         case OPCALL:
  212.         case OPCCALL:
  213.             if( ISCOMPLEX(p->exprblock.vtype) )
  214.                 p = putcxop(p);
  215.             else    p = putcall(p, (Addrp *)NULL);
  216.             break;
  217.  
  218.         case OPMIN:
  219.         case OPMAX:
  220.             p = putmnmx(p);
  221.             break;
  222.  
  223.  
  224.         case OPASSIGN:
  225.             if(ISCOMPLEX(p->exprblock.leftp->headblock.vtype)
  226.                 || ISCOMPLEX(p->exprblock.rightp->headblock.vtype)) {
  227.                 (void) putcxeq(p);
  228.                 p = ENULL;
  229.             } else if( ISCHAR(p) )
  230.                 p = putcheq(p);
  231.             else
  232.                 goto putopp;
  233.             break;
  234.  
  235.         case OPEQ:
  236.         case OPNE:
  237.             if( ISCOMPLEX(p->exprblock.leftp->headblock.vtype) ||
  238.                 ISCOMPLEX(p->exprblock.rightp->headblock.vtype) )
  239.             {
  240.                 p = putcxcmp(p);
  241.                 break;
  242.             }
  243.         case OPLT:
  244.         case OPLE:
  245.         case OPGT:
  246.         case OPGE:
  247.             if(ISCHAR(p->exprblock.leftp))
  248.             {
  249.                 p = putchcmp(p);
  250.                 break;
  251.             }
  252.             goto putopp;
  253.  
  254.         case OPPOWER:
  255.             p = putpower(p);
  256.             break;
  257.  
  258.         case OPSTAR:
  259.             /*   m * (2**k) -> m<<k   */
  260.             if(INT(p->exprblock.leftp->headblock.vtype) &&
  261.                 ISICON(p->exprblock.rightp) &&
  262.                 ( (k = log_2(p->exprblock.rightp->constblock.Const.ci))>0) )
  263.             {
  264.                 p->exprblock.opcode = OPLSHIFT;
  265.                 frexpr(p->exprblock.rightp);
  266.                 p->exprblock.rightp = ICON(k);
  267.                 goto putopp;
  268.             }
  269.             if (krparens && ISREAL(p->exprblock.vtype))
  270.                 return krput(p);
  271.  
  272.         case OPMOD:
  273.             goto putopp;
  274.         case OPPLUS:
  275.             if (krparens && ISREAL(p->exprblock.vtype))
  276.                 return krput(p);
  277.         case OPMINUS:
  278.         case OPSLASH:
  279.         case OPNEG:
  280.         case OPNEG1:
  281.         case OPABS:
  282.         case OPDABS:
  283.             if( ISCOMPLEX(p->exprblock.vtype) )
  284.                 p = putcxop(p);
  285.             else    goto putopp;
  286.             break;
  287.  
  288.         case OPCONV:
  289.             if( ISCOMPLEX(p->exprblock.vtype) )
  290.                 p = putcxop(p);
  291.             else if( ISCOMPLEX(p->exprblock.leftp->headblock.vtype) )
  292.             {
  293.                 p = putx( mkconv(p->exprblock.vtype,
  294.                     (expptr)realpart(putcx1(p->exprblock.leftp))));
  295.             }
  296.             else    goto putopp;
  297.             break;
  298.  
  299.         case OPNOT:
  300.         case OPOR:
  301.         case OPAND:
  302.         case OPEQV:
  303.         case OPNEQV:
  304.         case OPADDR:
  305.         case OPPLUSEQ:
  306.         case OPSTAREQ:
  307.         case OPCOMMA:
  308.         case OPQUEST:
  309.         case OPCOLON:
  310.         case OPBITOR:
  311.         case OPBITAND:
  312.         case OPBITXOR:
  313.         case OPBITNOT:
  314.         case OPLSHIFT:
  315.         case OPRSHIFT:
  316.         case OPASSIGNI:
  317.         case OPIDENTITY:
  318.         case OPCHARCAST:
  319.         case OPMIN2:
  320.         case OPMAX2:
  321.         case OPDMIN:
  322.         case OPDMAX:
  323. putopp:
  324.             p = putop(p);
  325.             break;
  326.  
  327.         case OPCONCAT:
  328.             /* weird things like ichar(a//a) */
  329.             p = (expptr)putch1(p);
  330.             break;
  331.  
  332.         default:
  333.             badop("putx", opc);
  334.             p = errnode ();
  335.         }
  336.         break;
  337.  
  338.     case TADDR:
  339.         p = putaddr(p);
  340.         break;
  341.  
  342.     default:
  343.         badtag("putx", p->tag);
  344.         p = errnode ();
  345.     }
  346.  
  347.     return p;
  348. }
  349.  
  350.  
  351.  
  352. LOCAL expptr putop(p)
  353. expptr p;
  354. {
  355.     expptr lp, tp;
  356.     int pt, lt, lt1;
  357.     int comma;
  358.  
  359.     switch(p->exprblock.opcode)    /* check for special cases and rewrite */
  360.     {
  361.     case OPCONV:
  362.         pt = p->exprblock.vtype;
  363.         lp = p->exprblock.leftp;
  364.         lt = lp->headblock.vtype;
  365.  
  366. /* Simplify nested type casts */
  367.  
  368.         while(p->tag==TEXPR && p->exprblock.opcode==OPCONV &&
  369.             ( (ISREAL(pt)&&ONEOF(lt,MSKREAL|MSKCOMPLEX)) ||
  370.             (INT(pt)&&(ONEOF(lt,MSKINT|MSKADDR|MSKCHAR|M(TYSUBR)))) ))
  371.         {
  372.             if(pt==TYDREAL && lt==TYREAL)
  373.             {
  374.                 if(lp->tag==TEXPR
  375.                 && lp->exprblock.opcode == OPCONV) {
  376.                     lt1 = lp->exprblock.leftp->headblock.vtype;
  377.                     if (lt1 == TYDREAL) {
  378.                     lp->exprblock.leftp =
  379.                         putx(lp->exprblock.leftp);
  380.                     return p;
  381.                     }
  382.                     if (lt1 == TYDCOMPLEX) {
  383.                     lp->exprblock.leftp = putx(
  384.                         (expptr)realpart(
  385.                         putcx1(lp->exprblock.leftp)));
  386.                     return p;
  387.                     }
  388.                     }
  389.                 break;
  390.             }
  391.             else if (ISREAL(pt) && ISCOMPLEX(lt)) {
  392.                 p->exprblock.leftp = putx(mkconv(pt,
  393.                     (expptr)realpart(
  394.                         putcx1(p->exprblock.leftp))));
  395.                 break;
  396.                 }
  397.             if(lt==TYCHAR && lp->tag==TEXPR &&
  398.                 lp->exprblock.opcode==OPCALL)
  399.             {
  400.