开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > 编译器/解释器 > 查看源码
expr.c.1
资源名称：pascal2c.tar.Z　[点击查看]
上传用户：upcnvip
上传日期：2007-01-06
资源大小：474k
文件大小：48k
源码类别：

编译器/解释器

开发平台：

C/C++

expr.c.1：源码内容
  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.
  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).
  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.
  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. */
  20. #define PROTO_EXPR_C
  21. #include "trans.h"
  27. void free_value(val)
  28. Value *val;
  29. {
  30.     if (!val || !val->type)
  31. return;
  32.     switch (val->type->kind) {
  34.         case TK_STRING:
  35.         case TK_REAL:
  36.         case TK_ARRAY:
  37.         case TK_RECORD:
  38.         case TK_SET:
  39.             if (val->s)
  40.                 FREE(val->s);
  41.             break;
  43. default:
  44.     break;
  45.     }
  46. }
  49. Value copyvalue(val)
  50. Value val;
  51. {
  52.     char *cp;
  54.     switch (val.type->kind) {
  56.         case TK_STRING:
  57.         case TK_SET:
  58.             if (val.s) {
  59.                 cp = ALLOC(val.i+1, char, literals);
  60.                 memcpy(cp, val.s, val.i);
  61. cp[val.i] = 0;
  62.                 val.s = cp;
  63.             }
  64.             break;
  66.         case TK_REAL:
  67.         case TK_ARRAY:
  68.         case TK_RECORD:
  69.             if (val.s)
  70.                 val.s = stralloc(val.s);
  71.             break;
  73. default:
  74.     break;
  75.     }
  76.     return val;
  77. }
  80. int valuesame(a, b)
  81. Value a, b;
  82. {
  83.     if (a.type != b.type)
  84.         return 0;
  85.     switch (a.type->kind) {
  87.         case TK_INTEGER:
  88.         case TK_CHAR:
  89.         case TK_BOOLEAN:
  90.         case TK_ENUM:
  91.         case TK_SMALLSET:
  92.         case TK_SMALLARRAY:
  93.             return (a.i == b.i);
  95.         case TK_STRING:
  96.         case TK_SET:
  97.             return (a.i == b.i && !memcmp(a.s, b.s, a.i));
  99.         case TK_REAL:
  100.         case TK_ARRAY:
  101.         case TK_RECORD:
  102.             return (!strcmp(a.s, b.s));
  104.         default:
  105.             return 1;
  106.     }
  107. }
  111. char *value_name(val, intfmt, islong)
  112. Value val;
  113. char *intfmt;
  114. int islong;
  115. {
  116.     Meaning *mp;
  117.     Type *type = val.type;
  119.     if (type->kind == TK_SUBR)
  120. type = type->basetype;
  121.     switch (type->kind) {
  123.         case TK_INTEGER:
  124.         case TK_SMALLSET:
  125.         case TK_SMALLARRAY:
  126.             if (!intfmt)
  127. intfmt = "%ld";
  128.     if (*intfmt == ''') {
  129. if (val.i >= -'~' && val.i <= -' ') {
  130.     intfmt = format_s("-%s", intfmt);
  131.     val.i = -val.i;
  132. }
  133. if (val.i < ' ' || val.i > '~' || islong)
  134.     intfmt = "%ld";
  135.     }
  136.             if (islong)
  137.                 intfmt = format_s("%sL", intfmt);
  138.             return format_d(intfmt, val.i);
  140.         case TK_REAL:
  141.             return val.s;
  143.         case TK_ARRAY:    /* obsolete */
  144.         case TK_RECORD:   /* obsolete */
  145.             return val.s;
  147.         case TK_STRING:
  148.             return makeCstring(val.s, val.i);
  150.         case TK_BOOLEAN:
  151.             if (!intfmt)
  152.                 if (val.i == 1 && *name_TRUE &&
  153.     strcmp(name_TRUE, "1") && !islong)
  154.                     intfmt = name_TRUE;
  155.                 else if (val.i == 0 && *name_FALSE &&
  156.  strcmp(name_FALSE, "0") && !islong)
  157.                     intfmt = name_FALSE;
  158.                 else
  159.                     intfmt = "%ld";
  160.             if (islong)
  161.                 intfmt = format_s("%sL", intfmt);
  162.             return format_d(intfmt, val.i);
  164.         case TK_CHAR:
  165.             if (islong)
  166.                 return format_d("%ldL", val.i);
  167.     else if ((val.i < 0 || val.i > 127) && highcharints)
  168. return format_d("%ld", val.i);
  169.             else
  170.                 return makeCchar(val.i);
  172.         case TK_POINTER:
  173.             return (*name_NULL) ? name_NULL : "NULL";
  175.         case TK_ENUM:
  176.             mp = val.type->fbase;
  177.             while (mp && mp->val.i != val.i)
  178.                 mp = mp->xnext;
  179.             if (!mp) {
  180.                 intwarning("value_name", "bad enum value [152]");
  181.                 return format_d("%ld", val.i);
  182.             }
  183.             return mp->name;
  185.         default:
  186.             intwarning("value_name", format_s("bad type for constant: %s [153]", 
  187.                                               typekindname(type->kind)));
  188.             return "<spam>";
  189.     }
  190. }
  195. Value value_cast(val, type)
  196. Value val;
  197. Type *type;
  198. {
  199.     char buf[20];
  201.     if (type->kind == TK_SUBR)
  202.         type = type->basetype;
  203.     if (val.type == type)
  204.         return val;
  205.     if (type && val.type) {
  206.         switch (type->kind) {
  208.             case TK_REAL:
  209.                 if (ord_type(val.type)->kind == TK_INTEGER) {
  210.                     sprintf(buf, "%d.0", val.i);
  211.                     val.s = stralloc(buf);
  212.                     val.type = tp_real;
  213.                     return val;
  214.                 }
  215.                 break;
  217.             case TK_CHAR:
  218.                 if (val.type->kind == TK_STRING) {
  219.                     if (val.i != 1)
  220.                         if (val.i > 0)
  221.                             warning("Char constant with more than one character [154]");
  222.                         else
  223.                             warning("Empty char constant [155]");
  224.                     val.i = val.s[0] & 0xff;
  225.                     val.s = NULL;
  226.                     val.type = tp_char;
  227.                     return val;
  228.                 }
  230.             case TK_POINTER:
  231.                 if (val.type == tp_anyptr && castnull != 1) {
  232.                     val.type = type;
  233.                     return val;
  234.                 }
  236.     default:
  237. break;
  238.         }
  239.     }
  240.     val.type = NULL;
  241.     return val;
  242. }
  246. Type *ord_type(tp)
  247. Type *tp;
  248. {
  249.     if (!tp) {
  250.         warning("Expected a constant [127]");
  251.         return tp_integer;
  252.     }
  253.     switch (tp->kind) {
  255.         case TK_SUBR:
  256.             tp = tp->basetype;
  257.             break;
  259.         case TK_STRING:
  260.             if (!CHECKORDEXPR(tp->indextype->smax, 1))
  261.                 tp = tp_char;
  262.             break;
  264. default:
  265.     break;
  267.     }
  268.     return tp;
  269. }
  273. int long_type(tp)
  274. Type *tp;
  275. {
  276.     switch (tp->kind) {
  278.         case TK_INTEGER:
  279.             return (tp != tp_int && tp != tp_uint && tp != tp_sint);
  281.         case TK_SUBR:
  282.             return (findbasetype(tp, 0) == tp_integer);
  284.         default:
  285.             return 0;
  286.     }
  287. }
  291. Value make_ord(type, i)
  292. Type *type;
  293. long i;
  294. {
  295.     Value val;
  297.     if (type->kind == TK_ENUM)
  298.         type = findbasetype(type, 0);
  299.     if (type->kind == TK_SUBR)
  300.         type = type->basetype;
  301.     val.type = type;
  302.     val.i = i;
  303.     val.s = NULL;
  304.     return val;
  305. }
  309. long ord_value(val)
  310. Value val;
  311. {
  312.     switch (val.type->kind) {
  314.         case TK_INTEGER:
  315.         case TK_ENUM:
  316.         case TK_CHAR:
  317.         case TK_BOOLEAN:
  318.             return val.i;
  320.         case TK_STRING:
  321.             if (val.i == 1)
  322.                 return val.s[0] & 0xff;
  324.         /* fall through */
  325.         default:
  326.             warning("Expected an ordinal type [156]");
  327.             return 0;
  328.     }
  329. }
  333. void ord_range_expr(type, smin, smax)
  334. Type *type;
  335. Expr **smin, **smax;
  336. {
  337.     if (!type) {
  338.         warning("Expected a constant [127]");
  339.         type = tp_integer;
  340.     }
  341.     if (type->kind == TK_STRING)
  342.         type = tp_char;
  343.     switch (type->kind) {
  345.         case TK_SUBR:
  346.         case TK_INTEGER:
  347.         case TK_ENUM:
  348.         case TK_CHAR:
  349.         case TK_BOOLEAN:
  350.             if (smin) *smin = type->smin;
  351.             if (smax) *smax = type->smax;
  352.             break;
  354.         default:
  355.             warning("Expected an ordinal type [156]");
  356.             if (smin) *smin = makeexpr_long(0);
  357.             if (smax) *smax = makeexpr_long(1);
  358.             break;
  359.     }
  360. }
  363. int ord_range(type, smin, smax)
  364. Type *type;
  365. long *smin, *smax;
  366. {
  367.     Expr *emin, *emax;
  368.     Value vmin, vmax;
  370.     ord_range_expr(type, &emin, &emax);
  371.     if (smin) {
  372.         vmin = eval_expr(emin);
  373.         if (!vmin.type)
  374.             return 0;
  375.     }
  376.     if (smax) {
  377.         vmax = eval_expr(emax);
  378.         if (!vmax.type)
  379.             return 0;
  380.     }
  381.     if (smin) *smin = ord_value(vmin);
  382.     if (smax) *smax = ord_value(vmax);
  383.     return 1;
  384. }
  392. void freeexpr(ex)
  393. register Expr *ex;
  394. {
  395.     register int i;
  397.     if (ex) {
  398.         for (i = 0; i < ex->nargs; i++)
  399.             freeexpr(ex->args[i]);
  400.         switch (ex->kind) {
  402.             case EK_CONST:
  403.             case EK_LONGCONST:
  404.                 free_value(&ex->val);
  405.                 break;
  407.             case EK_DOT:
  408.             case EK_NAME:
  409.             case EK_BICALL:
  410.                 if (ex->val.s)
  411.                     FREE(ex->val.s);
  412.                 break;
  414.     default:
  415. break;
  416.         }
  417.         FREE(ex);
  418.     }
  419. }
  424. Expr *makeexpr(kind, n)
  425. enum exprkind kind;
  426. int n;
  427. {
  428.     Expr *ex;
  430.     ex = ALLOCV(sizeof(Expr) + (n-1)*sizeof(Expr *), Expr, exprs);
  431.     ex->val.i = 0;
  432.     ex->val.s = NULL;
  433.     ex->kind = kind;
  434.     ex->nargs = n;
  435.     return ex;
  436. }
  439. Expr *makeexpr_un(kind, type, arg1)
  440. enum exprkind kind;
  441. Type *type;
  442. Expr *arg1;
  443. {
  444.     Expr *ex;
  446.     ex = makeexpr(kind, 1);
  447.     ex->val.type = type;
  448.     ex->args[0] = arg1;
  449.     if (debug>2) { fprintf(outf,"makeexpr_un returns "); dumpexpr(ex); fprintf(outf,"n"); }
  450.     return ex;
  451. }
  454. Expr *makeexpr_bin(kind, type, arg1, arg2)
  455. enum exprkind kind;
  456. Type *type;
  457. Expr *arg1, *arg2;
  458. {
  459.     Expr *ex;
  461.     ex = makeexpr(kind, 2);
  462.     ex->val.type = type;
  463.     ex->args[0] = arg1;
  464.     ex->args[1] = arg2;
  465.     if (debug>2) { fprintf(outf,"makeexpr_bin returns "); dumpexpr(ex); fprintf(outf,"n"); }
  466.     return ex;
  467. }
  471. Expr *makeexpr_val(val)
  472. Value val;
  473. {
  474.     Expr *ex;
  476.     if (val.type->kind == TK_INTEGER && 
  477.         (val.i < -32767 || val.i > 32767) &&
  478.         sizeof_int < 32)
  479.         ex = makeexpr(EK_LONGCONST, 0);
  480.     else
  481.         ex = makeexpr(EK_CONST, 0);
  482.     ex->val = val;
  483.     if (debug>2) { fprintf(outf,"makeexpr_val returns "); dumpexpr(ex); fprintf(outf,"n"); }
  484.     return ex;
  485. }
  489. Expr *makeexpr_char(c)
  490. int c;
  491. {
  492.     return makeexpr_val(make_ord(tp_char, c));
  493. }
  496. Expr *makeexpr_long(i)
  497. long i;
  498. {
  499.     return makeexpr_val(make_ord(tp_integer, i));
  500. }
  503. Expr *makeexpr_real(r)
  504. char *r;
  505. {
  506.     Value val;
  508.     val.type = tp_real;
  509.     val.i = 0;
  510.     val.s = stralloc(r);
  511.     return makeexpr_val(val);
  512. }
  515. Expr *makeexpr_lstring(msg, len)
  516. char *msg;
  517. int len;
  518. {
  519.     Value val;
  521.     val.type = tp_str255;
  522.     val.i = len;
  523.     val.s = ALLOC(len+1, char, literals);
  524.     memcpy(val.s, msg, len);
  525.     val.s[len] = 0;
  526.     return makeexpr_val(val);
  527. }
  530. Expr *makeexpr_string(msg)
  531. char *msg;
  532. {
  533.     Value val;
  535.     val.type = tp_str255;
  536.     val.i = strlen(msg);
  537.     val.s = stralloc(msg);
  538.     return makeexpr_val(val);
  539. }
  542. int checkstring(ex, msg)
  543. Expr *ex;
  544. char *msg;
  545. {
  546.     if (!ex || ex->val.type->kind != TK_STRING || ex->kind != EK_CONST)
  547.         return 0;
  548.     if (ex->val.i != strlen(msg))
  549.         return 0;
  550.     return memcmp(ex->val.s, msg, ex->val.i) == 0;
  551. }
  555. Expr *makeexpr_var(mp)
  556. Meaning *mp;
  557. {
  558.     Expr *ex;
  560.     ex = makeexpr(EK_VAR, 0);
  561.     ex->val.i = (long) mp;
  562.     ex->val.type = mp->type;
  563.     if (debug>2) { fprintf(outf,"makeexpr_var returns "); dumpexpr(ex); fprintf(outf,"n"); }
  564.     return ex;
  565. }
  569. Expr *makeexpr_name(name, type)
  570. char *name;
  571. Type *type;
  572. {
  573.     Expr *ex;
  575.     ex = makeexpr(EK_NAME, 0);
  576.     ex->val.s = stralloc(name);
  577.     ex->val.type = type;
  578.     if (debug>2) { fprintf(outf,"makeexpr_name returns "); dumpexpr(ex); fprintf(outf,"n"); }
  579.     return ex;
  580. }
  584. Expr *makeexpr_setbits()
  585. {
  586.     if (*name_SETBITS)
  587.         return makeexpr_name(name_SETBITS, tp_integer);
  588.     else
  589.         return makeexpr_long(setbits);
  590. }
  594. /* Note: BICALL's to the following functions should obey the ANSI standard. */
  595. /*       Non-ANSI transformations occur while writing the expression. */
  596. /*              char *sprintf(buf, fmt, ...)   [returns buf]  */
  597. /*              void *memcpy(dest, src, size)  [returns dest] */
  599. Expr *makeexpr_bicall_0(name, type)
  600. char *name;
  601. Type *type;
  602. {
  603.     Expr *ex;
  605.     if (!name || !*name) {
  606.         intwarning("makeexpr_bicall_0", "Required name of built-in procedure is missing [157]");
  607.         name = "MissingProc";
  608.     }
  609.     ex = makeexpr(EK_BICALL, 0);
  610.     ex->val.s = stralloc(name);
  611.     ex->val.type = type;
  612.     if (debug>2) { fprintf(outf,"makeexpr_bicall returns "); dumpexpr(ex); fprintf(outf,"n"); }
  613.     return ex;
  614. }
  617. Expr *makeexpr_bicall_1(name, type, arg1)
  618. char *name;
  619. Type *type;
  620. Expr *arg1;
  621. {
  622.     Expr *ex;
  624.     if (!name || !*name) {
  625.         intwarning("makeexpr_bicall_1", "Required name of built-in procedure is missing [157]");
  626.         name = "MissingProc";
  627.     }
  628.     ex = makeexpr(EK_BICALL, 1);
  629.     ex->val.s = stralloc(name);
  630.     ex->val.type = type;
  631.     ex->args[0] = arg1;
  632.     if (debug>2) { fprintf(outf,"makeexpr_bicall returns "); dumpexpr(ex); fprintf(outf,"n"); }
  633.     return ex;
  634. }
  637. Expr *makeexpr_bicall_2(name, type, arg1, arg2)
  638. char *name;
  639. Type *type;
  640. Expr *arg1, *arg2;
  641. {
  642.     Expr *ex;
  644.     if (!name || !*name) {
  645.         intwarning("makeexpr_bicall_2", "Required name of built-in procedure is missing [157]");
  646.         name = "MissingProc";
  647.     }
  648.     ex = makeexpr(EK_BICALL, 2);
  649.     if (!strcmp(name, "~SETIO"))
  650.         name = (iocheck_flag) ? "~~SETIO" : name_SETIO;
  651.     ex->val.s = stralloc(name);
  652.     ex->val.type = type;
  653.     ex->args[0] = arg1;
  654.     ex->args[1] = arg2;
  655.     if (debug>2) { fprintf(outf,"makeexpr_bicall returns "); dumpexpr(ex); fprintf(outf,"n"); }
  656.     return ex;
  657. }
  660. Expr *makeexpr_bicall_3(name, type, arg1, arg2, arg3)
  661. char *name;
  662. Type *type;
  663. Expr *arg1, *arg2, *arg3;
  664. {
  665.     Expr *ex;
  667.     if (!name || !*name) {
  668.         intwarning("makeexpr_bicall_3", "Required name of built-in procedure is missing [157]");
  669.         name = "MissingProc";
  670.     }
  671.     ex = makeexpr(EK_BICALL, 3);
  672.     ex->val.s = stralloc(name);
  673.     ex->val.type = type;
  674.     ex->args[0] = arg1;
  675.     ex->args[1] = arg2;
  676.     ex->args[2] = arg3;
  677.     if (debug>2) { fprintf(outf,"makeexpr_bicall returns "); dumpexpr(ex); fprintf(outf,"n"); }
  678.     return ex;
  679. }
  682. Expr *makeexpr_bicall_4(name, type, arg1, arg2, arg3, arg4)
  683. char *name;
  684. Type *type;
  685. Expr *arg1, *arg2, *arg3, *arg4;
  686. {
  687.     Expr *ex;
  689.     if (!name || !*name) {
  690.         intwarning("makeexpr_bicall_4", "Required name of built-in procedure is missing [157]");
  691.         name = "MissingProc";
  692.     }
  693.     ex = makeexpr(EK_BICALL, 4);
  694.     if (!strcmp(name, "~CHKIO"))
  695.         name = (iocheck_flag) ? "~~CHKIO" : name_CHKIO;
  696.     ex->val.s = stralloc(name);
  697.     ex->val.type = type;
  698.     ex->args[0] = arg1;
  699.     ex->args[1] = arg2;
  700.     ex->args[2] = arg3;
  701.     ex->args[3] = arg4;
  702.     if (debug>2) { fprintf(outf,"makeexpr_bicall returns "); dumpexpr(ex); fprintf(outf,"n"); }
  703.     return ex;
  704. }
  707. Expr *makeexpr_bicall_5(name, type, arg1, arg2, arg3, arg4, arg5)
  708. char *name;
  709. Type *type;
  710. Expr *arg1, *arg2, *arg3, *arg4, *arg5;
  711. {
  712.     Expr *ex;
  714.     if (!name || !*name) {
  715.         intwarning("makeexpr_bicall_5", "Required name of built-in procedure is missing [157]");
  716.         name = "MissingProc";
  717.     }
  718.     ex = makeexpr(EK_BICALL, 5);
  719.     ex->val.s = stralloc(name);
  720.     ex->val.type = type;
  721.     ex->args[0] = arg1;
  722.     ex->args[1] = arg2;
  723.     ex->args[2] = arg3;
  724.     ex->args[3] = arg4;
  725.     ex->args[4] = arg5;
  726.     if (debug>2) { fprintf(outf,"makeexpr_bicall returns "); dumpexpr(ex); fprintf(outf,"n"); }
  727.     return ex;
  728. }
  733. Expr *copyexpr(ex)
  734. register Expr *ex;
  735. {
  736.     register int i;
  737.     register Expr *ex2;
  739.     if (ex) {
  740.         ex2 = makeexpr(ex->kind, ex->nargs);
  741.         for (i = 0; i < ex->nargs; i++)
  742.             ex2->args[i] = copyexpr(ex->args[i]);
  743.         switch (ex->kind) {
  745.             case EK_CONST:
  746.             case EK_LONGCONST:
  747.                 ex2->val = copyvalue(ex->val);
  748.                 break;
  750.             case EK_DOT:
  751.             case EK_NAME:
  752.             case EK_BICALL:
  753.                 ex2->val.type = ex->val.type;
  754.                 ex2->val.i = ex->val.i;
  755.                 if (ex->val.s)
  756.                     ex2->val.s = stralloc(ex->val.s);
  757.                 break;
  759.             default:
  760.                 ex2->val = ex->val;
  761.                 break;
  762.         }
  763.         return ex2;
  764.     } else
  765.         return NULL;
  766. }
  770. int exprsame(a, b, strict)
  771. register Expr *a, *b;
  772. int strict;
  773. {
  774.     register int i;
  776.     if (!a)
  777.         return (!b);
  778.     if (!b)
  779.         return 0;
  780.     if (a->val.type != b->val.type && strict != 2) {
  781.         if (strict ||
  782.     !((a->val.type->kind == TK_POINTER &&
  783.        a->val.type->basetype == b->val.type) ||
  784.       (b->val.type->kind == TK_POINTER &&
  785.        b->val.type->basetype == a->val.type)))
  786.         return 0;
  787.     }
  788.     if (a->kind != b->kind || a->nargs != b->nargs)
  789.         return 0;
  790.     switch (a->kind) {
  792.         case EK_CONST:
  793.         case EK_LONGCONST:
  794.             if (!valuesame(a->val, b->val))
  795.                 return 0;
  796.             break;
  798.         case EK_BICALL:
  799.         case EK_NAME:
  800.             if (strcmp(a->val.s, b->val.s))
  801.                 return 0;
  802.             break;
  804.         case EK_VAR:
  805.         case EK_FUNCTION:
  806.         case EK_CTX:
  807.         case EK_MACARG:
  808.             if (a->val.i != b->val.i)
  809.                 return 0;
  810.             break;
  812.         case EK_DOT:
  813.             if (a->val.i != b->val.i ||
  814.                 (!a->val.i && strcmp(a->val.s, b->val.s)))
  815.                 return 0;
  816.             break;
  818. default:
  819.     break;
  820.     }
  821.     i = a->nargs;
  822.     while (--i >= 0)
  823.         if (!exprsame(a->args[i], b->args[i], (strict == 2) ? 1 : strict))
  824.             return 0;
  825.     return 1;
  826. }
  830. int exprequiv(a, b)
  831. register Expr *a, *b;
  832. {
  833.     register int i, j, k;
  834.     enum exprkind kind2;
  836.     if (!a)
  837.         return (!b);
  838.     if (!b)
  839.         return 0;
  840.     switch (a->kind) {
  842.         case EK_PLUS:
  843.         case EK_TIMES:
  844.         case EK_BAND:
  845.         case EK_BOR:
  846.         case EK_BXOR:
  847.         case EK_EQ:
  848.         case EK_NE:
  849.             if (b->kind != a->kind || b->nargs != a->nargs ||
  850.                 b->val.type != a->val.type)
  851.                 return 0;
  852.             if (a->nargs > 3)
  853.                 break;
  854.             for (i = 0; i < b->nargs; i++) {
  855.                 if (exprequiv(a->args[0], b->args[i])) {
  856.                     for (j = 0; j < b->nargs; j++) {
  857.                         if (j != i &&
  858.                             exprequiv(a->args[1], b->args[i])) {
  859.                             if (a->nargs == 2)
  860.                                 return 1;
  861.                             for (k = 0; k < b->nargs; k++) {
  862.                                 if (k != i && k != j &&
  863.                                     exprequiv(a->args[2], b->args[k]))
  864.                                     return 1;
  865.                             }
  866.                         }
  867.                     }
  868.                 }
  869.             }
  870.             break;
  872.         case EK_LT:
  873.         case EK_GT:
  874.         case EK_LE:
  875.         case EK_GE:
  876.             switch (a->kind) {
  877.                 case EK_LT:  kind2 = EK_GT; break;
  878.                 case EK_GT:  kind2 = EK_LT; break;
  879.                 case EK_LE:  kind2 = EK_GE; break;
  880.                 default:     kind2 = EK_LE; break;
  881.             }
  882.             if (b->kind != kind2 || b->val.type != a->val.type)
  883.                 break;
  884.             if (exprequiv(a->args[0], b->args[1]) &&
  885.                 exprequiv(a->args[1], b->args[0])) {
  886.                 return 1;
  887.             }
  888.             break;
  890.         case EK_CONST:
  891.         case EK_LONGCONST:
  892.         case EK_BICALL:
  893.         case EK_NAME:
  894.         case EK_VAR:
  895.         case EK_FUNCTION:
  896.         case EK_CTX:
  897.         case EK_DOT:
  898.             return exprsame(a, b, 0);
  900. default:
  901.     break;
  902.     }
  903.     if (b->kind != a->kind || b->nargs != a->nargs ||
  904.         b->val.type != a->val.type)
  905.         return 0;
  906.     i = a->nargs;
  907.     while (--i >= 0)
  908.         if (!exprequiv(a->args[i], b->args[i]))
  909.             return 0;
  910.     return 1;
  911. }
  915. void deletearg(ex, n)
  916. Expr **ex;
  917. register int n;
  918. {
  919.     register Expr *ex1 = *ex, *ex2;
  920.     register int i;
  922.     if (debug>2) { fprintf(outf,"deletearg("); dumpexpr(*ex); fprintf(outf,", %d)n", n); }
  923.     if (n < 0 || n >= (*ex)->nargs) {
  924.         intwarning("deletearg", "argument number out of range [158]");
  925.         return;
  926.     }
  927.     ex2 = makeexpr(ex1->kind, ex1->nargs-1);
  928.     ex2->val = ex1->val;
  929.     for (i = 0; i < n; i++)
  930.         ex2->args[i] = ex1->args[i];
  931.     for (; i < ex2->nargs; i++)
  932.         ex2->args[i] = ex1->args[i+1];
  933.     *ex = ex2;
  934.     FREE(ex1);
  935.     if (debug>2) { fprintf(outf,"deletearg returns "); dumpexpr(*ex); fprintf(outf,"n"); }
  936. }
  940. void insertarg(ex, n, arg)
  941. Expr **ex;
  942. Expr *arg;
  943. register int n;
  944. {
  945.     register Expr *ex1 = *ex, *ex2;
  946.     register int i;
  948.     if (debug>2) { fprintf(outf,"insertarg("); dumpexpr(*ex); fprintf(outf,", %d)n", n); }
  949.     if (n < 0 || n > (*ex)->nargs) {
  950.         intwarning("insertarg", "argument number out of range [159]");
  951.         return;
  952.     }
  953.     ex2 = makeexpr(ex1->kind, ex1->nargs+1);
  954.     ex2->val = ex1->val;
  955.     for (i = 0; i < n; i++)
  956.         ex2->args[i] = ex1->args[i];
  957.     ex2->args[n] = arg;
  958.     for (; i < ex1->nargs; i++)
  959.         ex2->args[i+1] = ex1->args[i];
  960.     *ex = ex2;
  961.     FREE(ex1);
  962.     if (debug>2) { fprintf(outf,"insertarg returns "); dumpexpr(*ex); fprintf(outf,"n"); }
  963. }
  967. Expr *grabarg(ex, n)
  968. Expr *ex;
  969. int n;
  970. {
  971.     Expr *ex2;
  973.     if (n < 0 || n >= ex->nargs) {
  974.         intwarning("grabarg", "argument number out of range [160]");
  975.         return ex;
  976.     }
  977.     ex2 = ex->args[n];
  978.     ex->args[n] = makeexpr_long(0);   /* placeholder */
  979.     freeexpr(ex);
  980.     return ex2;
  981. }
  985. void delsimparg(ep, n)
  986. Expr **ep;
  987. int n;
  988. {
  989.     if (n < 0 || n >= (*ep)->nargs) {
  990.         intwarning("delsimparg", "argument number out of range [161]");
  991.         return;
  992.     }
  993.     deletearg(ep, n);
  994.     switch ((*ep)->kind) {
  996.         case EK_PLUS:
  997.         case EK_TIMES:
  998.         case EK_COMMA:
  999.             if ((*ep)->nargs == 1)
  1000.                 *ep = grabarg(*ep, 0);
  1001.             break;
  1003. default:
  1004.     break;
  1006.     }
  1007. }
  1012. Expr *resimplify(ex)
  1013. Expr *ex;
  1014. {
  1015.     Expr *ex2;
  1016.     Type *type;
  1017.     int i;
  1019.     if (debug>2) { fprintf(outf,"resimplify("); dumpexpr(ex); fprintf(outf,")n"); }
  1020.     if (!ex)
  1021.         return NULL;
  1022.     type = ex->val.type;
  1023.     switch (ex->kind) {
  1025.         case EK_PLUS:
  1026.             ex2 = ex->args[0];
  1027.             for (i = 1; i < ex->nargs; i++)
  1028.                 ex2 = makeexpr_plus(ex2, ex->args[i]);
  1029.             FREE(ex);
  1030.             return ex2;
  1032.         case EK_TIMES:
  1033.             ex2 = ex->args[0];
  1034.             for (i = 1; i < ex->nargs; i++)
  1035.                 ex2 = makeexpr_times(ex2, ex->args[i]);
  1036.             FREE(ex);
  1037.             return ex2;
  1039.         case EK_NEG:
  1040.             ex = makeexpr_neg(grabarg(ex, 0));
  1041.             ex->val.type = type;
  1042.             return ex;
  1044.         case EK_NOT:
  1045.             ex = makeexpr_not(grabarg(ex, 0));
  1046.             ex->val.type = type;
  1047.             return ex;
  1049.         case EK_HAT:
  1050.             ex = makeexpr_hat(grabarg(ex, 0), 0);
  1051.     if (ex->kind == EK_HAT)
  1052. ex->val.type = type;
  1053.             return ex;
  1055.         case EK_ADDR:
  1056.             ex = makeexpr_addr(grabarg(ex, 0));
  1057.             ex->val.type = type;
  1058.             return ex;
  1060. case EK_ASSIGN:
  1061.     ex2 = makeexpr_assign(ex->args[0], ex->args[1]);
  1062.     FREE(ex);
  1063.     return ex2;
  1065. default:
  1066.     break;
  1067.     }
  1068.     return ex;
  1069. }
  1076. int realzero(s)
  1077. register char *s;
  1078. {
  1079.     if (*s == '-') s++;
  1080.     while (*s == '0' || *s == '.') s++;
  1081.     return (!isdigit(*s));
  1082. }
  1085. int checkconst(ex, val)
  1086. Expr *ex;
  1087. long val;
  1088. {
  1089.     Meaning *mp;
  1090.     Value exval;
  1092.     if (!ex)
  1093.         return 0;
  1094.     if (ex->kind == EK_CAST || ex->kind == EK_ACTCAST)
  1095.         ex = ex->args[0];
  1096.     if (ex->kind == EK_CONST || ex->kind == EK_LONGCONST)
  1097.         exval = ex->val;
  1098.     else if (ex->kind == EK_VAR && 
  1099.              (mp = (Meaning *)ex->val.i)->kind == MK_CONST &&
  1100.              foldconsts != 0)
  1101.         exval = mp->val;
  1102.     else
  1103.         return 0;
  1104.     switch (exval.type->kind) {
  1106.         case TK_BOOLEAN:
  1107.         case TK_INTEGER:
  1108.         case TK_CHAR:
  1109.         case TK_ENUM:
  1110.         case TK_SUBR:
  1111.         case TK_SMALLSET:
  1112.         case TK_SMALLARRAY:
  1113.             return exval.i == val;
  1115.         case TK_POINTER:
  1116.         case TK_STRING:
  1117.             return (val == 0 && exval.i == 0);
  1119.         case TK_REAL:
  1120.             return (val == 0 && realzero(exval.s));
  1122. default:
  1123.     return 0;
  1124.     }
  1125. }
  1129. int isliteralconst(ex, valp)
  1130. Expr *ex;
  1131. Value *valp;
  1132. {
  1133.     Meaning *mp;
  1135.     if (ex) {
  1136.         switch (ex->kind) {
  1138.             case EK_CONST:
  1139.             case EK_LONGCONST:
  1140.                 if (valp)
  1141.                     *valp = ex->val;
  1142.                 return 2;
  1144.             case EK_VAR:
  1145.                 mp = (Meaning *)ex->val.i;
  1146.                 if (mp->kind == MK_CONST) {
  1147.                     if (valp) {
  1148.                         if (foldconsts == 0)
  1149.                             valp->type = NULL;
  1150.                         else
  1151.                             *valp = mp->val;
  1152.                     }
  1153.                     return 1;
  1154.                 }
  1155.                 break;
  1157.     default:
  1158. break;
  1159.         }
  1160.     }
  1161.     if (valp)
  1162.         valp->type = NULL;
  1163.     return 0;
  1164. }
  1168. int isconstexpr(ex, valp)
  1169. Expr *ex;
  1170. long *valp;
  1171. {
  1172.     Value exval;
  1174.     if (debug>2) { fprintf(outf,"isconstexpr("); dumpexpr(ex); fprintf(outf,")n"); }
  1175.     exval = eval_expr(ex);
  1176.     if (exval.type) {
  1177.         if (valp)
  1178.             *valp = exval.i;
  1179.         return 1;
  1180.     } else
  1181.         return 0;
  1182. }
  1186. int isconstantexpr(ex)
  1187. Expr *ex;
  1188. {
  1189.     Meaning *mp;
  1190.     int i;
  1192.     switch (ex->kind) {
  1194.         case EK_CONST:
  1195.         case EK_LONGCONST:
  1196.         case EK_SIZEOF:
  1197.             return 1;
  1199.         case EK_ADDR:
  1200.             if (ex->args[0]->kind == EK_VAR) {
  1201.                 mp = (Meaning *)ex->val.i;
  1202.                 return (!mp->ctx || mp->ctx->kind == MK_MODULE);
  1203.             }
  1204.             return 0;
  1206.         case EK_VAR:
  1207.             mp = (Meaning *)ex->val.i;
  1208.             return (mp->kind == MK_CONST);
  1210.         case EK_BICALL:
  1211.         case EK_FUNCTION:
  1212.             if (!deterministic_func(ex))
  1213.                 return 0;
  1215.         /* fall through */
  1216.         case EK_EQ:
  1217.         case EK_NE:
  1218.         case EK_LT:
  1219.         case EK_GT:
  1220.         case EK_LE:
  1221.         case EK_GE:
  1222.         case EK_PLUS:
  1223.         case EK_NEG:
  1224.         case EK_TIMES:
  1225.         case EK_DIVIDE:
  1226.         case EK_DIV:
  1227.         case EK_MOD:
  1228.         case EK_AND:
  1229.         case EK_OR:
  1230.         case EK_NOT:
  1231.         case EK_BAND:
  1232.         case EK_BOR:
  1233.         case EK_BXOR:
  1234.         case EK_BNOT:
  1235.         case EK_LSH:
  1236.         case EK_RSH:
  1237.         case EK_CAST:
  1238.         case EK_ACTCAST:
  1239.         case EK_COND:
  1240.             for (i = 0; i < ex->nargs; i++) {
  1241.                 if (!isconstantexpr(ex->args[i]))
  1242.                     return 0;
  1243.             }
  1244.             return 1;
  1246.         case EK_COMMA:
  1247.             return isconstantexpr(ex->args[ex->nargs-1]);
  1249. default:
  1250.     return 0;
  1251.     }
  1252. }
  1258. Static Expr *docast(a, type)
  1259. Expr *a;
  1260. Type *type;
  1261. {
  1262.     Value val;
  1263.     Meaning *mp;
  1264.     int i;
  1265.     Expr *ex;
  1267.     if (a->val.type->kind == TK_SMALLSET && type->kind == TK_SET) {
  1268.         mp = makestmttempvar(type, name_SET);
  1269.         return makeexpr_bicall_2(setexpandname, type,
  1270.                                  makeexpr_var(mp),
  1271.                                  makeexpr_arglong(a, 1));
  1272.     } else if (a->val.type->kind == TK_SET && type->kind == TK_SMALLSET) {
  1273.         return packset(a, type);
  1274.     }
  1275.     switch (a->kind) {
  1277.         case EK_VAR:
  1278.             mp = (Meaning *) a->val.i;
  1279.             if (mp->kind == MK_CONST) {
  1280.                 if (mp->val.type->kind == TK_STRING && type->kind == TK_CHAR) {
  1281.                     val = value_cast(mp->val, type);
  1282.                     a->kind = EK_CONST;
  1283.                     a->val = val;
  1284.                     return a;
  1285.                 }
  1286.             }
  1287.             break;
  1289.         case EK_CONST:
  1290.         case EK_LONGCONST:
  1291.             val = value_cast(a->val, type);
  1292.             if (val.type) {
  1293.                 a->val = val;
  1294.                 return a;
  1295.             }
  1296.             break;
  1298.         case EK_PLUS:
  1299.         case EK_NEG:
  1300.         case EK_TIMES:
  1301.             if (type->kind == TK_REAL) {
  1302.                 for (i = 0; i < a->nargs; i++) {
  1303.                     ex = docast(a->args[i], type);
  1304.                     if (ex) {
  1305.                         a->args[i] = ex;
  1306.                         a->val.type = type;
  1307.                         return a;
  1308.                     }
  1309.                 }
  1310.             }
  1311.             break;
  1313. default:
  1314.     break;
  1315.     }
  1316.     return NULL;
  1317. }
  1321. /* Make an "active" cast, i.e., one that performs an explicit operation */
  1322. Expr *makeexpr_actcast(a, type)
  1323. Expr *a;
  1324. Type *type;
  1325. {
  1326.     if (debug>2) { fprintf(outf,"makeexpr_actcast("); dumpexpr(a); fprintf(outf,", "); dumptypename(type, 1); fprintf(outf,")n"); }
  1328.     if (similartypes(a->val.type, type)) {
  1329.         a->val.type = type;
  1330.         return a;
  1331.     }
  1332.     return makeexpr_un(EK_ACTCAST, type, a);
  1333. }
  1337. Expr *makeexpr_cast(a, type)
  1338. Expr *a;
  1339. Type *type;
  1340. {
  1341.     Expr *ex;
  1343.     if (debug>2) { fprintf(outf,"makeexpr_cast("); dumpexpr(a); fprintf(outf,", "); dumptypename(type, 1); fprintf(outf,")n"); }
  1344.     if (a->val.type == type)
  1345.         return a;
  1346.     ex = docast(a, type);
  1347.     if (ex)
  1348.         return ex;
  1349.     if (a->kind == EK_CAST &&
  1350.         a->args[0]->val.type->kind == TK_POINTER &&
  1351.         similartypes(type, a->args[0]->val.type)) {
  1352.         a = grabarg(a, 0);
  1353.         a->val.type = type;
  1354.         return a;
  1355.     }
  1356.     if ((a->kind == EK_CAST &&
  1357.          ((a->val.type->kind == TK_POINTER && type->kind == TK_POINTER) ||
  1358.           (ord_type(a->val.type)->kind == TK_INTEGER && ord_type(type)->kind == TK_INTEGER))) ||
  1359.         similartypes(type, a->val.type)) {
  1360.         a->val.type = type;
  1361.         return a;
  1362.     }
  1363.     return makeexpr_un(EK_CAST, type, a);
  1364. }
  1368. Expr *gentle_cast(a, type)
  1369. Expr *a;
  1370. Type *type;
  1371. {
  1372.     Expr *ex;
  1373.     Type *btype;
  1374.     long smin, smax;
  1376.     if (debug>2) { fprintf(outf,"gentle_cast("); dumpexpr(a); fprintf(outf,", "); dumptypename(type, 1); fprintf(outf,")n"); }
  1377.     if (!type) {
  1378. intwarning("gentle_cast", "type == NULL");
  1379. return a;
  1380.     }
  1381.     if (a->val.type->kind == TK_POINTER && type->kind == TK_POINTER) {
  1382.         if (voidstar && (type == tp_anyptr || a->val.type == tp_anyptr)) {
  1383.             if (type == tp_anyptr && a->kind == EK_CAST &&
  1384.                 a->args[0]->val.type->kind == TK_POINTER)
  1385.                 return a->args[0];    /* remove explicit cast since casting implicitly */
  1386.             return a;                 /* casting to/from "void *" */
  1387.         }
  1388.         return makeexpr_cast(a, type);
  1389.     }
  1390.     if (type->kind == TK_STRING)
  1391.         return makeexpr_stringify(a);
  1392.     if (type->kind == TK_ARRAY && a->val.type->kind == TK_STRING &&
  1393.         a->kind == EK_CONST && ord_range(type->indextype, &smin, &smax)) {
  1394.         smax = smax - smin + 1;
  1395.         if (a->val.i > smax) {
  1396.             warning("Too many characters for packed array of char [162]");
  1397.         } else if (a->val.i < smax) {
  1398.             ex = makeexpr_lstring(a->val.s, smax);
  1399.             while (smax > a->val.i)
  1400.                 ex->val.s[--smax] = ' ';
  1401.             freeexpr(a);
  1402.             return ex;
  1403.         }
  1404.     }
  1405.     btype = (type->kind == TK_SUBR) ? type->basetype : type;
  1406.     if ((a->kind == EK_CAST || a->kind == EK_ACTCAST) && 
  1407.         btype->kind == TK_INTEGER &&
  1408.         ord_type(a->val.type)->kind == TK_INTEGER)
  1409.         return makeexpr_longcast(a, long_type(type));
  1410.     if (a->val.type == btype)
  1411.         return a;
  1412.     ex = docast(a, btype);
  1413.     if (ex)
  1414.         return ex;
  1415.     if (btype->kind == TK_CHAR && a->val.type->kind == TK_STRING)
  1416.         return makeexpr_hat(a, 0);
  1417.     return a;
  1418. }
  1422. Expr *makeexpr_charcast(ex)
  1423. Expr *ex;
  1424. {
  1425.     Meaning *mp;
  1427.     if (ex->kind == EK_CONST && ex->val.type->kind == TK_STRING &&
  1428.         ex->val.i == 1) {
  1429.         ex->val.type = tp_char;
  1430.         ex->val.i = ex->val.s[0] & 0xff;
  1431.         ex->val.s = NULL;
  1432.     }
  1433.     if (ex->kind == EK_VAR &&
  1434. (mp = (Meaning *)ex->val.i)->kind == MK_CONST &&
  1435. mp->val.type->kind == TK_STRING &&
  1436. mp->val.i == 1) {
  1437.       ex->kind = EK_CONST;
  1438.       ex->val.type = tp_char;
  1439.       ex->val.i = mp->val.s[0] & 0xff;
  1440.       ex->val.s = NULL;
  1441.     }
  1442.     return ex;
  1443. }
  1447. Expr *makeexpr_stringcast(ex)
  1448. Expr *ex;
  1449. {
  1450.     char ch;
  1452.     if (ex->kind == EK_CONST && ord_type(ex->val.type)->kind == TK_CHAR) {
  1453.         ch = ex->val.i;
  1454.         freeexpr(ex);
  1455.         ex = makeexpr_lstring(&ch, 1);
  1456.     }
  1457.     return ex;
  1458. }
  1464. /* 0/1 = force to int/long, 2/3 = check if int/long */
  1466. Static Expr *dolongcast(a, tolong)
  1467. Expr *a;
  1468. int tolong;
  1469. {
  1470.     Meaning *mp;
  1471.     Expr *ex;
  1472.     Type *type;
  1473.     int i;
  1475.     switch (a->kind) {
  1477.         case EK_DOT:
  1478.             if (!a->val.i) {
  1479.                 if (long_type(a->val.type) == (tolong&1))
  1480.                     return a;
  1481.                 break;
  1482.             }
  1484.         /* fall through */
  1485.         case EK_VAR:
  1486.             mp = (Meaning *)a->val.i;
  1487.             if (mp->kind == MK_FIELD && mp->val.i) {
  1488.                 if (mp->val.i <= ((sizeof_int > 0) ? sizeof_int : 16) &&
  1489.                     !(tolong&1))
  1490.                     return a;
  1491.             } else if (mp->kind == MK_VAR ||
  1492.                        mp->kind == MK_VARREF ||
  1493.                        mp->kind == MK_PARAM ||
  1494.                        mp->kind == MK_VARPARAM ||
  1495.                        mp->kind == MK_FIELD) {
  1496.                 if (long_type(mp->type) == (tolong&1))
  1497.                     return a;
  1498.             }
  1499.             break;
  1501.         case EK_FUNCTION:
  1502.             mp = (Meaning *)a->val.i;
  1503.             if (long_type(mp->type->basetype) == (tolong&1))
  1504.                 return a;
  1505.             break;
  1507.         case EK_BICALL:
  1508.             if (!strcmp(a->val.s, signextname) && *signextname) {
  1509.                 i = 0;
  1510.                 goto unary;
  1511.             }
  1512.     if (!strcmp(a->val.s, "strlen"))
  1513. goto size_t_case;
  1514.             /* fall through */
  1516.         case EK_HAT:      /* get true type from a->val.type */
  1517.         case EK_INDEX:
  1518.         case EK_SPCALL:
  1519.         case EK_NAME:
  1520.             if (long_type(a->val.type) == (tolong&1))
  1521.                 return a;
  1522.             break;
  1524.         case EK_ASSIGN:   /* destination determines type, */
  1525.         case EK_POSTINC:  /*  but must not be changed */
  1526.         case EK_POSTDEC:
  1527.             return dolongcast(a->args[0], tolong|2);
  1529.         case EK_CAST:
  1530.             if (ord_type(a->val.type)->kind == TK_INTEGER &&
  1531.                  long_type(a->val.type) == (tolong&1))
  1532.                 return a;
  1533.             if (tolong == 0) {
  1534.                 a->val.type = tp_int;
  1535.                 return a;
  1536.             } else if (tolong == 1) {
  1537.                 a->val.type = tp_integer;
  1538.                 return a;
  1539.             }
  1540.             break;
  1542.         case EK_ACTCAST:
  1543.             if (ord_type(a->val.type)->kind == TK_INTEGER &&
  1544.                  long_type(a->val.type) == (tolong&1))
  1545.                 return a;
  1546.             break;
  1548.         case EK_CONST:
  1549.             type = ord_type(a->val.type);
  1550.             if (type->kind == TK_INTEGER || type->kind == TK_SMALLSET) {
  1551.                 if (tolong == 1)
  1552.                     a->kind = EK_LONGCONST;
  1553.                 if (tolong != 3)
  1554.                     return a;
  1555.             }
  1556.             break;
  1558.         case EK_LONGCONST:
  1559.             if (tolong == 0) {
  1560.                 if (a->val.i >= -32767 && a->val.i <= 32767)
  1561.                     a->kind = EK_CONST;
  1562.                 else
  1563.                     return NULL;
  1564.             }
  1565.             if (tolong != 2)
  1566.                 return a;
  1567.             break;
  1569.         case EK_SIZEOF:
  1570. size_t_case:
  1571.             if (size_t_long > 0 && tolong&1)
  1572.                 return a;
  1573.             if (size_t_long == 0 && !(tolong&1))
  1574.                 return a;
  1575.             break;
  1577.         case EK_PLUS:     /* usual arithmetic conversions apply */
  1578.         case EK_TIMES:
  1579.         case EK_DIV:
  1580.         case EK_MOD:
  1581.         case EK_BAND:
  1582.         case EK_BOR:
  1583.         case EK_BXOR:
  1584.         case EK_COND:
  1585.             i = (a->kind == EK_COND) ? 1 : 0;
  1586.             if (tolong&1) {
  1587.                 for (; i < a->nargs; i++) {
  1588.                     ex = dolongcast(a->args[i], tolong);
  1589.                     if (ex) {
  1590.                         a->args[i] = ex;
  1591.                         return a;
  1592.                     }
  1593.                 }
  1594.             } else {
  1595.                 for (; i < a->nargs; i++) {
  1596.                     if (!dolongcast(a->args[i], tolong))
  1597.                         return NULL;
  1598.                 }
  1599.                 return a;
  1600.             }
  1601.             break;
  1603.         case EK_BNOT:     /* single argument defines result type */
  1604.         case EK_NEG:
  1605.         case EK_LSH:
  1606.         case EK_RSH:
  1607.         case EK_COMMA:
  1608.             i = (a->kind == EK_COMMA) ? a->nargs-1 : 0;
  1609. unary:
  1610.             if (tolong&1) {
  1611.                 ex = dolongcast(a->args[i], tolong);
  1612.                 if (ex) {
  1613.                     a->args[i] = ex;
  1614.                     return a;
  1615.                 }
  1616.             } else {
  1617.                 if (dolongcast(a->args[i], tolong))
  1618.                     return a;
  1619.             }
  1620.             break;
  1622.         case EK_AND:  /* operators which always return int */
  1623.         case EK_OR:
  1624.         case EK_EQ:
  1625.         case EK_NE:
  1626.         case EK_LT:
  1627.         case EK_GT:
  1628.         case EK_LE:
  1629.         case EK_GE:
  1630.             if (tolong&1)
  1631.                 break;
  1632.             return a;
  1634. default:
  1635.     break;
  1636.     }
  1637.     return NULL;
  1638. }
  1641. /* Return -1 if short int or plain int, 1 if long, 0 if can't tell */
  1642. int exprlongness(ex)
  1643. Expr *ex;
  1644. {
  1645.     if (sizeof_int >= 32)
  1646.         return -1;
  1647.     return (dolongcast(ex, 3) != NULL) -
  1648.            (dolongcast(ex, 2) != NULL);
  1649. }
  1652. Expr *makeexpr_longcast(a, tolong)
  1653. Expr *a;
  1654. int tolong;
  1655. {
  1656.     Expr *ex;
  1657.     Type *type;
  1659.     if (sizeof_int >= 32)
  1660.         return a;
  1661.     type = ord_type(a->val.type);
  1662.     if (type->kind != TK_INTEGER && type->kind != TK_SMALLSET)
  1663.         return a;
  1664.     a = makeexpr_unlongcast(a);
  1665.     if (tolong) {
  1666.         ex = dolongcast(a, 1);
  1667.     } else {
  1668.         ex = dolongcast(copyexpr(a), 0);
  1669.         if (ex) {
  1670.             if (!dolongcast(ex, 2)) {
  1671.                 freeexpr(ex);
  1672.                 ex = NULL;
  1673.             }
  1674.         }
  1675.     }
  1676.     if (ex)
  1677.         return ex;
  1678.     return makeexpr_un(EK_CAST, (tolong) ? tp_integer : tp_int, a);
  1679. }
  1682. Expr *makeexpr_arglong(a, tolong)
  1683. Expr *a;
  1684. int tolong;
  1685. {
  1686.     int cast = castlongargs;
  1687.     if (cast < 0)
  1688. cast = castargs;
  1689.     if (cast > 0 || (cast < 0 && prototypes == 0)) {
  1690. return makeexpr_longcast(a, tolong);
  1691.     }
  1692.     return a;
  1693. }
  1697. Expr *makeexpr_unlongcast(a)
  1698. Expr *a;
  1699. {
  1700.     switch (a->kind) {
  1702.         case EK_LONGCONST:
  1703.             if (a->val.i >= -32767 && a->val.i <= 32767)
  1704.                 a->kind = EK_CONST;
  1705.             break;
  1707.         case EK_CAST:
  1708.             if ((a->val.type == tp_integer ||
  1709.                  a->val.type == tp_int) &&
  1710.                 ord_type(a->args[0]->val.type)->kind == TK_INTEGER) {
  1711.                 a = grabarg(a, 0);
  1712.             }
  1713.             break;
  1715.         default:
  1716.     break;
  1718.     }
  1719.     return a;
  1720. }
  1724. Expr *makeexpr_forcelongness(a)    /* force a to have a definite longness */
  1725. Expr *a;
  1726. {
  1727.     Expr *ex;
  1729.     ex = makeexpr_unlongcast(copyexpr(a));
  1730.     if (exprlongness(ex)) {
  1731.         freeexpr(a);
  1732.         return ex;
  1733.     }
  1734.     freeexpr(ex);
  1735.     if (exprlongness(a) == 0)
  1736.         return makeexpr_longcast(a, 1);
  1737.     else
  1738.         return a;
  1739. }
  1743. Expr *makeexpr_ord(ex)
  1744. Expr *ex;
  1745. {
  1746.     ex = makeexpr_charcast(ex);
  1747.     switch (ord_type(ex->val.type)->kind) {
  1749.         case TK_ENUM:
  1750.             return makeexpr_cast(ex, tp_int);
  1752.         case TK_CHAR:
  1753.             if (ex->kind == EK_CONST &&
  1754.                 (ex->val.i >= 32 && ex->val.i < 127)) {
  1755.                 insertarg(&ex, 0, makeexpr_name("'%lc'", tp_integer));
  1756.             }
  1757.             ex->val.type = tp_int;
  1758.             return ex;
  1760.         case TK_BOOLEAN:
  1761.             ex->val.type = tp_int;
  1762.             return ex;
  1764.         case TK_POINTER:
  1765.             return makeexpr_cast(ex, tp_integer);
  1767.         default:
  1768.             return ex;
  1769.     }
  1770. }
  1775. /* Tell whether an expression "looks" negative */
  1776. int expr_looks_neg(ex)
  1777. Expr *ex;
  1778. {
  1779.     int i;
  1781.     switch (ex->kind) {
  1783.         case EK_NEG:
  1784.             return 1;
  1786.         case EK_CONST:
  1787.         case EK_LONGCONST:
  1788.             switch (ord_type(ex->val.type)->kind) {
  1789.                 case TK_INTEGER:
  1790.                 case TK_CHAR:
  1791.                     return (ex->val.i < 0);
  1792.                 case TK_REAL:
  1793.                     return (ex->val.s && ex->val.s[0] == '-');
  1794.                 default:
  1795.                     return 0;
  1796.             }
  1798.         case EK_TIMES:
  1799.         case EK_DIVIDE:
  1800.             for (i = 0; i < ex->nargs; i++) {
  1801.                 if (expr_looks_neg(ex->args[i]))
  1802.                     return 1;
  1803.             }
  1804.             return 0;
  1806.         case EK_CAST:
  1807.             return expr_looks_neg(ex->args[0]);
  1809.         default:
  1810.             return 0;
  1811.     }
  1812. }
  1816. /* Tell whether an expression is probably negative */
  1817. int expr_is_neg(ex)
  1818. Expr *ex;
  1819. {
  1820.     int i;
  1822.     i = possiblesigns(ex) & (1|4);
  1823.     if (i == 1)
  1824. return 1;    /* if expression really is negative! */
  1825.     if (i == 4)
  1826. return 0;    /* if expression is definitely positive. */
  1827.     return expr_looks_neg(ex);
  1828. }
  1832. int expr_neg_cost(a)
  1833. Expr *a;
  1834. {
  1835.     int i, c;
  1837.     switch (a->kind) {
  1839.         case EK_CONST:
  1840.         case EK_LONGCONST:
  1841.             switch (ord_type(a->val.type)->kind) {
  1842.                 case TK_INTEGER:
  1843.                 case TK_CHAR:
  1844.                 case TK_REAL:
  1845.                     return 0;
  1846. default:
  1847.     return 1;
  1848.             }
  1850.         case EK_NEG:
  1851.             return -1;
  1853.         case EK_TIMES:
  1854.         case EK_DIVIDE:
  1855.             for (i = 0; i < a->nargs; i++) {
  1856.                 c = expr_neg_cost(a->args[i]);
  1857.                 if (c <= 0)
  1858.                     return c;
  1859.             }
  1860.             return 1;
  1862.         case EK_PLUS:
  1863.             for (i = 0; i < a->nargs; i++) {
  1864.                 if (expr_looks_neg(a->args[i]))
  1865.                     return 0;
  1866.             }
  1867.             return 1;
  1869.         default:
  1870.             return 1;
  1871.     }
  1872. }
  1876. Expr *enum_to_int(a)
  1877. Expr *a;
  1878. {
  1879.     if (ord_type(a->val.type)->kind == TK_ENUM) {
  1880.         if (a->kind == EK_CAST &&
  1881.              ord_type(a->args[0]->val.type)->kind == TK_INTEGER)
  1882.             return grabarg(a, 0);
  1883.         else
  1884.             return makeexpr_cast(a, tp_integer);
  1885.     } else
  1886.         return a;
  1887. }
  1891. Expr *neg_inside_sum(a)
  1892. Expr *a;
  1893. {
  1894.     int i;
  1896.     for (i = 0; i < a->nargs; i++)
  1897.         a->args[i] = makeexpr_neg(a->args[i]);
  1898.     return a;
  1899. }
  1903. Expr *makeexpr_neg(a)
  1904. Expr *a;
  1905. {
  1906.     int i;
  1908.     if (debug>2) { fprintf(outf,"makeexpr_neg("); dumpexpr(a); fprintf(outf,")n"); }
  1909.     a = enum_to_int(a);
  1910.     switch (a->kind) {
  1912.         case EK_CONST:
  1913.         case EK_LONGCONST:
  1914.             switch (ord_type(a->val.type)->kind) {
  1916.                 case TK_INTEGER:
  1917.                 case TK_CHAR:
  1918.                     if (a->val.i == MININT)
  1919.                         valrange();
  1920.                     else
  1921.                         a->val.i = - a->val.i;
  1922.                     return a;
  1924.                 case TK_REAL:
  1925.                     if (!realzero(a->val.s)) {
  1926.                         if (a->val.s[0] == '-')
  1927.                             strchange(&a->val.s, a->val.s+1);
  1928.                         else
  1929.                             strchange(&a->val.s, format_s("-%s", a->val.s));
  1930.                     }
  1931.                     return a;
  1933. default:
  1934.     break;
  1935.             }
  1936.             break;
  1938.         case EK_PLUS:
  1939.             if (expr_neg_cost(a) <= 0)
  1940.                 return neg_inside_sum(a);
  1941.             break;
  1943.         case EK_TIMES:
  1944.         case EK_DIVIDE:
  1945.             for (i = 0; i < a->nargs; i++) {
  1946.                 if (expr_neg_cost(a->args[i]) <= 0) {
  1947.                     a->args[i] = makeexpr_neg(a->args[i]);
  1948.                     return a;
  1949.                 }
  1950.             }
  1951.             break;
  1953.         case EK_CAST:
  1954.             if (a->val.type != tp_unsigned && 
  1955.                  a->val.type != tp_uint &&
  1956.                  a->val.type != tp_ushort &&
  1957.                  a->val.type != tp_ubyte &&
  1958.                  a->args[0]->val.type != tp_unsigned && 
  1959.                  a->args[0]->val.type != tp_uint &&
  1960.                  a->args[0]->val.type != tp_ushort &&
  1961.                  a->args[0]->val.type != tp_ubyte &&
  1962.                  expr_looks_neg(a->args[0])) {
  1963.                 a->args[0] = makeexpr_neg(a->args[0]);
  1964.                 return a;
  1965.             }
  1966.             break;
  1968.         case EK_NEG:
  1969.             return grabarg(a, 0);
  1971. default:
  1972.     break;
  1973.     }
  1974.     return makeexpr_un(EK_NEG, promote_type(a->val.type), a);
  1975. }
  1980. #define ISCONST(kind) ((kind)==EK_CONST || (kind)==EK_LONGCONST)
  1981. #define MOVCONST(ex) (ISCONST((ex)->kind) && (ex)->val.type->kind != TK_STRING)
  1982. #define COMMUTATIVE (kind != EK_COMMA && type->kind != TK_REAL)
  1984. Type *true_type(ex)
  1985. Expr *ex;
  1986. {
  1987.     Meaning *mp;
  1988.     Type *type, *tp;
  1990.     while (ex->kind == EK_CAST)
  1991. ex = ex->args[0];
  1992.     type = ex->val.type;
  1993.     if (ex->kind == EK_VAR || ex->kind == EK_FUNCTION || ex->kind == EK_DOT) {
  1994. mp = (Meaning *)ex->val.i;
  1995. if (mp && mp->type && mp->type->kind != TK_VOID)
  1996.     type = mp->type;
  1997.     }
  1998.     if (ex->kind == EK_INDEX) {
  1999. tp = true_type(ex->args[0]);
  2000. if ((tp->kind == TK_ARRAY || tp->kind == TK_SMALLARRAY ||
  2001.      tp->kind == TK_STRING) &&
  2002.     tp->basetype && tp->basetype->kind != TK_VOID)
  2003.     type = tp->basetype;
  2004.     }
  2005.     if (type->kind == TK_SUBR)
  2006. type = findbasetype(type, 0);
  2007.     return type;
  2008. }
  2010. int ischartype(ex)
  2011. Expr *ex;
  2012. {
  2013.     if (ord_type(ex->val.type)->kind == TK_CHAR)
  2014. return 1;
  2015.     if (true_type(ex)->kind == TK_CHAR)
  2016. return 1;
  2017.     if (ISCONST(ex->kind) && ex->nargs > 0 &&
  2018. ex->args[0]->kind == EK_NAME &&
  2019. ex->args[0]->val.s[0] == ''')
  2020. return 1;
  2021.     return 0;
  2022. }
  2024. Static Expr *commute(a, b, kind)
  2025. Expr *a, *b;
  2026. enum exprkind kind;
  2027. {
  2028.     int i, di;
  2029.     Type *type;
  2031.     if (debug>2) { fprintf(outf,"commute("); dumpexpr(a); fprintf(outf,", "); dumpexpr(b); fprintf(outf,")n"); }
  2032. #if 1
  2033.     type = promote_type_bin(a->val.type, b->val.type);
  2034. #else
  2035.     type = a->val.type;
  2036.     if (b->val.type->kind == TK_REAL)
  2037.         type = b->val.type;
  2038. #endif
  2039.     if (MOVCONST(a) && !MOVCONST(b) && COMMUTATIVE)
  2040.         swapexprs(a, b);                /* put constant last */
  2041.     if (a->kind == kind) {
  2042.         di = (MOVCONST(a->args[a->nargs-1]) && COMMUTATIVE) ? -1 : 0;
  2043.         if (b->kind == kind) {
  2044.             for (i = 0; i < b->nargs; i++)
  2045.                 insertarg(&a, a->nargs + di, b->args[i]);
  2046.             FREE(b);
  2047.         } else
  2048.             insertarg(&a, a->nargs + di, b);
  2049.         a->val.type = type;
  2050.     } else if (b->kind == kind) {
  2051.         if (MOVCONST(a) && COMMUTATIVE)
  2052.             insertarg(&b, b->nargs, a);
  2053.         else
  2054.             insertarg(&b, 0, a);
  2055.         a = b;
  2056.         a->val.type = type;
  2057.     } else {
  2058.         a = makeexpr_bin(kind, type, a, b);
  2059.     }
  2060.     if (debug>2) { fprintf(outf,"commute returns "); dumpexpr(a); fprintf(outf,"n"); }
  2061.     return a;
  2062. }
  2065. Expr *makeexpr_plus(a, b)
  2066. Expr *a, *b;
  2067. {
  2068.     int i, j, k;
  2069.     Type *type;
  2071.     if (debug>2) { fprintf(outf,"makeexpr_plus("); dumpexpr(a); fprintf(outf,", "); dumpexpr(b); fprintf(outf,")n"); }
  2072.     if (!a)
  2073.         return b;
  2074.     if (!b)
  2075.         return a;
  2076.     if (a->kind == EK_NEG && a->args[0]->kind == EK_PLUS)
  2077.         a = neg_inside_sum(grabarg(a, 0));
  2078.     if (b->kind == EK_NEG && b->args[0]->kind == EK_PLUS)
  2079.         b = neg_inside_sum(grabarg(b, 0));
  2080.     a = commute(enum_to_int(a), enum_to_int(b), EK_PLUS);
  2081.     type = NULL;
  2082.     for (i = 0; i < a->nargs; i++) {
  2083.         if (ord_type(a->args[i]->val.type)->kind == TK_CHAR ||
  2084.             a->args[i]->val.type->kind == TK_POINTER ||
  2085.             a->args[i]->val.type->kind == TK_STRING) {   /* for string literals */
  2086.             if (type == ord_type(a->args[i]->val.type))
  2087.                 type = tp_integer;   /* 'z'-'a' and p1-p2 are integers */
  2088.             else
  2089.                 type = ord_type(a->args[i]->val.type);
  2090.         }
  2091.     }
  2092.     if (type)
  2093.         a->val.type = type;
  2094.     for (i = 0; i < a->nargs && !ISCONST(a->args[i]->kind); i++) ;
  2095.     if (i < a->nargs-1) {
  2096.         for (j = i+1; j < a->nargs; j++) {
  2097.             if (ISCONST(a->args[j]->kind)) {
  2098.                 if ((ord_type(a->args[i]->val.type) == ord_type(a->args[j]->val.type) ||
  2099.      ord_type(a->args[i]->val.type)->kind == TK_INTEGER ||
  2100.      ord_type(a->args[j]->val.type)->kind == TK_INTEGER) &&
  2101.     (!ischartype(a->args[i]) || !ischartype(a->args[j])) &&
  2102.                     (a->args[i]->val.type->kind != TK_REAL &&
  2103.                      a->args[i]->val.type->kind != TK_STRING &&
  2104.                      a->args[j]->val.type->kind != TK_REAL &&
  2105.                      a->args[j]->val.type->kind != TK_STRING)) {
  2106.                     a->args[i]->val.i += a->args[j]->val.i;
  2107.                     delfreearg(&a, j);
  2108.                     j--;
  2109.                 } else if (a->args[i]->val.type->kind == TK_STRING &&
  2110.                            ord_type(a->args[j]->val.type)->kind == TK_INTEGER &&
  2111.                            a->args[j]->val.i < 0 &&
  2112.                            a->args[j]->val.i >= -stringleaders) {
  2113.                     /* strictly speaking, the following is illegal pointer arithmetic */
  2114.                     a->args[i] = makeexpr_lstring(a->args[i]->val.s + a->args[j]->val.i,