home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 October / usenetsourcesnewsgroupsinfomagicoctober1994disk2.iso / unix / volume21 / p2c / part25 < prev    next >
Text File  |  1990-04-05  |  53KB  |  1,872 lines
  1. Subject:  v21i070:  Pascal to C translator, Part25/32
  2. Newsgroups: comp.sources.unix
  3. Approved: rsalz@uunet.UU.NET
  4. X-Checksum-Snefru: 02158bff 52298f9e 19a2b2f2 708ebb7b
  5.  
  6. Submitted-by: Dave Gillespie <daveg@csvax.caltech.edu>
  7. Posting-number: Volume 21, Issue 70
  8. Archive-name: p2c/part25
  9.  
  10. #! /bin/sh
  11. # This is a shell archive.  Remove anything before this line, then unpack
  12. # it by saving it into a file and typing "sh file".  To overwrite existing
  13. # files, type "sh file -c".  You can also feed this as standard input via
  14. # unshar, or by typing "sh <file", e.g..  If this archive is complete, you
  15. # will see the following message at the end:
  16. #        "End of archive 25 (of 32)."
  17. # Contents:  src/expr.c.2
  18. # Wrapped by rsalz@litchi.bbn.com on Mon Mar 26 14:29:48 1990
  19. PATH=/bin:/usr/bin:/usr/ucb ; export PATH
  20. if test -f 'src/expr.c.2' -a "${1}" != "-c" ; then 
  21.   echo shar: Will not clobber existing file \"'src/expr.c.2'\"
  22. else
  23. echo shar: Extracting \"'src/expr.c.2'\" \(48964 characters\)
  24. sed "s/^X//" >'src/expr.c.2' <<'END_OF_FILE'
  25. X                                                  a->args[i]->val.i - a->args[j]->val.i);
  26. X                    for (k = 0; k < - a->args[j]->val.i; k++)
  27. X                        a->args[i]->val.s[k] = '>';
  28. X                    delfreearg(&a, j);
  29. X                    j--;
  30. X                }
  31. X            }
  32. X        }
  33. X    }
  34. X    if (checkconst(a->args[a->nargs-1], 0))
  35. X        delfreearg(&a, a->nargs-1);
  36. X    for (i = 0; i < a->nargs; i++) {
  37. X        if (a->args[i]->kind == EK_NEG && nosideeffects(a->args[i], 1)) {
  38. X            for (j = 0; j < a->nargs; j++) {
  39. X                if (exprsame(a->args[j], a->args[i]->args[0], 1)) {
  40. X                    delfreearg(&a, i);
  41. X                    if (i < j) j--; else i--;
  42. X                    delfreearg(&a, j);
  43. X                    i--;
  44. X                    break;
  45. X                }
  46. X            }
  47. X        }
  48. X    }
  49. X    if (a->nargs < 2) {
  50. X        if (a->nargs < 1) {
  51. X        type = a->val.type;
  52. X            FREE(a);
  53. X            a = gentle_cast(makeexpr_long(0), type);
  54. X        a->val.type = type;
  55. X        return a;
  56. X        } else {
  57. X            b = a->args[0];
  58. X            FREE(a);
  59. X            return b;
  60. X        }
  61. X    }
  62. X    if (a->nargs == 2 && ISCONST(a->args[1]->kind) &&
  63. X    a->args[1]->val.i <= -127 &&
  64. X    true_type(a->args[0]) == tp_char && signedchars != 0) {
  65. X    a->args[0] = force_unsigned(a->args[0]);
  66. X    }
  67. X    if (a->nargs > 2 &&
  68. X    ISCONST(a->args[a->nargs-1]->kind) &&
  69. X    ISCONST(a->args[a->nargs-2]->kind) &&
  70. X    ischartype(a->args[a->nargs-1]) &&
  71. X    ischartype(a->args[a->nargs-2])) {
  72. X    i = a->args[a->nargs-1]->val.i;
  73. X    j = a->args[a->nargs-2]->val.i;
  74. X    if ((i == 'a' || i == 'A' || i == -'a' || i == -'A') &&
  75. X        (j == 'a' || j == 'A' || j == -'a' || j == -'A')) {
  76. X        if (abs(i+j) == 32) {
  77. X        delfreearg(&a, a->nargs-1);
  78. X        delsimpfreearg(&a, a->nargs-1);
  79. X        a = makeexpr_bicall_1((i+j > 0) ? "_tolower" : "_toupper",
  80. X                      tp_char, a);
  81. X        }
  82. X    }
  83. X    }
  84. X    return a;
  85. X}
  86. X
  87. X
  88. XExpr *makeexpr_minus(a, b)
  89. XExpr *a, *b;
  90. X{
  91. X    int okneg;
  92. X
  93. X    if (debug>2) { fprintf(outf,"makeexpr_minus("); dumpexpr(a); fprintf(outf,", "); dumpexpr(b); fprintf(outf,")\n"); }
  94. X    if (ISCONST(b->kind) && b->val.i == 0 &&       /* kludge for array indexing */
  95. X        ord_type(b->val.type)->kind == TK_ENUM) {
  96. X        b->val.type = tp_integer;
  97. X    }
  98. X    okneg = (a->kind != EK_PLUS && b->kind != EK_PLUS);
  99. X    a = makeexpr_plus(a, makeexpr_neg(b));
  100. X    if (okneg && a->kind == EK_PLUS)
  101. X        a->val.i = 1;   /* this flag says to write as "a-b" if possible */
  102. X    return a;
  103. X}
  104. X
  105. X
  106. XExpr *makeexpr_inc(a, b)
  107. XExpr *a, *b;
  108. X{
  109. X    Type *type;
  110. X
  111. X    type = a->val.type;
  112. X    a = makeexpr_plus(makeexpr_charcast(a), b);
  113. X    if (ord_type(type)->kind != TK_INTEGER &&
  114. X    ord_type(type)->kind != TK_CHAR)
  115. X    a = makeexpr_cast(a, type);
  116. X    return a;
  117. X}
  118. X
  119. X
  120. X
  121. X/* Apply the distributive law for a sum of products */
  122. XExpr *distribute_plus(ex)
  123. XExpr *ex;
  124. X{
  125. X    int i, j, icom;
  126. X    Expr *common, *outer, *ex2, **exp;
  127. X
  128. X    if (debug>2) { fprintf(outf,"distribute_plus("); dumpexpr(ex); fprintf(outf,")\n"); }
  129. X    if (ex->kind != EK_PLUS)
  130. X        return ex;
  131. X    for (i = 0; i < ex->nargs; i++)
  132. X        if (ex->args[i]->kind == EK_TIMES)
  133. X            break;
  134. X    if (i == ex->nargs)
  135. X        return ex;
  136. X    outer = NULL;
  137. X    icom = 0;
  138. X    for (;;) {
  139. X    ex2 = ex->args[0];
  140. X    if (ex2->kind == EK_NEG)
  141. X        ex2 = ex2->args[0];
  142. X        if (ex2->kind == EK_TIMES) {
  143. X        if (icom >= ex2->nargs)
  144. X        break;
  145. X            common = ex2->args[icom];
  146. X        if (common->kind == EK_NEG)
  147. X        common = common->args[0];
  148. X        } else {
  149. X        if (icom > 0)
  150. X        break;
  151. X            common = ex2;
  152. X        icom++;
  153. X    }
  154. X        for (i = 1; i < ex->nargs; i++) {
  155. X        ex2 = ex->args[i];
  156. X        if (ex2->kind == EK_NEG)
  157. X        ex2 = ex2->args[i];
  158. X            if (ex2->kind == EK_TIMES) {
  159. X                for (j = ex2->nargs; --j >= 0; ) {
  160. X                    if (exprsame(ex2->args[j], common, 1) ||
  161. X            (ex2->args[j]->kind == EK_NEG &&
  162. X             exprsame(ex2->args[j]->args[0], common, 1)))
  163. X                        break;
  164. X                }
  165. X                if (j < 0)
  166. X                    break;
  167. X            } else {
  168. X                if (!exprsame(ex2, common, 1))
  169. X                    break;
  170. X            }
  171. X        }
  172. X        if (i == ex->nargs) {
  173. X            if (debug>2) { fprintf(outf,"distribute_plus does "); dumpexpr(common); fprintf(outf,"\n"); }
  174. X        common = copyexpr(common);
  175. X            for (i = 0; i < ex->nargs; i++) {
  176. X        if (ex->args[i]->kind == EK_NEG)
  177. X            ex2 = *(exp = &ex->args[i]->args[0]);
  178. X        else
  179. X            ex2 = *(exp = &ex->args[i]);
  180. X        if (ex2->kind == EK_TIMES) {
  181. X                    for (j = ex2->nargs; --j >= 0; ) {
  182. X                        if (exprsame(ex2->args[j], common, 1)) {
  183. X                            delsimpfreearg(exp, j);
  184. X                            break;
  185. X                        } else if (ex2->args[j]->kind == EK_NEG &&
  186. X                   exprsame(ex2->args[j]->args[0], common,1)) {
  187. X                freeexpr(ex2->args[j]);
  188. X                ex2->args[j] = makeexpr_long(-1);
  189. X                break;
  190. X            }
  191. X                    }
  192. X        } else {
  193. X            freeexpr(ex2);
  194. X            *exp = makeexpr_long(1);
  195. X                }
  196. X        ex->args[i] = resimplify(ex->args[i]);
  197. X            }
  198. X            outer = makeexpr_times(common, outer);
  199. X        } else
  200. X        icom++;
  201. X    }
  202. X    return makeexpr_times(resimplify(ex), outer);
  203. X}
  204. X
  205. X
  206. X
  207. X
  208. X
  209. XExpr *makeexpr_times(a, b)
  210. XExpr *a, *b;
  211. X{
  212. X    int i, n;
  213. X    Type *type;
  214. X
  215. X    if (debug>2) { fprintf(outf,"makeexpr_times("); dumpexpr(a); fprintf(outf,", "); dumpexpr(b); fprintf(outf,")\n"); }
  216. X    if (!a)
  217. X        return b;
  218. X    if (!b)
  219. X        return a;
  220. X    a = commute(a, b, EK_TIMES);
  221. X    if (a->val.type->kind == TK_INTEGER) {
  222. X        i = a->nargs-1;
  223. X        if (i > 0 && ISCONST(a->args[i-1]->kind)) {
  224. X            a->args[i-1]->val.i *= a->args[i]->val.i;
  225. X            delfreearg(&a, i);
  226. X        }
  227. X    }
  228. X    for (i = n = 0; i < a->nargs; i++) {
  229. X        if (expr_neg_cost(a->args[i]) < 0)
  230. X            n++;
  231. X    }
  232. X    if (n & 1) {
  233. X        for (i = 0; i < a->nargs; i++) {
  234. X            if (ISCONST(a->args[i]->kind) &&
  235. X                expr_neg_cost(a->args[i]) >= 0) {
  236. X                a->args[i] = makeexpr_neg(a->args[i]);
  237. X                n++;
  238. X                break;
  239. X            }
  240. X        }
  241. X    } else
  242. X        n++;
  243. X    for (i = 0; i < a->nargs && n >= 2; i++) {
  244. X        if (expr_neg_cost(a->args[i]) < 0) {
  245. X            a->args[i] = makeexpr_neg(a->args[i]);
  246. X            n--;
  247. X        }
  248. X    }
  249. X    if (checkconst(a->args[a->nargs-1], 1))
  250. X        delfreearg(&a, a->nargs-1);
  251. X    if (checkconst(a->args[a->nargs-1], -1)) {
  252. X        delfreearg(&a, a->nargs-1);
  253. X    a->args[0] = makeexpr_neg(a->args[0]);
  254. X    }
  255. X    if (checkconst(a->args[a->nargs-1], 0) && nosideeffects(a, 1)) {
  256. X        type = a->val.type;
  257. X        return makeexpr_cast(grabarg(a, a->nargs-1), type);
  258. X    }
  259. X    if (a->nargs < 2) {
  260. X        if (a->nargs < 1) {
  261. X            FREE(a);
  262. X            a = makeexpr_long(1);
  263. X        } else {
  264. X            b = a->args[0];
  265. X            FREE(a);
  266. X            a = b;
  267. X        }
  268. X    }
  269. X    return a;
  270. X}
  271. X
  272. X
  273. X
  274. XExpr *makeexpr_sqr(ex, cube)
  275. XExpr *ex;
  276. Xint cube;
  277. X{
  278. X    Expr *ex2;
  279. X    Meaning *tvar;
  280. X    Type *type;
  281. X
  282. X    if (exprspeed(ex) <= 2 && nosideeffects(ex, 0)) {
  283. X    ex2 = NULL;
  284. X    } else {
  285. X    type = (ex->val.type->kind == TK_REAL) ? tp_longreal : tp_integer;
  286. X    tvar = makestmttempvar(type, name_TEMP);
  287. X    ex2 = makeexpr_assign(makeexpr_var(tvar), ex);
  288. X    ex = makeexpr_var(tvar);
  289. X    }
  290. X    if (cube)
  291. X    ex = makeexpr_times(ex, makeexpr_times(copyexpr(ex), copyexpr(ex)));
  292. X    else
  293. X    ex = makeexpr_times(ex, copyexpr(ex));
  294. X    return makeexpr_comma(ex2, ex);
  295. X}
  296. X
  297. X
  298. X
  299. XExpr *makeexpr_divide(a, b)
  300. XExpr *a, *b;
  301. X{
  302. X    Expr *ex;
  303. X    int p;
  304. X
  305. X    if (debug>2) { fprintf(outf,"makeexpr_divide("); dumpexpr(a); fprintf(outf,", "); dumpexpr(b); fprintf(outf,")\n"); }
  306. X    if (a->val.type->kind != TK_REAL &&
  307. X    b->val.type->kind != TK_REAL) {     /* must do a real division */
  308. X        ex = docast(a, tp_longreal);
  309. X        if (ex)
  310. X            a = ex;
  311. X        else {
  312. X            ex = docast(b, tp_longreal);
  313. X            if (ex)
  314. X                b = ex;
  315. X            else
  316. X                a = makeexpr_cast(a, tp_longreal);
  317. X        }
  318. X    }
  319. X    if (a->kind == EK_TIMES) {
  320. X    for (p = 0; p < a->nargs; p++)
  321. X        if (exprsame(a->args[p], b, 1))
  322. X        break;
  323. X    if (p < a->nargs) {
  324. X        delfreearg(&a, p);
  325. X        freeexpr(b);
  326. X        if (a->nargs == 1)
  327. X        return grabarg(a, 0);
  328. X        else
  329. X        return a;
  330. X    }
  331. X    }
  332. X    if (expr_neg_cost(a) < 0 && expr_neg_cost(b) < 0) {
  333. X        a = makeexpr_neg(a);
  334. X        b = makeexpr_neg(b);
  335. X    }
  336. X    if (checkconst(b, 0))
  337. X        warning("Division by zero [163]");
  338. X    return makeexpr_bin(EK_DIVIDE, tp_longreal, a, b);
  339. X}
  340. X
  341. X
  342. X
  343. X
  344. Xint gcd(a, b)
  345. Xint a, b;
  346. X{
  347. X    if (a < 0) a = -a;
  348. X    if (b < 0) b = -b;
  349. X    while (a != 0) {
  350. X    b %= a;
  351. X    if (b != 0)
  352. X        a %= b;
  353. X    else
  354. X        return a;
  355. X    }
  356. X    return b;
  357. X}
  358. X
  359. X
  360. X
  361. X/* possible signs of ex: 1=may be neg, 2=may be zero, 4=may be pos */
  362. X
  363. Xint negsigns(mask)
  364. Xint mask;
  365. X{
  366. X    return (mask & 2) |
  367. X       ((mask & 1) << 2) |
  368. X       ((mask & 4) >> 2);
  369. X}
  370. X
  371. X
  372. Xint possiblesigns(ex)
  373. XExpr *ex;
  374. X{
  375. X    Value val;
  376. X    Type *tp;
  377. X    char *cp;
  378. X    int i, mask, mask2;
  379. X
  380. X    if (isliteralconst(ex, &val) && val.type) {
  381. X    if (val.type == tp_real || val.type == tp_longreal) {
  382. X        if (realzero(val.s))
  383. X        return 2;
  384. X        if (*val.s == '-')
  385. X        return 1;
  386. X        return 4;
  387. X    } else
  388. X        return (val.i < 0) ? 1 : (val.i == 0) ? 2 : 4;
  389. X    }
  390. X    if (ex->kind == EK_CAST &&
  391. X    similartypes(ex->val.type, ex->args[0]->val.type))
  392. X    return possiblesigns(ex->args[0]);
  393. X    if (ex->kind == EK_NEG)
  394. X    return negsigns(possiblesigns(ex->args[0]));
  395. X    if (ex->kind == EK_TIMES || ex->kind == EK_DIVIDE) {
  396. X    mask = possiblesigns(ex->args[0]);
  397. X    for (i = 1; i < ex->nargs; i++) {
  398. X        mask2 = possiblesigns(ex->args[i]);
  399. X        if (mask2 & 2)
  400. X        mask |= 2;
  401. X        if ((mask2 & (1|4)) == 1)
  402. X        mask = negsigns(mask);
  403. X        else if ((mask2 & (1|4)) != 4)
  404. X        mask = 1|2|4;
  405. X    }
  406. X    return mask;
  407. X    }
  408. X    if (ex->kind == EK_DIV || ex->kind == EK_MOD) {
  409. X    mask = possiblesigns(ex->args[0]);
  410. X    mask2 = possiblesigns(ex->args[1]);
  411. X    if (!((mask | mask2) & 1))
  412. X        return 2|4;
  413. X    }
  414. X    if (ex->kind == EK_PLUS) {
  415. X    mask = 0;
  416. X    for (i = 0; i < ex->nargs; i++) {
  417. X        mask2 = possiblesigns(ex->args[i]);
  418. X        if ((mask & negsigns(mask2)) & (1|4))
  419. X        mask |= (1|2|4);
  420. X        else
  421. X        mask |= mask2;
  422. X    }
  423. X    return mask;
  424. X    }
  425. X    if (ex->kind == EK_COND) {
  426. X    return possiblesigns(ex->args[1]) | possiblesigns(ex->args[2]);
  427. X    }
  428. X    if (ex->kind == EK_EQ || ex->kind == EK_LT || ex->kind == EK_GT ||
  429. X    ex->kind == EK_NE || ex->kind == EK_LE || ex->kind == EK_GE ||
  430. X    ex->kind == EK_AND || ex->kind == EK_OR || ex->kind == EK_NOT)
  431. X    return 2|4;
  432. X    if (ex->kind == EK_BICALL) {
  433. X    cp = ex->val.s;
  434. X    if (!strcmp(cp, "strlen") ||
  435. X        !strcmp(cp, "abs") ||
  436. X        !strcmp(cp, "labs") ||
  437. X        !strcmp(cp, "fabs"))
  438. X        return 2|4;
  439. X    }
  440. X    tp = (ex->kind == EK_VAR) ? ((Meaning *)ex->val.i)->type : ex->val.type;
  441. X    if (ord_range(ex->val.type, &val.i, NULL)) {
  442. X    if (val.i > 0)
  443. X        return 4;
  444. X    if (val.i >= 0)
  445. X        return 2|4;
  446. X    }
  447. X    if (ord_range(ex->val.type, NULL, &val.i)) {
  448. X    if (val.i < 0)
  449. X        return 1;
  450. X    if (val.i <= 0)
  451. X        return 1|2;
  452. X    }
  453. X    return 1|2|4;
  454. X}
  455. X
  456. X
  457. X
  458. X
  459. X
  460. XExpr *dodivmod(funcname, ekind, a, b)
  461. Xchar *funcname;
  462. Xenum exprkind ekind;
  463. XExpr *a, *b;
  464. X{
  465. X    Meaning *tvar;
  466. X    Type *type;
  467. X    Expr *asn;
  468. X    int sa, sb;
  469. X
  470. X    type = promote_type_bin(a->val.type, b->val.type);
  471. X    tvar = NULL;
  472. X    sa = possiblesigns(a);
  473. X    sb = possiblesigns(b);
  474. X    if ((sa & 1) || (sb & 1)) {
  475. X    if (*funcname) {
  476. X        asn = NULL;
  477. X        if (*funcname == '*') {
  478. X        if (exprspeed(a) >= 5 || !nosideeffects(a, 0)) {
  479. X            tvar = makestmttempvar(a->val.type, name_TEMP);
  480. X            asn = makeexpr_assign(makeexpr_var(tvar), a);
  481. X            a = makeexpr_var(tvar);
  482. X        }
  483. X        if (exprspeed(b) >= 5 || !nosideeffects(b, 0)) {
  484. X            tvar = makestmttempvar(b->val.type, name_TEMP);
  485. X            asn = makeexpr_comma(asn,
  486. X                     makeexpr_assign(makeexpr_var(tvar),
  487. X                             b));
  488. X            b = makeexpr_var(tvar);
  489. X        }
  490. X        }
  491. X        return makeexpr_comma(asn,
  492. X                  makeexpr_bicall_2(funcname, type, a, b));
  493. X    } else {
  494. X        if ((sa & 1) && (ekind == EK_MOD))
  495. X        note("Using % for possibly-negative arguments [317]");
  496. X        return makeexpr_bin(ekind, type, a, b);
  497. X    }
  498. X    } else
  499. X    return makeexpr_bin(ekind, type, a, b);
  500. X}
  501. X
  502. X
  503. X
  504. XExpr *makeexpr_div(a, b)
  505. XExpr *a, *b;
  506. X{
  507. X    Meaning *mp;
  508. X    Type *type;
  509. X    long i;
  510. X    int p;
  511. X
  512. X    if (ISCONST(a->kind) && ISCONST(b->kind)) {
  513. X        if (a->val.i >= 0 && b->val.i > 0) {
  514. X        a->val.i /= b->val.i;
  515. X        freeexpr(b);
  516. X        return a;
  517. X    }
  518. X    i = gcd(a->val.i, b->val.i);
  519. X    if (i >= 0) {
  520. X        a->val.i /= i;
  521. X        b->val.i /= i;
  522. X    }
  523. X    }
  524. X    if (((b->kind == EK_CONST && (i = b->val.i)) ||
  525. X         (b->kind == EK_VAR && (mp = (Meaning *)b->val.i)->kind == MK_CONST &&
  526. X                               (i = mp->val.i) && foldconsts != 0)) && i > 0) {
  527. X        if (i == 1)
  528. X            return a;
  529. X        if (div_po2 > 0) {
  530. X            p = 0;
  531. X            while (!(i&1))
  532. X                p++, i >>= 1;
  533. X            if (i == 1) {
  534. X        type = promote_type_bin(a->val.type, b->val.type);
  535. X                return makeexpr_bin(EK_RSH, type, a, makeexpr_long(p));
  536. X            }
  537. X        }
  538. X    }
  539. X    if (a->kind == EK_TIMES) {
  540. X    for (p = 0; p < a->nargs; p++) {
  541. X        if (exprsame(a->args[p], b, 1)) {
  542. X        delfreearg(&a, p);
  543. X        freeexpr(b);
  544. X        if (a->nargs == 1)
  545. X            return grabarg(a, 0);
  546. X        else
  547. X            return a;
  548. X        } else if (ISCONST(a->args[p]->kind) && ISCONST(b->kind)) {
  549. X        i = gcd(a->args[p]->val.i, b->val.i);
  550. X        if (i > 1) {
  551. X            a->args[p]->val.i /= i;
  552. X            b->val.i /= i;
  553. X            i = a->args[p]->val.i;
  554. X            delfreearg(&a, p);
  555. X            a = makeexpr_times(a, makeexpr_long(i));   /* resimplify */
  556. X            p = -1;   /* start the loop over */
  557. X        }
  558. X        }
  559. X    }
  560. X    }
  561. X    if (checkconst(b, 1)) {
  562. X        freeexpr(b);
  563. X        return a;
  564. X    } else if (checkconst(b, -1)) {
  565. X        freeexpr(b);
  566. X        return makeexpr_neg(a);
  567. X    } else {
  568. X        if (checkconst(b, 0))
  569. X            warning("Division by zero [163]");
  570. X        return dodivmod(divname, EK_DIV, a, b);
  571. X    }
  572. X}
  573. X
  574. X
  575. X
  576. XExpr *makeexpr_mod(a, b)
  577. XExpr *a, *b;
  578. X{
  579. X    Meaning *mp;
  580. X    Type *type;
  581. X    long i;
  582. X
  583. X    if (a->kind == EK_CONST && b->kind == EK_CONST &&
  584. X        a->val.i >= 0 && b->val.i > 0) {
  585. X        a->val.i %= b->val.i;
  586. X        freeexpr(b);
  587. X        return a;
  588. X    }
  589. X    if (((b->kind == EK_CONST && (i = b->val.i)) ||
  590. X         (b->kind == EK_VAR && (mp = (Meaning *)b->val.i)->kind == MK_CONST &&
  591. X                               (i = mp->val.i) && foldconsts != 0)) && i > 0) {
  592. X        if (i == 1)
  593. X            return makeexpr_long(0);
  594. X        if (mod_po2 != 0) {
  595. X            while (!(i&1))
  596. X                i >>= 1;
  597. X            if (i == 1) {
  598. X        type = promote_type_bin(a->val.type, b->val.type);
  599. X                return makeexpr_bin(EK_BAND, type, a,
  600. X                                    makeexpr_minus(b, makeexpr_long(1)));
  601. X            }
  602. X        }
  603. X    }
  604. X    if (checkconst(b, 0))
  605. X        warning("Division by zero [163]");
  606. X    return dodivmod(modname, EK_MOD, a, b);
  607. X}
  608. X
  609. X
  610. X
  611. XExpr *makeexpr_rem(a, b)
  612. XExpr *a, *b;
  613. X{
  614. X    if (!(possiblesigns(a) & 1) && !(possiblesigns(b) & 1))
  615. X    return makeexpr_mod(a, b);
  616. X    if (checkconst(b, 0))
  617. X        warning("Division by zero [163]");
  618. X    if (!*remname)
  619. X    note("Translating REM same as MOD [141]");
  620. X    return dodivmod(*remname ? remname : modname, EK_MOD, a, b);
  621. X}
  622. X
  623. X
  624. X
  625. X
  626. X
  627. Xint expr_not_cost(a)
  628. XExpr *a;
  629. X{
  630. X    int i, c;
  631. X
  632. X    switch (a->kind) {
  633. X
  634. X        case EK_CONST:
  635. X            return 0;
  636. X
  637. X        case EK_NOT:
  638. X            return -1;
  639. X
  640. X        case EK_EQ:
  641. X        case EK_NE:
  642. X        case EK_LT:
  643. X        case EK_GT:
  644. X        case EK_LE:
  645. X        case EK_GE:
  646. X            return 0;
  647. X
  648. X        case EK_AND:
  649. X        case EK_OR:
  650. X            c = 0;
  651. X            for (i = 0; i < a->nargs; i++)
  652. X                c += expr_not_cost(a->args[i]);
  653. X            return (c > 1) ? 1 : c;
  654. X
  655. X        case EK_BICALL:
  656. X            if (!strcmp(a->val.s, oddname) ||
  657. X                !strcmp(a->val.s, evenname))
  658. X                return 0;
  659. X            return 1;
  660. X
  661. X        default:
  662. X            return 1;
  663. X    }
  664. X}
  665. X
  666. X
  667. X
  668. XExpr *makeexpr_not(a)
  669. XExpr *a;
  670. X{
  671. X    Expr *ex;
  672. X    int i;
  673. X
  674. X    if (debug>2) { fprintf(outf,"makeexpr_not("); dumpexpr(a); fprintf(outf,")\n"); }
  675. X    switch (a->kind) {
  676. X
  677. X        case EK_CONST:
  678. X            if (a->val.type == tp_boolean) {
  679. X                a->val.i = !a->val.i;
  680. X                return a;
  681. X            }
  682. X            break;
  683. X
  684. X        case EK_EQ:
  685. X            a->kind = EK_NE;
  686. X            return a;
  687. X
  688. X        case EK_NE:
  689. X            a->kind = EK_EQ;
  690. X            return a;
  691. X
  692. X        case EK_LT:
  693. X            a->kind = EK_GE;
  694. X            return a;
  695. X
  696. X        case EK_GT:
  697. X            a->kind = EK_LE;
  698. X            return a;
  699. X
  700. X        case EK_LE:
  701. X            a->kind = EK_GT;
  702. X            return a;
  703. X
  704. X        case EK_GE:
  705. X            a->kind = EK_LT;
  706. X            return a;
  707. X
  708. X        case EK_AND:
  709. X        case EK_OR:
  710. X            if (expr_not_cost(a) > 0)
  711. X                break;
  712. X            a->kind = (a->kind == EK_OR) ? EK_AND : EK_OR;
  713. X            for (i = 0; i < a->nargs; i++)
  714. X                a->args[i] = makeexpr_not(a->args[i]);
  715. X            return a;
  716. X
  717. X        case EK_NOT:
  718. X            ex = a->args[0];
  719. X            FREE(a);
  720. X            ex->val.type = tp_boolean;
  721. X            return ex;
  722. X
  723. X        case EK_BICALL:
  724. X            if (!strcmp(a->val.s, oddname) && *evenname) {
  725. X                strchange(&a->val.s, evenname);
  726. X                return a;
  727. X            } else if (!strcmp(a->val.s, evenname)) {
  728. X                strchange(&a->val.s, oddname);
  729. X                return a;
  730. X            }
  731. X            break;
  732. X
  733. X    default:
  734. X        break;
  735. X    }
  736. X    return makeexpr_un(EK_NOT, tp_boolean, a);
  737. X}
  738. X
  739. X
  740. X
  741. X
  742. XType *mixsets(ep1, ep2)
  743. XExpr **ep1, **ep2;
  744. X{
  745. X    Expr *ex1 = *ep1, *ex2 = *ep2;
  746. X    Meaning *tvar;
  747. X    long min1, max1, min2, max2;
  748. X    Type *type;
  749. X
  750. X    if (ex1->val.type->kind == TK_SMALLSET &&
  751. X        ex2->val.type->kind == TK_SMALLSET)
  752. X        return ex1->val.type;
  753. X    if (ex1->val.type->kind == TK_SMALLSET) {
  754. X        tvar = makestmttempvar(ex2->val.type, name_SET);
  755. X        ex1 = makeexpr_bicall_2(setexpandname, ex2->val.type,
  756. X                                makeexpr_var(tvar),
  757. X                                makeexpr_arglong(ex1, 1));
  758. X    }
  759. X    if (ex2->val.type->kind == TK_SMALLSET) {
  760. X        tvar = makestmttempvar(ex1->val.type, name_SET);
  761. X        ex2 = makeexpr_bicall_2(setexpandname, ex1->val.type,
  762. X                                makeexpr_var(tvar),
  763. X                                makeexpr_arglong(ex2, 1));
  764. X    }
  765. X    if (ord_range(ex1->val.type->indextype, &min1, &max1) &&
  766. X        ord_range(ex2->val.type->indextype, &min2, &max2)) {
  767. X        if (min1 <= min2 && max1 >= max2)
  768. X            type = ex1->val.type;
  769. X        else if (min2 <= min1 && max2 >= max1)
  770. X            type = ex2->val.type;
  771. X        else {
  772. X            if (min2 < min1) min1 = min2;
  773. X            if (max2 > max1) max1 = max2;
  774. X            type = maketype(TK_SET);
  775. X            type->basetype = tp_integer;
  776. X            type->indextype = maketype(TK_SUBR);
  777. X            type->indextype->basetype = ord_type(ex1->val.type->indextype);
  778. X            type->indextype->smin = makeexpr_long(min1);
  779. X            type->indextype->smax = makeexpr_long(max1);
  780. X        }
  781. X    } else
  782. X    type = ex1->val.type;
  783. X    *ep1 = ex1, *ep2 = ex2;
  784. X    return type;
  785. X}
  786. X
  787. X
  788. X
  789. XMeaning *istempprocptr(ex)
  790. XExpr *ex;
  791. X{
  792. X    Meaning *mp;
  793. X
  794. X    if (debug>2) { fprintf(outf,"istempprocptr("); dumpexpr(ex); fprintf(outf,")\n"); }
  795. X    if (ex->kind == EK_COMMA && ex->nargs == 3) {
  796. X        if ((mp = istempvar(ex->args[2])) != NULL &&
  797. X        mp->type->kind == TK_PROCPTR &&
  798. X        ex->args[0]->kind == EK_ASSIGN &&
  799. X        ex->args[0]->args[0]->kind == EK_DOT &&
  800. X        exprsame(ex->args[0]->args[0]->args[0], ex->args[2], 1) &&
  801. X        ex->args[1]->kind == EK_ASSIGN &&
  802. X        ex->args[1]->args[0]->kind == EK_DOT &&
  803. X        exprsame(ex->args[1]->args[0]->args[0], ex->args[2], 1))
  804. X        return mp;
  805. X    }
  806. X    if (ex->kind == EK_COMMA && ex->nargs == 2) {
  807. X        if ((mp = istempvar(ex->args[1])) != NULL &&
  808. X        mp->type->kind == TK_CPROCPTR &&
  809. X        ex->args[0]->kind == EK_ASSIGN &&
  810. X        exprsame(ex->args[0]->args[0], ex->args[1], 1))
  811. X        return mp;
  812. X    }
  813. X    return NULL;
  814. X}
  815. X
  816. X
  817. X
  818. X
  819. XExpr *makeexpr_stringify(ex)
  820. XExpr *ex;
  821. X{
  822. X    ex = makeexpr_stringcast(ex);
  823. X    if (ex->val.type->kind == TK_STRING)
  824. X        return ex;
  825. X    return makeexpr_sprintfify(ex);
  826. X}
  827. X
  828. X
  829. X
  830. XExpr *makeexpr_rel(rel, a, b)
  831. Xenum exprkind rel;
  832. XExpr *a, *b;
  833. X{
  834. X    int i, sign;
  835. X    Expr *ex, *ex2;
  836. X    Meaning *mp;
  837. X    char *name;
  838. X
  839. X    if (debug>2) { fprintf(outf,"makeexpr_rel(%s,", exprkindname(rel)); dumpexpr(a); fprintf(outf,", "); dumpexpr(b); fprintf(outf,")\n"); }
  840. X
  841. X    a = makeexpr_unlongcast(a);
  842. X    b = makeexpr_unlongcast(b);
  843. X    if ((compenums == 0 || (compenums < 0 && ansiC <= 0)) &&
  844. X    (rel != EK_EQ && rel != EK_NE)){
  845. X    a = enum_to_int(a);
  846. X    b = enum_to_int(b);
  847. X    }
  848. X    if (a->val.type != b->val.type) {
  849. X        if (a->val.type->kind == TK_STRING &&
  850. X            a->kind != EK_CONST) {
  851. X            b = makeexpr_stringify(b);
  852. X        } else if (b->val.type->kind == TK_STRING &&
  853. X                   b->kind != EK_CONST) {
  854. X            a = makeexpr_stringify(a);
  855. X        } else if (ord_type(a->val.type)->kind == TK_CHAR ||
  856. X                   a->val.type->kind == TK_ARRAY) {
  857. X            b = gentle_cast(b, ord_type(a->val.type));
  858. X        } else if (ord_type(b->val.type)->kind == TK_CHAR ||
  859. X                   b->val.type->kind == TK_ARRAY) {
  860. X            a = gentle_cast(a, ord_type(b->val.type));
  861. X        } else if (a->val.type == tp_anyptr && !voidstar) {
  862. X            a = gentle_cast(a, b->val.type);
  863. X        } else if (b->val.type == tp_anyptr && !voidstar) {
  864. X            b = gentle_cast(b, a->val.type);
  865. X        }
  866. X    }
  867. X    if (useisspace && b->val.type->kind == TK_CHAR && checkconst(b, ' ')) {
  868. X        if (rel == EK_EQ) {
  869. X            freeexpr(b);
  870. X            return makeexpr_bicall_1("isspace", tp_boolean, a);
  871. X        } else if (rel == EK_NE) {
  872. X            freeexpr(b);
  873. X            return makeexpr_not(makeexpr_bicall_1("isspace", tp_boolean, a));
  874. X        }
  875. X    }
  876. X    if (rel == EK_LT || rel == EK_GE)
  877. X        sign = 1;
  878. X    else if (rel == EK_GT || rel == EK_LE)
  879. X        sign = -1;
  880. X    else
  881. X        sign = 0;
  882. X    if (ord_type(b->val.type)->kind == TK_INTEGER ||
  883. X    ord_type(b->val.type)->kind == TK_CHAR) {
  884. X        for (;;) {
  885. X            if (a->kind == EK_PLUS && ISCONST(a->args[a->nargs-1]->kind) &&
  886. X                 a->args[a->nargs-1]->val.i &&
  887. X                 (ISCONST(b->kind) ||
  888. X                  (b->kind == EK_PLUS && ISCONST(b->args[b->nargs-1]->kind)))) {
  889. X                b = makeexpr_minus(b, copyexpr(a->args[a->nargs-1]));
  890. X                a = makeexpr_minus(a, copyexpr(a->args[a->nargs-1]));
  891. X                continue;
  892. X            }
  893. X            if (b->kind == EK_PLUS && ISCONST(b->args[b->nargs-1]->kind) &&
  894. X                 b->args[b->nargs-1]->val.i &&
  895. X                 ISCONST(a->kind)) {
  896. X                a = makeexpr_minus(a, copyexpr(b->args[b->nargs-1]));
  897. X                b = makeexpr_minus(b, copyexpr(b->args[b->nargs-1]));
  898. X                continue;
  899. X            }
  900. X            if (b->kind == EK_PLUS && sign &&
  901. X                 checkconst(b->args[b->nargs-1], sign)) {
  902. X                b = makeexpr_plus(b, makeexpr_long(-sign));
  903. X                switch (rel) {
  904. X                    case EK_LT:
  905. X                        rel = EK_LE;
  906. X                        break;
  907. X                    case EK_GT:
  908. X                        rel = EK_GE;
  909. X                        break;
  910. X                    case EK_LE:
  911. X                        rel = EK_LT;
  912. X                        break;
  913. X                    case EK_GE:
  914. X                        rel = EK_GT;
  915. X                        break;
  916. X            default:
  917. X            break;
  918. X                }
  919. X                sign = -sign;
  920. X                continue;
  921. X            }
  922. X            if (a->kind == EK_TIMES && checkconst(b, 0) && !sign) {
  923. X                for (i = 0; i < a->nargs; i++) {
  924. X                    if (ISCONST(a->args[i]->kind) && a->args[i]->val.i)
  925. X                        break;
  926. X                    if (a->args[i]->kind == EK_SIZEOF)
  927. X                        break;
  928. X                }
  929. X                if (i < a->nargs) {
  930. X                    delfreearg(&a, i);
  931. X                    continue;
  932. X                }
  933. X            }
  934. X            break;
  935. X        }
  936. X        if (a->kind == EK_BICALL && !strcmp(a->val.s, "strlen") &&
  937. X            checkconst(b, 0)) {
  938. X            if (rel == EK_LT || rel == EK_GE) {
  939. X                note("Unusual use of STRLEN encountered [142]");
  940. X            } else {
  941. X                freeexpr(b);
  942. X                a = makeexpr_hat(grabarg(a, 0), 0);
  943. X                b = makeexpr_char(0);      /* "strlen(a) = 0" => "*a == 0" */
  944. X                if (rel == EK_EQ || rel == EK_LE)
  945. X                    return makeexpr_rel(EK_EQ, a, b);
  946. X                else
  947. X                    return makeexpr_rel(EK_NE, a, b);
  948. X            }
  949. X        }
  950. X        if (ISCONST(a->kind) && ISCONST(b->kind)) {
  951. X            if ((a->val.i == b->val.i && (rel == EK_EQ || rel == EK_GE || rel == EK_LE)) ||
  952. X                (a->val.i <  b->val.i && (rel == EK_NE || rel == EK_LE || rel == EK_LT)) ||
  953. X                (a->val.i >  b->val.i && (rel == EK_NE || rel == EK_GE || rel == EK_GT)))
  954. X                return makeexpr_val(make_ord(tp_boolean, 1));
  955. X            else
  956. X                return makeexpr_val(make_ord(tp_boolean, 0));
  957. X        }
  958. X    if ((a->val.type == tp_char || true_type(a) == tp_char) &&
  959. X        ISCONST(b->kind) && signedchars != 0) {
  960. X        i = (b->val.i == 128 && sign == 1) ||
  961. X        (b->val.i == 127 && sign == -1);
  962. X        if (highcharbits && (highcharbits > 0 || signedchars < 0) && i) {
  963. X        if (highcharbits == 2)
  964. X            b = makeexpr_long(128);
  965. X        else
  966. X            b = makeexpr_un(EK_BNOT, tp_integer, makeexpr_long(127));
  967. X        return makeexpr_rel((rel == EK_GE || rel == EK_GT)
  968. X                    ? EK_NE : EK_EQ,
  969. X                    makeexpr_bin(EK_BAND, tp_integer,
  970. X                         eatcasts(a), b),
  971. X                    makeexpr_long(0));
  972. X        } else if (signedchars == 1 && i) {
  973. X        return makeexpr_rel((rel == EK_GE || rel == EK_GT)
  974. X                    ? EK_LT : EK_GE,
  975. X                    eatcasts(a), makeexpr_long(0));
  976. X        } else if (signedchars == 1 && b->val.i >= 128 && sign == 0) {
  977. X        b->val.i -= 256;
  978. X        } else if (b->val.i >= 128 ||
  979. X               (b->val.i == 127 && sign != 0)) {
  980. X        if (highcharbits && (highcharbits > 0 || signedchars < 0))
  981. X            a = makeexpr_bin(EK_BAND, a->val.type, eatcasts(a),
  982. X                     makeexpr_long(255));
  983. X        else
  984. X            a = force_unsigned(a);
  985. X        }
  986. X    }
  987. X    } else if (a->val.type->kind == TK_STRING &&
  988. X               b->val.type->kind == TK_STRING) {
  989. X        if (b->kind == EK_CONST && b->val.i == 0 && !sign) {
  990. X            a = makeexpr_hat(a, 0);
  991. X            b = makeexpr_char(0);      /* "a = ''" => "*a == 0" */
  992. X        } else {
  993. X            a = makeexpr_bicall_2("strcmp", tp_int, a, b);
  994. X            b = makeexpr_long(0);
  995. X        }
  996. X    } else if ((a->val.type->kind == TK_ARRAY ||
  997. X        a->val.type->kind == TK_STRING ||
  998. X        a->val.type->kind == TK_RECORD) &&
  999. X           (b->val.type->kind == TK_ARRAY ||
  1000. X        b->val.type->kind == TK_STRING ||
  1001. X        b->val.type->kind == TK_RECORD)) {
  1002. X        if (a->val.type->kind == TK_ARRAY) {
  1003. X            if (b->val.type->kind == TK_ARRAY) {
  1004. X                ex = makeexpr_sizeof(copyexpr(a), 0);
  1005. X                ex2 = makeexpr_sizeof(copyexpr(b), 0);
  1006. X                if (!exprsame(ex, ex2, 1))
  1007. X                    warning("Incompatible array sizes [164]");
  1008. X                freeexpr(ex2);
  1009. X            } else {
  1010. X                ex = makeexpr_sizeof(copyexpr(a), 0);
  1011. X            }
  1012. X        } else
  1013. X            ex = makeexpr_sizeof(copyexpr(b), 0);
  1014. X    name = (usestrncmp &&
  1015. X        a->val.type->kind == TK_ARRAY &&
  1016. X        a->val.type->basetype->kind == TK_CHAR) ? "strncmp" : "memcmp";
  1017. X        a = makeexpr_bicall_3(name, tp_int,
  1018. X                  makeexpr_addr(a), 
  1019. X                  makeexpr_addr(b), ex);
  1020. X        b = makeexpr_long(0);
  1021. X    } else if (a->val.type->kind == TK_SET ||
  1022. X               a->val.type->kind == TK_SMALLSET) {
  1023. X        if (rel == EK_GE) {
  1024. X            swapexprs(a, b);
  1025. X            rel = EK_LE;
  1026. X        }
  1027. X        if (mixsets(&a, &b)->kind == TK_SMALLSET) {
  1028. X            if (rel == EK_LE) {
  1029. X                a = makeexpr_bin(EK_BAND, tp_integer,
  1030. X                                 a, makeexpr_un(EK_BNOT, tp_integer, b));
  1031. X                b = makeexpr_long(0);
  1032. X                rel = EK_EQ;
  1033. X            }
  1034. X        } else if (b->kind == EK_BICALL &&
  1035. X                   !strcmp(b->val.s, setexpandname) &&
  1036. X                   (mp = istempvar(b->args[0])) != NULL &&
  1037. X                   checkconst(b->args[1], 0)) {
  1038. X            canceltempvar(mp);
  1039. X            a = makeexpr_hat(a, 0);
  1040. X            b = grabarg(b, 1);
  1041. X            if (rel == EK_LE)
  1042. X                rel = EK_EQ;
  1043. X        } else {
  1044. X            ex = makeexpr_bicall_2((rel == EK_LE) ? subsetname : setequalname,
  1045. X                                   tp_boolean, a, b);
  1046. X            return (rel == EK_NE) ? makeexpr_not(ex) : ex;
  1047. X        }
  1048. X    } else if (a->val.type->kind == TK_PROCPTR ||
  1049. X           a->val.type->kind == TK_CPROCPTR) {
  1050. X        /* we compare proc only (not link) -- same as Pascal compiler! */
  1051. X    if (a->val.type->kind == TK_PROCPTR)
  1052. X        a = makeexpr_dotq(a, "proc", tp_anyptr);
  1053. X        if ((mp = istempprocptr(b)) != NULL) {
  1054. X            canceltempvar(mp);
  1055. X        b = grabarg(grabarg(b, 0), 1);
  1056. X            if (!voidstar)
  1057. X                b = makeexpr_cast(b, tp_anyptr);
  1058. X        } else if (b->val.type->kind == TK_PROCPTR)
  1059. X            b = makeexpr_dotq(b, "proc", tp_anyptr);
  1060. X    }
  1061. X    return makeexpr_bin(rel, tp_boolean, a, b);
  1062. X}
  1063. X
  1064. X
  1065. X
  1066. X
  1067. XExpr *makeexpr_and(a, b)
  1068. XExpr *a, *b;
  1069. X{
  1070. X    Expr *ex, **exp, *low;
  1071. X
  1072. X    if (!a)
  1073. X        return b;
  1074. X    if (!b)
  1075. X        return a;
  1076. X    for (exp = &a; (ex = *exp)->kind == EK_AND; exp = &ex->args[1]) ;
  1077. X    if ((b->kind == EK_LT || b->kind == EK_LE) &&
  1078. X        ((ex->kind == EK_LE && exprsame(ex->args[1], b->args[0], 1)) ||
  1079. X         (ex->kind == EK_GE && exprsame(ex->args[0], b->args[0], 1)))) {
  1080. X        low = (ex->kind == EK_LE) ? ex->args[0] : ex->args[1];
  1081. X        if (unsignedtrick && checkconst(low, 0)) {
  1082. X            freeexpr(ex);
  1083. X            b->args[0] = force_unsigned(b->args[0]);
  1084. X            *exp = b;
  1085. X            return a;
  1086. X        }
  1087. X        if (b->args[1]->val.type->kind == TK_CHAR && useisalpha) {
  1088. X            if (checkconst(low, 'A') && checkconst(b->args[1], 'Z')) {
  1089. X                freeexpr(ex);
  1090. X                *exp = makeexpr_bicall_1("isupper", tp_boolean, grabarg(b, 0));
  1091. X                return a;
  1092. X            }
  1093. X            if (checkconst(low, 'a') && checkconst(b->args[1], 'z')) {
  1094. X                freeexpr(ex);
  1095. X                *exp = makeexpr_bicall_1("islower", tp_boolean, grabarg(b, 0));
  1096. X                return a;
  1097. X            }
  1098. X            if (checkconst(low, '0') && checkconst(b->args[1], '9')) {
  1099. X                freeexpr(ex);
  1100. X                *exp = makeexpr_bicall_1("isdigit", tp_boolean, grabarg(b, 0));
  1101. X                return a;
  1102. X            }
  1103. X        }
  1104. X    }
  1105. X    return makeexpr_bin(EK_AND, tp_boolean, a, b);
  1106. X}
  1107. X
  1108. X
  1109. X
  1110. XExpr *makeexpr_or(a, b)
  1111. XExpr *a, *b;
  1112. X{
  1113. X    Expr *ex, **exp, *low;
  1114. X
  1115. X    if (!a)
  1116. X        return b;
  1117. X    if (!b)
  1118. X        return a;
  1119. X    for (exp = &a; (ex = *exp)->kind == EK_OR; exp = &ex->args[1]) ;
  1120. X    if (((b->kind == EK_BICALL && !strcmp(b->val.s, "isdigit") &&
  1121. X          ex->kind == EK_BICALL && !strcmp(ex->val.s, "isalpha")) ||
  1122. X         (b->kind == EK_BICALL && !strcmp(b->val.s, "isalpha") &&
  1123. X          ex->kind == EK_BICALL && !strcmp(ex->val.s, "isdigit"))) &&
  1124. X        exprsame(ex->args[0], b->args[0], 1)) {
  1125. X        strchange(&ex->val.s, "isalnum");
  1126. X        freeexpr(b);
  1127. X        return a;
  1128. X    }
  1129. X    if (((b->kind == EK_BICALL && !strcmp(b->val.s, "islower") &&
  1130. X          ex->kind == EK_BICALL && !strcmp(ex->val.s, "isupper")) ||
  1131. X         (b->kind == EK_BICALL && !strcmp(b->val.s, "isupper") &&
  1132. X          ex->kind == EK_BICALL && !strcmp(ex->val.s, "islower"))) &&
  1133. X        exprsame(ex->args[0], b->args[0], 1)) {
  1134. X        strchange(&ex->val.s, "isalpha");
  1135. X        freeexpr(b);
  1136. X        return a;
  1137. X    }
  1138. X    if ((b->kind == EK_GT || b->kind == EK_GE) &&
  1139. X        ((ex->kind == EK_GT && exprsame(ex->args[1], b->args[0], 1)) ||
  1140. X         (ex->kind == EK_LT && exprsame(ex->args[0], b->args[0], 1)))) {
  1141. X        low = (ex->kind == EK_GT) ? ex->args[0] : ex->args[1];
  1142. X        if (unsignedtrick && checkconst(low, 0)) {
  1143. X            freeexpr(ex);
  1144. X            b->args[0] = force_unsigned(b->args[0]);
  1145. X            *exp = b;
  1146. X            return a;
  1147. X        }
  1148. X    }
  1149. X    return makeexpr_bin(EK_OR, tp_boolean, a, b);
  1150. X}
  1151. X
  1152. X
  1153. X
  1154. XExpr *makeexpr_range(ex, exlow, exhigh, higheq)
  1155. XExpr *ex, *exlow, *exhigh;
  1156. Xint higheq;
  1157. X{
  1158. X    Expr *ex2;
  1159. X    enum exprkind rel = (higheq) ? EK_LE : EK_LT;
  1160. X
  1161. X    if (exprsame(exlow, exhigh, 1) && higheq)
  1162. X        return makeexpr_rel(EK_EQ, ex, exlow);
  1163. X    ex2 = makeexpr_rel(rel, copyexpr(ex), exhigh);
  1164. X    if (lelerange)
  1165. X        return makeexpr_and(makeexpr_rel(EK_LE, exlow, ex), ex2);
  1166. X    else
  1167. X        return makeexpr_and(makeexpr_rel(EK_GE, ex, exlow), ex2);
  1168. X}
  1169. X
  1170. X
  1171. X
  1172. X
  1173. XExpr *makeexpr_cond(c, a, b)
  1174. XExpr *c, *a, *b;
  1175. X{
  1176. X    Expr *ex;
  1177. X
  1178. X    ex = makeexpr(EK_COND, 3);
  1179. X    ex->val.type = a->val.type;
  1180. X    ex->args[0] = c;
  1181. X    ex->args[1] = a;
  1182. X    ex->args[2] = b;
  1183. X    if (debug>2) { fprintf(outf,"makeexpr_cond returns "); dumpexpr(ex); fprintf(outf,"\n"); }
  1184. X    return ex;
  1185. X}
  1186. X
  1187. X
  1188. X
  1189. X
  1190. Xint expr_is_lvalue(ex)
  1191. XExpr *ex;
  1192. X{
  1193. X    Meaning *mp;
  1194. X
  1195. X    switch (ex->kind) {
  1196. X
  1197. X        case EK_VAR:
  1198. X            mp = (Meaning *)ex->val.i;
  1199. X            return ((mp->kind == MK_VAR || mp->kind == MK_PARAM) ||
  1200. X                    (mp->kind == MK_CONST &&
  1201. X                     (mp->type->kind == TK_ARRAY ||
  1202. X                      mp->type->kind == TK_RECORD ||
  1203. X                      mp->type->kind == TK_SET)));
  1204. X
  1205. X        case EK_HAT:
  1206. X            return 1;
  1207. X
  1208. X        case EK_INDEX:
  1209. X            return expr_is_lvalue(ex->args[0]);
  1210. X
  1211. X    case EK_DOT:
  1212. X        return expr_is_lvalue(ex->args[0]);
  1213. X
  1214. X        default:
  1215. X            return 0;
  1216. X    }
  1217. X}
  1218. X
  1219. X
  1220. Xint expr_has_address(ex)
  1221. XExpr *ex;
  1222. X{
  1223. X    if (ex->kind == EK_DOT &&
  1224. X    ((Meaning *)ex->val.i)->val.i)
  1225. X    return 0;    /* bit fields do not have an address */
  1226. X    return expr_is_lvalue(ex);
  1227. X}
  1228. X
  1229. X
  1230. X
  1231. XExpr *checknil(ex)
  1232. XExpr *ex;
  1233. X{
  1234. X    if (nilcheck == 1) {
  1235. X        if (singlevar(ex)) {
  1236. X            ex = makeexpr_un(EK_CHECKNIL, ex->val.type, ex);
  1237. X        } else {
  1238. X            ex = makeexpr_bin(EK_CHECKNIL, ex->val.type, ex,
  1239. X                              makeexpr_var(makestmttempvar(ex->val.type,
  1240. X                                                           name_PTR)));
  1241. X        }
  1242. X    }
  1243. X    return ex;
  1244. X}
  1245. X
  1246. X
  1247. Xint checkvarinlists(yes, no, def, mp)
  1248. XStrlist *yes, *no;
  1249. Xint def;
  1250. XMeaning *mp;
  1251. X{
  1252. X    char *cp;
  1253. X    Meaning *ctx;
  1254. X
  1255. X    if (mp->kind == MK_FIELD)
  1256. X    ctx = mp->rectype->meaning;
  1257. X    else
  1258. X    ctx = mp->ctx;
  1259. X    if (ctx && ctx->name)
  1260. X    cp = format_ss("%s.%s", ctx->name, mp->name);
  1261. X    else
  1262. X    cp = NULL;
  1263. X    if (strlist_cifind(yes, cp))
  1264. X    return 1;
  1265. X    if (strlist_cifind(no, cp))
  1266. X    return 0;
  1267. X    if (strlist_cifind(yes, mp->name))
  1268. X    return 1;
  1269. X    if (strlist_cifind(no, mp->name))
  1270. X    return 0;
  1271. X    if (strlist_cifind(yes, "1"))
  1272. X    return 1;
  1273. X    if (strlist_cifind(no, "1"))
  1274. X    return 0;
  1275. X    return def;
  1276. X}
  1277. X
  1278. X
  1279. Xvoid requirefilebuffer(ex)
  1280. XExpr *ex;
  1281. X{
  1282. X    Meaning *mp;
  1283. X
  1284. X    mp = isfilevar(ex);
  1285. X    if (!mp) {
  1286. X    if (ex->kind == EK_HAT)
  1287. X        ex = ex->args[0];
  1288. X    if (ex->kind == EK_VAR) {
  1289. X        mp = (Meaning *)ex->val.i;
  1290. X        if (mp->kind == MK_PARAM || mp->kind == MK_VARPARAM)
  1291. X        note(format_s("File parameter %s needs its associated buffers [318]",
  1292. X                  mp->name));
  1293. X    }
  1294. X    } else if (!mp->bufferedfile &&
  1295. X           checkvarinlists(bufferedfiles, unbufferedfiles, 1, mp)) {
  1296. X    if (mp->wasdeclared)
  1297. X        note(format_s("Discovered too late that %s should be buffered [143]",
  1298. X              mp->name));
  1299. X    mp->bufferedfile = 1;
  1300. X    }
  1301. X}
  1302. X
  1303. X
  1304. XExpr *makeexpr_hat(a, check)
  1305. XExpr *a;
  1306. Xint check;
  1307. X{
  1308. X    Expr *ex;
  1309. X
  1310. X    if (debug>2) { fprintf(outf,"makeexpr_hat("); dumpexpr(a); fprintf(outf,")\n"); }
  1311. X    if (isfiletype(a->val.type)) {
  1312. X    requirefilebuffer(a);
  1313. X    if (*chargetfbufname &&
  1314. X        a->val.type->basetype->basetype->kind == TK_CHAR)
  1315. X        return makeexpr_bicall_1(chargetfbufname,
  1316. X                     a->val.type->basetype->basetype, a);
  1317. X    else if (*arraygetfbufname &&
  1318. X         a->val.type->basetype->basetype->kind == TK_ARRAY)
  1319. X        return makeexpr_bicall_2(arraygetfbufname,
  1320. X                     a->val.type->basetype->basetype, a,
  1321. X                     makeexpr_type(a->val.type->basetype->basetype));
  1322. X    else
  1323. X        return makeexpr_bicall_2(getfbufname,
  1324. X                     a->val.type->basetype->basetype, a,
  1325. X                     makeexpr_type(a->val.type->basetype->basetype));
  1326. X    }
  1327. X    if (a->kind == EK_PLUS && 
  1328. X               (ex = a->args[0])->val.type->kind == TK_POINTER &&
  1329. X               (ex->val.type->basetype->kind == TK_ARRAY ||
  1330. X                ex->val.type->basetype->kind == TK_STRING ||
  1331. X                ex->val.type->basetype->kind == TK_SET)) {
  1332. X        ex->val.type = ex->val.type->basetype;   /* convert *(a+n) to a[n] */
  1333. X        deletearg(&a, 0);
  1334. X        if (a->nargs == 1)
  1335. X            a = grabarg(a, 0);
  1336. X        return makeexpr_bin(EK_INDEX, ex->val.type->basetype, ex, a);
  1337. X    }
  1338. X    if (a->val.type->kind == TK_STRING || 
  1339. X        a->val.type->kind == TK_ARRAY ||
  1340. X        a->val.type->kind == TK_SET) {
  1341. X        if (starindex == 0)
  1342. X            return makeexpr_bin(EK_INDEX, a->val.type->basetype, a, makeexpr_long(0));
  1343. X        else
  1344. X            return makeexpr_un(EK_HAT, a->val.type->basetype, a);
  1345. X    }
  1346. X    if (a->val.type->kind != TK_POINTER || !a->val.type->basetype) {
  1347. X        warning("bad pointer dereference [165]");
  1348. X        return a;
  1349. X    }
  1350. X    if (a->kind == EK_CAST &&
  1351. X    a->val.type->basetype->kind == TK_POINTER &&
  1352. X    a->args[0]->val.type->kind == TK_POINTER &&
  1353. X    a->args[0]->val.type->basetype->kind == TK_POINTER) {
  1354. X    return makeexpr_cast(makeexpr_hat(a->args[0], 0),
  1355. X                 a->val.type->basetype);
  1356. X    }
  1357. X    switch (a->val.type->basetype->kind) {
  1358. X
  1359. X      case TK_ARRAY:
  1360. X      case TK_STRING:
  1361. X      case TK_SET:
  1362. X    if (a->kind != EK_HAT || 1 ||
  1363. X        a->val.type == a->args[0]->val.type->basetype) {
  1364. X        a->val.type = a->val.type->basetype;
  1365. X        return a;
  1366. X    }
  1367. X    
  1368. X      default:
  1369. X    if (a->kind == EK_ADDR) {
  1370. X        ex = a->args[0];
  1371. X        FREE(a);
  1372. X        return ex;
  1373. X    } else {
  1374. X        if (check)
  1375. X        ex = checknil(a);
  1376. X        else
  1377. X        ex = a;
  1378. X        return makeexpr_un(EK_HAT, a->val.type->basetype, ex);
  1379. X        }
  1380. X    }
  1381. X}
  1382. X
  1383. X
  1384. X
  1385. XExpr *un_sign_extend(a)
  1386. XExpr *a;
  1387. X{
  1388. X    if (a->kind == EK_BICALL &&
  1389. X        !strcmp(a->val.s, signextname) && *signextname) {
  1390. X        return grabarg(a, 0);
  1391. X    }
  1392. X    return a;
  1393. X}
  1394. X
  1395. X
  1396. X
  1397. XExpr *makeexpr_addr(a)
  1398. XExpr *a;
  1399. X{
  1400. X    Expr *ex;
  1401. X    Type *type;
  1402. X
  1403. X    a = un_sign_extend(a);
  1404. X    type = makepointertype(a->val.type);
  1405. X    if (debug>2) { fprintf(outf,"makeexpr_addr("); dumpexpr(a); fprintf(outf,", "); dumptypename(type, 1); fprintf(outf,")\n"); }
  1406. X    if (a->kind == EK_CONST && a->val.type->kind == TK_STRING) {
  1407. X        return a;     /* kludge to help assignments */
  1408. X    } else if (a->kind == EK_INDEX &&
  1409. X           (a->val.type->kind != TK_ARRAY &&
  1410. X        a->val.type->kind != TK_SET &&
  1411. X        a->val.type->kind != TK_STRING) &&
  1412. X           (addindex == 1 ||
  1413. X        (addindex != 0 && checkconst(a->args[1], 0)))) {
  1414. X        ex = makeexpr_plus(makeexpr_addr(a->args[0]), a->args[1]);
  1415. X        FREE(a);
  1416. X        ex->val.type = type;
  1417. X        return ex;
  1418. X    } else {
  1419. X        switch (a->val.type->kind) {
  1420. X        
  1421. X      case TK_ARRAY:
  1422. X      case TK_STRING:
  1423. X      case TK_SET:
  1424. X        if (a->val.type->smin) {
  1425. X        return makeexpr_un(EK_ADDR, type, 
  1426. X                   makeexpr_index(a, 
  1427. X                          copyexpr(a->val.type->smin),
  1428. X                          NULL));
  1429. X        }
  1430. X        a->val.type = type;
  1431. X        return a;
  1432. X        
  1433. X      default:
  1434. X        if (a->kind == EK_HAT) {
  1435. X        ex = a->args[0];
  1436. X        FREE(a);
  1437. X        return ex;
  1438. X        } else if (a->kind == EK_ACTCAST)
  1439. X        return makeexpr_actcast(makeexpr_addr(grabarg(a, 0)), type);
  1440. X        else if (a->kind == EK_CAST)
  1441. X        return makeexpr_cast(makeexpr_addr(grabarg(a, 0)), type);
  1442. X        else
  1443. X        return makeexpr_un(EK_ADDR, type, a);
  1444. X    }
  1445. X    }
  1446. X}
  1447. X
  1448. X
  1449. X
  1450. XExpr *makeexpr_addrstr(a)
  1451. XExpr *a;
  1452. X{
  1453. X    if (debug>2) { fprintf(outf,"makeexpr_addrstr("); dumpexpr(a); fprintf(outf,")\n"); }
  1454. X    if (a->val.type->kind == TK_POINTER)
  1455. X    return a;
  1456. X    return makeexpr_addr(a);
  1457. X}
  1458. X
  1459. X
  1460. X
  1461. XExpr *makeexpr_addrf(a)
  1462. XExpr *a;
  1463. X{
  1464. X    Meaning *mp, *tvar;
  1465. X
  1466. X    mp = (Meaning *)a->val.i;
  1467. X    if ((a->kind == EK_VAR &&
  1468. X         (mp == mp_input || mp == mp_output)) ||
  1469. X        (a->kind == EK_NAME &&
  1470. X         !strcmp(a->val.s, "stderr"))) {
  1471. X        if (addrstdfiles == 0) {
  1472. X            note(format_s("Taking address of %s; consider setting VarFiles = 0 [144]",
  1473. X                          (a->kind == EK_VAR) ? ((Meaning *)a->val.i)->name
  1474. X                                              : a->val.s));
  1475. X            tvar = makestmttempvar(tp_text, name_TEMP);
  1476. X            return makeexpr_comma(makeexpr_assign(makeexpr_var(tvar), a),
  1477. X                                  makeexpr_addr(makeexpr_var(tvar)));
  1478. X        }
  1479. X    }
  1480. X    if ((a->kind == EK_VAR &&
  1481. X         mp->kind == MK_FIELD && mp->val.i) ||
  1482. X        (a->kind == EK_BICALL &&
  1483. X         !strcmp(a->val.s, getbitsname))) {
  1484. X        warning("Can't take the address of a bit-field [166]");
  1485. X    }
  1486. X    return makeexpr_addr(a);
  1487. X}
  1488. X
  1489. X
  1490. X
  1491. XExpr *makeexpr_index(a, b, offset)
  1492. XExpr *a, *b, *offset;
  1493. X{
  1494. X    Type *indextype, *btype;
  1495. X
  1496. X    if (debug>2) { fprintf(outf,"makeexpr_index("); dumpexpr(a); fprintf(outf,", "); dumpexpr(b);
  1497. X                                                                 fprintf(outf,", "); dumpexpr(offset); fprintf(outf,")\n"); }
  1498. X    indextype = (a->val.type->kind == TK_ARRAY) ? a->val.type->indextype
  1499. X                                                : tp_integer;
  1500. X    b = gentle_cast(b, indextype);
  1501. X    if (!offset)
  1502. X        offset = makeexpr_long(0);
  1503. X    b = makeexpr_minus(b, gentle_cast(offset, indextype));
  1504. X    btype = a->val.type;
  1505. X    if (btype->basetype)
  1506. X    btype = btype->basetype;
  1507. X    if (checkconst(b, 0) && starindex == 1)
  1508. X        return makeexpr_un(EK_HAT, btype, a);
  1509. X    else
  1510. X        return makeexpr_bin(EK_INDEX, btype, a,
  1511. X                            gentle_cast(b, indextype));
  1512. X}
  1513. X
  1514. X
  1515. X
  1516. XExpr *makeexpr_type(type)
  1517. XType *type;
  1518. X{
  1519. X    Expr *ex;
  1520. X
  1521. X    ex = makeexpr(EK_TYPENAME, 0);
  1522. X    ex->val.type = type;
  1523. X    return ex;
  1524. X}
  1525. X
  1526. X
  1527. XExpr *makeexpr_sizeof(ex, incskipped)
  1528. XExpr *ex;
  1529. Xint incskipped;
  1530. X{
  1531. X    Expr *ex2, *ex3;
  1532. X    Type *btype;
  1533. X    char *name;
  1534. X
  1535. X    if (ex->val.type->meaning) {
  1536. X    name = find_special_variant(ex->val.type->meaning->name,
  1537. X                    "SpecialSizeOf", specialsizeofs, 1);
  1538. X    if (name) {
  1539. X        freeexpr(ex);
  1540. X        return pc_expr_str(name);
  1541. X    }
  1542. X    }
  1543. X    switch (ex->val.type->kind) {
  1544. X
  1545. X        case TK_CHAR:
  1546. X        case TK_BOOLEAN:
  1547. X            freeexpr(ex);
  1548. X            return makeexpr_long(1);
  1549. X
  1550. X        case TK_SUBR:
  1551. X        btype = findbasetype(ex->val.type, 0);
  1552. X        if (btype->kind == TK_CHAR || btype == tp_abyte) {
  1553. X        freeexpr(ex);
  1554. X        return makeexpr_long(1);
  1555. X        }
  1556. X        break;
  1557. X
  1558. X        case TK_STRING:
  1559. X        case TK_ARRAY:
  1560. X            if (!ex->val.type->meaning || ex->val.type->kind == TK_STRING) {
  1561. X                ex3 = arraysize(ex->val.type, incskipped);
  1562. X                return makeexpr_times(ex3,
  1563. X                                      makeexpr_sizeof(makeexpr_type(
  1564. X                                           ex->val.type->basetype), 1));
  1565. X            }
  1566. X            break;
  1567. X
  1568. X        case TK_SET:
  1569. X            ord_range_expr(ex->val.type->indextype, NULL, &ex2);
  1570. X            freeexpr(ex);
  1571. X            return makeexpr_times(makeexpr_plus(makeexpr_div(copyexpr(ex2),
  1572. X                                                             makeexpr_setbits()),
  1573. X                                                makeexpr_long(2)),
  1574. X                                  makeexpr_sizeof(makeexpr_type(tp_integer), 0));
  1575. X            break;
  1576. X
  1577. X    default:
  1578. X        break;
  1579. X    }
  1580. X    if (ex->kind != EK_CONST &&
  1581. X        (findbasetype(ex->val.type,0)->meaning || /* if type has a name... */
  1582. X         ex->val.type->kind == TK_STRING ||       /* if C sizeof(expr) will give wrong answer */
  1583. X         ex->val.type->kind == TK_ARRAY ||
  1584. X         ex->val.type->kind == TK_SET)) {
  1585. X        ex2 = makeexpr_type(ex->val.type);
  1586. X        freeexpr(ex);
  1587. X        ex = ex2;
  1588. X    }
  1589. X    return makeexpr_un(EK_SIZEOF, tp_integer, ex);
  1590. X}
  1591. X
  1592. X
  1593. X
  1594. X
  1595. X/* Compute a measure of how fast or slow the expression is likely to be.
  1596. X   0 is a constant, 1 is a variable, extra points added per "operation". */
  1597. X
  1598. Xint exprspeed(ex)
  1599. XExpr *ex;
  1600. X{
  1601. X    Meaning *mp, *mp2;
  1602. X    int i, cost, speed;
  1603. X
  1604. X    switch (ex->kind) {
  1605. X
  1606. X        case EK_VAR:
  1607. X            mp = (Meaning *)ex->val.i;
  1608. X            if (mp->kind == MK_CONST)
  1609. X                return 0;
  1610. X            if (!mp->ctx || mp->ctx->kind == MK_FUNCTION)
  1611. X                return 1;
  1612. X            i = 1;
  1613. X            for (mp2 = curctx; mp2 && mp2 != mp->ctx; mp2 = mp2->ctx)
  1614. X                i++;    /* cost of following static links */
  1615. X            return (i);
  1616. X
  1617. X        case EK_CONST:
  1618. X        case EK_LONGCONST:
  1619. X        case EK_SIZEOF:
  1620. X            return 0;
  1621. X
  1622. X        case EK_ADDR:
  1623. X            speed = exprspeed(ex->args[0]);
  1624. X            return (speed > 1) ? speed : 0;
  1625. X
  1626. X        case EK_DOT:
  1627. X            return exprspeed(ex->args[0]);
  1628. X
  1629. X        case EK_NEG:
  1630. X            return exprspeed(ex->args[0]) + 1;
  1631. X
  1632. X        case EK_CAST:
  1633. X        case EK_ACTCAST:
  1634. X            i = (ord_type(ex->val.type)->kind == TK_REAL) !=
  1635. X                (ord_type(ex->args[0]->val.type)->kind == TK_REAL);
  1636. X            return (i + exprspeed(ex->args[0]));
  1637. X
  1638. X        case EK_COND:
  1639. X            return 2 + exprspeed(ex->args[0]) +
  1640. X                   MAX(exprspeed(ex->args[1]), exprspeed(ex->args[2]));
  1641. X
  1642. X        case EK_AND:
  1643. X        case EK_OR:
  1644. X        case EK_COMMA:
  1645. X            speed = 2;
  1646. X            for (i = 0; i < ex->nargs; i++)
  1647. X                speed += exprspeed(ex->args[i]);
  1648. X            return speed;
  1649. X
  1650. X        case EK_FUNCTION:
  1651. X        case EK_BICALL:
  1652. X        case EK_SPCALL:
  1653. X            return 1000;
  1654. X
  1655. X        case EK_ASSIGN:
  1656. X        case EK_POSTINC:
  1657. X        case EK_POSTDEC:
  1658. X            return 100 + exprspeed(ex->args[0]) + exprspeed(ex->args[1]);
  1659. X
  1660. X        default:
  1661. X            cost = (ex->kind == EK_PLUS) ? 1 : 2;
  1662. X            if (ex->val.type->kind == TK_REAL)
  1663. X                cost *= 2;
  1664. X            speed = -cost;
  1665. X            for (i = 0; i < ex->nargs; i++) {
  1666. X                if (!isliteralconst(ex->args[i], NULL) ||
  1667. X                    ex->val.type->kind == TK_REAL)
  1668. X                    speed += exprspeed(ex->args[i]) + cost;
  1669. X            }
  1670. X            return MAX(speed, 0);
  1671. X    }
  1672. X}
  1673. X
  1674. X
  1675. X
  1676. X
  1677. Xint noargdependencies(ex, vars)
  1678. XExpr *ex;
  1679. Xint vars;
  1680. X{
  1681. X    int i;
  1682. X
  1683. X    for (i = 0; i < ex->nargs; i++) {
  1684. X        if (!nodependencies(ex->args[i], vars))
  1685. X            return 0;
  1686. X    }
  1687. X    return 1;
  1688. X}
  1689. X
  1690. X
  1691. Xint nodependencies(ex, vars)
  1692. XExpr *ex;
  1693. Xint vars;   /* 1 if explicit dependencies on vars count as dependencies */
  1694. X{           /* 2 if global but not local vars count as dependencies */
  1695. X    Meaning *mp;
  1696. X
  1697. X    if (debug>2) { fprintf(outf,"nodependencies("); dumpexpr(ex); fprintf(outf,")\n"); }
  1698. X    if (!noargdependencies(ex, vars))
  1699. X        return 0;
  1700. X    switch (ex->kind) {
  1701. X
  1702. X        case EK_VAR:
  1703. X            mp = (Meaning *)ex->val.i;
  1704. X        if (mp->kind == MK_CONST)
  1705. X        return 1;
  1706. X        if (vars == 2 &&
  1707. X        mp->ctx == curctx &&
  1708. X        mp->ctx->kind == MK_FUNCTION &&
  1709. X        !mp->varstructflag)
  1710. X        return 1;
  1711. X            return (mp->kind == MK_CONST ||
  1712. X            (!vars &&
  1713. X             (mp->kind == MK_VAR || mp->kind == MK_VARREF ||
  1714. X              mp->kind == MK_PARAM || mp->kind == MK_VARPARAM)));
  1715. X
  1716. X        case EK_BICALL:
  1717. X            return nosideeffects_func(ex);
  1718. X
  1719. X        case EK_FUNCTION:
  1720. X        case EK_SPCALL:
  1721. X        case EK_ASSIGN:
  1722. X        case EK_POSTINC:
  1723. X        case EK_POSTDEC:
  1724. X        case EK_HAT:
  1725. X        case EK_INDEX:
  1726. X            return 0;
  1727. X
  1728. X        default:
  1729. X            return 1;
  1730. X    }
  1731. X}
  1732. X
  1733. X
  1734. X
  1735. Xint exprdependsvar(ex, mp)
  1736. XExpr *ex;
  1737. XMeaning *mp;
  1738. X{
  1739. X    int i;
  1740. X
  1741. X    i = ex->nargs;
  1742. X    while (--i >= 0)
  1743. X    if (exprdependsvar(ex->args[i], mp))
  1744. X        return 1;
  1745. X    switch (ex->kind) {
  1746. X
  1747. X        case EK_VAR:
  1748. X        return ((Meaning *)ex->val.i == mp);
  1749. X
  1750. X    case EK_BICALL:
  1751. X        if (nodependencies(ex, 1))
  1752. X        return 0;
  1753. X
  1754. X    /* fall through */
  1755. X    case EK_FUNCTION:
  1756. X    case EK_SPCALL:
  1757. X        return (mp->ctx != curctx ||
  1758. X            mp->ctx->kind != MK_FUNCTION ||
  1759. X            mp->varstructflag);
  1760. X
  1761. X    case EK_HAT:
  1762. X        return 1;
  1763. X
  1764. X    default:
  1765. X        return 0;
  1766. X    }
  1767. X}
  1768. X
  1769. X
  1770. Xint exprdepends(ex, ex2)
  1771. XExpr *ex, *ex2;     /* Expression ex somehow depends on value of ex2 */
  1772. X{
  1773. X    switch (ex2->kind) {
  1774. X
  1775. X        case EK_VAR:
  1776. X        return exprdependsvar(ex, (Meaning *)ex2->val.i);
  1777. X
  1778. X    case EK_CONST:
  1779. X    case EK_LONGCONST:
  1780. X        return 0;
  1781. X
  1782. X    case EK_INDEX:
  1783. X    case EK_DOT:
  1784. X        return exprdepends(ex, ex2->args[0]);
  1785. X
  1786. X    default:
  1787. X        return !nodependencies(ex, 1);
  1788. X    }
  1789. X}
  1790. X
  1791. X
  1792. Xint nosideeffects_func(ex)
  1793. XExpr *ex;
  1794. X{
  1795. X    Meaning *mp;
  1796. X    Symbol *sp;
  1797. X
  1798. X    switch (ex->kind) {
  1799. X
  1800. X        case EK_FUNCTION:
  1801. X            mp = (Meaning *)ex->val.i;
  1802. X            sp = findsymbol_opt(mp->name);
  1803. X            return sp && (sp->flags & (NOSIDEEFF|DETERMF));
  1804. X
  1805. X        case EK_BICALL:
  1806. X            sp = findsymbol_opt(ex->val.s);
  1807. X            return sp && (sp->flags & (NOSIDEEFF|DETERMF));
  1808. X
  1809. X        default:
  1810. X            return 0;
  1811. X    }
  1812. X}
  1813. X
  1814. X
  1815. X
  1816. Xint deterministic_func(ex)
  1817. XExpr *ex;
  1818. X{
  1819. X    Meaning *mp;
  1820. X    Symbol *sp;
  1821. X
  1822. X    switch (ex->kind) {
  1823. X
  1824. X        case EK_FUNCTION:
  1825. X            mp = (Meaning *)ex->val.i;
  1826. X            sp = findsymbol_opt(mp->name);
  1827. X            return sp && (sp->flags & DETERMF);
  1828. X
  1829. X        case EK_BICALL:
  1830. X            sp = findsymbol_opt(ex->val.s);
  1831. X            return sp && (sp->flags & DETERMF);
  1832. X
  1833. X        default:
  1834. X            return 0;
  1835. X    }
  1836. X}
  1837. X
  1838. X
  1839. X
  1840. X
  1841. Xint noargsideeffects(ex, mode)
  1842. XExpr *ex;
  1843. Xint mode;
  1844. X{
  1845. X    int i;
  1846. X
  1847. X    for (i = 0; i < ex->nargs; i++) {
  1848. END_OF_FILE
  1849. if test 48964 -ne `wc -c <'src/expr.c.2'`; then
  1850.     echo shar: \"'src/expr.c.2'\" unpacked with wrong size!
  1851. fi
  1852. # end of 'src/expr.c.2'
  1853. fi
  1854. echo shar: End of archive 25 \(of 32\).
  1855. cp /dev/null ark25isdone
  1856. MISSING=""
  1857. for I in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 ; do
  1858.     if test ! -f ark${I}isdone ; then
  1859.     MISSING="${MISSING} ${I}"
  1860.     fi
  1861. done
  1862. if test "${MISSING}" = "" ; then
  1863.     echo You have unpacked all 32 archives.
  1864.     echo "Now see PACKNOTES and the README"
  1865.     rm -f ark[1-9]isdone ark[1-9][0-9]isdone
  1866. else
  1867.     echo You still need to unpack the following archives:
  1868.     echo "        " ${MISSING}
  1869. fi
  1870. ##  End of shell archive.
  1871. exit 0
  1872.