home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 October / usenetsourcesnewsgroupsinfomagicoctober1994disk2.iso / unix / volume21 / p2c / part30 < prev    next >
Text File  |  1990-04-05  |  53KB  |  1,639 lines
  1. Subject:  v21i075:  Pascal to C translator, Part30/32
  2. Newsgroups: comp.sources.unix
  3. Approved: rsalz@uunet.UU.NET
  4. X-Checksum-Snefru: d140c78b e19ae830 375027e7 9a3c700a
  5.  
  6. Submitted-by: Dave Gillespie <daveg@csvax.caltech.edu>
  7. Posting-number: Volume 21, Issue 75
  8. Archive-name: p2c/part30
  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 30 (of 32)."
  17. # Contents:  src/parse.c.2
  18. # Wrapped by rsalz@litchi.bbn.com on Mon Mar 26 14:29:53 1990
  19. PATH=/bin:/usr/bin:/usr/ucb ; export PATH
  20. if test -f 'src/parse.c.2' -a "${1}" != "-c" ; then 
  21.   echo shar: Will not clobber existing file \"'src/parse.c.2'\"
  22. else
  23. echo shar: Extracting \"'src/parse.c.2'\" \(49392 characters\)
  24. sed "s/^X//" >'src/parse.c.2' <<'END_OF_FILE'
  25. X                        if (spnextreturn) {
  26. X                            mp->refcount--;
  27. X                            sp->next = sp->next->next;
  28. X                        }
  29. X                        result = 1;
  30. X                    }
  31. X                }
  32. X                break;
  33. X
  34. X            case SK_RETURN:
  35. X            case SK_GOTO:
  36. X                result = 1;
  37. X                break;
  38. X
  39. X            case SK_IF:
  40. X                result = checkreturns(&sp->stm1, spnearret) &    /* NOT && */
  41. X                         checkreturns(&sp->stm2, spnearret);
  42. X                break;
  43. X
  44. X            case SK_TRY:
  45. X                (void) checkreturns(&sp->stm1, 0);
  46. X                (void) checkreturns(&sp->stm2, spnearret);
  47. X                break;
  48. X
  49. X            /* should handle CASE statements as well */
  50. X
  51. X            default:
  52. X                (void) checkreturns(&sp->stm1, 0);
  53. X                (void) checkreturns(&sp->stm2, 0);
  54. X                break;
  55. X        }
  56. X        spp = &sp->next;
  57. X    }
  58. X    return result;
  59. X}
  60. X
  61. X
  62. X
  63. X
  64. X
  65. X
  66. X
  67. X/* Replace all occurrences of one expression with another expression */
  68. X
  69. XExpr *replaceexprexpr(ex, oldex, newex)
  70. XExpr *ex, *oldex, *newex;
  71. X{
  72. X    int i;
  73. X    Type *type;
  74. X
  75. X    for (i = 0; i < ex->nargs; i++)
  76. X        ex->args[i] = replaceexprexpr(ex->args[i], oldex, newex);
  77. X    if (exprsame(ex, oldex, 2)) {
  78. X        if (ex->val.type->kind == TK_POINTER &&
  79. X            ex->val.type->basetype == oldex->val.type) {
  80. X            freeexpr(ex);
  81. X            return makeexpr_addr(copyexpr(newex));
  82. X        } else if (oldex->val.type->kind == TK_POINTER &&
  83. X                   oldex->val.type->basetype == ex->val.type) {
  84. X            freeexpr(ex);
  85. X            return makeexpr_hat(copyexpr(newex), 0);
  86. X        } else {
  87. X        type = ex->val.type;
  88. X            freeexpr(ex);
  89. X            ex = copyexpr(newex);
  90. X        ex->val.type = type;
  91. X        return ex;
  92. X        }
  93. X    }
  94. X    return resimplify(ex);
  95. X}
  96. X
  97. X
  98. Xvoid replaceexpr(sp, oldex, newex)
  99. XStmt *sp;
  100. XExpr *oldex, *newex;
  101. X{
  102. X    while (sp) {
  103. X        replaceexpr(sp->stm1, oldex, newex);
  104. X        replaceexpr(sp->stm2, oldex, newex);
  105. X        if (sp->exp1)
  106. X            sp->exp1 = replaceexprexpr(sp->exp1, oldex, newex);
  107. X        if (sp->exp2)
  108. X            sp->exp2 = replaceexprexpr(sp->exp2, oldex, newex);
  109. X        if (sp->exp3)
  110. X            sp->exp3 = replaceexprexpr(sp->exp3, oldex, newex);
  111. X        sp = sp->next;
  112. X    }
  113. X}
  114. X
  115. X
  116. X
  117. X
  118. X
  119. X
  120. XStmt *mixassignments(sp, mp)
  121. XStmt *sp;
  122. XMeaning *mp;
  123. X{
  124. X    if (!sp)
  125. X        return NULL;
  126. X    sp->next = mixassignments(sp->next, mp);
  127. X    if (sp->next &&
  128. X     sp->kind == SK_ASSIGN &&
  129. X         sp->exp1->kind == EK_ASSIGN &&
  130. X         sp->exp1->args[0]->kind == EK_VAR &&
  131. X         (!mp || mp == (Meaning *)sp->exp1->args[0]->val.i) &&
  132. X         ord_type(sp->exp1->args[0]->val.type)->kind == TK_INTEGER &&
  133. X         nodependencies(sp->exp1->args[1], 0) &&
  134. X         sp->next->kind == SK_ASSIGN &&
  135. X         sp->next->exp1->kind == EK_ASSIGN &&
  136. X         (exprsame(sp->exp1->args[0], sp->next->exp1->args[0], 1) ||
  137. X          (mp && mp->istemporary)) &&
  138. X         exproccurs(sp->next->exp1->args[1], sp->exp1->args[0]) == 1) {
  139. X        sp->next->exp1->args[1] = replaceexprexpr(sp->next->exp1->args[1],
  140. X                                                  sp->exp1->args[0],
  141. X                                                  sp->exp1->args[1]);
  142. X        if (mp && mp->istemporary)
  143. X            canceltempvar(mp);
  144. X        return sp->next;
  145. X    }
  146. X    return sp;
  147. X}
  148. X
  149. X
  150. X
  151. X
  152. X
  153. X
  154. X
  155. X
  156. X/* Do various simple (sometimes necessary) massages on the statements */
  157. X
  158. X
  159. XStatic Stmt bogusreturn = { SK_RETURN, NULL, NULL, NULL, NULL, NULL, NULL };
  160. X
  161. X
  162. X
  163. XStatic int isescape(ex)
  164. XExpr *ex;
  165. X{
  166. X    if (ex->kind == EK_BICALL && (!strcmp(ex->val.s, name_ESCAPE) ||
  167. X                                  !strcmp(ex->val.s, name_ESCIO) ||
  168. X                  !strcmp(ex->val.s, name_OUTMEM) ||
  169. X                  !strcmp(ex->val.s, name_CASECHECK) ||
  170. X                  !strcmp(ex->val.s, name_NILCHECK) ||
  171. X                                  !strcmp(ex->val.s, "_exit") ||
  172. X                                  !strcmp(ex->val.s, "exit")))
  173. X        return 1;
  174. X    if (ex->kind == EK_CAST)
  175. X        return isescape(ex->args[0]);
  176. X    return 0;
  177. X}
  178. X
  179. X
  180. X/* check if a block can never exit by falling off the end */
  181. XStatic int deadendblock(sp)
  182. XStmt *sp;
  183. X{
  184. X    if (!sp)
  185. X        return 0;
  186. X    while (sp->next)
  187. X        sp = sp->next;
  188. X    return (sp->kind == SK_GOTO ||
  189. X            sp->kind == SK_BREAK ||
  190. X            sp->kind == SK_CONTINUE ||
  191. X            sp->kind == SK_RETURN ||
  192. X            sp->kind == SK_CASECHECK ||
  193. X            (sp->kind == SK_IF && deadendblock(sp->stm1) &&
  194. X                                  deadendblock(sp->stm2)) ||
  195. X            (sp->kind == SK_ASSIGN && isescape(sp->exp1)));
  196. X}
  197. X
  198. X
  199. X
  200. X
  201. Xint expr_is_bool(ex, want)
  202. XExpr *ex;
  203. Xint want;
  204. X{
  205. X    long val;
  206. X
  207. X    if (ex->val.type == tp_boolean && isconstexpr(ex, &val))
  208. X        return (val == want);
  209. X    return 0;
  210. X}
  211. X
  212. X
  213. X
  214. X
  215. X/* Returns 1 if c1 implies c2, 0 otherwise */
  216. X/* If not1 is true, then checks if (!c1) implies c2; similarly for not2 */
  217. X
  218. X/* Identities used:
  219. X        c1 -> (c2a && c2b)      <=>     (c1 -> c2a) && (c1 -> c2b)
  220. X        c1 -> (c2a || c2b)      <=>     (c1 -> c2a) || (c1 -> c2b)
  221. X        (c1a && c1b) -> c2      <=>     (c1a -> c2) || (c1b -> c2)
  222. X        (c1a || c1b) -> c2      <=>     (c1a -> c2) && (c1b -> c2)
  223. X        (!c1) -> (!c2)          <=>     c2 -> c1
  224. X        (a == b) -> c2(b)       <=>     c2(a)
  225. X        !(c1 && c2)             <=>     (!c1) || (!c2)
  226. X        !(c1 || c2)             <=>     (!c1) && (!c2)
  227. X*/
  228. X/* This could be smarter about, e.g., (a>5) -> (a>0) */
  229. X
  230. Xint implies(c1, c2, not1, not2)
  231. XExpr *c1, *c2;
  232. Xint not1, not2;
  233. X{
  234. X    Expr *ex;
  235. X    int i;
  236. X
  237. X    if (c1->kind == EK_EQ && c1->args[0]->val.type == tp_boolean) {
  238. X        if (checkconst(c1->args[0], 1)) {     /* things like "flag = true" */
  239. X            return implies(c1->args[1], c2, not1, not2);
  240. X        } else if (checkconst(c1->args[1], 1)) {
  241. X            return implies(c1->args[0], c2, not1, not2);
  242. X        } else if (checkconst(c1->args[0], 0)) {
  243. X            return implies(c1->args[1], c2, !not1, not2);
  244. X        } else if (checkconst(c1->args[1], 0)) {
  245. X            return implies(c1->args[0], c2, !not1, not2);
  246. X        }
  247. X    }
  248. X    if (c2->kind == EK_EQ && c2->args[0]->val.type == tp_boolean) {
  249. X        if (checkconst(c2->args[0], 1)) {
  250. X            return implies(c1, c2->args[1], not1, not2);
  251. X        } else if (checkconst(c2->args[1], 1)) {
  252. X            return implies(c1, c2->args[0], not1, not2);
  253. X        } else if (checkconst(c2->args[0], 0)) {
  254. X            return implies(c1, c2->args[1], not1, !not2);
  255. X        } else if (checkconst(c2->args[1], 0)) {
  256. X            return implies(c1, c2->args[0], not1, !not2);
  257. X        }
  258. X    }
  259. X    switch (c2->kind) {
  260. X
  261. X        case EK_AND:
  262. X            if (not2)               /* c1 -> (!c2a || !c2b) */
  263. X                return (implies(c1, c2->args[0], not1, 1) ||
  264. X                        implies(c1, c2->args[1], not1, 1));
  265. X            else                    /* c1 -> (c2a && c2b) */
  266. X                return (implies(c1, c2->args[0], not1, 0) &&
  267. X                        implies(c1, c2->args[1], not1, 0));
  268. X
  269. X        case EK_OR:
  270. X            if (not2)               /* c1 -> (!c2a && !c2b) */
  271. X                return (implies(c1, c2->args[0], not1, 1) &&
  272. X                        implies(c1, c2->args[1], not1, 1));
  273. X            else                    /* c1 -> (c2a || c2b) */
  274. X                return (implies(c1, c2->args[0], not1, 0) ||
  275. X                        implies(c1, c2->args[1], not1, 0));
  276. X
  277. X        case EK_NOT:                /* c1 -> (!c2) */
  278. X            return (implies(c1, c2->args[0], not1, !not2));
  279. X
  280. X        case EK_CONST:
  281. X            if ((c2->val.i != 0) != not2)  /* c1 -> true */
  282. X                return 1;
  283. X            break;
  284. X
  285. X    default:
  286. X        break;
  287. X    }
  288. X    switch (c1->kind) {
  289. X
  290. X        case EK_AND:
  291. X            if (not1)               /* (!c1a || !c1b) -> c2 */
  292. X                return (implies(c1->args[0], c2, 1, not2) &&
  293. X                        implies(c1->args[1], c2, 1, not2));
  294. X            else                    /* (c1a && c1b) -> c2 */
  295. X                return (implies(c1->args[0], c2, 0, not2) ||
  296. X                        implies(c1->args[1], c2, 0, not2));
  297. X
  298. X        case EK_OR:
  299. X            if (not1)               /* (!c1a && !c1b) -> c2 */
  300. X                return (implies(c1->args[0], c2, 1, not2) ||
  301. X                        implies(c1->args[1], c2, 1, not2));
  302. X            else                    /* (c1a || c1b) -> c2 */
  303. X                return (implies(c1->args[0], c2, 0, not2) &&
  304. X                        implies(c1->args[1], c2, 0, not2));
  305. X
  306. X        case EK_NOT:                /* (!c1) -> c2 */
  307. X            return (implies(c1->args[0], c2, !not1, not2));
  308. X
  309. X        case EK_CONST:
  310. X            if ((c1->val.i != 0) == not1)  /*  false -> c2 */
  311. X                return 1;
  312. X            break;
  313. X
  314. X        case EK_EQ:                 /* (a=b) -> c2 */
  315. X        case EK_ASSIGN:             /* (a:=b) -> c2 */
  316. X        case EK_NE:                 /* (a<>b) -> c2 */
  317. X            if ((c1->kind == EK_NE) == not1) {
  318. X                if (c1->args[0]->kind == EK_VAR) {
  319. X                    ex = replaceexprexpr(copyexpr(c2), c1->args[0], c1->args[1]);
  320. X                    i = expr_is_bool(ex, !not2);
  321. X                    freeexpr(ex);
  322. X                    if (i)
  323. X                        return 1;
  324. X                }
  325. X                if (c1->args[1]->kind == EK_VAR) {
  326. X                    ex = replaceexprexpr(copyexpr(c2), c1->args[1], c1->args[0]);
  327. X                    i = expr_is_bool(ex, !not2);
  328. X                    freeexpr(ex);
  329. X                    if (i)
  330. X                        return 1;
  331. X                }
  332. X            }
  333. X            break;
  334. X
  335. X    default:
  336. X        break;
  337. X    }
  338. X    if (not1 == not2 && exprequiv(c1, c2)) {    /* c1 -> c1 */
  339. X        return 1;
  340. X    }
  341. X    return 0;
  342. X}
  343. X
  344. X
  345. X
  346. X
  347. X
  348. Xvoid infiniteloop(sp)
  349. XStmt *sp;
  350. X{
  351. X    switch (infloopstyle) {
  352. X
  353. X        case 1:      /* write "for (;;) ..." */
  354. X            sp->kind = SK_FOR;
  355. X            freeexpr(sp->exp1);
  356. X            sp->exp1 = NULL;
  357. X            break;
  358. X
  359. X        case 2:      /* write "while (1) ..." */
  360. X            sp->kind = SK_WHILE;
  361. X            freeexpr(sp->exp1);
  362. X            sp->exp1 = makeexpr_val(make_ord(tp_boolean, 1));
  363. X            break;
  364. X
  365. X        case 3:      /* write "do ... while (1)" */
  366. X            sp->kind = SK_REPEAT;
  367. X            freeexpr(sp->exp1);
  368. X            sp->exp1 = makeexpr_val(make_ord(tp_boolean, 1));
  369. X            break;
  370. X
  371. X        default:     /* leave it alone */
  372. X            break;
  373. X
  374. X    }
  375. X}
  376. X
  377. X
  378. X
  379. X
  380. X
  381. XExpr *print_func(ex)
  382. XExpr *ex;
  383. X{
  384. X    if (!ex || ex->kind != EK_BICALL)
  385. X    return NULL;
  386. X    if ((!strcmp(ex->val.s, "printf") &&
  387. X     ex->args[0]->kind == EK_CONST) ||
  388. X    !strcmp(ex->val.s, "putchar") ||
  389. X    !strcmp(ex->val.s, "puts"))
  390. X    return ex_output;
  391. X    if ((!strcmp(ex->val.s, "fprintf") ||
  392. X     !strcmp(ex->val.s, "sprintf")) &&
  393. X    ex->args[1]->kind == EK_CONST)
  394. X    return ex->args[0];
  395. X    if (!strcmp(ex->val.s, "putc") ||
  396. X    !strcmp(ex->val.s, "fputc") ||
  397. X    !strcmp(ex->val.s, "fputs"))
  398. X    return ex->args[1];
  399. X    return NULL;
  400. X}
  401. X
  402. X
  403. X
  404. Xint printnl_func(ex)
  405. XExpr *ex;
  406. X{
  407. X    char *cp, ch;
  408. X    int i, len;
  409. X
  410. X    if (debug>2) { fprintf(outf,"printnl_func("); dumpexpr(ex); fprintf(outf, ")\n"); }
  411. X    if (!strcmp(ex->val.s, "printf") ||
  412. X    !strcmp(ex->val.s, "puts") ||
  413. X    !strcmp(ex->val.s, "fputs")) {
  414. X    if (ex->args[0]->kind != EK_CONST)
  415. X        return 0;
  416. X    cp = ex->args[0]->val.s;
  417. X    len = ex->args[0]->val.i;
  418. X    } else if (!strcmp(ex->val.s, "fprintf")) {
  419. X    if (ex->args[1]->kind != EK_CONST)
  420. X        return 0;
  421. X    cp = ex->args[1]->val.s;
  422. X    len = ex->args[1]->val.i;
  423. X    } else if (!strcmp(ex->val.s, "putchar") ||
  424. X           !strcmp(ex->val.s, "putc") ||
  425. X           !strcmp(ex->val.s, "fputc")) {
  426. X    if (ex->args[0]->kind != EK_CONST)
  427. X        return 0;
  428. X    ch = ex->args[0]->val.i;
  429. X    cp = &ch;
  430. X    len = 1;
  431. X    } else
  432. X    return 0;
  433. X    for (i = 1; i <= len; i++)
  434. X    if (*cp++ != '\n')
  435. X        return 0;
  436. X    return len + (!strcmp(ex->val.s, "puts"));
  437. X}
  438. X
  439. X
  440. X
  441. XExpr *chg_printf(ex)
  442. XExpr *ex;
  443. X{
  444. X    Expr *fex;
  445. X
  446. X    if (debug>2) { fprintf(outf,"chg_printf("); dumpexpr(ex); fprintf(outf, ")\n"); }
  447. X    if (!strcmp(ex->val.s, "putchar")) {
  448. X    ex = makeexpr_sprintfify(grabarg(ex, 0));
  449. X    canceltempvar(istempvar(ex->args[0]));
  450. X    strchange(&ex->val.s, "printf");
  451. X    delfreearg(&ex, 0);
  452. X    ex->val.type = tp_void;
  453. X    } else if (!strcmp(ex->val.s, "putc") ||
  454. X           !strcmp(ex->val.s, "fputc") ||
  455. X           !strcmp(ex->val.s, "fputs")) {
  456. X    fex = copyexpr(ex->args[1]);
  457. X    ex = makeexpr_sprintfify(grabarg(ex, 0));
  458. X    canceltempvar(istempvar(ex->args[0]));
  459. X    strchange(&ex->val.s, "fprintf");
  460. X    ex->args[0] = fex;
  461. X    ex->val.type = tp_void;
  462. X    } else if (!strcmp(ex->val.s, "puts")) {
  463. X    ex = makeexpr_concat(makeexpr_sprintfify(grabarg(ex, 0)),
  464. X                 makeexpr_string("\n"), 1);
  465. X    strchange(&ex->val.s, "printf");
  466. X    delfreearg(&ex, 0);
  467. X    ex->val.type = tp_void;
  468. X    }
  469. X    if (!strcmp(ex->val.s, "fprintf") && exprsame(ex->args[0], ex_output, 1)) {
  470. X    delfreearg(&ex, 0);
  471. X    strchange(&ex->val.s, "printf");
  472. X    }
  473. X    return ex;
  474. X}
  475. X
  476. X
  477. XExpr *mix_printf(ex, ex2)
  478. XExpr *ex, *ex2;
  479. X{
  480. X    int i;
  481. X
  482. X    ex = chg_printf(ex);
  483. X    if (debug>2) { fprintf(outf,"chg_printf returns "); dumpexpr(ex); fprintf(outf, "\n"); }
  484. X    ex2 = chg_printf(copyexpr(ex2));
  485. X    if (debug>2) { fprintf(outf,"chg_printf returns "); dumpexpr(ex2);fprintf(outf, "\n"); }
  486. X    i = (!strcmp(ex->val.s, "printf")) ? 0 : 1;
  487. X    ex->args[i] = makeexpr_concat(ex->args[i], ex2->args[i], 0);
  488. X    for (i++; i < ex2->nargs; i++) {
  489. X    insertarg(&ex, ex->nargs, ex2->args[i]);
  490. X    }
  491. X    return ex;
  492. X}
  493. X
  494. X
  495. X
  496. X
  497. X
  498. X
  499. Xvoid eatstmt(spp)
  500. XStmt **spp;
  501. X{
  502. X    Stmt *sp = *spp;
  503. X
  504. X    if (debug>2) { fprintf(outf, "eatstmt on:\n"); dumpstmt(sp, 5); }
  505. X    *spp = sp->next;
  506. X    sp->next = NULL;
  507. X    free_stmt(sp);
  508. X}
  509. X
  510. X
  511. X
  512. Xint haslabels(sp)
  513. XStmt *sp;
  514. X{
  515. X    if (!sp)
  516. X        return 0;
  517. X    if (haslabels(sp->stm1) || haslabels(sp->stm2))
  518. X        return 1;
  519. X    return (sp->kind == SK_LABEL);
  520. X}
  521. X
  522. X
  523. X
  524. Xvoid fixblock(spp, thereturn)
  525. XStmt **spp, *thereturn;
  526. X{
  527. X    Stmt *sp, *sp1, *sp2, *sp3, **spp2, *thisreturn;
  528. X    Expr *ex;
  529. X    Meaning *tvar, *mp;
  530. X    int save_tryblock;
  531. X    short save_tryflag;
  532. X    int i, j, de1, de2;
  533. X    long saveserial = curserial;
  534. X
  535. X    while ((sp = *spp)) {
  536. X        sp2 = sp->next;
  537. X        sp->next = NULL;
  538. X        sp = fix_statement(*spp);
  539. X        if (!sp) {
  540. X            *spp = sp2;
  541. X            continue;
  542. X        }
  543. X        *spp = sp;
  544. X        for (sp3 = sp; sp3->next; sp3 = sp3->next) ;
  545. X        sp3->next = sp2;
  546. X        if (!sp->next)
  547. X            thisreturn = thereturn;
  548. X        else if (sp->next->kind == SK_RETURN ||
  549. X                 (sp->next->kind == SK_ASSIGN &&
  550. X                  isescape(sp->next->exp1)))
  551. X            thisreturn = sp->next;
  552. X        else
  553. X            thisreturn = NULL;
  554. X    if (sp->serial >= 0)
  555. X        curserial = sp->serial;
  556. X        switch (sp->kind) {
  557. X
  558. X            case SK_ASSIGN:
  559. X            if (sp->exp1)
  560. X            sp->exp1 = fixexpr(sp->exp1, ENV_STMT);
  561. X        if (!sp->exp1)
  562. X            intwarning("fixblock", "sp->exp1 == NULL in SK_ASSIGN");
  563. X                if (!sp->exp1 || nosideeffects(sp->exp1, 1)) {
  564. X            eatstmt(spp);
  565. X            continue;
  566. X                } else {
  567. X                    switch (sp->exp1->kind) {
  568. X
  569. X                        case EK_COND:
  570. X                            *spp = makestmt_if(sp->exp1->args[0],
  571. X                                               makestmt_call(sp->exp1->args[1]),
  572. X                                               makestmt_call(sp->exp1->args[2]));
  573. X                            (*spp)->next = sp->next;
  574. X                            continue;    /* ... to fix this new if statement */
  575. X
  576. X                        case EK_ASSIGN:
  577. X                            if (sp->exp1->args[1]->kind == EK_COND && usecommas != 1) {
  578. X                                *spp = makestmt_if(sp->exp1->args[1]->args[0],
  579. X                                                   makestmt_assign(copyexpr(sp->exp1->args[0]),
  580. X                                                                   sp->exp1->args[1]->args[1]),
  581. X                                                   makestmt_assign(sp->exp1->args[0],
  582. X                                                                   sp->exp1->args[1]->args[2]));
  583. X                                (*spp)->next = sp->next;
  584. X                                continue;
  585. X                            }
  586. X                if (isescape(sp->exp1->args[1])) {
  587. X                                sp->exp1 = grabarg(sp->exp1, 1);
  588. X                continue;
  589. X                            }
  590. X                if (exprsame(sp->exp1->args[0], sp->exp1->args[1], 1)) {
  591. X                              /*  *spp = sp->next;  */
  592. X                                sp->exp1 = grabarg(sp->exp1, 0);
  593. X                                continue;
  594. X                            }
  595. X                if (sp->exp1->args[1]->kind == EK_BICALL) {
  596. X                if (!strcmp(sp->exp1->args[1]->val.s,
  597. X                        getfbufname) &&
  598. X                    buildreads == 1 &&
  599. X                    sp->next &&
  600. X                    sp->next->kind == SK_ASSIGN &&
  601. X                    sp->next->exp1->kind == EK_BICALL &&
  602. X                    !strcmp(sp->next->exp1->val.s,
  603. X                        getname) &&
  604. X                    expr_has_address(sp->exp1->args[0]) &&
  605. X                    similartypes(sp->exp1->args[0]->val.type,
  606. X                         sp->exp1->args[1]->args[0]->val.type->basetype->basetype) &&
  607. X                    exprsame(sp->exp1->args[1]->args[0],
  608. X                         sp->next->exp1->args[0], 1)) {
  609. X                    eatstmt(&sp->next);
  610. X                    ex = makeexpr_bicall_4("fread", tp_integer,
  611. X                               makeexpr_addr(sp->exp1->args[0]),
  612. X                               makeexpr_sizeof(sp->exp1->args[1]->args[1], 0),
  613. X                               makeexpr_long(1),
  614. X                               sp->exp1->args[1]->args[0]);
  615. X                    FREE(sp->exp1);
  616. X                    sp->exp1 = ex;
  617. X                    continue;
  618. X                }
  619. X                if (!strcmp(sp->exp1->args[1]->val.s,
  620. X                        chargetfbufname) &&
  621. X                    buildreads != 0 &&
  622. X                    sp->next &&
  623. X                    sp->next->kind == SK_ASSIGN &&
  624. X                    sp->next->exp1->kind == EK_BICALL &&
  625. X                    !strcmp(sp->next->exp1->val.s,
  626. X                        chargetname) &&
  627. X                    expr_has_address(sp->exp1->args[0]) &&
  628. X                    exprsame(sp->exp1->args[1]->args[0],
  629. X                         sp->next->exp1->args[0], 1)) {
  630. X                    eatstmt(&sp->next);
  631. X                    strchange(&sp->exp1->args[1]->val.s,
  632. X                          "getc");
  633. X                    continue;
  634. X                }
  635. X                }
  636. X                            break;
  637. X
  638. X                        case EK_BICALL:
  639. X                            if (!strcmp(sp->exp1->val.s, name_ESCAPE)) {
  640. X                                if (fixexpr_tryblock) {
  641. X                                    *spp = makestmt_assign(makeexpr_var(mp_escapecode),
  642. X                                                           grabarg(sp->exp1, 0));
  643. X                                    (*spp)->next = makestmt(SK_GOTO);
  644. X                                    (*spp)->next->exp1 = makeexpr_name(format_s(name_LABEL,
  645. X                                                                                format_d("try%d",
  646. X                                                                                         fixexpr_tryblock)),
  647. X                                                                       tp_integer);
  648. X                                    (*spp)->next->next = sp->next;
  649. X                                    fixexpr_tryflag = 1;
  650. X                                    continue;
  651. X                                }
  652. X                            } else if (!strcmp(sp->exp1->val.s, name_ESCIO)) {
  653. X                                if (fixexpr_tryblock) {
  654. X                                    *spp = makestmt_assign(makeexpr_var(mp_escapecode),
  655. X                                                           makeexpr_long(-10));
  656. X                                    (*spp)->next = makestmt_assign(makeexpr_var(mp_ioresult),
  657. X                                                                   grabarg(sp->exp1, 0));
  658. X                                    (*spp)->next->next = makestmt(SK_GOTO);
  659. X                                    (*spp)->next->next->exp1 = makeexpr_name(format_s(name_LABEL,
  660. X                                                                                      format_d("try%d",
  661. X                                                                                               fixexpr_tryblock)),
  662. X                                                                             tp_integer);
  663. X                                    (*spp)->next->next->next = sp->next;
  664. X                                    fixexpr_tryflag = 1;
  665. X                                    continue;
  666. X                                }
  667. X                            }
  668. X                if (!strcmp(sp->exp1->val.s, putfbufname) &&
  669. X                buildwrites == 1 &&
  670. X                sp->next &&
  671. X                sp->next->kind == SK_ASSIGN &&
  672. X                sp->next->exp1->kind == EK_BICALL &&
  673. X                !strcmp(sp->next->exp1->val.s,
  674. X                    putname) &&
  675. X                exprsame(sp->exp1->args[0],
  676. X                     sp->next->exp1->args[0], 1)) {
  677. X                eatstmt(&sp->next);
  678. X                if (!expr_has_address(sp->exp1->args[2]) ||
  679. X                    sp->exp1->args[2]->val.type !=
  680. X                        sp->exp1->args[1]->val.type) {
  681. X                    tvar = maketempvar(sp->exp1->args[1]->val.type,
  682. X                               name_TEMP);
  683. X                    sp2 = makestmt_assign(makeexpr_var(tvar),
  684. X                              sp->exp1->args[2]);
  685. X                    sp2->next = sp;
  686. X                    *spp = sp2;
  687. X                    sp->exp1->args[2] = makeexpr_var(tvar);
  688. X                    freetempvar(tvar);
  689. X                }
  690. X                ex = makeexpr_bicall_4("fwrite", tp_integer,
  691. X                               makeexpr_addr(sp->exp1->args[2]),
  692. X                               makeexpr_sizeof(sp->exp1->args[1], 0),
  693. X                               makeexpr_long(1),
  694. X                               sp->exp1->args[0]);
  695. X                FREE(sp->exp1);
  696. X                sp->exp1 = ex;
  697. X                continue;
  698. X                }
  699. X                if (!strcmp(sp->exp1->val.s, charputfbufname) &&
  700. X                buildwrites != 0 &&
  701. X                sp->next &&
  702. X                sp->next->kind == SK_ASSIGN &&
  703. X                sp->next->exp1->kind == EK_BICALL &&
  704. X                !strcmp(sp->next->exp1->val.s,
  705. X                    charputname) &&
  706. X                exprsame(sp->exp1->args[0],
  707. X                     sp->next->exp1->args[0], 1)) {
  708. X                eatstmt(&sp->next);
  709. X                swapexprs(sp->exp1->args[0],
  710. X                      sp->exp1->args[1]);
  711. X                strchange(&sp->exp1->val.s, "putc");
  712. X                continue;
  713. X                }
  714. X                if ((!strcmp(sp->exp1->val.s, resetbufname) ||
  715. X                 !strcmp(sp->exp1->val.s, setupbufname)) &&
  716. X                (mp = isfilevar(sp->exp1->args[0])) != NULL &&
  717. X                !mp->bufferedfile) {
  718. X                eatstmt(spp);
  719. X                continue;
  720. X                }
  721. X                ex = print_func(sp->exp1);
  722. X                if (ex && sp->next && mixwritelns &&
  723. X                sp->next->kind == SK_ASSIGN &&
  724. X                exprsame(ex, print_func(sp->next->exp1), 1) &&
  725. X                (printnl_func(sp->exp1) ||
  726. X                 printnl_func(sp->next->exp1))) {
  727. X                sp->exp1 = mix_printf(sp->exp1,
  728. X                              sp->next->exp1);
  729. X                eatstmt(&sp->next);
  730. X                continue;
  731. X                }
  732. X                            break;
  733. X
  734. X                        case EK_FUNCTION:
  735. X                        case EK_SPCALL:
  736. X                        case EK_POSTINC:
  737. X                        case EK_POSTDEC:
  738. X                        case EK_AND:
  739. X                        case EK_OR:
  740. X                            break;
  741. X
  742. X                        default:
  743. X                            spp2 = spp;
  744. X                            for (i = 0; i < sp->exp1->nargs; i++) {
  745. X                                *spp2 = makestmt_call(sp->exp1->args[i]);
  746. X                                spp2 = &(*spp2)->next;
  747. X                            }
  748. X                            *spp2 = sp->next;
  749. X                            continue;    /* ... to fix these new statements */
  750. X
  751. X                    }
  752. X                }
  753. X                break;
  754. X
  755. X            case SK_IF:
  756. X                fixblock(&sp->stm1, thisreturn);
  757. X                fixblock(&sp->stm2, thisreturn);
  758. X                if (!sp->stm1) {
  759. X                    if (!sp->stm2) {
  760. X                        sp->kind = SK_ASSIGN;
  761. X                        continue;
  762. X                    } else {
  763. X            if (sp->stm2->kind == SK_IF && sp->stm2->exp2) {
  764. X                freeexpr(sp->stm2->exp2);
  765. X                sp->stm2->exp2 = NULL;
  766. X            }
  767. X                        sp->exp1 = makeexpr_not(sp->exp1);   /* if (x) else foo  =>  if (!x) foo */
  768. X                        swapstmts(sp->stm1, sp->stm2);
  769. X            /* Ought to exchange comments for then/else parts */
  770. X                    }
  771. X                }
  772. X        /* At this point we know sp1 != NULL */
  773. X                if (thisreturn) {
  774. X                    if (thisreturn->kind == SK_WHILE) {
  775. X                        if (usebreaks) {
  776. X                            sp1 = sp->stm1;
  777. X                            while (sp1->next)
  778. X                                sp1 = sp1->next;
  779. X                            if (sp->stm2) {
  780. X                sp2 = sp->stm2;
  781. X                while (sp2->next)
  782. X                    sp2 = sp2->next;
  783. X                                i = stmtcount(sp->stm1);
  784. X                                j = stmtcount(sp->stm2);
  785. X                                if (j >= breaklimit && i <= 2 && j > i*2 &&
  786. X                                    ((implies(sp->exp1, thisreturn->exp1, 0, 1) &&
  787. X                      !checkexprchanged(sp->stm1, sp->exp1)) ||
  788. X                     (sp1->kind == SK_ASSIGN &&
  789. X                      implies(sp1->exp1, thisreturn->exp1, 0, 1)))) {
  790. X                                    sp1->next = makestmt(SK_BREAK);
  791. X                                } else if (i >= breaklimit && j <= 2 && i > j*2 &&
  792. X                                           ((implies(sp->exp1, thisreturn->exp1, 1, 1) &&
  793. X                         !checkexprchanged(sp->stm2, sp->exp1)) ||
  794. X                        (sp2->kind == SK_ASSIGN &&
  795. X                         implies(sp2->exp1, thisreturn->exp1, 0, 1)))) {
  796. X                                    sp2->next = makestmt(SK_BREAK);
  797. X                } else if (!checkconst(sp->exp2, 1)) {
  798. X                    /* not part of an else-if */
  799. X                    if (j >= continuelimit) {
  800. X                    sp1->next = makestmt(SK_CONTINUE);
  801. X                    } else if (i >= continuelimit) {
  802. X                    sp2->next = makestmt(SK_CONTINUE);
  803. X                    }
  804. X                }
  805. X                } else {
  806. X                                i = stmtcount(sp->stm1);
  807. X                                if (i >= breaklimit &&
  808. X                                    implies(sp->exp1, thisreturn->exp1, 1, 1)) {
  809. X                                    sp->exp1 = makeexpr_not(sp->exp1);
  810. X                                    sp1->next = sp->next;
  811. X                                    sp->next = sp->stm1;
  812. X                                    sp->stm1 = makestmt(SK_BREAK);
  813. X                                } else if (i >= continuelimit) {
  814. X                                    sp->exp1 = makeexpr_not(sp->exp1);
  815. X                                    sp1->next = sp->next;
  816. X                                    sp->next = sp->stm1;
  817. X                                    sp->stm1 = makestmt(SK_CONTINUE);
  818. X                                }
  819. X                            }
  820. X                        }
  821. X                    } else {
  822. X                        if (usereturns) {
  823. X                            sp2 = sp->stm1;
  824. X                            while (sp2->next)
  825. X                                sp2 = sp2->next;
  826. X                            if (sp->stm2) {
  827. X                                /* if (x) foo; else bar; (return;)  =>  if (x) {foo; return;} bar; */
  828. X                                if (stmtcount(sp->stm2) >= returnlimit) {
  829. X                    if (!deadendblock(sp->stm1))
  830. X                    sp2->next = copystmt(thisreturn);
  831. X                                } else if (stmtcount(sp->stm1) >= returnlimit) {
  832. X                                    sp2 = sp->stm2;
  833. X                                    while (sp2->next)
  834. X                                        sp2 = sp2->next;
  835. X                    if (!deadendblock(sp->stm2))
  836. X                    sp2->next = copystmt(thisreturn);
  837. X                                }
  838. X                            } else {      /* if (x) foo; (return;)  =>  if (!x) return; foo; */
  839. X                                if (stmtcount(sp->stm1) >= returnlimit) {
  840. X                                    sp->exp1 = makeexpr_not(sp->exp1);
  841. X                                    sp2->next = sp->next;
  842. X                                    sp->next = sp->stm1;
  843. X                                    sp->stm1 = copystmt(thisreturn);
  844. X                                }
  845. X                            }
  846. X                        }
  847. X                    }
  848. X                }
  849. X                if (!checkconst(sp->exp2, 1)) {    /* not part of an else-if */
  850. X                    de1 = deadendblock(sp->stm1);
  851. X                    de2 = deadendblock(sp->stm2);
  852. X                    if (de2 && !de1) {
  853. X                        sp->exp1 = makeexpr_not(sp->exp1);
  854. X                        swapstmts(sp->stm1, sp->stm2);
  855. X                        de1 = 1, de2 = 0;
  856. X                    }
  857. X                    if (de1 && !de2 && sp->stm2) {
  858. X            if (sp->stm2->kind == SK_IF && sp->stm2->exp2) {
  859. X                freeexpr(sp->stm2->exp2);
  860. X                sp->stm2->exp2 = NULL;
  861. X            }
  862. X                        for (sp2 = sp->stm2; sp2->next; sp2 = sp2->next) ;
  863. X                        sp2->next = sp->next;
  864. X                        sp->next = sp->stm2;      /* if (x) ESCAPE else foo  =>  if (x) ESCAPE; foo */
  865. X                        sp->stm2 = NULL;
  866. X                    }
  867. X                }
  868. X                sp->exp1 = fixexpr(sp->exp1, ENV_BOOL);
  869. X                break;
  870. X
  871. X            case SK_WHILE:
  872. X                if (whilefgets &&    /* handle "while eof(f) do readln(f,...)" */
  873. X            sp->stm1->kind == SK_ASSIGN &&
  874. X            sp->stm1->exp1->kind == EK_BICALL &&
  875. X            !strcmp(sp->stm1->exp1->val.s, "fgets") &&
  876. X            nosideeffects(sp->stm1->exp1->args[0], 1) &&
  877. X            nosideeffects(sp->stm1->exp1->args[1], 1) &&
  878. X            nosideeffects(sp->stm1->exp1->args[2], 1)) {
  879. X            if ((sp->exp1->kind == EK_NOT &&
  880. X             sp->exp1->args[0]->kind == EK_BICALL && *eofname &&
  881. X             !strcmp(sp->exp1->args[0]->val.s, eofname) &&
  882. X             exprsame(sp->exp1->args[0]->args[0],
  883. X                  sp->stm1->exp1->args[2], 1)) ||
  884. X            (sp->exp1->kind == EK_EQ &&
  885. X             sp->exp1->args[0]->kind == EK_BICALL &&
  886. X             !strcmp(sp->exp1->args[0]->val.s, "feof") &&
  887. X             checkconst(sp->exp1->args[1], 0) &&
  888. X             exprsame(sp->exp1->args[0]->args[0],
  889. X                  sp->stm1->exp1->args[2], 1))) {
  890. X            sp->stm1->exp1->val.type = tp_strptr;
  891. X            sp->exp1 = makeexpr_rel(EK_NE,
  892. X                        sp->stm1->exp1,
  893. X                        makeexpr_nil());
  894. X            sp->stm1 = sp->stm1->next;
  895. X            }
  896. X                }
  897. X                fixblock(&sp->stm1, sp);
  898. X                sp->exp1 = fixexpr(sp->exp1, ENV_BOOL);
  899. X                if (checkconst(sp->exp1, 1))
  900. X                    infiniteloop(sp);
  901. X                break;
  902. X
  903. X            case SK_REPEAT:
  904. X                fixblock(&sp->stm1, NULL);
  905. X                sp->exp1 = fixexpr(sp->exp1, ENV_BOOL);
  906. X                if (checkconst(sp->exp1, 1))
  907. X                    infiniteloop(sp);
  908. X                break;
  909. X
  910. X            case SK_TRY:
  911. X                save_tryblock = fixexpr_tryblock;
  912. X                save_tryflag = fixexpr_tryflag;
  913. X                fixexpr_tryblock = sp->exp1->val.i;
  914. X                fixexpr_tryflag = 0;
  915. X                fixblock(&sp->stm1, NULL);
  916. X                if (fixexpr_tryflag)
  917. X                    sp->exp2 = makeexpr_long(1);
  918. X                fixexpr_tryblock = save_tryblock;
  919. X                fixexpr_tryflag = save_tryflag;
  920. X                fixblock(&sp->stm2, NULL);
  921. X                break;
  922. X
  923. X            case SK_BODY:
  924. X                fixblock(&sp->stm1, thisreturn);
  925. X                break;
  926. X
  927. X            case SK_CASE:
  928. X                fixblock(&sp->stm1, NULL);
  929. X                sp->exp1 = fixexpr(sp->exp1, ENV_EXPR);
  930. X                if (!sp->stm1) {    /* empty case */
  931. X                    sp->kind = SK_ASSIGN;
  932. X                    continue;
  933. X                } else if (sp->stm1->kind != SK_CASELABEL) {   /* default only */
  934. X                    for (sp2 = sp->stm1; sp2->next; sp2 = sp2->next) ;
  935. X                    sp2->next = sp->next;
  936. X                    sp->next = sp->stm1;
  937. X                    sp->kind = SK_ASSIGN;
  938. X                    sp->stm1 = NULL;
  939. X                    continue;
  940. X                }
  941. X                break;
  942. X
  943. X            default:
  944. X                fixblock(&sp->stm1, NULL);
  945. X                fixblock(&sp->stm2, NULL);
  946. X                sp->exp1 = fixexpr(sp->exp1, ENV_EXPR);
  947. X                sp->exp2 = fixexpr(sp->exp2, ENV_EXPR);
  948. X                sp->exp3 = fixexpr(sp->exp3, ENV_EXPR);
  949. X                if (sp->next &&
  950. X                    (sp->kind == SK_GOTO ||
  951. X                     sp->kind == SK_BREAK ||
  952. X                     sp->kind == SK_CONTINUE ||
  953. X                     sp->kind == SK_RETURN) &&
  954. X                    !haslabels(sp->next)) {
  955. X                    if (elimdeadcode) {
  956. X                        note("Deleting unreachable code [255]");
  957. X                        while (sp->next && !haslabels(sp->next))
  958. X                            eatstmt(&sp->next);
  959. X                    } else {
  960. X                        note("Code is unreachable [256]");
  961. X                    }
  962. X                } else if (sp->kind == SK_RETURN &&
  963. X                           thisreturn &&
  964. X                           thisreturn->kind == SK_RETURN &&
  965. X                           exprsame(sp->exp1, thisreturn->exp1, 1)) {
  966. X                    eatstmt(spp);
  967. X            continue;
  968. X                }
  969. X                break;
  970. X        }
  971. X        spp = &sp->next;
  972. X    }
  973. X    saveserial = curserial;
  974. X}
  975. X
  976. X
  977. X
  978. X
  979. X/* Convert comma expressions into multiple statements */
  980. X
  981. XStatic int checkcomma_expr(spp, exp)
  982. XStmt **spp;
  983. XExpr **exp;
  984. X{
  985. X    Stmt *sp;
  986. X    Expr *ex = *exp;
  987. X    int i, res;
  988. X
  989. X    switch (ex->kind) {
  990. X
  991. X        case EK_COMMA:
  992. X            if (spp) {
  993. X                res = checkcomma_expr(spp, &ex->args[ex->nargs-1]);
  994. X                for (i = ex->nargs-1; --i >= 0; ) {
  995. X                    sp = makestmt(SK_ASSIGN);
  996. X                    sp->exp1 = ex->args[i];
  997. X                    sp->next = *spp;
  998. X                    *spp = sp;
  999. X                    res = checkcomma_expr(spp, &ex->args[i]);
  1000. X                }
  1001. X                *exp = ex->args[ex->nargs-1];
  1002. X            }
  1003. X            return 1;
  1004. X
  1005. X        case EK_COND:
  1006. X            if (isescape(ex->args[1]) && spp &&
  1007. X                !isescape(ex->args[2])) {
  1008. X                swapexprs(ex->args[1], ex->args[2]);
  1009. X                ex->args[0] = makeexpr_not(ex->args[0]);
  1010. X            }
  1011. X            if (isescape(ex->args[2])) {
  1012. X                if (spp) {
  1013. X                    res = checkcomma_expr(spp, &ex->args[1]);
  1014. X                    if (ex->args[0]->kind == EK_ASSIGN) {
  1015. X                        sp = makestmt(SK_ASSIGN);
  1016. X                        sp->exp1 = copyexpr(ex->args[0]);
  1017. X                        sp->next = makestmt(SK_IF);
  1018. X                        sp->next->next = *spp;
  1019. X                        *spp = sp;
  1020. X                        res = checkcomma_expr(spp, &sp->exp1);
  1021. X                        ex->args[0] = grabarg(ex->args[0], 0);
  1022. X                        sp = sp->next;
  1023. X                    } else {
  1024. X                        sp = makestmt(SK_IF);
  1025. X                        sp->next = *spp;
  1026. X                        *spp = sp;
  1027. X                    }
  1028. X                    sp->exp1 = makeexpr_not(ex->args[0]);
  1029. X                    sp->stm1 = makestmt(SK_ASSIGN);
  1030. X                    sp->stm1->exp1 = eatcasts(ex->args[2]);
  1031. X                    res = checkcomma_expr(&sp->stm1, &ex->args[2]);
  1032. X                    res = checkcomma_expr(spp, &sp->exp1);
  1033. X                    *exp = ex->args[1];
  1034. X                }
  1035. X                return 1;
  1036. X            }
  1037. X            return checkcomma_expr(spp, &ex->args[0]);
  1038. X
  1039. X        case EK_AND:
  1040. X        case EK_OR:
  1041. X            return checkcomma_expr(spp, &ex->args[0]);
  1042. X
  1043. X    default:
  1044. X        res = 0;
  1045. X        for (i = ex->nargs; --i >= 0; ) {
  1046. X        res += checkcomma_expr(spp, &ex->args[i]);
  1047. X        }
  1048. X        return res;
  1049. X
  1050. X    }
  1051. X}
  1052. X
  1053. X
  1054. X
  1055. XStatic void checkcommas(spp)
  1056. XStmt **spp;
  1057. X{
  1058. X    Stmt *sp;
  1059. X    int res;
  1060. X
  1061. X    while ((sp = *spp)) {
  1062. X        checkcommas(&sp->stm1);
  1063. X        checkcommas(&sp->stm2);
  1064. X        switch (sp->kind) {
  1065. X
  1066. X            case SK_ASSIGN:
  1067. X            case SK_IF:
  1068. X            case SK_CASE:
  1069. X            case SK_RETURN:
  1070. X                if (sp->exp1)
  1071. X                    res = checkcomma_expr(spp, &sp->exp1);
  1072. X                break;
  1073. X
  1074. X            case SK_WHILE:
  1075. X                /* handle the argument */
  1076. X                break;
  1077. X
  1078. X            case SK_REPEAT:
  1079. X                /* handle the argument */
  1080. X                break;
  1081. X
  1082. X            case SK_FOR:
  1083. X        if (sp->exp1)
  1084. X            res = checkcomma_expr(spp, &sp->exp1);
  1085. X                /* handle the other arguments */
  1086. X                break;
  1087. X
  1088. X        default:
  1089. X        break;
  1090. X        }
  1091. X        spp = &sp->next;
  1092. X    }
  1093. X}
  1094. X
  1095. X
  1096. X
  1097. X
  1098. XStatic int checkvarchangeable(ex, mp)
  1099. XExpr *ex;
  1100. XMeaning *mp;
  1101. X{
  1102. X    switch (ex->kind) {
  1103. X
  1104. X        case EK_VAR:
  1105. X            return (mp == (Meaning *)ex->val.i);
  1106. X
  1107. X        case EK_DOT:
  1108. X        case EK_INDEX:
  1109. X            return checkvarchangeable(ex->args[0], mp);
  1110. X
  1111. X    default:
  1112. X        return 0;
  1113. X    }
  1114. X}
  1115. X
  1116. X
  1117. X
  1118. Xint checkvarchangedexpr(ex, mp, addrokay)
  1119. XExpr *ex;
  1120. XMeaning *mp;
  1121. Xint addrokay;
  1122. X{
  1123. X    int i;
  1124. X    Meaning *mp3;
  1125. X    unsigned int safemask = 0;
  1126. X
  1127. X    switch (ex->kind) {
  1128. X
  1129. X        case EK_FUNCTION:
  1130. X        case EK_SPCALL:
  1131. X            if (ex->kind == EK_FUNCTION) {
  1132. X                i = 0;
  1133. X                mp3 = ((Meaning *)ex->val.i)->type->fbase;
  1134. X            } else {
  1135. X                i = 1;
  1136. X                if (ex->args[0]->val.type->kind != TK_PROCPTR)
  1137. X                    return 1;
  1138. X                mp3 = ex->args[0]->val.type->basetype->fbase;
  1139. X            }
  1140. X            for ( ; i < ex->nargs && i < 16; i++) {
  1141. X                if (!mp3) {
  1142. X                    intwarning("checkvarchangedexpr", "Too many arguments for EK_FUNCTION [266]");
  1143. X                    break;
  1144. X                }
  1145. X                if (mp3->kind == MK_PARAM &&
  1146. X                    (mp3->type->kind == TK_ARRAY ||
  1147. X                     mp3->type->kind == TK_STRING ||
  1148. X                     mp3->type->kind == TK_SET))
  1149. X                    safemask |= 1<<i;
  1150. X                if (mp3->kind == MK_VARPARAM &&
  1151. X                    mp3->type == tp_strptr && mp3->anyvarflag)
  1152. X                    i++;
  1153. X                mp3 = mp3->xnext;
  1154. X            }
  1155. X            if (mp3)
  1156. X                intwarning("checkvarchangedexpr", "Too few arguments for EK_FUNCTION [267]");
  1157. X            break;
  1158. X
  1159. X        case EK_VAR:
  1160. X            if (mp == (Meaning *)ex->val.i) {
  1161. X                if ((mp->type->kind == TK_ARRAY ||
  1162. X                     mp->type->kind == TK_STRING ||
  1163. X                     mp->type->kind == TK_SET) &&
  1164. X                    ex->val.type->kind == TK_POINTER && !addrokay)
  1165. X                    return 1;   /* must be an implicit & */
  1166. X            }
  1167. X            break;
  1168. X
  1169. X        case EK_ADDR:
  1170. X        case EK_ASSIGN:
  1171. X        case EK_POSTINC:
  1172. X        case EK_POSTDEC:
  1173. X            if (checkvarchangeable(ex->args[0], mp))
  1174. X                return 1;
  1175. X            break;
  1176. X
  1177. X        case EK_BICALL:
  1178. X            if (structuredfunc(ex) && checkvarchangeable(ex->args[0], mp))
  1179. X                return 1;
  1180. X            safemask = safemask_bicall(ex->val.s);
  1181. X            break;
  1182. X            /* In case calls to these functions were lazy and passed
  1183. X               the array rather than its (implicit) address.  Other
  1184. X               BICALLs had better be careful about their arguments. */
  1185. X
  1186. X        case EK_PLUS:
  1187. X            if (addrokay)         /* to keep from being scared by pointer */
  1188. X                safemask = ~0;    /*  arithmetic on string being passed */
  1189. X            break;                /*  to functions. */
  1190. X
  1191. X    default:
  1192. X        break;
  1193. X    }
  1194. X    for (i = 0; i < ex->nargs; i++) {
  1195. X        if (checkvarchangedexpr(ex->args[i], mp, safemask&1))
  1196. X            return 1;
  1197. X        safemask >>= 1;
  1198. X    }
  1199. X    return 0;
  1200. X}
  1201. X
  1202. X
  1203. X
  1204. Xint checkvarchanged(sp, mp)
  1205. XStmt *sp;
  1206. XMeaning *mp;
  1207. X{
  1208. X    if (mp->constqual)
  1209. X    return 0;
  1210. X    if (mp->varstructflag || !mp->ctx || mp->ctx->kind != MK_FUNCTION ||
  1211. X        mp->volatilequal || alwayscopyvalues)
  1212. X        return 1;
  1213. X    while (sp) {
  1214. X        if (/* sp->kind == SK_GOTO || */
  1215. X        sp->kind == SK_LABEL ||
  1216. X            checkvarchanged(sp->stm1, mp) ||
  1217. X            checkvarchanged(sp->stm2, mp) ||
  1218. X            (sp->exp1 && checkvarchangedexpr(sp->exp1, mp, 1)) ||
  1219. X            (sp->exp2 && checkvarchangedexpr(sp->exp2, mp, 1)) ||
  1220. X            (sp->exp3 && checkvarchangedexpr(sp->exp3, mp, 1)))
  1221. X            return 1;
  1222. X        sp = sp->next;
  1223. X    }
  1224. X    return 0;
  1225. X}
  1226. X
  1227. X
  1228. X
  1229. Xint checkexprchanged(sp, ex)
  1230. XStmt *sp;
  1231. XExpr *ex;
  1232. X{
  1233. X    Meaning *mp;
  1234. X    int i;
  1235. X
  1236. X    for (i = 0; i < ex->nargs; i++) {
  1237. X        if (checkexprchanged(sp, ex->args[i]))
  1238. X            return 1;
  1239. X    }
  1240. X    switch (ex->kind) {
  1241. X
  1242. X        case EK_VAR:
  1243. X            mp = (Meaning *)ex->val.i;
  1244. X            if (mp->kind == MK_CONST)
  1245. X                return 0;
  1246. X            else
  1247. X                return checkvarchanged(sp, mp);
  1248. X
  1249. X        case EK_HAT:
  1250. X        case EK_INDEX:
  1251. X        case EK_SPCALL:
  1252. X            return 1;
  1253. X
  1254. X        case EK_FUNCTION:
  1255. X        case EK_BICALL:
  1256. X            return !nosideeffects_func(ex);
  1257. X
  1258. X    default:
  1259. X        return 0;
  1260. X    }
  1261. X}
  1262. X
  1263. X
  1264. X
  1265. X
  1266. X
  1267. X/* Check if a variable always occurs with a certain offset added, e.g. "i+1" */
  1268. X
  1269. XStatic int theoffset, numoffsets, numzerooffsets;
  1270. X#define BadOffset  (-999)
  1271. X
  1272. Xvoid checkvaroffsetexpr(ex, mp, myoffset)
  1273. XExpr *ex;
  1274. XMeaning *mp;
  1275. Xint myoffset;
  1276. X{
  1277. X    int i, nextoffset = 0;
  1278. X    Expr *ex2;
  1279. X
  1280. X    if (!ex)
  1281. X    return;
  1282. X    switch (ex->kind) {
  1283. X
  1284. X      case EK_VAR:
  1285. X    if (ex->val.i == (long)mp) {
  1286. X        if (myoffset == 0)
  1287. X        numzerooffsets++;
  1288. X        else if (numoffsets == 0 || myoffset == theoffset) {
  1289. X        theoffset = myoffset;
  1290. X        numoffsets++;
  1291. X        } else
  1292. X        theoffset = BadOffset;
  1293. X    }
  1294. X    break;
  1295. X
  1296. X      case EK_PLUS:
  1297. X    ex2 = ex->args[ex->nargs-1];
  1298. X    if (ex2->kind == EK_CONST &&
  1299. X        ex2->val.type->kind == TK_INTEGER) {
  1300. X        nextoffset = ex2->val.i;
  1301. X    }
  1302. X    break;
  1303. X
  1304. X      case EK_HAT:
  1305. X      case EK_POSTINC:
  1306. X      case EK_POSTDEC:
  1307. X    nextoffset = BadOffset;
  1308. X    break;
  1309. X
  1310. X      case EK_ASSIGN:
  1311. X    checkvaroffsetexpr(ex->args[0], mp, BadOffset);
  1312. X    checkvaroffsetexpr(ex->args[1], mp, 0);
  1313. X    return;
  1314. X
  1315. X      default:
  1316. X    break;
  1317. X    }
  1318. X    i = ex->nargs;
  1319. X    while (--i >= 0)
  1320. X    checkvaroffsetexpr(ex->args[i], mp, nextoffset);
  1321. X}
  1322. X
  1323. X
  1324. Xvoid checkvaroffsetstmt(sp, mp)
  1325. XStmt *sp;
  1326. XMeaning *mp;
  1327. X{
  1328. X    while (sp) {
  1329. X    checkvaroffsetstmt(sp->stm1, mp);
  1330. X    checkvaroffsetstmt(sp->stm1, mp);
  1331. X    checkvaroffsetexpr(sp->exp1, mp, 0);
  1332. X    checkvaroffsetexpr(sp->exp2, mp, 0);
  1333. X    checkvaroffsetexpr(sp->exp3, mp, 0);
  1334. X    sp = sp->next;
  1335. X    }
  1336. X}
  1337. X
  1338. X
  1339. Xint checkvaroffset(sp, mp)
  1340. XStmt *sp;
  1341. XMeaning *mp;
  1342. X{
  1343. X    if (mp->varstructflag || !mp->ctx || mp->ctx->kind != MK_FUNCTION)
  1344. X    return 0;
  1345. X    numoffsets = 0;
  1346. X    numzerooffsets = 0;
  1347. X    checkvaroffsetstmt(sp, mp);
  1348. X    if (numoffsets == 0 || theoffset == BadOffset ||
  1349. X    numoffsets <= numzerooffsets * 3)
  1350. X    return 0;
  1351. X    else
  1352. X    return theoffset;
  1353. X}
  1354. X
  1355. X
  1356. X
  1357. X
  1358. Xvoid initfilevars(mp, sppp, exbase)
  1359. XMeaning *mp;
  1360. XStmt ***sppp;
  1361. XExpr *exbase;
  1362. X{
  1363. X    Stmt *sp;
  1364. X    Type *tp;
  1365. X    Expr *ex;
  1366. X
  1367. X    while (mp) {
  1368. X    if ((mp->kind == MK_VAR && mp->refcount > 0 && !mp->istemporary) ||
  1369. X        mp->kind == MK_FIELD) {
  1370. X        tp = mp->type;
  1371. X        if (isfiletype(tp)) {
  1372. X        mp->refcount++;
  1373. X        sp = makestmt(SK_ASSIGN);
  1374. X        sp->next = **sppp;
  1375. X        **sppp = sp;
  1376. X        if (exbase)
  1377. X            ex = makeexpr_dot(copyexpr(exbase), mp);
  1378. X        else
  1379. X            ex = makeexpr_var(mp);
  1380. X        sp->exp1 = makeexpr_assign(copyexpr(ex), makeexpr_nil());
  1381. X        } else if (tp->kind == TK_RECORD) {
  1382. X        if (exbase)
  1383. X            ex = makeexpr_dot(copyexpr(exbase), mp);
  1384. X        else
  1385. X            ex = makeexpr_var(mp);
  1386. X        initfilevars(tp->fbase, sppp, ex);
  1387. X        freeexpr(ex);
  1388. X        } else if (tp->kind == TK_ARRAY) {
  1389. X        while (tp->kind == TK_ARRAY)
  1390. X            tp = tp->basetype;
  1391. X        if (isfiletype(tp))
  1392. X            note(format_s("Array of files %s should be initialized [257]",
  1393. X                  mp->name));
  1394. X        }
  1395. X    }
  1396. X    mp = mp->cnext;
  1397. X    }
  1398. X}
  1399. X
  1400. X
  1401. X
  1402. X
  1403. X
  1404. XStatic Stmt *p_body()
  1405. X{
  1406. X    Stmt *sp, **spp, *spbody, **sppbody, *spbase, *thereturn;
  1407. X    Meaning *mp;
  1408. X    Expr *ex;
  1409. X    int haspostamble;
  1410. X    long saveserial;
  1411. X
  1412. X    if (verbose)
  1413. X    fprintf(logf, "%s, %d/%d: Translating %s (in %s)\n",
  1414. X        infname, inf_lnum, outf_lnum,
  1415. X        curctx->name, curctx->ctx->name);
  1416. X    notephase = 1;
  1417. X    spp = &spbase;
  1418. X    addstmt(SK_HEADER);
  1419. X    sp->exp1 = makeexpr_var(curctx);
  1420. X    checkkeyword(TOK_INLINE);
  1421. X    if (curtok != TOK_END && curtok != TOK_BEGIN && curtok != TOK_INLINE) {
  1422. X    if (curctx->kind == MK_FUNCTION || curctx->anyvarflag)
  1423. X        wexpecttok(TOK_BEGIN);
  1424. X    else
  1425. X        wexpecttok(TOK_END);
  1426. X    skiptotoken2(TOK_BEGIN, TOK_END);
  1427. X    }
  1428. X    if (curtok == TOK_END) {
  1429. X    gettok();
  1430. X    spbody = NULL;
  1431. X    } else {
  1432. X    spbody = p_stmt(NULL, SF_FUNC);  /* parse the procedure/program body */
  1433. X    }
  1434. X    if (curtok == TOK_IDENT && curtokmeaning == curctx) {
  1435. X    gettok();    /* Modula-2 */
  1436. X    }
  1437. X    notephase = 2;
  1438. X    saveserial = curserial;
  1439. X    curserial = 10000;
  1440. X    if (curctx->kind == MK_FUNCTION) {     /* handle copy parameters */
  1441. X        for (mp = curctx->type->fbase; mp; mp = mp->xnext) {
  1442. X            if (!mp->othername && mp->varstructflag) {
  1443. X                mp->othername = stralloc(format_s(name_COPYPAR, mp->name));
  1444. X                mp->rectype = mp->type;
  1445. X                addstmt(SK_ASSIGN);
  1446. X                sp->exp1 = makeexpr_assign(makeexpr_var(mp), 
  1447. X                                           makeexpr_name(mp->othername, mp->rectype));
  1448. X                mp->refcount++;
  1449. X            } else if (mp->othername) {
  1450. X                if (checkvarchanged(spbody, mp)) {
  1451. X                    addstmt(SK_ASSIGN);
  1452. X                    sp->exp1 = makeexpr_assign(makeexpr_var(mp),
  1453. X                                               makeexpr_hat(makeexpr_name(mp->othername,
  1454. X                                                                          mp->rectype), 0));
  1455. X                    mp->refcount++;
  1456. X                } else {           /* don't need to copy it after all */
  1457. X                    strchange(&mp->othername, mp->name);
  1458. X                    ex = makeexpr_var(mp);
  1459. X                    ex->val.type = mp->rectype;
  1460. X                    replaceexpr(spbody, makeexpr_var(mp), makeexpr_hat(ex, 0));
  1461. X                }
  1462. X            }
  1463. X        }
  1464. X    }
  1465. X    for (mp = curctx->cbase; mp; mp = mp->cnext) {
  1466. X    if (mp->kind == MK_LABEL && mp->val.i) {
  1467. X        addstmt(SK_IF);
  1468. X        sp->exp1 = makeexpr_bicall_1("setjmp", tp_int,
  1469. X                     makeexpr_var(mp->xnext));
  1470. X        sp->stm1 = makestmt(SK_GOTO);
  1471. X        sp->stm1->exp1 = makeexpr_name(format_s(name_LABEL, mp->name),
  1472. X                       tp_integer);
  1473. X    }
  1474. X    }
  1475. X    *spp = spbody;
  1476. X    sppbody = spp;
  1477. X    while (*spp)
  1478. X        spp = &((*spp)->next);
  1479. X    haspostamble = 0;
  1480. X    initfilevars(curctx->cbase, &sppbody, NULL);
  1481. X    for (mp = curctx->cbase; mp; mp = mp->cnext) {
  1482. X        if (mp->kind == MK_VAR && mp->refcount > 0 && isfiletype(mp->type) &&
  1483. X             !mp->istemporary) {
  1484. X            if (curctx->kind != MK_MODULE || curctx->anyvarflag) {
  1485. X                addstmt(SK_IF);                    /* close file variables */
  1486. X                sp->exp1 = makeexpr_rel(EK_NE, makeexpr_var(mp), makeexpr_nil());
  1487. X                sp->stm1 = makestmt(SK_ASSIGN);
  1488. X                sp->stm1->exp1 = makeexpr_bicall_1("fclose", tp_void, makeexpr_var(mp));
  1489. X            }
  1490. X            haspostamble = 1;
  1491. X        }
  1492. X    }
  1493. X    thereturn = &bogusreturn;
  1494. X    if (curctx->kind == MK_FUNCTION && curctx->type->basetype != tp_void) {
  1495. X        if ((haspostamble || !checkreturns(&spbase, 1)) &&
  1496. X            curctx->cbase->refcount > 0) {      /* add function return code */
  1497. X            addstmt(SK_RETURN);
  1498. X            sp->exp1 = makeexpr_var(curctx->cbase);
  1499. X        }
  1500. X        thereturn = NULL;
  1501. X    } else if (curctx->kind == MK_MODULE && curctx->anyvarflag) {
  1502. X        addstmt(SK_ASSIGN);
  1503. X        sp->exp1 = makeexpr_bicall_1("exit", tp_void, makeexpr_long(0));
  1504. X        thereturn = NULL;
  1505. X    }
  1506. X    if (debug>2) { fprintf(outf, "calling fixblock/usecommas on:\n"); dumpstmt(spbase, 5); }
  1507. X    curserial = saveserial;
  1508. X    sp = makestmt(SK_BODY);
  1509. X    sp->stm1 = spbase;
  1510. X    fixblock(&sp, thereturn);           /* finishing touches to statements and expressions */
  1511. X    spbase = sp->stm1;
  1512. X    FREE(sp);
  1513. X    if (usecommas != 1)
  1514. X        checkcommas(&spbase);    /* unroll ugly EK_COMMA and EK_COND expressions */
  1515. X    if (debug>1) { fprintf(outf, "p_body returns:\n"); dumpstmt(spbase, 5); }
  1516. X    notephase = 0;
  1517. X    return spbase;
  1518. X}
  1519. X
  1520. X
  1521. X
  1522. X
  1523. X#define checkWord()  if (anywords) output(" "); anywords = 1
  1524. X
  1525. XStatic void out_function(func)
  1526. XMeaning *func;
  1527. X{
  1528. X    Meaning *mp;
  1529. X    Symbol *sym;
  1530. X    int opts, anywords, spacing, saveindent;
  1531. X
  1532. X    if (func->varstructflag) {
  1533. X        makevarstruct(func);
  1534. X    }
  1535. X    if (collectnest) {
  1536. X    for (mp = func->cbase; mp; mp = mp->cnext) {
  1537. X        if (mp->kind == MK_FUNCTION && mp->isforward) {
  1538. X        forward_decl(mp, 0);
  1539. X        }
  1540. X    }
  1541. X    for (mp = func->cbase; mp; mp = mp->cnext) {
  1542. X        if (mp->kind == MK_FUNCTION && mp->type) {
  1543. X        pushctx(mp);
  1544. X        out_function(mp);    /* generate the sub-procedures first */
  1545. X        popctx();
  1546. X        }
  1547. X    }
  1548. X    }
  1549. X    spacing = functionspace;
  1550. X    for (mp = func; mp->ctx->kind == MK_FUNCTION; mp = mp->ctx) {
  1551. X        if (spacing > minfuncspace)
  1552. X            spacing--;
  1553. X    }
  1554. X    outsection(spacing);
  1555. X    flushcomments(&func->comments, -1, 0);
  1556. X    if (usePPMacros == 1) {
  1557. X        forward_decl(func, 0);
  1558. X        outsection(minorspace);
  1559. X    }
  1560. X    opts = ODECL_HEADER;
  1561. X    anywords = 0;
  1562. X    if (func->namedfile) {
  1563. X    checkWord();
  1564. X    if (useAnyptrMacros || ansiC < 2)
  1565. X        output("Inline");
  1566. X    else
  1567. X        output("inline");
  1568. X    }
  1569. X    if (!func->exported) {
  1570. X    if (func->ctx->kind == MK_FUNCTION) {
  1571. X        if (useAnyptrMacros) {
  1572. X        checkWord();
  1573. X        output("Local");
  1574. X        } else if (use_static) {
  1575. X        checkWord();
  1576. X        output("static");
  1577. X        }
  1578. X    } else if ((findsymbol(func->name)->flags & NEEDSTATIC) ||
  1579. X           (use_static != 0 && !useAnyptrMacros)) {
  1580. X        checkWord();
  1581. X        output("static");
  1582. X    } else if (useAnyptrMacros) {
  1583. X        checkWord();
  1584. X        output("Static");
  1585. X    }
  1586. X    }
  1587. X    if (func->type->basetype != tp_void || ansiC != 0) {
  1588. X    checkWord();
  1589. X        outbasetype(func->type, 0);
  1590. X    }
  1591. X    if (anywords) {
  1592. X        if (newlinefunctions)
  1593. X            opts |= ODECL_FUNCTION;
  1594. X        else
  1595. X            output(" ");
  1596. X    }
  1597. X    outdeclarator(func->type, func->name, opts);
  1598. X    if (fullprototyping == 0) {
  1599. X    saveindent = outindent;
  1600. X    moreindent(argindent);
  1601. X        out_argdecls(func->type);
  1602. X    outindent = saveindent;
  1603. X    }
  1604. X    for (mp = func->type->fbase; mp; mp = mp->xnext) {
  1605. X        if (mp->othername && strcmp(mp->name, mp->othername))
  1606. X            mp->wasdeclared = 0;    /* make sure we also declare the copy */
  1607. X    }
  1608. X    func->wasdeclared = 1;
  1609. X    outcontext = func;
  1610. X    out_block((Stmt *)func->val.i, BR_FUNCTION, 10000);
  1611. X    if (useundef) {
  1612. X    anywords = 0;
  1613. X    for (mp = func->cbase; mp; mp = mp->cnext) {
  1614. X        if (mp->kind == MK_CONST &&
  1615. END_OF_FILE
  1616. if test 49392 -ne `wc -c <'src/parse.c.2'`; then
  1617.     echo shar: \"'src/parse.c.2'\" unpacked with wrong size!
  1618. fi
  1619. # end of 'src/parse.c.2'
  1620. fi
  1621. echo shar: End of archive 30 \(of 32\).
  1622. cp /dev/null ark30isdone
  1623. MISSING=""
  1624. 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
  1625.     if test ! -f ark${I}isdone ; then
  1626.     MISSING="${MISSING} ${I}"
  1627.     fi
  1628. done
  1629. if test "${MISSING}" = "" ; then
  1630.     echo You have unpacked all 32 archives.
  1631.     echo "Now see PACKNOTES and the README"
  1632.     rm -f ark[1-9]isdone ark[1-9][0-9]isdone
  1633. else
  1634.     echo You still need to unpack the following archives:
  1635.     echo "        " ${MISSING}
  1636. fi
  1637. ##  End of shell archive.
  1638. exit 0
  1639.