home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 379a.lha / p2c1_13a / src / src.zoo / pexpr3.c < prev    next >
C/C++ Source or Header  |  1990-03-14  |  19KB  |  547 lines
  1. /* "p2c", a Pascal to C translator.
  2.    Copyright (C) 1989 David Gillespie.
  3.    Author's address: daveg@csvax.caltech.edu; 256-80 Caltech/Pasadena CA 91125.
  4.  
  5. This program is free software; you can redistribute it and/or modify
  6. it under the terms of the GNU General Public License as published by
  7. the Free Software Foundation (any version).
  8.  
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12. GNU General Public License for more details.
  13.  
  14. You should have received a copy of the GNU General Public License
  15. along with this program; see the file COPYING.  If not, write to
  16. the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
  17.  
  18. #define PROTO_PEXPR3_C
  19. #include "trans.h"
  20.  
  21. Expr *pc_expr()
  22. {
  23.     return pc_expr2(0);
  24. }
  25.  
  26. Expr *pc_expr_str(buf)
  27. char *buf;
  28. {
  29.     Strlist *defsl, *sl;
  30.     Expr *ex;
  31.  
  32.     defsl = NULL;
  33.     sl = strlist_append(&defsl, buf);
  34.     C_lex++;
  35.     push_input_strlist(defsl, buf);
  36.     ex = pc_expr();
  37.     if (curtok != TOK_EOF)
  38.         warning(format_s("Junk (%s) at end of C expression [306]",
  39.              tok_name(curtok)));
  40.     pop_input();
  41.     C_lex--;
  42.     strlist_empty(&defsl);
  43.     return ex;
  44. }
  45.  
  46. /* Simplify an expression */
  47.  
  48. Expr *fixexpr(ex, env)
  49. Expr *ex;
  50. int env;
  51. {
  52.     Expr *ex2, *ex3, **ep;
  53.     Type *type, *type2;
  54.     Meaning *mp;
  55.     char *cp;
  56.     char sbuf[5];
  57.     int i;
  58.     Value val;
  59.  
  60.     if (!ex)
  61.         return NULL;
  62.     switch (ex->kind) {
  63.  
  64.         case EK_BICALL:
  65.             ex2 = fix_bicall(ex, env);
  66.             if (ex2) {
  67.                 ex = ex2;
  68.                 break;
  69.             }
  70.             cp = ex->val.s;
  71.             if (!strcmp(cp, "strlen")) {
  72.                 if (ex->args[0]->kind == EK_BICALL &&
  73.                     !strcmp(ex->args[0]->val.s, "sprintf") &&
  74.                     sprintf_value == 0) {     /* does sprintf return char count? */
  75.                     ex = grabarg(ex, 0);
  76.                     strchange(&ex->val.s, "*sprintf");
  77.                     ex = fixexpr(ex, env);
  78.                 } else {
  79.                     ex->args[0] = fixexpr(ex->args[0], ENV_EXPR);
  80.                 }
  81.             } else if (!strcmp(cp, name_SETIO)) {
  82.                 ex->args[0] = fixexpr(ex->args[0], ENV_BOOL);
  83.             } else if (!strcmp(cp, "~~SETIO")) {
  84.                 ex->args[0] = fixexpr(ex->args[0], ENV_BOOL);
  85.                 ex = makeexpr_cond(ex->args[0],
  86.                                    makeexpr_long(0),
  87.                                    makeexpr_bicall_1(name_ESCIO, tp_int, ex->args[1]));
  88.             } else if (!strcmp(cp, name_CHKIO)) {
  89.                 ex->args[0] = fixexpr(ex->args[0], ENV_BOOL);
  90.                 ex->args[2] = fixexpr(ex->args[2], env);
  91.                 ex->args[3] = fixexpr(ex->args[3], env);
  92.             } else if (!strcmp(cp, "~~CHKIO")) {
  93.                 ex->args[0] = fixexpr(ex->args[0], ENV_BOOL);
  94.                 ex->args[2] = fixexpr(ex->args[2], env);
  95.                 ex->args[3] = fixexpr(ex->args[3], env);
  96.                 ex2 = makeexpr_bicall_1(name_ESCIO, tp_int, ex->args[1]);
  97.                 if (ord_type(ex->args[3]->val.type)->kind != TK_INTEGER)
  98.                     ex2 = makeexpr_cast(ex2, ex->args[3]->val.type);
  99.                 ex = makeexpr_cond(ex->args[0], ex->args[2], ex2);
  100.             } else if (!strcmp(cp, "assert")) {
  101.                 ex->args[0] = fixexpr(ex->args[0], ENV_BOOL);
  102.             } else {
  103.                 for (i = 0; i < ex->nargs; i++)
  104.                     ex->args[i] = fixexpr(ex->args[i], ENV_EXPR);
  105.         ex = cleansprintf(ex);
  106.                 if (!strcmp(cp, "sprintf")) {
  107.                     if (checkstring(ex->args[1], "%s")) {
  108.                         delfreearg(&ex, 1);
  109.                         strchange(&ex->val.s, "strcpy");
  110.                         ex = fixexpr(ex, env);
  111.                     } else if (sprintf_value != 1 && env != ENV_STMT) {
  112.                         if (*sprintfname) {
  113.                             strchange(&ex->val.s, format_s("*%s", sprintfname));
  114.                         } else {
  115.                             strchange(&ex->val.s, "*sprintf");
  116.                             ex = makeexpr_comma(ex, copyexpr(ex->args[0]));
  117.                         }
  118.                     }
  119.                 } else if (!strcmp(cp, "strcpy")) {
  120.                     if (env == ENV_STMT &&
  121.                          ex->args[1]->kind == EK_BICALL &&
  122.                          !strcmp(ex->args[1]->val.s, "strcpy") &&
  123.                          nosideeffects(ex->args[1]->args[0], 1)) {
  124.                         ex2 = ex->args[1];
  125.                         ex->args[1] = copyexpr(ex2->args[0]);
  126.                         ex = makeexpr_comma(ex2, ex);
  127.                     }
  128.                 } else if (!strcmp(cp, "memcpy")) {
  129.                     strchange(&ex->val.s, format_s("*%s", memcpyname));
  130.                     if (!strcmp(memcpyname, "*bcopy")) {
  131.                         swapexprs(ex->args[0], ex->args[1]);
  132.                         if (env != ENV_STMT)
  133.                             ex = makeexpr_comma(ex, copyexpr(ex->args[1]));
  134.                     }
  135.         } else if (!strcmp(cp, setunionname) &&
  136.                (ex3 = singlevar(ex->args[0])) != NULL &&
  137.                ((i=1, exprsame(ex->args[0], ex->args[i], 0)) ||
  138.                 (i=2, exprsame(ex->args[0], ex->args[i], 0))) &&
  139.                !exproccurs(ex3, ex->args[3-i])) {
  140.             ep = &ex->args[3-i];
  141.             while ((ex2 = *ep)->kind == EK_BICALL &&
  142.                (!strcmp(ex2->val.s, setaddname) ||
  143.                 !strcmp(ex2->val.s, setaddrangename)))
  144.             ep = &ex2->args[0];
  145.             if (ex2->kind == EK_BICALL &&
  146.             !strcmp(ex2->val.s, setexpandname) &&
  147.             checkconst(ex2->args[1], 0) &&
  148.             (mp = istempvar(ex2->args[0])) != NULL) {
  149.             if (ex2 == ex->args[3-i]) {
  150.                 ex = grabarg(ex, i);
  151.             } else {
  152.                 freeexpr(ex2);
  153.                 *ep = ex->args[i];
  154.                 ex = ex->args[3-i];
  155.             }
  156.             }
  157.         } else if (!strcmp(cp, setdiffname) && *setremname &&
  158.                (ex3 = singlevar(ex->args[0])) != NULL &&
  159.                exprsame(ex->args[0], ex->args[1], 0) &&
  160.                !exproccurs(ex3, ex->args[2])) {
  161.             ep = &ex->args[2];
  162.             while ((ex2 = *ep)->kind == EK_BICALL &&
  163.                !strcmp(ex2->val.s, setaddname))
  164.             ep = &ex2->args[0];
  165.             if (ex2->kind == EK_BICALL &&
  166.             !strcmp(ex2->val.s, setexpandname) &&
  167.             checkconst(ex2->args[1], 0) &&
  168.             (mp = istempvar(ex2->args[0])) != NULL) {
  169.             if (ex2 == ex->args[2]) {
  170.                 ex = grabarg(ex, 1);
  171.             } else {
  172.                 ex2 = ex->args[2];
  173.                 while (ex2->kind == EK_BICALL &&
  174.                    !strcmp(ex2->val.s, setaddname)) {
  175.                 strchange(&ex2->val.s, setremname);
  176.                 ex2 = ex2->args[0];
  177.                 }
  178.                 freeexpr(ex2);
  179.                 *ep = ex->args[1];
  180.                 ex = ex->args[2];
  181.             }
  182.             }
  183.                 } else if (!strcmp(cp, setexpandname) && env == ENV_STMT &&
  184.                            checkconst(ex->args[1], 0)) {
  185.                     ex = makeexpr_assign(makeexpr_hat(ex->args[0], 0),
  186.                                          ex->args[1]);
  187.                 } else if (!strcmp(cp, getbitsname)) {
  188.             type = ex->args[0]->val.type;
  189.             if (type->kind == TK_POINTER)
  190.             type = type->basetype;
  191.                     sbuf[0] = (type->issigned) ? 'S' : 'U';
  192.                     sbuf[1] = (type->kind == TK_ARRAY) ? 'B' : 'S';
  193.                     sbuf[2] = 0;
  194.                     if (sbuf[1] == 'S' &&
  195.                         type->smax->val.type == tp_boolean) {
  196.                         ex = makeexpr_rel(EK_NE,
  197.                                           makeexpr_bin(EK_BAND, tp_integer,
  198.                                                        ex->args[0],
  199.                                                        makeexpr_bin(EK_LSH, tp_integer,
  200.                                                                     makeexpr_longcast(makeexpr_long(1),
  201.                                                                                       type->basetype
  202.                                                                                             == tp_unsigned),
  203.                                                                     ex->args[1])),
  204.                                           makeexpr_long(0));
  205.                         ex = fixexpr(ex, env);
  206.                     } else
  207.                         strchange(&ex->val.s, format_s(cp, sbuf));
  208.                 } else if (!strcmp(cp, putbitsname)) {
  209.             type = ex->args[0]->val.type;
  210.             if (type->kind == TK_POINTER)
  211.             type = type->basetype;
  212.                     sbuf[0] = (type->issigned) ? 'S' : 'U';
  213.                     sbuf[1] = (type->kind == TK_ARRAY) ? 'B' : 'S';
  214.                     sbuf[2] = 0;
  215.                     if (sbuf[1] == 'S' &&
  216.                         type->smax->val.type == tp_boolean) {
  217.                         ex = makeexpr_assign(ex->args[0],
  218.                                              makeexpr_bin(EK_BOR, tp_integer,
  219.                                                           copyexpr(ex->args[0]),
  220.                                                           makeexpr_bin(EK_LSH, tp_integer,
  221.                                                                        makeexpr_longcast(ex->args[2],
  222.                                                                                          type->basetype
  223.                                                                                                == tp_unsigned),
  224.                                                                        ex->args[1])));
  225.                     } else
  226.                         strchange(&ex->val.s, format_s(cp, sbuf));
  227.                 } else if (!strcmp(cp, storebitsname)) {
  228.             type = ex->args[0]->val.type;
  229.             if (type->kind == TK_POINTER)
  230.             type = type->basetype;
  231.                     sbuf[0] = (type->issigned) ? 'S' : 'U';
  232.                     sbuf[1] = (type->kind == TK_ARRAY) ? 'B' : 'S';
  233.                     sbuf[2] = 0;
  234.                     strchange(&ex->val.s, format_s(cp, sbuf));
  235.                 } else if (!strcmp(cp, clrbitsname)) {
  236.             type = ex->args[0]->val.type;
  237.             if (type->kind == TK_POINTER)
  238.             type = type->basetype;
  239.                     sbuf[0] = (type->kind == TK_ARRAY) ? 'B' : 'S';
  240.                     sbuf[1] = 0;
  241.                     if (sbuf[0] == 'S' &&
  242.                         type->smax->val.type == tp_boolean) {
  243.                         ex = makeexpr_assign(ex->args[0],
  244.                                              makeexpr_bin(EK_BAND, tp_integer,
  245.                                                    copyexpr(ex->args[0]),
  246.                                                    makeexpr_un(EK_BNOT, tp_integer,
  247.                                                           makeexpr_bin(EK_LSH, tp_integer,
  248.                                                                        makeexpr_longcast(makeexpr_long(1),
  249.                                                                                          type->basetype
  250.                                                                                                == tp_unsigned),
  251.                                                                        ex->args[1]))));
  252.                     } else
  253.                         strchange(&ex->val.s, format_s(cp, sbuf));
  254.                 } else if (!strcmp(cp, "fopen")) {
  255.             if (which_lang == LANG_HP &&
  256.             ex->args[0]->kind == EK_CONST &&
  257.             ex->args[0]->val.type->kind == TK_STRING &&
  258.             ex->args[0]->val.i >= 1 &&
  259.             ex->args[0]->val.i <= 2 &&
  260.             isdigit(ex->args[0]->val.s[0]) &&
  261.             (ex->args[0]->val.i == 1 ||
  262.              isdigit(ex->args[0]->val.s[1]))) {
  263.             strchange(&ex->val.s, "fdopen");
  264.             ex->args[0] = makeexpr_long(atoi(ex->args[0]->val.s));
  265.             }
  266.         }
  267.             }
  268.             break;
  269.  
  270.         case EK_NOT:
  271.             ex = makeexpr_not(fixexpr(grabarg(ex, 0), ENV_BOOL));
  272.             break;
  273.  
  274.         case EK_AND:
  275.         case EK_OR:
  276.             for (i = 0; i < ex->nargs; i++)
  277.                 ex->args[i] = fixexpr(ex->args[i], ENV_BOOL);
  278.             break;
  279.  
  280.         case EK_EQ:
  281.         case EK_NE:
  282.             ex->args[0] = fixexpr(ex->args[0], ENV_EXPR);
  283.             ex->args[1] = fixexpr(ex->args[1], ENV_EXPR);
  284.             if (checkconst(ex->args[1], 0) && env == ENV_BOOL &&
  285.                 ord_type(ex->args[1]->val.type)->kind != TK_ENUM &&
  286.                 (implicitzero > 0 ||
  287.                  (implicitzero < 0 && ex->args[0]->kind == EK_BICALL &&
  288.                                       boolean_bicall(ex->args[0]->val.s)))) {
  289.                 if (ex->kind == EK_EQ)
  290.                     ex = makeexpr_not(grabarg(ex, 0));
  291.                 else {
  292.                     ex = grabarg(ex, 0);
  293.                     ex->val.type = tp_boolean;
  294.                 }
  295.             }
  296.             break;
  297.  
  298.         case EK_COND:
  299.             ex->args[0] = fixexpr(ex->args[0], ENV_BOOL);
  300. #if 0
  301.             val = eval_expr(ex->args[0]);
  302. #else
  303.         val = ex->args[0]->val;
  304.         if (ex->args[0]->kind != EK_CONST)
  305.         val.type = NULL;
  306. #endif
  307.             if (val.type == tp_boolean) {
  308.                 ex = grabarg(ex, (val.i) ? 1 : 2);
  309.                 ex = fixexpr(ex, env);
  310.             } else {
  311.                 ex->args[1] = fixexpr(ex->args[1], env);
  312.                 ex->args[2] = fixexpr(ex->args[2], env);
  313.             }
  314.             break;
  315.  
  316.         case EK_COMMA:
  317.             for (i = 0; i < ex->nargs-1; ) {
  318.                 ex->args[i] = fixexpr(ex->args[i], ENV_STMT);
  319.                 if (nosideeffects(ex->args[i], 1))
  320.                     delfreearg(&ex, i);
  321.                 else
  322.                     i++;
  323.             }
  324.             ex->args[ex->nargs-1] = fixexpr(ex->args[ex->nargs-1], env);
  325.             if (ex->nargs == 1)
  326.                 ex = grabarg(ex, 0);
  327.             break;
  328.  
  329.         case EK_CHECKNIL:
  330.             ex->args[0] = fixexpr(ex->args[0], ENV_EXPR);
  331.             if (ex->nargs == 2) {
  332.                 ex->args[1] = fixexpr(ex->args[1], ENV_EXPR);
  333.                 ex2 = makeexpr_assign(copyexpr(ex->args[1]), ex->args[0]);
  334.                 ex3 = ex->args[1];
  335.             } else {
  336.                 ex2 = copyexpr(ex->args[0]);
  337.                 ex3 = ex->args[0];
  338.             }
  339.             type = ex->args[0]->val.type;
  340.             type2 = ex->val.type;
  341.             ex = makeexpr_cond(makeexpr_rel(EK_NE, ex2, makeexpr_nil()),
  342.                                ex3,
  343.                                makeexpr_cast(makeexpr_bicall_0(name_NILCHECK,
  344.                                                                tp_int),
  345.                                              type));
  346.             ex->val.type = type2;
  347.             ex = fixexpr(ex, env);
  348.             break;
  349.  
  350.         case EK_CAST:
  351.         case EK_ACTCAST:
  352.             if (env == ENV_STMT) {
  353.                 ex = fixexpr(grabarg(ex, 0), ENV_STMT);
  354.             } else {
  355.                 ex->args[0] = fixexpr(ex->args[0], ENV_EXPR);
  356.             }
  357.             break;
  358.  
  359.         default:
  360.             for (i = 0; i < ex->nargs; i++)
  361.                 ex->args[i] = fixexpr(ex->args[i], ENV_EXPR);
  362.             break;
  363.     }
  364.     return fix_expression(ex, env);
  365. }
  366.  
  367.  
  368.  
  369.  
  370.  
  371.  
  372.  
  373.  
  374. /* Output an expression */
  375.  
  376.  
  377. #define bitOp(k)  ((k)==EK_BAND || (k)==EK_BOR || (k)==EK_BXOR)
  378.  
  379. #define shfOp(k)  ((k)==EK_LSH || (k)==EK_RSH)
  380.  
  381. #define logOp(k)  ((k)==EK_AND || (k)==EK_OR)
  382.  
  383. #define relOp(k)  ((k)==EK_EQ || (k)==EK_LT || (k)==EK_GT ||    \
  384.            (k)==EK_NE || (k)==EK_GE || (k)==EK_LE)
  385.  
  386. #define mathOp(k) ((k)==EK_PLUS || (k)==EK_TIMES || (k)==EK_NEG ||   \
  387.            (k)==EK_DIV || (k)==EK_DIVIDE || (k)==EK_MOD)
  388.  
  389. #define divOp(k)  ((k)==EK_DIV || (k)==EK_DIVIDE)
  390.  
  391.  
  392. Static int incompat(ex, num, prec)
  393. Expr *ex;
  394. int num, prec;
  395. {
  396.     Expr *subex = ex->args[num];
  397.  
  398.     if (extraparens == 0)
  399.     return prec;
  400.     if (ex->kind == subex->kind) {
  401.     if (logOp(ex->kind) || bitOp(ex->kind) ||
  402.         (divOp(ex->kind) && num == 0))
  403.         return -99;   /* not even invisible parens */
  404.     else if (extraparens != 2)
  405.         return prec;
  406.     }
  407.     if (extraparens == 2)
  408.     return 15;
  409.     if (divOp(ex->kind) && num == 0 &&
  410.     (subex->kind == EK_TIMES || divOp(subex->kind)))
  411.     return -99;
  412.     if (bitOp(ex->kind) || shfOp(ex->kind))
  413.     return 15;
  414.     if (relOp(ex->kind) && relOp(subex->kind))
  415.     return 15;
  416.     if ((relOp(ex->kind) || logOp(ex->kind)) && bitOp(subex->kind))
  417.     return 15;
  418.     if (ex->kind == EK_COMMA)
  419.     return 15;
  420.     if (ex->kind == EK_ASSIGN && relOp(subex->kind))
  421.     return 15;
  422.     if (extraparens != 1)
  423.     return prec;
  424.     if (ex->kind == EK_ASSIGN)
  425.     return prec;
  426.     if (relOp(ex->kind) && mathOp(subex->kind))
  427.     return prec;
  428.     return 15;
  429. }
  430.  
  431. #define EXTRASPACE() if (spaceexprs == 1) output(" ")
  432. #define NICESPACE()  if (spaceexprs != 0) output(" ")
  433.  
  434. void outop3(breakbefore, name)
  435. int breakbefore;
  436. char *name;
  437. {
  438.     if (breakbefore & BRK_LEFT) {
  439.     output("\002");
  440.     if (breakbefore & BRK_RPREF)
  441.         output("\013");
  442.     }
  443.     output(name);
  444.     if (breakbefore & BRK_HANG)
  445.     output("\015");
  446.     if (breakbefore & BRK_RIGHT) {
  447.     output("\002");
  448.     if (breakbefore & BRK_LPREF)
  449.         output("\013");
  450.     }
  451. }
  452.  
  453. #define outop(name) do { \
  454.     NICESPACE(); outop3(breakflag, name); NICESPACE(); \
  455. } while (0)
  456.  
  457. #define outop2(name) do { \
  458.     EXTRASPACE(); outop3(breakflag, name); EXTRASPACE(); \
  459. } while (0)
  460.  
  461. #define checkbreak(code) do { \
  462.     breakflag=(code); \
  463.     if ((prec != -99) && (breakflag & BRK_ALLNONE)) output("\007"); \
  464. } while (0)
  465.  
  466.  
  467. Static void out_ctx(ctx, address)
  468. Meaning *ctx;
  469. int address;
  470. {
  471.     Meaning *ctx2;
  472.     int breakflag = breakbeforedot;
  473.  
  474.     if (ctx->kind == MK_FUNCTION && ctx->varstructflag) {
  475.         if (curctx != ctx) {
  476.         if (address && curctx->ctx && curctx->ctx != ctx) {
  477.         output("\003");
  478.         if (breakflag & BRK_ALLNONE)
  479.             output("\007");
  480.         }
  481.             output(format_s(name_LINK, curctx->ctx->name));
  482.             ctx2 = curctx->ctx;
  483.             while (ctx2 && ctx2 != ctx) {
  484.                 outop2("->");
  485.                 output(format_s(name_LINK, ctx2->ctx->name));
  486.                 ctx2 = ctx2->ctx;
  487.             }
  488.             if (ctx2 != ctx)
  489.                 intwarning("out_ctx",
  490.                            format_s("variable from %s not present in context path [307]",
  491.                                      ctx->name));
  492.         if (address && curctx->ctx && curctx->ctx != ctx)
  493.         output("\004");
  494.             if (!address)
  495.                 outop2("->");
  496.         } else {
  497.             if (address) {
  498.                 output("&");
  499.         EXTRASPACE();
  500.         }
  501.             output(format_s(name_VARS, curctx->name));
  502.             if (!address) {
  503.                 outop2(".");
  504.         }
  505.         }
  506.     } else {
  507.         if (address)
  508.             output("NULL");
  509.     }
  510. }
  511.  
  512.  
  513.  
  514. void out_var(mp, prec)
  515. Meaning *mp;
  516. int prec;
  517. {
  518.     switch (mp->kind) {
  519.  
  520.         case MK_CONST:
  521.             output(mp->name);
  522.             return;
  523.  
  524.         case MK_VAR:
  525.         case MK_VARREF:
  526.         case MK_VARMAC:
  527.         case MK_PARAM:
  528.         case MK_VARPARAM:
  529.             if (mp->varstructflag) {
  530.         output("\003");
  531.                 out_ctx(mp->ctx, 0);
  532.         output(mp->name);
  533.         output("\004");
  534.         } else
  535.         output(mp->name);
  536.             return;
  537.  
  538.     default:
  539.         if (mp->name)
  540.         output(mp->name);
  541.         else
  542.         intwarning("out_var", "mp->sym == NULL [308]");
  543.         return;
  544.     }
  545. }
  546.  
  547.