home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 October / usenetsourcesnewsgroupsinfomagicoctober1994disk2.iso / unix / volume21 / p2c / part29 < prev    next >
Text File  |  1990-04-05  |  53KB  |  1,749 lines
  1. Subject:  v21i074:  Pascal to C translator, Part29/32
  2. Newsgroups: comp.sources.unix
  3. Approved: rsalz@uunet.UU.NET
  4. X-Checksum-Snefru: e2cd7442 ae0d945f bd38715f 243e88b5
  5.  
  6. Submitted-by: Dave Gillespie <daveg@csvax.caltech.edu>
  7. Posting-number: Volume 21, Issue 74
  8. Archive-name: p2c/part29
  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 29 (of 32)."
  17. # Contents:  src/parse.c.1
  18. # Wrapped by rsalz@litchi.bbn.com on Mon Mar 26 14:29:52 1990
  19. PATH=/bin:/usr/bin:/usr/ucb ; export PATH
  20. if test -f 'src/parse.c.1' -a "${1}" != "-c" ; then 
  21.   echo shar: Will not clobber existing file \"'src/parse.c.1'\"
  22. else
  23. echo shar: Extracting \"'src/parse.c.1'\" \(49384 characters\)
  24. sed "s/^X//" >'src/parse.c.1' <<'END_OF_FILE'
  25. X/* "p2c", a Pascal to C translator.
  26. X   Copyright (C) 1989 David Gillespie.
  27. X   Author's address: daveg@csvax.caltech.edu; 256-80 Caltech/Pasadena CA 91125.
  28. X
  29. XThis program is free software; you can redistribute it and/or modify
  30. Xit under the terms of the GNU General Public License as published by
  31. Xthe Free Software Foundation (any version).
  32. X
  33. XThis program is distributed in the hope that it will be useful,
  34. Xbut WITHOUT ANY WARRANTY; without even the implied warranty of
  35. XMERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  36. XGNU General Public License for more details.
  37. X
  38. XYou should have received a copy of the GNU General Public License
  39. Xalong with this program; see the file COPYING.  If not, write to
  40. Xthe Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
  41. X
  42. X
  43. X
  44. X#define PROTO_PARSE_C
  45. X#include "trans.h"
  46. X
  47. X
  48. X
  49. XStatic short candeclare;
  50. XStatic int trycount;
  51. XStatic Strlist *includedfiles;
  52. XStatic char echo_first;
  53. XStatic int echo_pos;
  54. X
  55. X
  56. X
  57. Xvoid setup_parse()
  58. X{
  59. X    candeclare = 0;
  60. X    trycount = 0;
  61. X    includedfiles = NULL;
  62. X    echo_first = 1;
  63. X    echo_pos = 0;
  64. X    fixexpr_tryblock = 0;
  65. X}
  66. X
  67. X
  68. X
  69. Xvoid echobreak()
  70. X{
  71. X    if (echo_pos > 0) {
  72. X    printf("\n");
  73. X    echo_pos = 0;
  74. X    echo_first = 0;
  75. X    }
  76. X}
  77. X
  78. X
  79. Xvoid echoword(name, comma)
  80. Xchar *name;
  81. Xint comma;
  82. X{
  83. X    FILE *f = (outf == stdout) ? stderr : stdout;
  84. X
  85. X    if (quietmode || showprogress)
  86. X        return;
  87. X    if (!echo_first) {
  88. X    if (comma) {
  89. X        fprintf(f, ",");
  90. X        echo_pos++;
  91. X    }
  92. X        if (echo_pos + strlen(name) > 77) {
  93. X            fprintf(f, "\n");
  94. X            echo_pos = 0;
  95. X        } else {
  96. X            fprintf(f, " ");
  97. X            echo_pos++;
  98. X        }
  99. X    }
  100. X    echo_first = 0;
  101. X    fprintf(f, "%s", name);
  102. X    echo_pos += strlen(name);
  103. X    fflush(f);
  104. X}
  105. X
  106. X
  107. X
  108. Xvoid echoprocname(mp)
  109. XMeaning *mp;
  110. X{
  111. X    echoword(mp->name, 1);
  112. X}
  113. X
  114. X
  115. X
  116. X
  117. X
  118. XStatic void forward_decl(func, isextern)
  119. XMeaning *func;
  120. Xint isextern;
  121. X{
  122. X    if (func->wasdeclared)
  123. X        return;
  124. X    if (isextern && func->constdefn && !checkvarmac(func))
  125. X    return;
  126. X    if (isextern) {
  127. X        output("extern ");
  128. X    } else if (func->ctx->kind == MK_FUNCTION) {
  129. X    if (useAnyptrMacros)
  130. X        output("Local ");
  131. X    else
  132. X        output("static ");
  133. X    } else if ((use_static != 0 && !useAnyptrMacros) ||
  134. X           (findsymbol(func->name)->flags & NEEDSTATIC)) {
  135. X    output("static ");
  136. X    } else if (useAnyptrMacros) {
  137. X    output("Static ");
  138. X    }
  139. X    if (func->type->basetype != tp_void || ansiC != 0) {
  140. X        outbasetype(func->type, ODECL_FORWARD);
  141. X        output(" ");
  142. X    }
  143. X    outdeclarator(func->type, func->name, ODECL_FORWARD);
  144. X    output(";\n");
  145. X    func->wasdeclared = 1;
  146. X}
  147. X
  148. X
  149. X
  150. X
  151. X/* Check if calling a parent procedure, whose body must */
  152. X/*   be declared forward */
  153. X
  154. Xvoid need_forward_decl(func)
  155. XMeaning *func;
  156. X{
  157. X    Meaning *mp;
  158. X
  159. X    if (func->wasdeclared)
  160. X        return;
  161. X    for (mp = curctx->ctx; mp; mp = mp->ctx) {
  162. X        if (mp == func) {
  163. X        if (func->ctx->kind == MK_FUNCTION)
  164. X        func->isforward = 1;
  165. X        else
  166. X        forward_decl(func, 0);
  167. X            return;
  168. X        }
  169. X    }
  170. X}
  171. X
  172. X
  173. X
  174. X
  175. Xvoid free_stmt(sp)
  176. Xregister Stmt *sp;
  177. X{
  178. X    if (sp) {
  179. X        free_stmt(sp->stm1);
  180. X        free_stmt(sp->stm2);
  181. X        free_stmt(sp->next);
  182. X        freeexpr(sp->exp1);
  183. X        freeexpr(sp->exp2);
  184. X        freeexpr(sp->exp3);
  185. X        FREE(sp);
  186. X    }
  187. X}
  188. X
  189. X
  190. X
  191. X
  192. XStmt *makestmt(kind)
  193. Xenum stmtkind kind;
  194. X{
  195. X    Stmt *sp;
  196. X
  197. X    sp = ALLOC(1, Stmt, stmts);
  198. X    sp->kind = kind;
  199. X    sp->next = NULL;
  200. X    sp->stm1 = NULL;
  201. X    sp->stm2 = NULL;
  202. X    sp->exp1 = NULL;
  203. X    sp->exp2 = NULL;
  204. X    sp->exp3 = NULL;
  205. X    sp->serial = curserial = ++serialcount;
  206. X    return sp;
  207. X}
  208. X
  209. X
  210. X
  211. XStmt *makestmt_call(call)
  212. XExpr *call;
  213. X{
  214. X    Stmt *sp = makestmt(SK_ASSIGN);
  215. X    sp->exp1 = call;
  216. X    return sp;
  217. X}
  218. X
  219. X
  220. X
  221. XStmt *makestmt_assign(lhs, rhs)
  222. XExpr *lhs, *rhs;
  223. X{
  224. X    Stmt *sp = makestmt(SK_ASSIGN);
  225. X    sp->exp1 = makeexpr_assign(lhs, rhs);
  226. X    return sp;
  227. X}
  228. X
  229. X
  230. X
  231. XStmt *makestmt_if(cond, thn, els)
  232. XExpr *cond;
  233. XStmt *thn, *els;
  234. X{
  235. X    Stmt *sp = makestmt(SK_IF);
  236. X    sp->exp1 = cond;
  237. X    sp->stm1 = thn;
  238. X    sp->stm2 = els;
  239. X    return sp;
  240. X}
  241. X
  242. X
  243. X
  244. XStmt *makestmt_seq(s1, s2)
  245. XStmt *s1, *s2;
  246. X{
  247. X    Stmt *s1a;
  248. X
  249. X    if (!s1)
  250. X        return s2;
  251. X    if (!s2)
  252. X        return s1;
  253. X    for (s1a = s1; s1a->next; s1a = s1a->next) ;
  254. X    s1a->next = s2;
  255. X    return s1;
  256. X}
  257. X
  258. X
  259. X
  260. XStmt *copystmt(sp)
  261. XStmt *sp;
  262. X{
  263. X    Stmt *sp2;
  264. X
  265. X    if (sp) {
  266. X        sp2 = makestmt(sp->kind);
  267. X        sp2->stm1 = copystmt(sp->stm1);
  268. X        sp2->stm2 = copystmt(sp->stm2);
  269. X        sp2->exp1 = copyexpr(sp->exp1);
  270. X        sp2->exp2 = copyexpr(sp->exp2);
  271. X        sp2->exp3 = copyexpr(sp->exp3);
  272. X        return sp2;
  273. X    } else
  274. X        return NULL;
  275. X}
  276. X
  277. X
  278. X
  279. Xvoid nukestmt(sp)
  280. XStmt *sp;
  281. X{
  282. X    if (sp) {
  283. X        sp->kind = SK_ASSIGN;
  284. X        sp->exp1 = makeexpr_long(0);
  285. X    }
  286. X}
  287. X
  288. X
  289. X
  290. Xvoid splicestmt(sp, spnew)
  291. XStmt *sp, *spnew;
  292. X{
  293. X    Stmt *snext;
  294. X
  295. X    snext = sp->next;
  296. X    *sp = *spnew;
  297. X    while (sp->next)
  298. X        sp = sp->next;
  299. X    sp->next = snext;
  300. X}
  301. X
  302. X
  303. X
  304. Xint stmtcount(sp)
  305. XStmt *sp;
  306. X{
  307. X    int i = 0;
  308. X
  309. X    while (sp) {
  310. X        i += 1 + stmtcount(sp->stm1) + stmtcount(sp->stm2);
  311. X        sp = sp->next;
  312. X    }
  313. X    return i;
  314. X}
  315. X
  316. X
  317. X
  318. X
  319. X
  320. XStmt *close_files_to_ctx(ctx)
  321. XMeaning *ctx;
  322. X{
  323. X    Meaning *ctx2, *mp;
  324. X    Stmt *splist = NULL, *sp;
  325. X
  326. X    ctx2 = curctx;
  327. X    while (ctx2 && ctx2 != ctx && ctx2->kind == MK_FUNCTION) {
  328. X    for (mp = ctx2->cbase; mp; mp = mp->cnext) {
  329. X        if (mp->kind == MK_VAR &&
  330. X        isfiletype(mp->type) && !mp->istemporary) {
  331. X        var_reference(mp);
  332. X        sp = makestmt_if(makeexpr_rel(EK_NE, makeexpr_var(mp),
  333. X                          makeexpr_nil()),
  334. X                 makestmt_call(
  335. X                     makeexpr_bicall_1("fclose", tp_void,
  336. X                               makeexpr_var(mp))),
  337. X                 NULL);
  338. X        splist = makestmt_seq(splist, sp);
  339. X        }
  340. X    }
  341. X    ctx2 = ctx2->ctx;
  342. X    }
  343. X    return splist;
  344. X}
  345. X
  346. X
  347. X
  348. X
  349. Xint simplewith(ex)
  350. XExpr *ex;
  351. X{
  352. X    switch (ex->kind) {
  353. X        case EK_VAR:
  354. X        case EK_CONST:
  355. X            return 1;
  356. X        case EK_DOT:
  357. X            return simplewith(ex->args[0]);
  358. X        default:
  359. X            return 0;
  360. X    }
  361. X}
  362. X
  363. X
  364. Xint simplefor(sp, ex)
  365. XStmt *sp;
  366. XExpr *ex;
  367. X{
  368. X    return (exprspeed(sp->exp2) <= 3 &&
  369. X            !checkexprchanged(sp->stm1, sp->exp2) &&
  370. X        !exproccurs(sp->exp2, ex));
  371. X}
  372. X
  373. X
  374. X
  375. Xint tryfuncmacro(exp, mp)
  376. XExpr **exp;
  377. XMeaning *mp;
  378. X{
  379. X    char *name;
  380. X    Strlist *lp;
  381. X    Expr *ex = *exp, *ex2;
  382. X
  383. X    ex2 = (mp) ? mp->constdefn : NULL;
  384. X    if (!ex2) {
  385. X    if (ex->kind == EK_BICALL || ex->kind == EK_NAME)
  386. X        name = ex->val.s;
  387. X    else if (ex->kind == EK_FUNCTION)
  388. X        name = ((Meaning *)ex->val.i)->name;
  389. X    else
  390. X        return 0;
  391. X    lp = strlist_cifind(funcmacros, name);
  392. X    ex2 = (lp) ? (Expr *)lp->value : NULL;
  393. X    }
  394. X    if (ex2) {
  395. X        *exp = replacemacargs(copyexpr(ex2), ex);
  396. X    freeexpr(ex);
  397. X        return 1;
  398. X    }
  399. X    return 0;
  400. X}
  401. X
  402. X
  403. X
  404. X
  405. X
  406. X#define addstmt(kind)   \
  407. X    *spp = sp = makestmt(kind),   \
  408. X    spp = &(sp->next)
  409. X
  410. X#define newstmt(kind)   \
  411. X    addstmt(kind),   \
  412. X    steal_comments(firstserial, sp->serial, sflags & SF_FIRST),   \
  413. X    sflags &= ~SF_FIRST
  414. X
  415. X
  416. X
  417. X#define SF_FUNC    0x1
  418. X#define SF_SAVESER 0x2
  419. X#define SF_FIRST   0x4
  420. X#define SF_IF       0x8
  421. X
  422. XStatic Stmt *p_stmt(slist, sflags)
  423. XStmt *slist;
  424. Xint sflags;
  425. X{
  426. X    Stmt *sbase = NULL, **spp = &sbase, **spp2, **spp3, **savespp;
  427. X    Stmt *defsp, **defsphook;
  428. X    register Stmt *sp;
  429. X    Stmt *sp2;
  430. X    long li1, li2, firstserial = 0, saveserial = 0, saveserial2;
  431. X    int i, forfixed, offset, line1, line2, toobig, isunsafe;
  432. X    Token savetok;
  433. X    char *name;
  434. X    Expr *ep, *ep2, *ep3, *forstep, *range, *swexpr, *trueswexpr;
  435. X    Type *tp;
  436. X    Meaning *mp, *tvar, *tempmark;
  437. X    Symbol *sym;
  438. X    enum exprkind ekind;
  439. X    Stmt *(*prochandler)();
  440. X    Strlist *cmt;
  441. X
  442. X    tempmark = markstmttemps();
  443. Xagain:
  444. X    while (findlabelsym()) {
  445. X        newstmt(SK_LABEL);
  446. X        sp->exp1 = makeexpr_name(format_s(name_LABEL, curtokmeaning->name), tp_integer);
  447. X        gettok();
  448. X        wneedtok(TOK_COLON);
  449. X    }
  450. X    firstserial = curserial;
  451. X    checkkeyword(TOK_TRY);
  452. X    checkkeyword(TOK_INLINE);
  453. X    checkkeyword(TOK_LOOP);
  454. X    checkkeyword(TOK_RETURN);
  455. X    if (modula2) {
  456. X    if (sflags & SF_SAVESER)
  457. X        goto stmtSeq;
  458. X    }
  459. X    switch (curtok) {
  460. X
  461. X        case TOK_BEGIN:
  462. X        stmtSeq:
  463. X        if (sflags & (SF_FUNC|SF_SAVESER)) {
  464. X        saveserial = curserial;
  465. X        cmt = grabcomment(CMT_ONBEGIN);
  466. X        if (sflags & SF_FUNC)
  467. X            cmt = fixbeginendcomment(cmt);
  468. X        strlist_mix(&curcomments, cmt);
  469. X        }
  470. X        i = sflags & SF_FIRST;
  471. X            do {
  472. X        if (modula2) {
  473. X            if (curtok == TOK_BEGIN || curtok == TOK_SEMI)
  474. X            gettok();
  475. X            checkkeyword(TOK_ELSIF);
  476. X            if (curtok == TOK_ELSE || curtok == TOK_ELSIF)
  477. X            break;
  478. X        } else
  479. X            gettok();
  480. X                *spp = p_stmt(sbase, i);
  481. X        i = 0;
  482. X                while (*spp)
  483. X                    spp = &((*spp)->next);
  484. X            } while (curtok == TOK_SEMI);
  485. X        if (sflags & (SF_FUNC|SF_SAVESER)) {
  486. X        cmt = grabcomment(CMT_ONEND);
  487. X        changecomments(cmt, -1, -1, -1, saveserial);
  488. X        if (sflags & SF_FUNC)
  489. X            cmt = fixbeginendcomment(cmt);
  490. X        strlist_mix(&curcomments, cmt);
  491. X        if (sflags & SF_FUNC)
  492. X            changecomments(curcomments, -1, saveserial, -1, 10000);
  493. X        curserial = saveserial;
  494. X        }
  495. X        checkkeyword(TOK_ELSIF);
  496. X        if (modula2 && (sflags & SF_IF)) {
  497. X        break;
  498. X        }
  499. X        if (curtok == TOK_VBAR)
  500. X        break;
  501. X            if (!wneedtok(TOK_END))
  502. X        skippasttoken(TOK_END);
  503. X            break;
  504. X
  505. X        case TOK_CASE:
  506. X            gettok();
  507. X            swexpr = trueswexpr = p_ord_expr();
  508. X            if (nosideeffects(swexpr, 1)) {
  509. X                tvar = NULL;
  510. X            } else {
  511. X                tvar = makestmttempvar(swexpr->val.type, name_TEMP);
  512. X                swexpr = makeexpr_var(tvar);
  513. X            }
  514. X            savespp = spp;
  515. X            newstmt(SK_CASE);
  516. X        saveserial2 = curserial;
  517. X            sp->exp1 = trueswexpr;
  518. X            spp2 = &sp->stm1;
  519. X            tp = swexpr->val.type;
  520. X            defsp = NULL;
  521. X            defsphook = &defsp;
  522. X            if (!wneedtok(TOK_OF)) {
  523. X        skippasttoken(TOK_END);
  524. X        break;
  525. X        }
  526. X        i = 1;
  527. X        while (curtok == TOK_VBAR)
  528. X        gettok();
  529. X        checkkeyword(TOK_OTHERWISE);
  530. X            while (curtok != TOK_END && curtok != TOK_OTHERWISE && curtok != TOK_ELSE) {
  531. X                spp3 = spp2;
  532. X        saveserial = curserial;
  533. X                *spp2 = sp = makestmt(SK_CASELABEL);
  534. X        steal_comments(saveserial, sp->serial, i);
  535. X                spp2 = &sp->next;
  536. X                range = NULL;
  537. X                toobig = 0;
  538. X                for (;;) {
  539. X                    ep = gentle_cast(p_expr(tp), tp);
  540. X                    if (curtok == TOK_DOTS) {
  541. X                        li1 = ord_value(eval_expr(ep));
  542. X                        gettok();
  543. X                        ep2 = gentle_cast(p_expr(tp), tp);
  544. X                        li2 = ord_value(eval_expr(ep2));
  545. X                        range = makeexpr_or(range,
  546. X                                            makeexpr_range(copyexpr(swexpr),
  547. X                                                           ep, ep2, 1));
  548. X                        if (li2 - li1 >= caselimit)
  549. X                            toobig = 1;
  550. X                        if (!toobig) {
  551. X                            for (;;) {
  552. X                                sp->exp1 = makeexpr_val(make_ord(tp, li1));
  553. X                                if (li1 >= li2) break;
  554. X                                li1++;
  555. X                serialcount--;   /* make it reuse the count */
  556. X                                sp->stm1 = makestmt(SK_CASELABEL);
  557. X                                sp = sp->stm1;
  558. X                            }
  559. X                        }
  560. X                    } else {
  561. X                        sp->exp1 = copyexpr(ep);
  562. X                        range = makeexpr_or(range,
  563. X                                            makeexpr_rel(EK_EQ, 
  564. X                                                         copyexpr(swexpr),
  565. X                                                         ep));
  566. X                    }
  567. X                    if (curtok == TOK_COMMA) {
  568. X                        gettok();
  569. X            serialcount--;   /* make it reuse the count */
  570. X                        sp->stm1 = makestmt(SK_CASELABEL);
  571. X                        sp = sp->stm1;
  572. X                    } else
  573. X                        break;
  574. X                }
  575. X                wneedtok(TOK_COLON);
  576. X                if (toobig) {
  577. X                    free_stmt(*spp3);
  578. X                    spp2 = spp3;
  579. X                    *defsphook = makestmt_if(range, p_stmt(NULL, SF_SAVESER),
  580. X                         NULL);
  581. X                    if (defsphook != &defsp && elseif != 0)
  582. X                        (*defsphook)->exp2 = makeexpr_long(1);
  583. X                    defsphook = &((*defsphook)->stm2);
  584. X                } else {
  585. X                    freeexpr(range);
  586. X                    sp->stm1 = p_stmt(NULL, SF_SAVESER);
  587. X                }
  588. X        i = 0;
  589. X        checkkeyword(TOK_OTHERWISE);
  590. X                if (curtok != TOK_END && curtok != TOK_OTHERWISE && curtok != TOK_ELSE) {
  591. X            if (curtok == TOK_VBAR) {
  592. X            while (curtok == TOK_VBAR)
  593. X                gettok();
  594. X            } else
  595. X            wneedtok(TOK_SEMI);
  596. X            checkkeyword(TOK_OTHERWISE);
  597. X        }
  598. X            }
  599. X            if (defsp) {
  600. X                *spp2 = defsp;
  601. X                spp2 = defsphook;
  602. X                if (tvar) {
  603. X                    sp = makestmt_assign(makeexpr_var(tvar), trueswexpr);
  604. X                    sp->next = *savespp;
  605. X                    *savespp = sp;
  606. X                    sp->next->exp1 = swexpr;
  607. X                }
  608. X            } else {
  609. X                if (tvar) {
  610. X                    canceltempvar(tvar);
  611. X                    freeexpr(swexpr);
  612. X                }
  613. X            }
  614. X            if (curtok == TOK_OTHERWISE || curtok == TOK_ELSE) {
  615. X                gettok();
  616. X                while (curtok == TOK_SEMI)
  617. X                    gettok();
  618. X/*        changecomments(curcomments, CMT_TRAIL, curserial,
  619. X                                CMT_POST, -1);   */
  620. X        i = SF_FIRST;
  621. X        while (curtok != TOK_END) {
  622. X                    *spp2 = p_stmt(NULL, i);
  623. X                    while (*spp2)
  624. X                        spp2 = &((*spp2)->next);
  625. X            i = 0;
  626. X                    if (curtok != TOK_SEMI)
  627. X                        break;
  628. X                    gettok();
  629. X                }
  630. X                if (!wexpecttok(TOK_END))
  631. X            skiptotoken(TOK_END);
  632. X            } else if (casecheck == 1 || (casecheck == 2 && range_flag)) {
  633. X                *spp2 = makestmt(SK_CASECHECK);
  634. X            }
  635. X        curserial = saveserial2;
  636. X        strlist_mix(&curcomments, grabcomment(CMT_ONEND));
  637. X            gettok();
  638. X            break;
  639. X
  640. X        case TOK_FOR:
  641. X            forfixed = fixedflag;
  642. X            gettok();
  643. X            newstmt(SK_FOR);
  644. X            ep = p_expr(tp_integer);
  645. X            if (!wneedtok(TOK_ASSIGN)) {
  646. X        skippasttoken(TOK_DO);
  647. X        break;
  648. X        }
  649. X            ep2 = makeexpr_charcast(p_expr(ep->val.type));
  650. X            if (curtok != TOK_DOWNTO) {
  651. X        if (!wexpecttok(TOK_TO)) {
  652. X            skippasttoken(TOK_DO);
  653. X            break;
  654. X        }
  655. X        }
  656. X            savetok = curtok;
  657. X            gettok();
  658. X            sp->exp2 = makeexpr_charcast(p_expr(ep->val.type));
  659. X        checkkeyword(TOK_BY);
  660. X        if (curtok == TOK_BY) {
  661. X        gettok();
  662. X        forstep = p_expr(tp_integer);
  663. X        i = possiblesigns(forstep);
  664. X        if ((i & 5) == 5) {
  665. X            if (expr_is_neg(forstep)) {
  666. X            ekind = EK_GE;
  667. X            note("Assuming FOR loop step is negative [252]");
  668. X            } else {
  669. X            ekind = EK_LE;
  670. X            note("Assuming FOR loop step is positive [252]");
  671. X            }
  672. X        } else {
  673. X            if (!(i & 1))
  674. X            ekind = EK_LE;
  675. X            else
  676. X            ekind = EK_GE;
  677. X        }
  678. X        } else {
  679. X        if (savetok == TOK_DOWNTO) {
  680. X            ekind = EK_GE;
  681. X            forstep = makeexpr_long(-1);
  682. X        } else {
  683. X            ekind = EK_LE;
  684. X            forstep = makeexpr_long(1);
  685. X        }
  686. X        }
  687. X            tvar = NULL;
  688. X        swexpr = NULL;
  689. X            if (ep->kind == EK_VAR) {
  690. X                tp = findbasetype(ep->val.type, 0);
  691. X                if ((tp == tp_char || tp == tp_schar || tp == tp_uchar ||
  692. X                     tp == tp_abyte || tp == tp_sbyte || tp == tp_ubyte ||
  693. X             tp == tp_boolean) &&
  694. X                    ((checkconst(sp->exp2, 0) &&
  695. X              tp != tp_sbyte && tp != tp_schar) ||
  696. X                     checkconst(sp->exp2, -128) ||
  697. X                     (checkconst(sp->exp2, 127) &&
  698. X              tp != tp_ubyte && tp != tp_uchar) ||
  699. X                     checkconst(sp->exp2, 255) ||
  700. X                     (tp == tp_char &&
  701. X                      (useAnyptrMacros == 1 || unsignedchar != 1) &&
  702. X                      isliteralconst(sp->exp2, NULL) == 2 &&
  703. X                      sp->exp2->val.i >= 128))) {
  704. X                    swexpr = ep;
  705. X                    tvar = makestmttempvar(tp_sshort, name_TEMP);
  706. X                    ep = makeexpr_var(tvar);
  707. X                } else if (((tp == tp_sshort &&
  708. X                             (checkconst(sp->exp2, -32768) ||
  709. X                              checkconst(sp->exp2, 32767))) ||
  710. X                            (tp == tp_ushort &&
  711. X                             (checkconst(sp->exp2, 0) ||
  712. X                              checkconst(sp->exp2, 65535))))) {
  713. X                    swexpr = ep;
  714. X                    tvar = makestmttempvar(tp_integer, name_TEMP);
  715. X                    ep = makeexpr_var(tvar);
  716. X                } else if (tp == tp_integer &&
  717. X               (checkconst(sp->exp2, LONG_MAX) ||
  718. X                (sp->exp2->kind == EK_VAR &&
  719. X                 sp->exp2->val.i == (long)mp_maxint))) {
  720. X                    swexpr = ep;
  721. X                    tvar = makestmttempvar(tp_unsigned, name_TEMP);
  722. X                    ep = makeexpr_var(tvar);
  723. X                }
  724. X            }
  725. X        sp->exp3 = makeexpr_assign(copyexpr(ep),
  726. X                       makeexpr_inc(copyexpr(ep),
  727. X                            copyexpr(forstep)));
  728. X            wneedtok(TOK_DO);
  729. X            forfixed = (fixedflag != forfixed);
  730. X            mp = makestmttempvar(ep->val.type, name_FOR);
  731. X            sp->stm1 = p_stmt(NULL, SF_SAVESER);
  732. X            if (tvar) {
  733. X                if (checkexprchanged(sp->stm1, swexpr))
  734. X                    note(format_s("Rewritten FOR loop won't work if it meddles with %s [253]",
  735. X                                  ((Meaning *)swexpr->val.i)->name));
  736. X                sp->stm1 = makestmt_seq(makestmt_assign(swexpr, makeexpr_var(tvar)),
  737. X                                        sp->stm1);
  738. X            } else if (offsetforloops && ep->kind == EK_VAR) {
  739. X        offset = checkvaroffset(sp->stm1, (Meaning *)ep->val.i);
  740. X        if (offset != 0) {
  741. X            ep3 = makeexpr_inc(copyexpr(ep), makeexpr_long(-offset));
  742. X            replaceexpr(sp->stm1, ep, ep3);
  743. X            freeexpr(ep3);
  744. X            ep2 = makeexpr_plus(ep2, makeexpr_long(offset));
  745. X            sp->exp2 = makeexpr_inc(sp->exp2, makeexpr_long(offset));
  746. X        }
  747. X        }
  748. X            if (!exprsame(ep, ep2, 1))
  749. X                sp->exp1 = makeexpr_assign(copyexpr(ep), copyexpr(ep2));
  750. X        isunsafe = ((!nodependencies(ep2, 2) &&
  751. X             !nosideeffects(sp->exp2, 1)) ||
  752. X            (!nodependencies(sp->exp2, 2) &&
  753. X             !nosideeffects(ep2, 1)));
  754. X            if (forfixed || (simplefor(sp, ep) && !isunsafe)) {
  755. X                canceltempvar(mp);
  756. X                sp->exp2 = makeexpr_rel(ekind, ep, sp->exp2);
  757. X            } else {
  758. X        ep3 = makeexpr_neg(copyexpr(forstep));
  759. X        if ((checkconst(forstep, 1) || checkconst(forstep, -1)) &&
  760. X            sp->exp2->kind == EK_PLUS &&
  761. X            exprsame(sp->exp2->args[sp->exp2->nargs-1], ep3, 2)) {
  762. X            sp->exp2 = makeexpr_inc(sp->exp2, forstep);
  763. X        } else {
  764. X            freeexpr(forstep);
  765. X            freeexpr(ep3);
  766. X            ep3 = makeexpr_long(0);
  767. X        }
  768. X        if (forevalorder && isunsafe) {
  769. X            if (exprdepends(sp->exp2, ep)) {
  770. X            tvar = makestmttempvar(mp->type, name_TEMP);
  771. X            sp->exp1 = makeexpr_comma(
  772. X                     makeexpr_comma(
  773. X                       makeexpr_assign(makeexpr_var(tvar),
  774. X                               copyexpr(ep2)),
  775. X                       makeexpr_assign(makeexpr_var(mp),
  776. X                               sp->exp2)),
  777. X                     makeexpr_assign(copyexpr(ep),
  778. X                             makeexpr_var(tvar)));
  779. X            } else
  780. X            sp->exp1 = makeexpr_comma(
  781. X                     sp->exp1,
  782. X                     makeexpr_assign(makeexpr_var(mp),
  783. X                             sp->exp2));
  784. X        } else {
  785. X            if (isunsafe)
  786. X            note("Evaluating FOR loop limit before initial value [315]");
  787. X            sp->exp1 = makeexpr_comma(
  788. X                     makeexpr_assign(makeexpr_var(mp),
  789. X                         sp->exp2),
  790. X                     sp->exp1);
  791. X        }
  792. X        sp->exp2 = makeexpr_inc(makeexpr_var(mp), ep3);
  793. X                sp->exp2 = makeexpr_rel(ekind, ep, sp->exp2);
  794. X            }
  795. X        freeexpr(ep2);
  796. X            break;
  797. X
  798. X        case TOK_GOTO:
  799. X            gettok();
  800. X            if (findlabelsym()) {
  801. X                if (curtokmeaning->ctx != curctx) {
  802. X            curtokmeaning->val.i = 1;
  803. X            *spp = close_files_to_ctx(curtokmeaning->ctx);
  804. X            while (*spp)
  805. X            spp = &((*spp)->next);
  806. X            newstmt(SK_ASSIGN);
  807. X            var_reference(curtokmeaning->xnext);
  808. X            if (curtokmeaning->ctx->kind == MK_MODULE &&
  809. X            !curtokmeaning->xnext->wasdeclared) {
  810. X            outsection(minorspace);
  811. X            declarevar(curtokmeaning->xnext, 0x7);
  812. X            curtokmeaning->xnext->wasdeclared = 1;
  813. X            outsection(minorspace);
  814. X            }
  815. X            sp->exp1 = makeexpr_bicall_2("longjmp", tp_void,
  816. X                         makeexpr_var(curtokmeaning->xnext),
  817. X                         makeexpr_long(1));
  818. X        } else {
  819. X            newstmt(SK_GOTO);
  820. X            sp->exp1 = makeexpr_name(format_s(name_LABEL,
  821. X                              curtokmeaning->name),
  822. X                         tp_integer);
  823. X        }
  824. X            } else {
  825. X                warning("Expected a label [263]");
  826. X        }
  827. X        gettok();
  828. X            break;
  829. X
  830. X        case TOK_IF:
  831. X            gettok();
  832. X            newstmt(SK_IF);
  833. X        saveserial = curserial;
  834. X        curserial = ++serialcount;
  835. X            sp->exp1 = p_expr(tp_boolean);
  836. X            wneedtok(TOK_THEN);
  837. X            sp->stm1 = p_stmt(NULL, SF_SAVESER|SF_IF);
  838. X        changecomments(curcomments, -1, saveserial+1, -1, saveserial);
  839. X        checkkeyword(TOK_ELSIF);
  840. X        while (curtok == TOK_ELSIF) {
  841. X        gettok();
  842. X        sp->stm2 = makestmt(SK_IF);
  843. X        sp = sp->stm2;
  844. X        sp->exp1 = p_expr(tp_boolean);
  845. X        wneedtok(TOK_THEN);
  846. X        sp->stm1 = p_stmt(NULL, SF_SAVESER|SF_IF);
  847. X        sp->exp2 = makeexpr_long(1);
  848. X        }
  849. X        if (curtok == TOK_ELSE) {
  850. X                line1 = inf_lnum;
  851. X        strlist_mix(&curcomments, grabcomment(CMT_ONELSE));
  852. X                gettok();
  853. X                line2 = (curtok == TOK_IF) ? inf_lnum : -1;
  854. X        saveserial2 = curserial;
  855. X                sp->stm2 = p_stmt(NULL, SF_SAVESER|SF_IF);
  856. X        changecomments(curcomments, -1, saveserial2, -1, saveserial+1);
  857. X                if (sp->stm2 && sp->stm2->kind == SK_IF &&
  858. X            !sp->stm2->next && !modula2) {
  859. X                    sp->stm2->exp2 = makeexpr_long(elseif > 0 ||
  860. X                                                   (elseif < 0 && line1 == line2));
  861. X                }
  862. X            }
  863. X        if (modula2)
  864. X        wneedtok(TOK_END);
  865. X        curserial = saveserial;
  866. X            break;
  867. X
  868. X        case TOK_INLINE:
  869. X            gettok();
  870. X            note("Inline assembly language encountered [254]");
  871. X            if (curtok != TOK_LPAR) {   /* Macintosh style */
  872. X        newstmt(SK_ASSIGN);
  873. X        sp->exp1 = makeexpr_bicall_1("inline", tp_void,
  874. X                         p_expr(tp_integer));
  875. X        break;
  876. X        }
  877. X            do {
  878. X                name = getinlinepart();
  879. X                if (!*name)
  880. X                    break;
  881. X                newstmt(SK_ASSIGN);
  882. X                sp->exp1 = makeexpr_bicall_1("asm", tp_void,
  883. X                            makeexpr_string(format_s(" inline %s", name)));
  884. X                gettok();
  885. X            } while (curtok == TOK_SLASH);
  886. X            skipcloseparen();
  887. X            break;
  888. X
  889. X    case TOK_LOOP:
  890. X        gettok();
  891. X        newstmt(SK_WHILE);
  892. X        sp->exp1 = makeexpr_long(1);
  893. X            sp->stm1 = p_stmt(NULL, SF_SAVESER);
  894. X        break;
  895. X
  896. X        case TOK_REPEAT:
  897. X            newstmt(SK_REPEAT);
  898. X        saveserial = curserial;
  899. X            spp2 = &(sp->stm1);
  900. X        i = SF_FIRST;
  901. X            do {
  902. X                gettok();
  903. X                *spp2 = p_stmt(sp->stm1, i);
  904. X        i = 0;
  905. X                while (*spp2)
  906. X                    spp2 = &((*spp2)->next);
  907. X            } while (curtok == TOK_SEMI);
  908. X            if (!wneedtok(TOK_UNTIL))
  909. X        skippasttoken(TOK_UNTIL);
  910. X            sp->exp1 = makeexpr_not(p_expr(tp_boolean));
  911. X        curserial = saveserial;
  912. X        strlist_mix(&curcomments, grabcomment(CMT_ONEND));
  913. X            break;
  914. X
  915. X    case TOK_RETURN:
  916. X        gettok();
  917. X        newstmt(SK_RETURN);
  918. X        if (curctx->isfunction) {
  919. X        sp->exp1 = gentle_cast(p_expr(curctx->cbase->type),
  920. X                       curctx->cbase->type);
  921. X        }
  922. X        break;
  923. X
  924. X        case TOK_TRY:
  925. X        findsymbol("RECOVER")->flags &= ~KWPOSS;
  926. X            newstmt(SK_TRY);
  927. X            sp->exp1 = makeexpr_long(++trycount);
  928. X            spp2 = &(sp->stm1);
  929. X        i = SF_FIRST;
  930. X            do {
  931. X                gettok();
  932. X                *spp2 = p_stmt(sp->stm1, i);
  933. X        i = 0;
  934. X                while (*spp2)
  935. X                    spp2 = &((*spp2)->next);
  936. X            } while (curtok == TOK_SEMI);
  937. X            if (!wneedtok(TOK_RECOVER))
  938. X        skippasttoken(TOK_RECOVER);
  939. X            sp->stm2 = p_stmt(NULL, SF_SAVESER);
  940. X            break;
  941. X
  942. X        case TOK_WHILE:
  943. X            gettok();
  944. X            newstmt(SK_WHILE);
  945. X            sp->exp1 = p_expr(tp_boolean);
  946. X            wneedtok(TOK_DO);
  947. X            sp->stm1 = p_stmt(NULL, SF_SAVESER);
  948. X            break;
  949. X
  950. X        case TOK_WITH:
  951. X            gettok();
  952. X            if (withlevel >= MAXWITHS-1)
  953. X                error("Too many nested WITHs");
  954. X            ep = p_expr(NULL);
  955. X            if (ep->val.type->kind != TK_RECORD)
  956. X                warning("Argument of WITH is not a RECORD [264]");
  957. X            withlist[withlevel] = ep->val.type;
  958. X            if (simplewith(ep)) {
  959. X                withexprs[withlevel] = ep;
  960. X                mp = NULL;
  961. X            } else {           /* need to save a temporary pointer */
  962. X                tp = makepointertype(ep->val.type);
  963. X                mp = makestmttempvar(tp, name_WITH);
  964. X                withexprs[withlevel] = makeexpr_hat(makeexpr_var(mp), 0);
  965. X            }
  966. X            withlevel++;
  967. X            if (curtok == TOK_COMMA) {
  968. X                curtok = TOK_WITH;
  969. X                sp2 = p_stmt(NULL, sflags & SF_FIRST);
  970. X            } else {
  971. X                wneedtok(TOK_DO);
  972. X                sp2 = p_stmt(NULL, sflags & SF_FIRST);
  973. X            }
  974. X            withlevel--;
  975. X            if (mp) {    /* if "with p^" for constant p, don't need temp ptr */
  976. X                if (ep->kind == EK_HAT && ep->args[0]->kind == EK_VAR &&
  977. X                    !checkvarchanged(sp2, (Meaning *)ep->args[0]->val.i)) {
  978. X                    replaceexpr(sp2, withexprs[withlevel]->args[0],
  979. X                                     ep->args[0]);
  980. X                    freeexpr(ep);
  981. X                    canceltempvar(mp);
  982. X                } else {
  983. X                    newstmt(SK_ASSIGN);
  984. X                    sp->exp1 = makeexpr_assign(makeexpr_var(mp),
  985. X                                               makeexpr_addr(ep));
  986. X                }
  987. X            }
  988. X            freeexpr(withexprs[withlevel]);
  989. X            *spp = sp2;
  990. X            while (*spp)
  991. X                spp = &((*spp)->next);
  992. X            break;
  993. X
  994. X        case TOK_INCLUDE:
  995. X            badinclude();
  996. X            goto again;
  997. X
  998. X    case TOK_ADDR:   /* flakey Turbo "@procptr := anyptr" assignment */
  999. X        newstmt(SK_ASSIGN);
  1000. X        ep = p_expr(tp_void);
  1001. X        if (wneedtok(TOK_ASSIGN))
  1002. X        sp->exp1 = makeexpr_assign(ep, p_expr(ep->val.type));
  1003. X        else
  1004. X        sp->exp1 = ep;
  1005. X        break;
  1006. X
  1007. X        case TOK_IDENT:
  1008. X            mp = curtokmeaning;
  1009. X        if (mp == mp_str_hp)
  1010. X        mp = curtokmeaning = mp_str_turbo;
  1011. X        if (mp == mp_val_modula)
  1012. X        mp = curtokmeaning = mp_val_turbo;
  1013. X        if (mp == mp_blockread_ucsd)
  1014. X        mp = curtokmeaning = mp_blockread_turbo;
  1015. X        if (mp == mp_blockwrite_ucsd)
  1016. X        mp = curtokmeaning = mp_blockwrite_turbo;
  1017. X        if (mp == mp_dec_dec)
  1018. X        mp = curtokmeaning = mp_dec_turbo;
  1019. X            if (!mp) {
  1020. X                sym = curtoksym;     /* make a guess at what the undefined name is... */
  1021. X                name = stralloc(curtokcase);
  1022. X                gettok();
  1023. X                newstmt(SK_ASSIGN);
  1024. X                if (curtok == TOK_ASSIGN) {
  1025. X                    gettok();
  1026. X                    ep = p_expr(NULL);
  1027. X                    mp = addmeaning(sym, MK_VAR);
  1028. X                    mp->name = name;
  1029. X                    mp->type = ep->val.type;
  1030. X                    sp->exp1 = makeexpr_assign(makeexpr_var(mp), ep);
  1031. X                } else if (curtok == TOK_HAT || curtok == TOK_ADDR ||
  1032. X                           curtok == TOK_LBR || curtok == TOK_DOT) {
  1033. X                    ep = makeexpr_name(name, tp_integer);
  1034. X                    ep = fake_dots_n_hats(ep);
  1035. X                    if (wneedtok(TOK_ASSIGN))
  1036. X            sp->exp1 = makeexpr_assign(ep, p_expr(NULL));
  1037. X            else
  1038. X            sp->exp1 = ep;
  1039. X                } else if (curtok == TOK_LPAR) {
  1040. X                    ep = makeexpr_bicall_0(name, tp_void);
  1041. X                    do {
  1042. X                        gettok();
  1043. X                        insertarg(&ep, ep->nargs, p_expr(NULL));
  1044. X                    } while (curtok == TOK_COMMA);
  1045. X                    skipcloseparen();
  1046. X                    sp->exp1 = ep;
  1047. X                } else {
  1048. X                    sp->exp1 = makeexpr_bicall_0(name, tp_void);
  1049. X                }
  1050. X        if (!tryfuncmacro(&sp->exp1, NULL))
  1051. X            undefsym(sym);
  1052. X            } else if (mp->kind == MK_FUNCTION && !mp->isfunction) {
  1053. X                mp->refcount++;
  1054. X                gettok();
  1055. X                ep = p_funccall(mp);
  1056. X                if (!mp->constdefn)
  1057. X                    need_forward_decl(mp);
  1058. X                if (mp->handler && !(mp->sym->flags & LEAVEALONE) &&
  1059. X                                   !mp->constdefn) {
  1060. X                    prochandler = (Stmt *(*)())mp->handler;
  1061. X                    *spp = (*prochandler)(ep, slist);
  1062. X                    while (*spp)
  1063. X                        spp = &((*spp)->next);
  1064. X                } else {
  1065. X                    newstmt(SK_ASSIGN);
  1066. X                    sp->exp1 = ep;
  1067. X                }
  1068. X            } else if (mp->kind == MK_SPECIAL) {
  1069. X                gettok();
  1070. X                if (mp->handler && !mp->isfunction) {
  1071. X                    if ((mp->sym->flags & LEAVEALONE) || mp->constdefn) {
  1072. X                        ep = makeexpr_bicall_0(mp->name, tp_void);
  1073. X                        if (curtok == TOK_LPAR) {
  1074. X                            do {
  1075. X                                gettok();
  1076. X                                insertarg(&ep, ep->nargs, p_expr(NULL));
  1077. X                            } while (curtok == TOK_COMMA);
  1078. X                            skipcloseparen();
  1079. X                        }
  1080. X                        newstmt(SK_ASSIGN);
  1081. X            tryfuncmacro(&ep, mp);
  1082. X            sp->exp1 = ep;
  1083. X                    } else {
  1084. X                        prochandler = (Stmt *(*)())mp->handler;
  1085. X                        *spp = (*prochandler)(mp, slist);
  1086. X                        while (*spp)
  1087. X                            spp = &((*spp)->next);
  1088. X                    }
  1089. X                } else
  1090. X                    symclass(curtoksym);
  1091. X            } else {
  1092. X                newstmt(SK_ASSIGN);
  1093. X                if (curtokmeaning->kind == MK_FUNCTION &&
  1094. X            peeknextchar() != '(') {
  1095. X                    mp = curctx;
  1096. X                    while (mp && mp != curtokmeaning)
  1097. X                        mp = mp->ctx;
  1098. X                    if (mp)
  1099. X                        curtokmeaning = curtokmeaning->cbase;
  1100. X                }
  1101. X                ep = p_expr(tp_void);
  1102. X#if 0
  1103. X        if (!(ep->kind == EK_SPCALL ||
  1104. X              (ep->kind == EK_COND &&
  1105. X               ep->args[1]->kind == EK_SPCALL)))
  1106. X            wexpecttok(TOK_ASSIGN);
  1107. X#endif
  1108. X        if (curtok == TOK_ASSIGN) {
  1109. X            gettok();
  1110. X            if (curtok == TOK_IDENT && !strcicmp(curtokbuf, "ZERO") &&
  1111. X            !curtokmeaning) {   /* VAX Pascal foolishness */
  1112. X            gettok();
  1113. X            ep2 = makeexpr_sizeof(copyexpr(ep), 0);
  1114. X            sp->exp1 = makeexpr_bicall_3("memset", tp_void,
  1115. X                             makeexpr_addr(ep),
  1116. X                             makeexpr_long(0), ep2);
  1117. X            } else
  1118. X            sp->exp1 = makeexpr_assign(ep, p_expr(ep->val.type));
  1119. X        } else
  1120. X            sp->exp1 = ep;
  1121. X            }
  1122. X            break;
  1123. X
  1124. X    default:
  1125. X        break;    /* null statement */
  1126. X    }
  1127. X    freestmttemps(tempmark);
  1128. X    if (sflags & SF_SAVESER)
  1129. X    curserial = firstserial;
  1130. X    return sbase;
  1131. X}
  1132. X
  1133. X
  1134. X
  1135. X
  1136. X
  1137. X
  1138. X
  1139. X#define BR_NEVER        0x1     /* never use braces */
  1140. X#define BR_FUNCTION     0x2     /* function body */
  1141. X#define BR_THENPART     0x4     /* before an "else" */
  1142. X#define BR_ALWAYS       0x8     /* always use braces */
  1143. X#define BR_REPEAT       0x10    /* "do-while" loop */
  1144. X#define BR_TRY          0x20    /* in a recover block */
  1145. X#define BR_ELSEPART     0x40    /* after an "else" */
  1146. X#define BR_CASE         0x80    /* case of a switch stmt */
  1147. X
  1148. XStatic int usebraces(sp, opts)
  1149. XStmt *sp;
  1150. Xint opts;
  1151. X{
  1152. X    if (opts & (BR_FUNCTION|BR_ALWAYS))
  1153. X        return 1;
  1154. X    if (opts & BR_NEVER)
  1155. X        return 0;
  1156. X    switch (bracesalways) {
  1157. X        case 0:
  1158. X            if (sp) {
  1159. X                if (sp->next ||
  1160. X                    sp->kind == SK_TRY ||
  1161. X                    (sp->kind == SK_IF && !sp->stm2) ||
  1162. X                    (opts & BR_REPEAT))
  1163. X                    return 1;
  1164. X            }
  1165. X            break;
  1166. X
  1167. X        case 1:
  1168. X            return 1;
  1169. X            break;
  1170. X
  1171. X        default:
  1172. X            if (sp) {
  1173. X                if (sp->next ||
  1174. X                    sp->kind == SK_IF ||
  1175. X                    sp->kind == SK_WHILE ||
  1176. X                    sp->kind == SK_REPEAT ||
  1177. X                    sp->kind == SK_TRY ||
  1178. X            sp->kind == SK_CASE ||
  1179. X                    sp->kind == SK_FOR)
  1180. X                    return 1;
  1181. X            }
  1182. X            break;
  1183. X    }
  1184. X    if (sp != NULL &&
  1185. X    findcomment(curcomments, CMT_NOT | CMT_TRAIL, sp->serial) != NULL)
  1186. X    return 1;
  1187. X    return 0;
  1188. X}
  1189. X
  1190. X
  1191. X
  1192. X#define outspnl(spflag) output((spflag) ? " " : "\n")
  1193. X
  1194. X#define openbrace()                 \
  1195. X    wbraces = (!candeclare);        \
  1196. X    if (wbraces) {                  \
  1197. X        output("{");                \
  1198. X        outspnl(braceline <= 0);    \
  1199. X        candeclare = 1;             \
  1200. X    }
  1201. X
  1202. X#define closebrace()                \
  1203. X    if (wbraces) {                  \
  1204. X        if (sp->next || braces)     \
  1205. X            output("}\n");          \
  1206. X        else                        \
  1207. X            braces = 1;             \
  1208. X    }
  1209. X
  1210. X
  1211. X
  1212. XMeaning *outcontext;
  1213. X
  1214. XStatic void outnl(serial)
  1215. Xint serial;
  1216. X{
  1217. X    outtrailcomment(curcomments, serial, commentindent);
  1218. X}
  1219. X
  1220. X
  1221. XStatic void out_block(spbase, opts, serial)
  1222. XStmt *spbase;
  1223. Xint opts, serial;
  1224. X{
  1225. X    int i, j, braces, always, trynum, istrail, hascmt;
  1226. X    int gotcomments = 0;
  1227. X    int saveindent, saveindent2, delta;
  1228. X    Stmt *sp = spbase;
  1229. X    Stmt *sp2, *sp3;
  1230. X    Meaning *ctx, *mp;
  1231. X    Strlist *curcmt, *cmt, *savecurcmt = curcomments;
  1232. X    Strlist *trailcmt, *begincmt, *endcmt;
  1233. X
  1234. X    if (debug>1) { fprintf(outf, "out_block of:\n"); dumpstmt(spbase,5); }
  1235. X    if (opts & BR_FUNCTION) {
  1236. X    if (outcontext && outcontext->comments) {
  1237. X        gotcomments = 1;
  1238. X        curcomments = outcontext->comments;
  1239. X    }
  1240. X    attach_comments(spbase);
  1241. X    }
  1242. X    braces = usebraces(sp, opts);
  1243. X    trailcmt = findcomment(curcomments, CMT_TRAIL, serial);
  1244. X    begincmt = findcomment(curcomments, CMT_ONBEGIN, serial);
  1245. X    istrail = 1;
  1246. X    if (!trailcmt) {
  1247. X    trailcmt = begincmt;
  1248. X    begincmt = NULL;
  1249. X    istrail = 0;
  1250. X    }
  1251. X    endcmt = findcomment(curcomments, CMT_ONEND, serial);
  1252. X    if ((begincmt || endcmt) && !(opts & BR_NEVER))
  1253. X    braces = 1;
  1254. X    if (opts & BR_ELSEPART) {
  1255. X    cmt = findcomment(curcomments, CMT_ONELSE, serial);
  1256. X    if (cmt) {
  1257. X        if (trailcmt) {
  1258. X        out_spaces(bracecommentindent, commentoverindent,
  1259. X               commentlen(cmt), 0);
  1260. X        output("\001");
  1261. X        outcomment(cmt);
  1262. X        } else
  1263. X        trailcmt = cmt;
  1264. X    }
  1265. X    }
  1266. X    if (braces) {
  1267. X    j = (opts & BR_FUNCTION) ? funcopenindent : openbraceindent;
  1268. X        if (!line_start()) {
  1269. X        if (trailcmt &&
  1270. X        cur_column() + commentlen(trailcmt) + 2 > linewidth &&
  1271. X        outindent + commentlen(trailcmt) + 2 < linewidth)  /*close enough*/
  1272. X        i = 0;
  1273. X        else if (opts & BR_ELSEPART)
  1274. X        i = ((braceelseline & 2) == 0);
  1275. X        else if (braceline >= 0)
  1276. X        i = (braceline == 0);
  1277. X        else
  1278. X                i = ((opts & BR_FUNCTION) == 0);
  1279. X        if (trailcmt && begincmt) {
  1280. X        out_spaces(commentindent, commentoverindent,
  1281. X               commentlen(trailcmt), j);
  1282. X        outcomment(trailcmt);
  1283. X        trailcmt = begincmt;
  1284. X        begincmt = NULL;
  1285. X        istrail = 0;
  1286. X        } else
  1287. X        outspnl(i);
  1288. X        }
  1289. X    if (line_start())
  1290. X        singleindent(j);
  1291. X        output("{");
  1292. X        candeclare = 1;
  1293. X    } else if (!sp) {
  1294. X        if (!line_start())
  1295. X            outspnl(!nullstmtline && !(opts & BR_TRY));
  1296. X    if (line_start())
  1297. X        singleindent(tabsize);
  1298. X        output(";");
  1299. X    }
  1300. X    if (opts & BR_CASE)
  1301. X    delta = 0;
  1302. X    else {
  1303. X    delta = tabsize;
  1304. X    if (opts & BR_FUNCTION)
  1305. X        delta = adddeltas(delta, bodyindent);
  1306. X    else if (braces)
  1307. X        delta = adddeltas(delta, blockindent);
  1308. X    }
  1309. X    futureindent(delta);
  1310. X    if (bracecombine && braces)
  1311. X    i = applydelta(outindent, delta) - cur_column();
  1312. X    else
  1313. X    i = -1;
  1314. X    if (commentvisible(trailcmt)) {
  1315. X    if (line_start()) {
  1316. X        singleindent(delta);
  1317. X        out_spaces(commentoverindent, 1000, commentlen(trailcmt), 0);
  1318. X        outcomment(trailcmt);
  1319. X    } else /*if (commentlen(trailcmt) + cur_column() + 1 <= linewidth)*/ {
  1320. X        out_spaces(istrail ? commentindent : bracecommentindent,
  1321. X               commentoverindent, commentlen(trailcmt), delta);
  1322. X        outcomment(trailcmt);
  1323. X    } /*else {
  1324. X        output("\n");
  1325. X        singleindent(delta);
  1326. X        out_spaces(commentoverindent, 1000, commentlen(trailcmt), 0);
  1327. X        outcomment(trailcmt);
  1328. X    }*/
  1329. X    i = -9999;
  1330. X    }
  1331. X    if (i > 0)
  1332. X    out_spaces(i, 0, 0, 0);
  1333. X    else if (i != -9999)
  1334. X    output("\n");
  1335. X    saveindent = outindent;
  1336. X    moreindent(delta);
  1337. X    outcomment(begincmt);
  1338. X    while (sp) {
  1339. X    flushcomments(NULL, CMT_PRE, sp->serial);
  1340. X    if (cmtdebug)
  1341. X        output(format_d("[%d] ", sp->serial));
  1342. X        switch (sp->kind) {
  1343. X
  1344. X            case SK_HEADER:
  1345. X                ctx = (Meaning *)sp->exp1->val.i;
  1346. X        eatblanklines();
  1347. X                if (declarevars(ctx, 0))
  1348. X                    outsection(minorspace);
  1349. X        flushcomments(NULL, CMT_NOT | CMT_ONEND, serial);
  1350. X                if (ctx->kind == MK_MODULE) {
  1351. X                    if (ctx->anyvarflag) {
  1352. X                        output(format_s(name_MAIN, ""));
  1353. X                        output("(argc, argv);\n");
  1354. X                    } else {
  1355. X                        output("static int _was_initialized = 0;\n");
  1356. X                        output("if (_was_initialized++)\n");
  1357. X            singleindent(tabsize);
  1358. X                        output("return;\n");
  1359. X                    }
  1360. X            while (initialcalls) {
  1361. X            output(initialcalls->s);
  1362. X            output(";\n");
  1363. X            strlist_remove(&initialcalls, initialcalls->s);
  1364. X            }
  1365. X                } else {
  1366. X                    if (ctx->varstructflag && ctx->ctx->kind == MK_FUNCTION &&
  1367. X                                              ctx->ctx->varstructflag) {
  1368. X                        output(format_s(name_VARS, ctx->name));
  1369. X                        output(".");
  1370. X                        output(format_s(name_LINK, ctx->ctx->name));
  1371. X                        output(" = ");
  1372. X                        output(format_s(name_LINK, ctx->ctx->name));
  1373. X                        output(";\n");
  1374. X                    }
  1375. X                    for (mp = ctx->cbase; mp; mp = mp->cnext) {
  1376. X                        if ((mp->kind == MK_VAR ||    /* these are variables with */
  1377. X                 mp->kind == MK_VARREF) &&
  1378. X                mp->varstructflag &&      /* initializers which were moved */
  1379. X                mp->cnext &&              /* into a varstruct, so they */
  1380. X                mp->cnext->snext == mp && /* must be initialized now */
  1381. X                mp->cnext->constdefn) {
  1382. X                            if (mp->type->kind == TK_ARRAY) {
  1383. X                                output("memcpy(");
  1384. X                                out_var(mp, 2);
  1385. X                                output(", ");
  1386. X                                out_var(mp->cnext, 2);
  1387. X                                output(", sizeof(");
  1388. X                                out_type(mp->type, 1);
  1389. X                                output("))");
  1390. X                            } else {
  1391. X                                out_var(mp, 2);
  1392. X                                output(" = ");
  1393. X                                out_var(mp->cnext, 2);
  1394. X                            }
  1395. X                            output(";\n");
  1396. X                        }
  1397. X                    }
  1398. X                }
  1399. X                break;
  1400. X
  1401. X            case SK_RETURN:
  1402. X                output("return");
  1403. X        if (sp->exp1) {
  1404. X            switch (returnparens) {
  1405. X            
  1406. X              case 0:
  1407. X            output(" ");
  1408. X            out_expr(sp->exp1);
  1409. X            break;
  1410. X            
  1411. X              case 1:
  1412. X            if (spaceexprs != 0)
  1413. X                output(" ");
  1414. X            out_expr_parens(sp->exp1);
  1415. X            break;
  1416. X            
  1417. X              default:
  1418. X            if (sp->exp1->kind == EK_VAR ||
  1419. X                sp->exp1->kind == EK_CONST ||
  1420. X                sp->exp1->kind == EK_LONGCONST ||
  1421. X                sp->exp1->kind == EK_BICALL) {
  1422. X                output(" ");
  1423. X                out_expr(sp->exp1);
  1424. X            } else {
  1425. X                if (spaceexprs != 0)
  1426. X                output(" ");
  1427. X                out_expr_parens(sp->exp1);
  1428. X            }
  1429. X            break;
  1430. X            }
  1431. X        }
  1432. X        output(";");
  1433. X        outnl(sp->serial);
  1434. X                break;
  1435. X
  1436. X            case SK_ASSIGN:
  1437. X                out_expr_stmt(sp->exp1);
  1438. X                output(";");
  1439. X        outnl(sp->serial);
  1440. X                break;
  1441. X
  1442. X            case SK_CASE:
  1443. X                output("switch (");
  1444. X                out_expr(sp->exp1);
  1445. X                output(")");
  1446. X                outspnl(braceline <= 0);
  1447. X                output("{");
  1448. X        outnl(sp->serial);
  1449. X        saveindent2 = outindent;
  1450. X        moreindent(tabsize);
  1451. X        moreindent(switchindent);
  1452. X                sp2 = sp->stm1;
  1453. X                while (sp2 && sp2->kind == SK_CASELABEL) {
  1454. X                    outsection(casespacing);
  1455. X                    sp3 = sp2;
  1456. X            i = 0;
  1457. X            hascmt = (findcomment(curcomments, -1, sp2->serial) != NULL);
  1458. X            singleindent(caseindent);
  1459. X            flushcomments(NULL, CMT_PRE, sp2->serial);
  1460. X                    for (;;) {
  1461. X            if (i)
  1462. X                singleindent(caseindent);
  1463. X            i = 0;
  1464. X                        output("case ");
  1465. X                        out_expr(sp3->exp1);
  1466. X                        output(":\001");
  1467. X                        sp3 = sp3->stm1;
  1468. X                        if (!sp3 || sp3->kind != SK_CASELABEL)
  1469. X                            break;
  1470. X                        if (casetabs != 1000)
  1471. X                            out_spaces(casetabs, 0, 0, 0);
  1472. X                        else {
  1473. X                            output("\n");
  1474. X                i = 1;
  1475. X            }
  1476. X                    }
  1477. X                    if (sp3)
  1478. X                        out_block(sp3, BR_NEVER|BR_CASE, sp2->serial);
  1479. X                    else {
  1480. X            outnl(sp2->serial);
  1481. X            if (!hascmt)
  1482. X                output("/* blank case */\n");
  1483. X            }
  1484. X                    output("break;\n");
  1485. X            flushcomments(NULL, -1, sp2->serial);
  1486. X                    sp2 = sp2->next;
  1487. X                }
  1488. X                if (sp2) {
  1489. X                    outsection(casespacing);
  1490. X            singleindent(caseindent);
  1491. X            flushcomments(NULL, CMT_PRE, sp2->serial);
  1492. X                    output("default:");
  1493. X                    out_block(sp2, BR_NEVER|BR_CASE, sp2->serial);
  1494. X                    output("break;\n");
  1495. X            flushcomments(NULL, -1, sp2->serial);
  1496. X                }
  1497. X                outindent = saveindent2;
  1498. X                output("}");
  1499. X        curcmt = findcomment(curcomments, CMT_ONEND, sp->serial);
  1500. X        if (curcmt)
  1501. X            outcomment(curcmt);
  1502. X        else
  1503. X            output("\n");
  1504. X                break;
  1505. X
  1506. X            case SK_CASECHECK:
  1507. X        output(name_CASECHECK);
  1508. X                output("();   /* CASE value range error */\n");
  1509. X                break;
  1510. X
  1511. X            case SK_FOR:
  1512. X                output("for (");
  1513. X        if (for_allornone)
  1514. X            output("\007");
  1515. X                if (sp->exp1 || sp->exp2 || sp->exp3 || spaceexprs > 0) {
  1516. X                    if (sp->exp1)
  1517. X                        out_expr_top(sp->exp1);
  1518. X                    else if (spaceexprs > 0)
  1519. X                        output(" ");
  1520. X                    output(";\002 ");
  1521. X                    if (sp->exp2)
  1522. X                        out_expr(sp->exp2);
  1523. X                    output(";\002 ");
  1524. X                    if (sp->exp3)
  1525. X                        out_expr_top(sp->exp3);
  1526. X                } else {
  1527. X                    output(";;");
  1528. X                }
  1529. X                output(")");
  1530. X                out_block(sp->stm1, 0, sp->serial);
  1531. X                break;
  1532. X
  1533. X            case SK_LABEL:
  1534. X                if (!line_start())
  1535. X                    output("\n");
  1536. X        singleindent(labelindent);
  1537. X                out_expr(sp->exp1);
  1538. X                output(":");
  1539. X                if (!sp->next)
  1540. X                    output(" ;");
  1541. X                outnl(sp->serial);
  1542. X                break;
  1543. X
  1544. X            case SK_GOTO:
  1545. X                /* what about non-local goto's? */
  1546. X                output("goto ");
  1547. X                out_expr(sp->exp1);
  1548. X                output(";");
  1549. X        outnl(sp->serial);
  1550. X                break;
  1551. X
  1552. X            case SK_IF:
  1553. X                sp2 = sp;
  1554. X                for (;;) {
  1555. X                    output("if (");
  1556. X                    out_expr_bool(sp2->exp1);
  1557. X                    output(")");
  1558. X                    if (sp2->stm2) {
  1559. X            cmt = findcomment(curcomments, CMT_ONELSE, sp->serial+1);
  1560. X                        i = (!cmt && sp2->stm2->kind == SK_IF &&
  1561. X                 !sp2->stm2->next &&
  1562. X                 ((sp2->stm2->exp2)
  1563. X                  ? checkconst(sp2->stm2->exp2, 1)
  1564. X                  : (elseif > 0)));
  1565. X            if (braceelse &&
  1566. X                            (usebraces(sp2->stm1, 0) ||
  1567. X                             usebraces(sp2->stm2, 0) || i))
  1568. X                            always = BR_ALWAYS;
  1569. X                        else
  1570. X                            always = 0;
  1571. X                        out_block(sp2->stm1, BR_THENPART|always, sp->serial);
  1572. X                        output("else");
  1573. X                        sp2 = sp2->stm2;
  1574. X                        if (i) {
  1575. X                            output(" ");
  1576. X                        } else {
  1577. X                            out_block(sp2, BR_ELSEPART|always, sp->serial+1);
  1578. X                            break;
  1579. X                        }
  1580. X                    } else {
  1581. X                        out_block(sp2->stm1, 0, sp->serial);
  1582. X                        break;
  1583. X                    }
  1584. X                }
  1585. X                break;
  1586. X
  1587. X            case SK_REPEAT:
  1588. X                output("do");
  1589. X                out_block(sp->stm1, BR_ALWAYS|BR_REPEAT, sp->serial);
  1590. X                output("while (");
  1591. X                out_expr_bool(sp->exp1);
  1592. X                output(");");
  1593. X        cmt = findcomment(curcomments, CMT_ONEND, sp->serial);
  1594. X        if (commentvisible(cmt)) {
  1595. X            out_spaces(commentindent, commentoverindent,
  1596. X                   commentlen(cmt), 0);
  1597. X            output("\001");
  1598. X            outcomment(cmt);
  1599. X        } else
  1600. X            output("\n");
  1601. X                break;
  1602. X
  1603. X            case SK_TRY:
  1604. X                trynum = sp->exp1->val.i;
  1605. X                output(format_d("TRY(try%d);", trynum));
  1606. X                out_block(sp->stm1, BR_NEVER|BR_TRY, sp->serial);
  1607. X                if (sp->exp2)
  1608. X                    output(format_ds("RECOVER2(try%d,%s);", trynum,
  1609. X                                     format_s(name_LABEL, format_d("try%d", trynum))));
  1610. X                else
  1611. X                    output(format_d("RECOVER(try%d);", trynum));
  1612. X                out_block(sp->stm2, BR_NEVER|BR_TRY, sp->serial);
  1613. X                output(format_d("ENDTRY(try%d);\n", trynum));
  1614. X                break;
  1615. X
  1616. X            case SK_WHILE:
  1617. X                output("while (");
  1618. X                out_expr_bool(sp->exp1);
  1619. X                output(")");
  1620. X                out_block(sp->stm1, 0, sp->serial);
  1621. X                break;
  1622. X
  1623. X            case SK_BREAK:
  1624. X                output("break;");
  1625. X        outnl(sp->serial);
  1626. X                break;
  1627. X
  1628. X            case SK_CONTINUE:
  1629. X                output("continue;");
  1630. X        outnl(sp->serial);
  1631. X                break;
  1632. X
  1633. X        default:
  1634. X            intwarning("out_block",
  1635. X               format_s("Misplaced statement kind %s [265]",
  1636. X                    stmtkindname(sp->kind)));
  1637. X        break;
  1638. X        }
  1639. X    flushcomments(NULL, -1, sp->serial);
  1640. X        candeclare = 0;
  1641. X        if (debug>1) { fprintf(outf, "in out_block:\n"); dumpstmt(spbase,5); }
  1642. X        sp = sp->next;
  1643. X    }
  1644. X    if (opts & BR_FUNCTION) {
  1645. X    cmt = extractcomment(&curcomments, CMT_ONEND, serial);
  1646. X    if (findcomment(curcomments, -1, -1) != NULL)  /* check for non-DONE */
  1647. X        output("\n");
  1648. X    flushcomments(NULL, -1, -1);
  1649. X    curcomments = cmt;
  1650. X    }
  1651. X    outindent = saveindent;
  1652. X    if (braces) {
  1653. X    if (line_start()) {
  1654. X        if (opts & BR_FUNCTION)
  1655. X        singleindent(funccloseindent);
  1656. X        else
  1657. X        singleindent(closebraceindent);
  1658. X    }
  1659. X        output("}");
  1660. X    i = 1;
  1661. X    cmt = findcomment(curcomments, CMT_ONEND, serial);
  1662. X    if (!(opts & BR_REPEAT) && commentvisible(cmt)) {
  1663. X        out_spaces(bracecommentindent, commentoverindent,
  1664. X               commentlen(cmt), 0);
  1665. X        output("\001");
  1666. X        outcomment(cmt);
  1667. X        i = 0;
  1668. X    }
  1669. X    if (i) {
  1670. X        outspnl((opts & BR_REPEAT) ||
  1671. X            ((opts & BR_THENPART) && (braceelseline & 1) == 0));
  1672. X    }
  1673. X        candeclare = 0;
  1674. X    }
  1675. X    if (gotcomments) {
  1676. X    outcontext->comments = curcomments;
  1677. X    curcomments = savecurcmt;
  1678. X    }
  1679. X}
  1680. X
  1681. X
  1682. X
  1683. X
  1684. X
  1685. X/* Should have a way to convert GOTO's to the end of the function to RETURN's */
  1686. X
  1687. X
  1688. X/* Convert "_RETV = foo;" at end of function to "return foo" */
  1689. X
  1690. XStatic int checkreturns(spp, nearret)
  1691. XStmt **spp;
  1692. Xint nearret;
  1693. X{
  1694. X    Stmt *sp;
  1695. X    Expr *rvar, *ex;
  1696. X    Meaning *mp;
  1697. X    int spnearret, spnextreturn;
  1698. X    int result = 0;
  1699. X
  1700. X    if (debug>2) { fprintf(outf, "checkreturns on:\n"); dumpstmt(*spp, 5); }
  1701. X    while ((sp = *spp)) {
  1702. X        spnextreturn = (sp->next &&
  1703. X                        sp->next->kind == SK_RETURN && sp->next->exp1 &&
  1704. X                        isretvar(sp->next->exp1) == curctx->cbase);
  1705. X        spnearret = (nearret && !sp->next) || spnextreturn;
  1706. X        result = 0;
  1707. X        switch (sp->kind) {
  1708. X
  1709. X            case SK_ASSIGN:
  1710. X                ex = sp->exp1;
  1711. X                if (ex->kind == EK_ASSIGN || structuredfunc(ex)) {
  1712. X                    rvar = ex->args[0];
  1713. X                    mp = isretvar(rvar);
  1714. X                    if (mp == curctx->cbase && spnearret) {
  1715. X                        if (ex->kind == EK_ASSIGN) {
  1716. X                            if (mp->kind == MK_VARPARAM) {
  1717. X                                ex = makeexpr_comma(ex, makeexpr_var(mp));
  1718. X                            } else {
  1719. X                                ex = grabarg(ex, 1);
  1720. X                                mp->refcount--;
  1721. X                            }
  1722. X                        }
  1723. X                        sp->exp1 = ex;
  1724. X                        sp->kind = SK_RETURN;
  1725. END_OF_FILE
  1726. if test 49384 -ne `wc -c <'src/parse.c.1'`; then
  1727.     echo shar: \"'src/parse.c.1'\" unpacked with wrong size!
  1728. fi
  1729. # end of 'src/parse.c.1'
  1730. fi
  1731. echo shar: End of archive 29 \(of 32\).
  1732. cp /dev/null ark29isdone
  1733. MISSING=""
  1734. 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
  1735.     if test ! -f ark${I}isdone ; then
  1736.     MISSING="${MISSING} ${I}"
  1737.     fi
  1738. done
  1739. if test "${MISSING}" = "" ; then
  1740.     echo You have unpacked all 32 archives.
  1741.     echo "Now see PACKNOTES and the README"
  1742.     rm -f ark[1-9]isdone ark[1-9][0-9]isdone
  1743. else
  1744.     echo You still need to unpack the following archives:
  1745.     echo "        " ${MISSING}
  1746. fi
  1747. ##  End of shell archive.
  1748. exit 0
  1749.