home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / unix / volume21 / p2c / part16 < prev    next >
Encoding:
Internet Message Format  |  1990-04-05  |  44.1 KB
  1. Subject:  v21i061:  Pascal to C translator, Part16/32
  2. Newsgroups: comp.sources.unix
  3. Approved: rsalz@uunet.UU.NET
  4. X-Checksum-Snefru: a713ac3c a1f8f4a6 88f31b90 cee897dc
  5.  
  6. Submitted-by: Dave Gillespie <daveg@csvax.caltech.edu>
  7. Posting-number: Volume 21, Issue 61
  8. Archive-name: p2c/part16
  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 16 (of 32)."
  17. # Contents:  src/expr.c.3
  18. # Wrapped by rsalz@litchi.bbn.com on Mon Mar 26 14:29:38 1990
  19. PATH=/bin:/usr/bin:/usr/ucb ; export PATH
  20. if test -f 'src/expr.c.3' -a "${1}" != "-c" ; then 
  21.   echo shar: Will not clobber existing file \"'src/expr.c.3'\"
  22. else
  23. echo shar: Extracting \"'src/expr.c.3'\" \(41883 characters\)
  24. sed "s/^X//" >'src/expr.c.3' <<'END_OF_FILE'
  25. X        if (!nosideeffects(ex->args[i], mode))
  26. X            return 0;
  27. X    }
  28. X    return 1;
  29. X}
  30. X
  31. X
  32. X/* mode=0: liberal about bicall's: safe unless sideeffects_bicall() */
  33. X/* mode=1: conservative about bicall's: must be explicitly NOSIDEEFF */
  34. X
  35. Xint nosideeffects(ex, mode)
  36. XExpr *ex;
  37. Xint mode;
  38. X{
  39. X    if (debug>2) { fprintf(outf,"nosideeffects("); dumpexpr(ex); fprintf(outf,")\n"); }
  40. X    if (!noargsideeffects(ex, mode))
  41. X        return 0;
  42. X    switch (ex->kind) {
  43. X
  44. X        case EK_BICALL:
  45. X            if (mode == 0)
  46. X                return !sideeffects_bicall(ex->val.s);
  47. X
  48. X        /* fall through */
  49. X        case EK_FUNCTION:
  50. X            return nosideeffects_func(ex);
  51. X
  52. X        case EK_SPCALL:
  53. X        case EK_ASSIGN:
  54. X        case EK_POSTINC:
  55. X        case EK_POSTDEC:
  56. X            return 0;
  57. X
  58. X        default:
  59. X            return 1;
  60. X    }
  61. X}
  62. X
  63. X
  64. X
  65. Xint exproccurs(ex, ex2)
  66. XExpr *ex, *ex2;
  67. X{
  68. X    int i, count = 0;
  69. X
  70. X    if (debug>2) { fprintf(outf,"exproccurs("); dumpexpr(ex); fprintf(outf,", "); dumpexpr(ex2); fprintf(outf,")\n"); }
  71. X    for (i = 0; i < ex->nargs; i++)
  72. X        count += exproccurs(ex->args[i], ex2);
  73. X    if (exprsame(ex, ex2, 0))
  74. X        count++;
  75. X    return count;
  76. X}
  77. X
  78. X
  79. X
  80. XExpr *singlevar(ex)
  81. XExpr *ex;
  82. X{
  83. X    if (debug>2) { fprintf(outf,"singlevar("); dumpexpr(ex); fprintf(outf,")\n"); }
  84. X    switch (ex->kind) {
  85. X
  86. X        case EK_VAR:
  87. X        case EK_MACARG:
  88. X            return ex;
  89. X
  90. X        case EK_HAT:
  91. X        case EK_ADDR:
  92. X        case EK_DOT:
  93. X            return singlevar(ex->args[0]);
  94. X
  95. X        case EK_INDEX:
  96. X            if (!nodependencies(ex->args[1], 1))
  97. X                return NULL;
  98. X            return singlevar(ex->args[0]);
  99. X
  100. X    default:
  101. X        return NULL;
  102. X    }
  103. X}
  104. X
  105. X
  106. X
  107. X/* Is "ex" a function which takes a return buffer pointer as its
  108. X   first argument, and returns a copy of that pointer? */
  109. X
  110. Xint structuredfunc(ex)
  111. XExpr *ex;
  112. X{
  113. X    Meaning *mp;
  114. X    Symbol *sp;
  115. X
  116. X    if (debug>2) { fprintf(outf,"structuredfunc("); dumpexpr(ex); fprintf(outf,")\n"); }
  117. X    switch (ex->kind) {
  118. X
  119. X        case EK_FUNCTION:
  120. X            mp = (Meaning *)ex->val.i;
  121. X            if (mp->isfunction && mp->cbase && mp->cbase->kind == MK_VARPARAM)
  122. X                return 1;
  123. X            sp = findsymbol_opt(mp->name);
  124. X            return sp && (sp->flags & (STRUCTF|STRLAPF));
  125. X
  126. X        case EK_BICALL:
  127. X            sp = findsymbol_opt(ex->val.s);
  128. X            return sp && (sp->flags & (STRUCTF|STRLAPF));
  129. X
  130. X    default:
  131. X        return 0;
  132. X    }
  133. X}
  134. X
  135. X
  136. X
  137. Xint strlapfunc(ex)
  138. XExpr *ex;
  139. X{
  140. X    Meaning *mp;
  141. X    Symbol *sp;
  142. X
  143. X    switch (ex->kind) {
  144. X
  145. X        case EK_FUNCTION:
  146. X            mp = (Meaning *)ex->val.i;
  147. X            sp = findsymbol_opt(mp->name);
  148. X            return sp && (sp->flags & STRLAPF);
  149. X
  150. X        case EK_BICALL:
  151. X            sp = findsymbol_opt(ex->val.s);
  152. X            return sp && (sp->flags & STRLAPF);
  153. X
  154. X        default:
  155. X            return 0;
  156. X    }
  157. X}
  158. X
  159. X
  160. X
  161. XMeaning *istempvar(ex)
  162. XExpr *ex;
  163. X{
  164. X    Meaning *mp;
  165. X
  166. X    if (debug>2) { fprintf(outf,"istempvar("); dumpexpr(ex); fprintf(outf,")\n"); }
  167. X    if (ex->kind == EK_VAR) {
  168. X        mp = (Meaning *)ex->val.i;
  169. X        if (mp->istemporary)
  170. X            return mp;
  171. X        else
  172. X            return NULL;
  173. X    }
  174. X    return NULL;
  175. X}
  176. X
  177. X
  178. X
  179. XMeaning *isretvar(ex)
  180. XExpr *ex;
  181. X{
  182. X    Meaning *mp;
  183. X
  184. X    if (debug>2) { fprintf(outf,"isretvar("); dumpexpr(ex); fprintf(outf,")\n"); }
  185. X    if (ex->kind == EK_HAT)
  186. X        ex = ex->args[0];
  187. X    if (ex->kind == EK_VAR) {
  188. X        mp = (Meaning *)ex->val.i;
  189. X        if (mp->ctx && mp->ctx->kind == MK_FUNCTION &&
  190. X            mp->ctx->isfunction && mp == mp->ctx->cbase)
  191. X            return mp;
  192. X        else
  193. X            return NULL;
  194. X    }
  195. X    return NULL;
  196. X}
  197. X
  198. X
  199. X
  200. XExpr *bumpstring(ex, index, offset)
  201. XExpr *ex, *index;
  202. Xint offset;
  203. X{
  204. X    if (checkconst(index, offset)) {
  205. X        freeexpr(index);
  206. X        return ex;
  207. X    }
  208. X    if (addindex != 0)
  209. X        ex = makeexpr_plus(makeexpr_addrstr(ex),
  210. X               makeexpr_minus(index, makeexpr_long(offset)));
  211. X    else
  212. X        ex = makeexpr_addr(makeexpr_index(ex, index, makeexpr_long(offset)));
  213. X    ex->val.type = tp_str255;
  214. X    return ex;
  215. X}
  216. X
  217. X
  218. X
  219. Xlong po2m1(n)
  220. Xint n;
  221. X{
  222. X    if (n == 32)
  223. X        return -1;
  224. X    else if (n == 31)
  225. X        return 0x7fffffff;
  226. X    else
  227. X        return (1<<n) - 1;
  228. X}
  229. X
  230. X
  231. X
  232. Xint isarithkind(kind)
  233. Xenum exprkind kind;
  234. X{
  235. X    return (kind == EK_EQ || kind == EK_LT || kind == EK_GT ||
  236. X        kind == EK_NE || kind == EK_LE || kind == EK_GE ||
  237. X        kind == EK_PLUS || kind == EK_TIMES || kind == EK_DIVIDE ||
  238. X        kind == EK_DIV || kind == EK_MOD || kind == EK_NEG ||
  239. X        kind == EK_AND || kind == EK_OR || kind == EK_NOT ||
  240. X        kind == EK_BAND || kind == EK_BOR || kind == EK_BXOR ||
  241. X        kind == EK_LSH || kind == EK_RSH || kind == EK_BNOT ||
  242. X        kind == EK_FUNCTION || kind == EK_BICALL);
  243. X}
  244. X
  245. X
  246. XExpr *makeexpr_assign(a, b)
  247. XExpr *a, *b;
  248. X{
  249. X    int i, j;
  250. X    Expr *ex, *ex2, *ex3, **ep;
  251. X    Meaning *mp;
  252. X    Type *tp;
  253. X
  254. X    if (debug>2) { fprintf(outf,"makeexpr_assign("); dumpexpr(a); fprintf(outf,", "); dumpexpr(b); fprintf(outf,")\n"); }
  255. X    if (stringtrunclimit > 0 &&
  256. X    a->val.type->kind == TK_STRING &&
  257. X    (i = strmax(a)) <= stringtrunclimit &&
  258. X    strmax(b) > i) {
  259. X    note("Possible string truncation in assignment [145]");
  260. X    }
  261. X    a = un_sign_extend(a);
  262. X    b = gentle_cast(b, a->val.type);
  263. X    if (b->kind == EK_BICALL && !strcmp(b->val.s, "sprintf") &&
  264. X         (mp = istempvar(b->args[0])) != NULL &&
  265. X         b->nargs >= 2 &&
  266. X         b->args[1]->kind == EK_CONST &&              /* all this handles string appending */
  267. X         b->args[1]->val.i > 2 &&                     /*   of the form, "s := s + ..." */
  268. X         !strncmp(b->args[1]->val.s, "%s", 2) &&
  269. X         exprsame(a, b->args[2], 1) &&
  270. X         nosideeffects(a, 0) &&
  271. X         (ex = singlevar(a)) != NULL) {
  272. X        ex2 = copyexpr(b);
  273. X        delfreearg(&ex2, 2);
  274. X        freeexpr(ex2->args[1]);
  275. X        ex2->args[1] = makeexpr_lstring(b->args[1]->val.s+2,
  276. X                                        b->args[1]->val.i-2);
  277. X        if (/*(ex = singlevar(a)) != NULL && */
  278. X           /* noargdependencies(ex2) && */ !exproccurs(ex2, ex)) {
  279. X            freeexpr(b);
  280. X            if (ex2->args[1]->val.i == 2 &&     /* s := s + s2 */
  281. X                !strncmp(ex2->args[1]->val.s, "%s", 2)) {
  282. X                canceltempvar(mp);
  283. X        tp = ex2->val.type;
  284. X                return makeexpr_bicall_2("strcat", tp,
  285. X                                         makeexpr_addrstr(a), grabarg(ex2, 2));
  286. X            } else if (sprintflength(ex2, 0) >= 0) {    /* s := s + 's2' */
  287. X        tp = ex2->val.type;
  288. X                return makeexpr_bicall_2("strcat", tp,
  289. X                                         makeexpr_addrstr(a), 
  290. X                                         makeexpr_unsprintfify(ex2));
  291. X            } else {                            /* general case */
  292. X                canceltempvar(mp);
  293. X                freeexpr(ex2->args[0]);
  294. X                ex = makeexpr_bicall_1("strlen", tp_int, copyexpr(a));
  295. X                ex2->args[0] = bumpstring(a, ex, 0);
  296. X                return ex2;
  297. X            }
  298. X        } else
  299. X            freeexpr(ex2);
  300. X    }
  301. X    if (b->kind == EK_BICALL && !strcmp(b->val.s, "sprintf") &&
  302. X         istempvar(b->args[0]) &&
  303. X         (ex = singlevar(a)) != NULL) {
  304. X        j = -1;     /* does lhs var appear exactly once on rhs? */
  305. X        for (i = 2; i < b->nargs; i++) {
  306. X            if (exprsame(b->args[i], ex, 1) && j < 0)
  307. X                j = i;
  308. X            else if (exproccurs(b->args[i], ex))
  309. X                break;
  310. X        }
  311. X        if (i == b->nargs && j > 0) {
  312. X            b->args[j] = makeexpr_bicall_2("strcpy", tp_str255,
  313. X                                           makeexpr_addrstr(b->args[0]),
  314. X                                           makeexpr_addrstr(b->args[j]));
  315. X            b->args[0] = makeexpr_addrstr(a);
  316. X            return b;
  317. X        }
  318. X    }
  319. X    if (structuredfunc(b) && (ex2 = singlevar(a)) != NULL) {
  320. X    ep = &b->args[0];
  321. X    i = strlapfunc(b);
  322. X    while (structuredfunc((ex = *ep))) {
  323. X        i = i && strlapfunc(ex);
  324. X        ep = &ex->args[0];
  325. X    }
  326. X    if ((mp = istempvar(ex)) != NULL &&
  327. X        (i || !exproccurs(b, ex2))) {
  328. X        canceltempvar(mp);
  329. X        freeexpr(*ep);
  330. X        *ep = makeexpr_addrstr(a);
  331. X        return b;
  332. X    }
  333. X    }
  334. X    if (a->val.type->kind == TK_PROCPTR &&
  335. X        (mp = istempprocptr(b)) != NULL &&
  336. X        nosideeffects(a, 0)) {
  337. X        freeexpr(b->args[0]->args[0]->args[0]);
  338. X        b->args[0]->args[0]->args[0] = copyexpr(a);
  339. X    if (b->nargs == 3) {
  340. X        freeexpr(b->args[1]->args[0]->args[0]);
  341. X        b->args[1]->args[0]->args[0] = a;
  342. X        delfreearg(&b, 2);
  343. X    } else {
  344. X        freeexpr(b->args[1]);
  345. X        b->args[1] = makeexpr_assign(makeexpr_dotq(a, "link", tp_anyptr),
  346. X                     makeexpr_nil());
  347. X    }
  348. X        canceltempvar(mp);
  349. X        return b;
  350. X    }
  351. X    if (a->val.type->kind == TK_PROCPTR &&
  352. X    (b->val.type->kind == TK_CPROCPTR ||
  353. X     checkconst(b, 0))) {
  354. X    ex = makeexpr_dotq(copyexpr(a), "proc", tp_anyptr);
  355. X    b = makeexpr_comma(makeexpr_assign(ex, b),
  356. X               makeexpr_assign(makeexpr_dotq(a, "link", tp_anyptr),
  357. X                       makeexpr_nil()));
  358. X    return b;
  359. X    }
  360. X    if (a->val.type->kind == TK_CPROCPTR &&
  361. X    (mp = istempprocptr(b)) != NULL &&
  362. X    nosideeffects(a, 0)) {
  363. X    freeexpr(b->args[0]->args[0]);
  364. X    b->args[0]->args[0] = a;
  365. X    if (b->nargs == 3)
  366. X        delfreearg(&b, 1);
  367. X    delfreearg(&b, 1);
  368. X    canceltempvar(mp);
  369. X    return b;
  370. X    }
  371. X    if (a->val.type->kind == TK_CPROCPTR &&
  372. X    b->val.type->kind == TK_PROCPTR) {
  373. X    b = makeexpr_dotq(b, "proc", tp_anyptr);
  374. X    }
  375. X    if (a->val.type->kind == TK_STRING) {
  376. X        if (b->kind == EK_CONST && b->val.i == 0 && !isretvar(a)) {
  377. X                /* optimizing retvar would mess up "return" optimization */
  378. X            return makeexpr_assign(makeexpr_hat(a, 0),
  379. X                                   makeexpr_char(0));
  380. X        }
  381. X        a = makeexpr_addrstr(a);
  382. X        b = makeexpr_addrstr(b);
  383. X        return makeexpr_bicall_2("strcpy", a->val.type, a, b);
  384. X    }
  385. X    if (a->kind == EK_BICALL && !strcmp(a->val.s, "strlen")) {
  386. X        if (b->kind == EK_CAST &&
  387. X             ord_type(b->args[0]->val.type)->kind == TK_INTEGER) {
  388. X            b = grabarg(b, 0);
  389. X        }
  390. X        j = (b->kind == EK_PLUS &&      /* handle "s[0] := xxx" */
  391. X             b->args[0]->kind == EK_BICALL &&
  392. X             !strcmp(b->args[0]->val.s, "strlen") &&
  393. X             exprsame(a->args[0], b->args[0]->args[0], 0) &&
  394. X             isliteralconst(b->args[1], NULL) == 2);
  395. X        if (j && b->args[1]->val.i > 0 &&
  396. X                 b->args[1]->val.i <= 5) {     /* lengthening the string */
  397. X            a = grabarg(a, 0);
  398. X            i = b->args[1]->val.i;
  399. X            freeexpr(b);
  400. X            if (i == 1)
  401. X                b = makeexpr_string(" ");
  402. X            else
  403. X                b = makeexpr_lstring("12345", i);
  404. X            return makeexpr_bicall_2("strcat", a->val.type, a, b);
  405. X        } else {      /* maybe shortening the string */
  406. X            if (!j && !isconstexpr(b, NULL))
  407. X                note("Modification of string length may translate incorrectly [146]");
  408. X            a = grabarg(a, 0);
  409. X            b = makeexpr_ord(b);
  410. X            return makeexpr_assign(makeexpr_index(a, b, NULL),
  411. X                                   makeexpr_char(0));
  412. X        }
  413. X    }
  414. X    if (a->val.type->kind == TK_ARRAY ||
  415. X    (a->val.type->kind == TK_PROCPTR && copystructs < 1) ||
  416. X    (a->val.type->kind == TK_RECORD &&
  417. X     (copystructs < 1 || a->val.type != b->val.type))) {
  418. X        ex = makeexpr_sizeof(copyexpr(a), 0);
  419. X        ex2 = makeexpr_sizeof(copyexpr(b), 0);
  420. X        if (!exprsame(ex, ex2, 1) &&
  421. X            !(a->val.type->kind == TK_ARRAY &&
  422. X              b->val.type->kind != TK_ARRAY))
  423. X            warning("Incompatible types or sizes [167]");
  424. X        freeexpr(ex2);
  425. X        ex = makeexpr_arglong(ex, (size_t_long != 0));
  426. X        a = makeexpr_addrstr(a);
  427. X        b = makeexpr_addrstr(b);
  428. X        return makeexpr_bicall_3("memcpy", a->val.type, a, b, ex);
  429. X    }
  430. X    if (a->val.type->kind == TK_SET) {
  431. X        a = makeexpr_addrstr(a);
  432. X        b = makeexpr_addrstr(b);
  433. X        return makeexpr_bicall_2(setcopyname, a->val.type, a, b);
  434. X    }
  435. X    for (ep = &a; (ex3 = *ep); ) {
  436. X        if (ex3->kind == EK_COMMA)
  437. X            ep = &ex3->args[ex3->nargs-1];
  438. X        else if (ex3->kind == EK_CAST || ex3->kind == EK_ACTCAST)
  439. X            ep = &ex3->args[0];
  440. X        else
  441. X            break;
  442. X    }
  443. X    if (ex3->kind == EK_BICALL) {
  444. X        if (!strcmp(ex3->val.s, getbitsname)) {
  445. X        tp = ex3->args[0]->val.type;
  446. X        if (tp->kind == TK_ARRAY)
  447. X        ex3->args[0] = makeexpr_addr(ex3->args[0]);
  448. X            ex3->val.type = tp_void;
  449. X            if (checkconst(b, 0) && *clrbitsname) {
  450. X                strchange(&ex3->val.s, clrbitsname);
  451. X            } else if (*putbitsname &&
  452. X                       ((ISCONST(b->kind) &&
  453. X                         (b->val.i | ~((1 << (1 << tp->escale)) - 1)) == -1) ||
  454. X                        checkconst(b, (1 << (1 << tp->escale)) - 1))) {
  455. X                strchange(&ex3->val.s, putbitsname);
  456. X                insertarg(ep, 2, makeexpr_arglong(makeexpr_ord(b), 0));
  457. X            } else {
  458. X                b = makeexpr_arglong(makeexpr_ord(b), 0);
  459. X                if (*storebitsname) {
  460. X                    strchange(&ex3->val.s, storebitsname);
  461. X                    insertarg(ep, 2, b);
  462. X                } else {
  463. X                    if (exproccurs(b, ex3->args[0])) {
  464. X                        mp = makestmttempvar(b->val.type, name_TEMP);
  465. X                        ex2 = makeexpr_assign(makeexpr_var(mp), b);
  466. X                        b = makeexpr_var(mp);
  467. X                    } else
  468. X                        ex2 = NULL;
  469. X                    ex = copyexpr(ex3);
  470. X                    strchange(&ex3->val.s, putbitsname);
  471. X                    insertarg(&ex3, 2, b);
  472. X                    strchange(&ex->val.s, clrbitsname);
  473. X                    *ep = makeexpr_comma(ex2, makeexpr_comma(ex, ex3));
  474. X                }
  475. X            }
  476. X            return a;
  477. X        } else if (!strcmp(ex3->val.s, getfbufname)) {
  478. X        ex3->val.type = tp_void;
  479. X        strchange(&ex3->val.s, putfbufname);
  480. X        insertarg(ep, 2, b);
  481. X        return a;
  482. X        } else if (!strcmp(ex3->val.s, chargetfbufname)) {
  483. X        ex3->val.type = tp_void;
  484. X        if (*charputfbufname) {
  485. X        strchange(&ex3->val.s, charputfbufname);
  486. X        insertarg(ep, 1, b);
  487. X        } else {
  488. X        strchange(&ex3->val.s, putfbufname);
  489. X        insertarg(ep, 1, makeexpr_type(ex3->val.type->basetype->basetype));
  490. X        insertarg(ep, 2, b);
  491. X        }
  492. X        return a;
  493. X        } else if (!strcmp(ex3->val.s, arraygetfbufname)) {
  494. X        ex3->val.type = tp_void;
  495. X        if (*arrayputfbufname) {
  496. X        strchange(&ex3->val.s, arrayputfbufname);
  497. X        insertarg(ep, 1, b);
  498. X        } else {
  499. X        strchange(&ex3->val.s, putfbufname);
  500. X        insertarg(ep, 1, makeexpr_type(ex3->val.type->basetype->basetype));
  501. X        insertarg(ep, 2, b);
  502. X        }
  503. X        return a;
  504. X    }
  505. X    }
  506. X    while (a->kind == EK_CAST || a->kind == EK_ACTCAST) {
  507. X    if (ansiC < 2 ||     /* in GNU C, a cast is an lvalue */
  508. X        isarithkind(a->args[0]->kind) ||
  509. X        (a->val.type->kind == TK_POINTER &&
  510. X         a->args[0]->val.type->kind == TK_POINTER)) {
  511. X        if (a->kind == EK_CAST)
  512. X        b = makeexpr_cast(b, a->args[0]->val.type);
  513. X        else
  514. X        b = makeexpr_actcast(b, a->args[0]->val.type);
  515. X            a = grabarg(a, 0);
  516. X        } else
  517. X        break;
  518. X    }
  519. X    if (a->kind == EK_NEG)
  520. X    return makeexpr_assign(grabarg(a, 0), makeexpr_neg(b));
  521. X    if (a->kind == EK_NOT)
  522. X    return makeexpr_assign(grabarg(a, 0), makeexpr_not(b));
  523. X    if (a->kind == EK_BNOT)
  524. X    return makeexpr_assign(grabarg(a, 0),
  525. X                   makeexpr_un(EK_BNOT, b->val.type, b));
  526. X    if (a->kind == EK_PLUS) {
  527. X    for (i = 0; i < a->nargs && a->nargs > 1; ) {
  528. X        if (isconstantexpr(a->args[i])) {
  529. X        b = makeexpr_minus(b, a->args[i]);
  530. X        deletearg(&a, i);
  531. X        } else
  532. X        i++;
  533. X    }
  534. X    if (a->nargs == 1)
  535. X        return makeexpr_assign(grabarg(a, 0), b);
  536. X    }
  537. X    if (a->kind == EK_TIMES) {
  538. X    for (i = 0; i < a->nargs && a->nargs > 1; ) {
  539. X        if (isconstantexpr(a->args[i])) {
  540. X        if (a->val.type->kind == TK_REAL)
  541. X            b = makeexpr_divide(b, a->args[i]);
  542. X        else {
  543. X            if (ISCONST(b->kind) && ISCONST(a->args[i]->kind) &&
  544. X            (b->val.i % a->args[i]->val.i) != 0) {
  545. X            break;
  546. X            }
  547. X            b = makeexpr_div(b, a->args[i]);
  548. X        }
  549. X        deletearg(&a, i);
  550. X        } else
  551. X        i++;
  552. X    }
  553. X    if (a->nargs == 1)
  554. X        return makeexpr_assign(grabarg(a, 0), b);
  555. X    }
  556. X    if ((a->kind == EK_DIVIDE || a->kind == EK_DIV) &&
  557. X     isconstantexpr(a->args[1])) {
  558. X    b = makeexpr_times(b, a->args[1]);
  559. X    return makeexpr_assign(a->args[0], b);
  560. X    }
  561. X    if (a->kind == EK_LSH && isconstantexpr(a->args[1])) {
  562. X    if (ISCONST(b->kind) && ISCONST(a->args[1]->kind)) {
  563. X        if ((b->val.i & ((1L << a->args[1]->val.i)-1)) == 0) {
  564. X        b->val.i >>= a->args[1]->val.i;
  565. X        return makeexpr_assign(grabarg(a, 0), b);
  566. X        }
  567. X    } else {
  568. X        b = makeexpr_bin(EK_RSH, b->val.type, b, a->args[1]);
  569. X        return makeexpr_assign(a->args[0], b);
  570. X    }
  571. X    }
  572. X    if (a->kind == EK_RSH && isconstantexpr(a->args[1])) {
  573. X    if (ISCONST(b->kind) && ISCONST(a->args[1]->kind))
  574. X        b->val.i <<= a->args[1]->val.i;
  575. X    else
  576. X        b = makeexpr_bin(EK_LSH, b->val.type, b, a->args[1]);
  577. X    return makeexpr_assign(a->args[0], b);
  578. X    }
  579. X    if (isarithkind(a->kind))
  580. X    warning("Invalid assignment [168]");
  581. X    return makeexpr_bin(EK_ASSIGN, a->val.type, a, makeexpr_unlongcast(b));
  582. X}
  583. X
  584. X
  585. X
  586. X
  587. XExpr *makeexpr_comma(a, b)
  588. XExpr *a, *b;
  589. X{
  590. X    Type *type;
  591. X
  592. X    if (!a || nosideeffects(a, 1))
  593. X        return b;
  594. X    if (!b)
  595. X        return a;
  596. X    type = b->val.type;
  597. X    a = commute(a, b, EK_COMMA);
  598. X    a->val.type = type;
  599. X    return a;
  600. X}
  601. X
  602. X
  603. X
  604. X
  605. Xint strmax(ex)
  606. XExpr *ex;
  607. X{
  608. X    Meaning *mp;
  609. X    long smin, smax;
  610. X    Value val;
  611. X    Type *type;
  612. X
  613. X    type = ex->val.type;
  614. X    if (type->kind == TK_POINTER)
  615. X        type = type->basetype;
  616. X    if (type->kind == TK_CHAR)
  617. X        return 1;
  618. X    if (type->kind == TK_ARRAY && type->basetype->kind == TK_CHAR) {
  619. X        if (ord_range(type->indextype, &smin, &smax))
  620. X            return smax - smin + 1;
  621. X        else
  622. X            return stringceiling;
  623. X    }
  624. X    if (type->kind != TK_STRING) {
  625. X        intwarning("strmax", "strmax encountered a non-string value [169]");
  626. X        return stringceiling;
  627. X    }
  628. X    if (ex->kind == EK_CONST)
  629. X        return ex->val.i;
  630. X    if (ex->kind == EK_VAR && foldstrconsts != 0 &&
  631. X        (mp = (Meaning *)(ex->val.i))->kind == MK_CONST)
  632. X        return mp->val.i;
  633. X    if (ex->kind == EK_BICALL) {
  634. X    if (!strcmp(ex->val.s, strsubname)) {
  635. X        if (isliteralconst(ex->args[3], &val) && val.type)
  636. X        return val.i;
  637. X    }
  638. X    }
  639. X    if (ord_range(type->indextype, NULL, &smax))
  640. X        return smax;
  641. X    else
  642. X        return stringceiling;
  643. X}
  644. X
  645. X
  646. X
  647. X
  648. Xint strhasnull(val)
  649. XValue val;
  650. X{
  651. X    int i;
  652. X
  653. X    for (i = 0; i < val.i; i++) {
  654. X        if (!val.s[i])
  655. X            return (i == val.i-1) ? 1 : 2;
  656. X    }
  657. X    return 0;
  658. X}
  659. X
  660. X
  661. X
  662. Xint istempsprintf(ex)
  663. XExpr *ex;
  664. X{
  665. X    return (ex->kind == EK_BICALL && !strcmp(ex->val.s, "sprintf") &&
  666. X            ex->nargs >= 2 &&
  667. X            istempvar(ex->args[0]) && 
  668. X            ex->args[1]->kind == EK_CONST && 
  669. X            ex->args[1]->val.type->kind == TK_STRING);
  670. X}
  671. X
  672. X
  673. X
  674. XExpr *makeexpr_sprintfify(ex)
  675. XExpr *ex;
  676. X{
  677. X    Meaning *tvar;
  678. X    char stringbuf[500];
  679. X    char *cp, ch;
  680. X    int j, nnulls;
  681. X    Expr *ex2;
  682. X
  683. X    if (debug>2) { fprintf(outf,"makeexpr_sprintfify("); dumpexpr(ex); fprintf(outf,")\n"); }
  684. X    if (istempsprintf(ex))
  685. X        return ex;
  686. X    ex = makeexpr_stringcast(ex);
  687. X    tvar = makestmttempvar(tp_str255, name_STRING);
  688. X    if (ex->kind == EK_CONST && ex->val.type->kind == TK_STRING) {
  689. X        cp = stringbuf;
  690. X        nnulls = 0;
  691. X        for (j = 0; j < ex->val.i; j++) {
  692. X            ch = ex->val.s[j];
  693. X            if (!ch) {
  694. X                if (j < ex->val.i-1)
  695. X                    note("Null character in sprintf control string [147]");
  696. X                else
  697. X                    note("Null character at end of sprintf control string [148]");
  698. X                if (keepnulls) {
  699. X                    *cp++ = '%';
  700. X                    *cp++ = 'c';
  701. X                    nnulls++;
  702. X                }
  703. X            } else {
  704. X                *cp++ = ch;
  705. X                if (ch == '%')
  706. X                    *cp++ = ch;
  707. X            }
  708. X        }
  709. X        *cp = 0;
  710. X        ex = makeexpr_bicall_2("sprintf", tp_str255,
  711. X                               makeexpr_var(tvar),
  712. X                               makeexpr_string(stringbuf));
  713. X        while (--nnulls >= 0)
  714. X            insertarg(&ex, 2, makeexpr_char(0));
  715. X        return ex;
  716. X    } else if (ex->val.type->kind == TK_ARRAY &&
  717. X               ex->val.type->basetype->kind == TK_CHAR) {
  718. X        ex2 = arraysize(ex->val.type, 0);
  719. X        return cleansprintf(
  720. X                makeexpr_bicall_4("sprintf", tp_str255,
  721. X                                  makeexpr_var(tvar),
  722. X                                  makeexpr_string("%.*s"),
  723. X                                  ex2,
  724. X                                  makeexpr_addrstr(ex)));
  725. X    } else {
  726. X        if (ord_type(ex->val.type)->kind == TK_CHAR)
  727. X            cp = "%c";
  728. X        else if (ex->val.type->kind == TK_STRING)
  729. X            cp = "%s";
  730. X        else {
  731. X            warning("Mixing non-strings with strings [170]");
  732. X            return ex;
  733. X        }
  734. X        return makeexpr_bicall_3("sprintf", tp_str255,
  735. X                                 makeexpr_var(tvar),
  736. X                                 makeexpr_string(cp),
  737. X                                 ex);
  738. X    }
  739. X}
  740. X
  741. X
  742. X
  743. XExpr *makeexpr_unsprintfify(ex)
  744. XExpr *ex;
  745. X{
  746. X    char stringbuf[500];
  747. X    char *cp, ch;
  748. X    int i;
  749. X
  750. X    if (debug>2) { fprintf(outf,"makeexpr_unsprintfify("); dumpexpr(ex); fprintf(outf,")\n"); }
  751. X    if (!istempsprintf(ex))
  752. X        return ex;
  753. X    canceltempvar(istempvar(ex->args[0]));
  754. X    for (i = 2; i < ex->nargs; i++) {
  755. X        if (ex->args[i]->val.type->kind != TK_CHAR ||
  756. X            !checkconst(ex, 0))
  757. X            return ex;
  758. X    }
  759. X    cp = stringbuf;
  760. X    for (i = 0; i < ex->args[1]->val.i; i++) {
  761. X        ch = ex->args[1]->val.s[i];
  762. X        *cp++ = ch;
  763. X        if (ch == '%') {
  764. X            if (++i == ex->args[1]->val.i)
  765. X                return ex;
  766. X            ch = ex->args[1]->val.s[i];
  767. X            if (ch == 'c')
  768. X                cp[-1] = 0;
  769. X            else if (ch != '%')
  770. X                return ex;
  771. X        }
  772. X    }
  773. X    freeexpr(ex);
  774. X    return makeexpr_lstring(stringbuf, cp - stringbuf);
  775. X}
  776. X
  777. X
  778. X
  779. X/* Returns >= 0 iff unsprintfify would return a string constant */
  780. X
  781. Xint sprintflength(ex, allownulls)
  782. XExpr *ex;
  783. Xint allownulls;
  784. X{
  785. X    int i, len;
  786. X
  787. X    if (!istempsprintf(ex))
  788. X        return -1;
  789. X    for (i = 2; i < ex->nargs; i++) {
  790. X        if (!allownulls ||
  791. X            ex->args[i]->val.type->kind != TK_CHAR ||
  792. X            !checkconst(ex, 0))
  793. X            return -1;
  794. X    }
  795. X    len = 0;
  796. X    for (i = 0; i < ex->args[1]->val.i; i++) {
  797. X        len++;
  798. X        if (ex->args[1]->val.s[i] == '%') {
  799. X            if (++i == ex->args[1]->val.i)
  800. X                return -1;
  801. X            if (ex->args[1]->val.s[i] != 'c' &&
  802. X                ex->args[1]->val.s[i] != '%')
  803. X                return -1;
  804. X        }
  805. X    }
  806. X    return len;
  807. X}
  808. X
  809. X
  810. X
  811. XExpr *makeexpr_concat(a, b, usesprintf)
  812. XExpr *a, *b;
  813. Xint usesprintf;
  814. X{
  815. X    int i, ii, j, len, nargs;
  816. X    Type *type;
  817. X    Meaning *mp, *tvar;
  818. X    Expr *ex, *args[2];
  819. X    int akind[2];
  820. X    Value val, val1, val2;
  821. X    char formatstr[300];
  822. X
  823. X    if (debug>2) { fprintf(outf,"makeexpr_concat("); dumpexpr(a); fprintf(outf,", "); dumpexpr(b); fprintf(outf,")\n"); }
  824. X    if (!a)
  825. X        return b;
  826. X    if (!b)
  827. X        return a;
  828. X    a = makeexpr_stringcast(a);
  829. X    b = makeexpr_stringcast(b);
  830. X    if (checkconst(a, 0)) {
  831. X        freeexpr(a);
  832. X        return b;
  833. X    }
  834. X    if (checkconst(b, 0)) {
  835. X        freeexpr(b);
  836. X        return a;
  837. X    }
  838. X    len = strmax(a) + strmax(b);
  839. X    type = makestringtype(len);
  840. X    if (a->kind == EK_CONST && b->kind == EK_CONST) {
  841. X        val1 = a->val;
  842. X        val2 = b->val;
  843. X        val.i = val1.i + val2.i;
  844. X        val.s = ALLOC(val.i+1, char, literals);
  845. X    val.s[val.i] = 0;
  846. X        val.type = type;
  847. X        memcpy(val.s, val1.s, val1.i);
  848. X        memcpy(val.s + val1.i, val2.s, val2.i);
  849. X        freeexpr(a);
  850. X        freeexpr(b);
  851. X        return makeexpr_val(val);
  852. X    }
  853. X    tvar = makestmttempvar(type, name_STRING);
  854. X    if (sprintf_value != 2 || usesprintf) {
  855. X        nargs = 2;                 /* Generate a call to sprintf(), unfolding */
  856. X        args[0] = a;               /*  nested sprintf()'s. */
  857. X        args[1] = b;
  858. X        *formatstr = 0;
  859. X        for (i = 0; i < 2; i++) {
  860. X#if 1
  861. X            ex = args[i] = makeexpr_sprintfify(args[i]);
  862. X        if (!ex->args[1] || !ex->args[1]->val.s)
  863. X        intwarning("makeexpr_concat", "NULL in ex->args[1]");
  864. X        else
  865. X        strncat(formatstr, ex->args[1]->val.s, ex->args[1]->val.i);
  866. X            canceltempvar(istempvar(ex->args[0]));
  867. X            nargs += (ex->nargs - 2);
  868. X            akind[i] = 0;      /* now obsolete */
  869. X#else
  870. X            ex = args[i];
  871. X            if (ex->kind == EK_CONST)
  872. X                ex = makeexpr_sprintfify(ex);
  873. X            if (istempsprintf(ex)) {
  874. X                strncat(formatstr, ex->args[1]->val.s, ex->args[1]->val.i);
  875. X                canceltempvar(istempvar(ex->args[0]));
  876. X                nargs += (ex->nargs - 2);
  877. X                akind[i] = 0;
  878. X            } else {
  879. X                strcat(formatstr, "%s");
  880. X                nargs++;
  881. X                akind[i] = 1;
  882. X            }
  883. X#endif
  884. X        }
  885. X        ex = makeexpr(EK_BICALL, nargs);
  886. X        ex->val.type = type;
  887. X        ex->val.s = stralloc("sprintf");
  888. X        ex->args[0] = makeexpr_var(tvar);
  889. X        ex->args[1] = makeexpr_string(formatstr);
  890. X        j = 2;
  891. X        for (i = 0; i < 2; i++) {
  892. X            switch (akind[i]) {
  893. X                case 0:   /* flattened sub-sprintf */
  894. X                    for (ii = 2; ii < args[i]->nargs; ii++)
  895. X                        ex->args[j++] = copyexpr(args[i]->args[ii]);
  896. X                    freeexpr(args[i]);
  897. X                    break;
  898. X                case 1:   /* included string expr */
  899. X                    ex->args[j++] = args[i];
  900. X                    break;
  901. X            }
  902. X        }
  903. X    } else {
  904. X        ex = a;
  905. X        while (ex->kind == EK_BICALL && !strcmp(ex->val.s, "strcat"))
  906. X            ex = ex->args[0];
  907. X        if (ex->kind == EK_BICALL && !strcmp(ex->val.s, "strcpy") &&
  908. X            (mp = istempvar(ex->args[0])) != NULL) {
  909. X            canceltempvar(mp);
  910. X            freeexpr(ex->args[0]);
  911. X            ex->args[0] = makeexpr_var(tvar);
  912. X        } else {
  913. X            a = makeexpr_bicall_2("strcpy", type, makeexpr_var(tvar), a);
  914. X        }
  915. X        ex = makeexpr_bicall_2("strcat", type, a, b);
  916. X    }
  917. X    if (debug>2) { fprintf(outf,"makeexpr_concat returns "); dumpexpr(ex); fprintf(outf,"\n"); }
  918. X    return ex;
  919. X}
  920. X
  921. X
  922. X
  923. XExpr *cleansprintf(ex)
  924. XExpr *ex;
  925. X{
  926. X    int fidx, i, j, k, len, changed = 0;
  927. X    char *cp, *bp;
  928. X    char fmtbuf[300];
  929. X
  930. X    if (ex->kind != EK_BICALL)
  931. X    return ex;
  932. X    if (!strcmp(ex->val.s, "printf"))
  933. X    fidx = 0;
  934. X    else if (!strcmp(ex->val.s, "sprintf") ||
  935. X         !strcmp(ex->val.s, "fprintf"))
  936. X    fidx = 1;
  937. X    else
  938. X    return ex;
  939. X    len = ex->args[fidx]->val.i;
  940. X    cp = ex->args[fidx]->val.s;      /* printf("%*d",17,x)  =>  printf("%17d",x) */
  941. X    bp = fmtbuf;
  942. X    j = fidx + 1;
  943. X    for (i = 0; i < len; i++) {
  944. X        *bp++ = cp[i];
  945. X        if (cp[i] == '%') {
  946. X        if (cp[i+1] == 's' && ex->args[j]->kind == EK_CONST) {
  947. X        bp--;
  948. X        for (k = 0; k < ex->args[j]->val.i; k++)
  949. X            *bp++ = ex->args[j]->val.s[k];
  950. X        delfreearg(&ex, j);
  951. X        changed = 1;
  952. X        i++;
  953. X        continue;
  954. X        }
  955. X            for (i++; i < len &&
  956. X                      !(isalpha(cp[i]) && cp[i] != 'l'); i++) {
  957. X                if (cp[i] == '*') {
  958. X                    if (isliteralconst(ex->args[j], NULL) == 2) {
  959. X                        sprintf(bp, "%ld", ex->args[j]->val.i);
  960. X                        bp += strlen(bp);
  961. X                        delfreearg(&ex, j);
  962. X                        changed = 1;
  963. X                    } else {
  964. X                        *bp++ = cp[i];
  965. X                        j++;
  966. X                    }
  967. X                } else
  968. X                    *bp++ = cp[i];
  969. X            }
  970. X            if (i < len)
  971. X                *bp++ = cp[i];
  972. X            j++;
  973. X        }
  974. X    }
  975. X    *bp = 0;
  976. X    if (changed) {
  977. X        freeexpr(ex->args[fidx]);
  978. X        ex->args[fidx] = makeexpr_string(fmtbuf);
  979. X    }
  980. X    return ex;
  981. X}
  982. X
  983. X
  984. X
  985. XExpr *makeexpr_substring(vex, ex, exi, exj)
  986. XExpr *vex, *ex, *exi, *exj;
  987. X{
  988. X    exi = makeexpr_unlongcast(exi);
  989. X    exj = makeexpr_longcast(exj, 0);
  990. X    ex = bumpstring(ex, exi, 1);
  991. X    return cleansprintf(makeexpr_bicall_4("sprintf", tp_str255,
  992. X                                          vex,
  993. X                                          makeexpr_string("%.*s"),
  994. X                                          exj,
  995. X                                          ex));
  996. X}
  997. X
  998. X
  999. X
  1000. X
  1001. XExpr *makeexpr_dot(ex, mp)
  1002. XExpr *ex;
  1003. XMeaning *mp;
  1004. X{
  1005. X    Type *ot1, *ot2;
  1006. X    Expr *ex2, *ex3, *nex;
  1007. X    Meaning *tvar;
  1008. X
  1009. X    if (ex->kind == EK_FUNCTION && copystructfuncs > 0) {
  1010. X        tvar = makestmttempvar(ex->val.type, name_TEMP);
  1011. X        ex2 = makeexpr_assign(makeexpr_var(tvar), ex);
  1012. X        ex = makeexpr_var(tvar);
  1013. X    } else
  1014. X        ex2 = NULL;
  1015. X    if (mp->constdefn) {
  1016. X        nex = makeexpr(EK_MACARG, 0);
  1017. X        nex->val.type = tp_integer;
  1018. X        ex3 = replaceexprexpr(copyexpr(mp->constdefn), nex, ex);
  1019. X        freeexpr(ex);
  1020. X        freeexpr(nex);
  1021. X        ex = gentle_cast(ex3, mp->val.type);
  1022. X    } else {
  1023. X        ex = makeexpr_un(EK_DOT, mp->type, ex);
  1024. X        ex->val.i = (long)mp;
  1025. X        ot1 = ord_type(mp->type);
  1026. X        ot2 = ord_type(mp->val.type);
  1027. X        if (ot1->kind != ot2->kind && ot2->kind == TK_ENUM && ot2->meaning && useenum)
  1028. X            ex = makeexpr_cast(ex, mp->val.type);
  1029. X        else if (mp->val.i && !hassignedchar &&
  1030. X         (mp->type == tp_sint || mp->type == tp_abyte)) {
  1031. X            if (*signextname) {
  1032. X                ex = makeexpr_bicall_2(signextname, tp_integer,
  1033. X                                       ex, makeexpr_long(mp->val.i));
  1034. X            } else
  1035. X                note(format_s("Unable to sign-extend field %s [149]", mp->name));
  1036. X        }
  1037. X    }
  1038. X    ex->val.type = mp->val.type;
  1039. X    return makeexpr_comma(ex2, ex);
  1040. X}
  1041. X
  1042. X
  1043. X
  1044. XExpr *makeexpr_dotq(ex, name, type)
  1045. XExpr *ex;
  1046. Xchar *name;
  1047. XType *type;
  1048. X{
  1049. X    ex = makeexpr_un(EK_DOT, type, ex);
  1050. X    ex->val.s = stralloc(name);
  1051. X    return ex;
  1052. X}
  1053. X
  1054. X
  1055. X
  1056. XExpr *strmax_func(ex)
  1057. XExpr *ex;
  1058. X{
  1059. X    Meaning *mp;
  1060. X    Expr *ex2;
  1061. X    Type *type;
  1062. X
  1063. X    type = ex->val.type;
  1064. X    if (type->kind == TK_POINTER) {
  1065. X        intwarning("strmax_func", "got a pointer instead of a string [171]");
  1066. X        type = type->basetype;
  1067. X    }
  1068. X    if (type->kind == TK_CHAR)
  1069. X        return makeexpr_long(1);
  1070. X    if (type->kind != TK_STRING) {
  1071. X        warning("STRMAX of non-string value [172]");
  1072. X        return makeexpr_long(stringceiling);
  1073. X    }
  1074. X    if (ex->kind == EK_CONST)
  1075. X    return makeexpr_long(ex->val.i);
  1076. X    if (ex->kind == EK_VAR &&
  1077. X    (mp = (Meaning *)ex->val.i)->kind == MK_CONST &&
  1078. X    mp->type == tp_str255)
  1079. X    return makeexpr_long(mp->val.i);
  1080. X    if (ex->kind == EK_VAR &&
  1081. X        (mp = (Meaning *)ex->val.i)->kind == MK_VARPARAM &&
  1082. X        mp->type == tp_strptr) {
  1083. X    if (mp->anyvarflag) {
  1084. X        if (mp->ctx != curctx && mp->ctx->kind == MK_FUNCTION)
  1085. X        note(format_s("Reference to STRMAX of parent proc's \"%s\" must be fixed [150]",
  1086. X                  mp->name));
  1087. X        return makeexpr_name(format_s(name_STRMAX, mp->name), tp_int);
  1088. X    } else
  1089. X        note(format_s("STRMAX of \"%s\" wants VarStrings=1 [151]", mp->name));
  1090. X    }
  1091. X    ord_range_expr(type->indextype, NULL, &ex2);
  1092. X    return copyexpr(ex2);
  1093. X}
  1094. X
  1095. X
  1096. X
  1097. X
  1098. XExpr *makeexpr_nil()
  1099. X{
  1100. X    Expr *ex;
  1101. X
  1102. X    ex = makeexpr(EK_CONST, 0);
  1103. X    ex->val.type = tp_anyptr;
  1104. X    ex->val.i = 0;
  1105. X    ex->val.s = NULL;
  1106. X    return ex;
  1107. X}
  1108. X
  1109. X
  1110. X
  1111. XExpr *makeexpr_ctx(ctx)
  1112. XMeaning *ctx;
  1113. X{
  1114. X    Expr *ex;
  1115. X
  1116. X    ex = makeexpr(EK_CTX, 0);
  1117. X    ex->val.type = tp_text;     /* handy pointer type */
  1118. X    ex->val.i = (long)ctx;
  1119. X    return ex;
  1120. X}
  1121. X
  1122. X
  1123. X
  1124. X
  1125. XExpr *force_signed(ex)
  1126. XExpr *ex;
  1127. X{
  1128. X    Type *tp;
  1129. X
  1130. X    if (isliteralconst(ex, NULL) == 2 && ex->nargs == 0)
  1131. X        return ex;
  1132. X    tp = true_type(ex);
  1133. X    if (tp == tp_ushort || tp == tp_ubyte || tp == tp_uchar)
  1134. X    return makeexpr_cast(ex, tp_sshort);
  1135. X    else if (tp == tp_unsigned || tp == tp_uint) {
  1136. X    if (exprlongness(ex) < 0)
  1137. X        return makeexpr_cast(ex, tp_sint);
  1138. X    else
  1139. X        return makeexpr_cast(ex, tp_integer);
  1140. X    }
  1141. X    return ex;
  1142. X}
  1143. X
  1144. X
  1145. X
  1146. XExpr *force_unsigned(ex)
  1147. XExpr *ex;
  1148. X{
  1149. X    Type *tp;
  1150. X
  1151. X    if (isliteralconst(ex, NULL) == 2 && !expr_is_neg(ex))
  1152. X        return ex;
  1153. X    tp = true_type(ex);
  1154. X    if (tp == tp_unsigned || tp == tp_uint || tp == tp_ushort ||
  1155. X    tp == tp_ubyte || tp == tp_uchar)
  1156. X        return ex;
  1157. X    if (tp->kind == TK_CHAR)
  1158. X    return makeexpr_actcast(ex, tp_uchar);
  1159. X    else if (exprlongness(ex) < 0)
  1160. X        return makeexpr_cast(ex, tp_uint);
  1161. X    else
  1162. X        return makeexpr_cast(ex, tp_unsigned);
  1163. X}
  1164. X
  1165. X
  1166. X
  1167. X
  1168. X#define CHECKSIZE(size) (((size) > 0 && (size)%charsize == 0) ? (size)/charsize : 0)
  1169. X
  1170. Xlong type_sizeof(type, pasc)
  1171. XType *type;
  1172. Xint pasc;
  1173. X{
  1174. X    long s1, smin, smax;
  1175. X    int charsize = (sizeof_char) ? sizeof_char : CHAR_BIT;      /* from <limits.h> */
  1176. X
  1177. X    switch (type->kind) {
  1178. X
  1179. X        case TK_INTEGER:
  1180. X            if (type == tp_integer ||
  1181. X                type == tp_unsigned)
  1182. X                return pasc ? 4 : CHECKSIZE(sizeof_integer);
  1183. X            else
  1184. X                return pasc ? 2 : CHECKSIZE(sizeof_short);
  1185. X
  1186. X        case TK_CHAR:
  1187. X        case TK_BOOLEAN:
  1188. X            return 1;
  1189. X
  1190. X        case TK_SUBR:
  1191. X            type = findbasetype(type, 0);
  1192. X            if (pasc) {
  1193. X                if (type == tp_integer || type == tp_unsigned)
  1194. X                    return 4;
  1195. X                else
  1196. X                    return 2;
  1197. X            } else {
  1198. X                if (type == tp_abyte || type == tp_ubyte || type == tp_sbyte)
  1199. X                    return 1;
  1200. X                else if (type == tp_ushort || type == tp_sshort)
  1201. X                    return CHECKSIZE(sizeof_short);
  1202. X                else
  1203. X                    return CHECKSIZE(sizeof_integer);
  1204. X            }
  1205. X
  1206. X        case TK_POINTER:
  1207. X            return pasc ? 4 : CHECKSIZE(sizeof_pointer);
  1208. X
  1209. X        case TK_REAL:
  1210. X        if (type == tp_longreal)
  1211. X        return pasc ? (which_lang == LANG_TURBO ? 6 : 8) : CHECKSIZE(sizeof_double);
  1212. X        else
  1213. X        return pasc ? 4 : CHECKSIZE(sizeof_float);
  1214. X
  1215. X        case TK_ENUM:
  1216. X        if (!pasc)
  1217. X        return CHECKSIZE(sizeof_enum);
  1218. X        type = findbasetype(type, 0);
  1219. X            return type->kind != TK_ENUM ? type_sizeof(type, pasc)
  1220. X           : CHECKSIZE(pascalenumsize);
  1221. X
  1222. X        case TK_SMALLSET:
  1223. X        case TK_SMALLARRAY:
  1224. X            return pasc ? 0 : type_sizeof(type->basetype, pasc);
  1225. X
  1226. X        case TK_ARRAY:
  1227. X            s1 = type_sizeof(type->basetype, pasc);
  1228. X            if (s1 && ord_range(type->indextype, &smin, &smax))
  1229. X                return s1 * (smax - smin + 1);
  1230. X            else
  1231. X                return 0;
  1232. X
  1233. X        case TK_RECORD:
  1234. X            if (pasc && type->meaning) {
  1235. X                if (!strcmp(type->meaning->sym->name, "NA_WORD"))
  1236. X                    return 2;
  1237. X                else if (!strcmp(type->meaning->sym->name, "NA_LONGWORD"))
  1238. X                    return 4;
  1239. X                else if (!strcmp(type->meaning->sym->name, "NA_QUADWORD"))
  1240. X                    return 8;
  1241. X                else
  1242. X                    return 0;
  1243. X            } else
  1244. X                return 0;
  1245. X
  1246. X        default:
  1247. X            return 0;
  1248. X    }
  1249. X}
  1250. X
  1251. X
  1252. X
  1253. XStatic Value eval_expr_either(ex, pasc)
  1254. XExpr *ex;
  1255. Xint pasc;
  1256. X{
  1257. X    Value val, val2;
  1258. X    Meaning *mp;
  1259. X    int i;
  1260. X
  1261. X    if (debug>2) { fprintf(outf,"eval_expr("); dumpexpr(ex); fprintf(outf,")\n"); }
  1262. X    switch (ex->kind) {
  1263. X
  1264. X        case EK_CONST:
  1265. X        case EK_LONGCONST:
  1266. X            return ex->val;
  1267. X
  1268. X        case EK_VAR:
  1269. X            mp = (Meaning *) ex->val.i;
  1270. X            if (mp->kind == MK_CONST && 
  1271. X                (foldconsts != 0 ||
  1272. X                 mp == mp_maxint || mp == mp_minint))
  1273. X                return mp->val;
  1274. X            break;
  1275. X
  1276. X        case EK_SIZEOF:
  1277. X            i = type_sizeof(ex->args[0]->val.type, pasc);
  1278. X            if (i)
  1279. X                return make_ord(tp_integer, i);
  1280. X            break;
  1281. X
  1282. X        case EK_PLUS:
  1283. X            val = eval_expr_either(ex->args[0], pasc);
  1284. X            if (!val.type || ord_type(val.type) != tp_integer)
  1285. X                val.type = NULL;
  1286. X            for (i = 1; val.type && i < ex->nargs; i++) {
  1287. X                val2 = eval_expr_either(ex->args[i], pasc);
  1288. X                if (!val2.type || ord_type(val2.type) != tp_integer)
  1289. X                    val.type = NULL;
  1290. X                else
  1291. X                    val.i += val2.i;
  1292. X            }
  1293. X            return val;
  1294. X
  1295. X        case EK_TIMES:
  1296. X            val = eval_expr_either(ex->args[0], pasc);
  1297. X            if (!val.type || ord_type(val.type) != tp_integer)
  1298. X                val.type = NULL;
  1299. X            for (i = 1; val.type && i < ex->nargs; i++) {
  1300. X                val2 = eval_expr_either(ex->args[i], pasc);
  1301. X                if (!val2.type || ord_type(val2.type) != tp_integer)
  1302. X                    val.type = NULL;
  1303. X                else
  1304. X                    val.i *= val2.i;
  1305. X            }
  1306. X            return val;
  1307. X
  1308. X        case EK_DIV:
  1309. X            val = eval_expr_either(ex->args[0], pasc);
  1310. X            val2 = eval_expr_either(ex->args[1], pasc);
  1311. X            if (val.type && ord_type(val.type) == tp_integer &&
  1312. X                val2.type && ord_type(val2.type) == tp_integer && val2.i) {
  1313. X                val.i /= val2.i;
  1314. X                return val;
  1315. X            }
  1316. X            break;
  1317. X
  1318. X        case EK_MOD:
  1319. X            val = eval_expr_either(ex->args[0], pasc);
  1320. X            val2 = eval_expr_either(ex->args[1], pasc);
  1321. X            if (val.type && ord_type(val.type) == tp_integer &&
  1322. X                val2.type && ord_type(val2.type) == tp_integer && val2.i) {
  1323. X                val.i %= val2.i;
  1324. X                return val;
  1325. X            }
  1326. X            break;
  1327. X
  1328. X        case EK_NEG:
  1329. X            val = eval_expr_either(ex->args[0], pasc);
  1330. X            if (val.type) {
  1331. X                val.i = -val.i;
  1332. X                return val;
  1333. X            }
  1334. X            break;
  1335. X
  1336. X        case EK_LSH:
  1337. X            val = eval_expr_either(ex->args[0], pasc);
  1338. X            val2 = eval_expr_either(ex->args[1], pasc);
  1339. X            if (val.type && val2.type) {
  1340. X                val.i <<= val2.i;
  1341. X                return val;
  1342. X            }
  1343. X            break;
  1344. X
  1345. X        case EK_RSH:
  1346. X            val = eval_expr_either(ex->args[0], pasc);
  1347. X            val2 = eval_expr_either(ex->args[1], pasc);
  1348. X            if (val.type && val2.type) {
  1349. X                val.i >>= val2.i;
  1350. X                return val;
  1351. X            }
  1352. X            break;
  1353. X
  1354. X        case EK_BAND:
  1355. X            val = eval_expr_either(ex->args[0], pasc);
  1356. X            val2 = eval_expr_either(ex->args[1], pasc);
  1357. X            if (val.type && val2.type) {
  1358. X                val.i &= val2.i;
  1359. X                return val;
  1360. X            }
  1361. X            break;
  1362. X
  1363. X        case EK_BOR:
  1364. X            val = eval_expr_either(ex->args[0], pasc);
  1365. X            val2 = eval_expr_either(ex->args[1], pasc);
  1366. X            if (val.type && val2.type) {
  1367. X                val.i |= val2.i;
  1368. X                return val;
  1369. X            }
  1370. X            break;
  1371. X
  1372. X        case EK_BXOR:
  1373. X            val = eval_expr_either(ex->args[0], pasc);
  1374. X            val2 = eval_expr_either(ex->args[1], pasc);
  1375. X            if (val.type && val2.type) {
  1376. X                val.i ^= val2.i;
  1377. X                return val;
  1378. X            }
  1379. X            break;
  1380. X
  1381. X        case EK_BNOT:
  1382. X            val = eval_expr_either(ex->args[0], pasc);
  1383. X            if (val.type) {
  1384. X                val.i = ~val.i;
  1385. X                return val;
  1386. X            }
  1387. X            break;
  1388. X
  1389. X        case EK_EQ:
  1390. X        case EK_NE:
  1391. X        case EK_GT:
  1392. X        case EK_LT:
  1393. X        case EK_GE:
  1394. X        case EK_LE:
  1395. X            val = eval_expr_either(ex->args[0], pasc);
  1396. X            val2 = eval_expr_either(ex->args[1], pasc);
  1397. X            if (val.type) {
  1398. X                if (val.i == val2.i)
  1399. X                    val.i = (ex->kind == EK_EQ || ex->kind == EK_GE || ex->kind == EK_LE);
  1400. X                else if (val.i < val2.i)
  1401. X                    val.i = (ex->kind == EK_LT || ex->kind == EK_LE || ex->kind == EK_NE);
  1402. X                else
  1403. X                    val.i = (ex->kind == EK_GT || ex->kind == EK_GE || ex->kind == EK_NE);
  1404. X                val.type = tp_boolean;
  1405. X                return val;
  1406. X            }
  1407. X            break;
  1408. X
  1409. X        case EK_NOT:
  1410. X            val = eval_expr_either(ex->args[0], pasc);
  1411. X            if (val.type)
  1412. X                val.i = !val.i;
  1413. X            return val;
  1414. X
  1415. X        case EK_AND:
  1416. X            for (i = 0; i < ex->nargs; i++) {
  1417. X                val = eval_expr_either(ex->args[i], pasc);
  1418. X                if (!val.type || !val.i)
  1419. X                    return val;
  1420. X            }
  1421. X            return val;
  1422. X
  1423. X        case EK_OR:
  1424. X            for (i = 0; i < ex->nargs; i++) {
  1425. X                val = eval_expr_either(ex->args[i], pasc);
  1426. X                if (!val.type || val.i)
  1427. X                    return val;
  1428. X            }
  1429. X            return val;
  1430. X
  1431. X        case EK_COMMA:
  1432. X            return eval_expr_either(ex->args[ex->nargs-1], pasc);
  1433. X
  1434. X    default:
  1435. X        break;
  1436. X    }
  1437. X    val.type = NULL;
  1438. X    return val;
  1439. X}
  1440. X
  1441. X
  1442. XValue eval_expr(ex)
  1443. XExpr *ex;
  1444. X{
  1445. X    return eval_expr_either(ex, 0);
  1446. X}
  1447. X
  1448. X
  1449. XValue eval_expr_consts(ex)
  1450. XExpr *ex;
  1451. X{
  1452. X    Value val;
  1453. X    short save_fold = foldconsts;
  1454. X
  1455. X    foldconsts = 1;
  1456. X    val = eval_expr_either(ex, 0);
  1457. X    foldconsts = save_fold;
  1458. X    return val;
  1459. X}
  1460. X
  1461. X
  1462. XValue eval_expr_pasc(ex)
  1463. XExpr *ex;
  1464. X{
  1465. X    return eval_expr_either(ex, 1);
  1466. X}
  1467. X
  1468. X
  1469. X
  1470. Xint expr_is_const(ex)
  1471. XExpr *ex;
  1472. X{
  1473. X    int i;
  1474. X
  1475. X    switch (ex->kind) {
  1476. X
  1477. X        case EK_CONST:
  1478. X        case EK_LONGCONST:
  1479. X        case EK_SIZEOF:
  1480. X            return 1;
  1481. X
  1482. X        case EK_VAR:
  1483. X            return (((Meaning *)ex->val.i)->kind == MK_CONST);
  1484. X
  1485. X        case EK_HAT:
  1486. X        case EK_ASSIGN:
  1487. X        case EK_POSTINC:
  1488. X        case EK_POSTDEC:
  1489. X            return 0;
  1490. X
  1491. X        case EK_ADDR:
  1492. X            if (ex->args[0]->kind == EK_VAR)
  1493. X                return 1;
  1494. X            return 0;   /* conservative */
  1495. X
  1496. X        case EK_FUNCTION:
  1497. X            if (!nosideeffects_func(ex))
  1498. X                return 0;
  1499. X            break;
  1500. X
  1501. X        case EK_BICALL:
  1502. X            if (!nosideeffects_func(ex))
  1503. X                return 0;
  1504. X            break;
  1505. X
  1506. X    default:
  1507. X        break;
  1508. X    }
  1509. X    for (i = 0; i < ex->nargs; i++) {
  1510. X        if (!expr_is_const(ex->args[i]))
  1511. X            return 0;
  1512. X    }
  1513. X    return 1;
  1514. X}
  1515. X
  1516. X
  1517. X
  1518. X
  1519. X
  1520. XExpr *eatcasts(ex)
  1521. XExpr *ex;
  1522. X{
  1523. X    while (ex->kind == EK_CAST)
  1524. X        ex = grabarg(ex, 0);
  1525. X    return ex;
  1526. X}
  1527. X
  1528. X
  1529. X
  1530. X
  1531. X
  1532. X/* End. */
  1533. X
  1534. X
  1535. X
  1536. END_OF_FILE
  1537. if test 41883 -ne `wc -c <'src/expr.c.3'`; then
  1538.     echo shar: \"'src/expr.c.3'\" unpacked with wrong size!
  1539. fi
  1540. # end of 'src/expr.c.3'
  1541. fi
  1542. echo shar: End of archive 16 \(of 32\).
  1543. cp /dev/null ark16isdone
  1544. MISSING=""
  1545. 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
  1546.     if test ! -f ark${I}isdone ; then
  1547.     MISSING="${MISSING} ${I}"
  1548.     fi
  1549. done
  1550. if test "${MISSING}" = "" ; then
  1551.     echo You have unpacked all 32 archives.
  1552.     echo "Now see PACKNOTES and the README"
  1553.     rm -f ark[1-9]isdone ark[1-9][0-9]isdone
  1554. else
  1555.     echo You still need to unpack the following archives:
  1556.     echo "        " ${MISSING}
  1557. fi
  1558. ##  End of shell archive.
  1559. exit 0
  1560.