home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Professional / OS2PRO194.ISO / os2 / prgramer / pascal2c / parse.c < prev    next >
C/C++ Source or Header  |  1992-08-03  |  131KB  |  4,381 lines
  1. /* "p2c", a Pascal to C translator.
  2.    Copyright (C) 1989, 1990, 1991 Free Software Foundation.
  3.    Author's address: daveg@csvax.caltech.edu; 256-80 Caltech/Pasadena CA 91125.
  4.  
  5. This program is free software; you can redistribute it and/or modify
  6. it under the terms of the GNU General Public License as published by
  7. the Free Software Foundation (any version).
  8.  
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12. GNU General Public License for more details.
  13.  
  14. You should have received a copy of the GNU General Public License
  15. along with this program; see the file COPYING.  If not, write to
  16. the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
  17.  
  18.  
  19.  
  20. #define PROTO_PARSE_C
  21. #include "trans.h"
  22.  
  23.  
  24.  
  25. Static short candeclare;
  26. Static int trycount;
  27. Static Strlist *includedfiles;
  28. Static char echo_first;
  29. Static int echo_pos;
  30.  
  31.  
  32.  
  33. void setup_parse()
  34. {
  35.     candeclare = 0;
  36.     trycount = 0;
  37.     includedfiles = NULL;
  38.     echo_first = 1;
  39.     echo_pos = 0;
  40.     fixexpr_tryblock = 0;
  41. }
  42.  
  43.  
  44.  
  45. void echobreak()
  46. {
  47.     if (echo_pos > 0) {
  48.     printf("\n");
  49.     echo_pos = 0;
  50.     echo_first = 0;
  51.     }
  52. }
  53.  
  54.  
  55. void echoword(name, comma)
  56. char *name;
  57. int comma;
  58. {
  59.     FILE *f = (outf == stdout) ? stderr : stdout;
  60.  
  61.     if (quietmode || showprogress)
  62.         return;
  63.     if (!echo_first) {
  64.     if (comma) {
  65.         fprintf(f, ",");
  66.         echo_pos++;
  67.     }
  68.         if (echo_pos + strlen(name) > 77) {
  69.             fprintf(f, "\n");
  70.             echo_pos = 0;
  71.         } else {
  72.             fprintf(f, " ");
  73.             echo_pos++;
  74.         }
  75.     }
  76.     echo_first = 0;
  77.     fprintf(f, "%s", name);
  78.     echo_pos += strlen(name);
  79.     fflush(f);
  80. }
  81.  
  82.  
  83.  
  84. void echoprocname(mp)
  85. Meaning *mp;
  86. {
  87.     echoword(mp->name, 1);
  88. }
  89.  
  90.  
  91.  
  92.  
  93.  
  94. Static void forward_decl(func, isextern)
  95. Meaning *func;
  96. int isextern;
  97. {
  98.     if (func->wasdeclared)
  99.         return;
  100.     if (isextern && func->constdefn && !checkvarmac(func))
  101.     return;
  102.     if (isextern) {
  103.         output("extern ");
  104.     } else if (func->ctx->kind == MK_FUNCTION) {
  105.     if (useAnyptrMacros)
  106.         output("Local ");
  107.     else
  108.         output("static ");
  109.     } else if ((use_static != 0 && !useAnyptrMacros) ||
  110.            (findsymbol(func->name)->flags & NEEDSTATIC)) {
  111.     output("static ");
  112.     } else if (useAnyptrMacros) {
  113.     output("Static ");
  114.     }
  115.     if (func->type->basetype != tp_void || ansiC != 0) {
  116.         outbasetype(func->type, ODECL_FORWARD);
  117.         output(" ");
  118.     }
  119.     outdeclarator(func->type, func->name, ODECL_FORWARD);
  120.     output(";\n");
  121.     func->wasdeclared = 1;
  122. }
  123.  
  124.  
  125.  
  126.  
  127. /* Check if calling a parent procedure, whose body must */
  128. /*   be declared forward */
  129.  
  130. void need_forward_decl(func)
  131. Meaning *func;
  132. {
  133.     Meaning *mp;
  134.  
  135.     if (func->wasdeclared)
  136.         return;
  137.     for (mp = curctx->ctx; mp; mp = mp->ctx) {
  138.         if (mp == func) {
  139.         if (func->ctx->kind == MK_FUNCTION)
  140.         func->isforward = 1;
  141.         else
  142.         forward_decl(func, 0);
  143.             return;
  144.         }
  145.     }
  146. }
  147.  
  148.  
  149.  
  150.  
  151. void free_stmt(sp)
  152. register Stmt *sp;
  153. {
  154.     if (sp) {
  155.         free_stmt(sp->stm1);
  156.         free_stmt(sp->stm2);
  157.         free_stmt(sp->next);
  158.         freeexpr(sp->exp1);
  159.         freeexpr(sp->exp2);
  160.         freeexpr(sp->exp3);
  161.         FREE(sp);
  162.     }
  163. }
  164.  
  165.  
  166.  
  167.  
  168. Stmt *makestmt(kind)
  169. enum stmtkind kind;
  170. {
  171.     Stmt *sp;
  172.  
  173.     sp = ALLOC(1, Stmt, stmts);
  174.     sp->kind = kind;
  175.     sp->next = NULL;
  176.     sp->stm1 = NULL;
  177.     sp->stm2 = NULL;
  178.     sp->exp1 = NULL;
  179.     sp->exp2 = NULL;
  180.     sp->exp3 = NULL;
  181.     sp->serial = curserial = ++serialcount;
  182.     return sp;
  183. }
  184.  
  185.  
  186.  
  187. Stmt *makestmt_call(call)
  188. Expr *call;
  189. {
  190.     Stmt *sp = makestmt(SK_ASSIGN);
  191.     sp->exp1 = call;
  192.     return sp;
  193. }
  194.  
  195.  
  196.  
  197. Stmt *makestmt_assign(lhs, rhs)
  198. Expr *lhs, *rhs;
  199. {
  200.     Stmt *sp = makestmt(SK_ASSIGN);
  201.     sp->exp1 = makeexpr_assign(lhs, rhs);
  202.     return sp;
  203. }
  204.  
  205.  
  206.  
  207. Stmt *makestmt_if(cond, thn, els)
  208. Expr *cond;
  209. Stmt *thn, *els;
  210. {
  211.     Stmt *sp = makestmt(SK_IF);
  212.     sp->exp1 = cond;
  213.     sp->stm1 = thn;
  214.     sp->stm2 = els;
  215.     return sp;
  216. }
  217.  
  218.  
  219.  
  220. Stmt *makestmt_seq(s1, s2)
  221. Stmt *s1, *s2;
  222. {
  223.     Stmt *s1a;
  224.  
  225.     if (!s1)
  226.         return s2;
  227.     if (!s2)
  228.         return s1;
  229.     for (s1a = s1; s1a->next; s1a = s1a->next) ;
  230.     s1a->next = s2;
  231.     return s1;
  232. }
  233.  
  234.  
  235.  
  236. Stmt *copystmt(sp)
  237. Stmt *sp;
  238. {
  239.     Stmt *sp2;
  240.  
  241.     if (sp) {
  242.         sp2 = makestmt(sp->kind);
  243.         sp2->stm1 = copystmt(sp->stm1);
  244.         sp2->stm2 = copystmt(sp->stm2);
  245.         sp2->exp1 = copyexpr(sp->exp1);
  246.         sp2->exp2 = copyexpr(sp->exp2);
  247.         sp2->exp3 = copyexpr(sp->exp3);
  248.         return sp2;
  249.     } else
  250.         return NULL;
  251. }
  252.  
  253.  
  254.  
  255. void nukestmt(sp)
  256. Stmt *sp;
  257. {
  258.     if (sp) {
  259.         sp->kind = SK_ASSIGN;
  260.         sp->exp1 = makeexpr_long(0);
  261.     }
  262. }
  263.  
  264.  
  265.  
  266. void splicestmt(sp, spnew)
  267. Stmt *sp, *spnew;
  268. {
  269.     Stmt *snext;
  270.  
  271.     if (spnew) {
  272.     snext = sp->next;
  273.     *sp = *spnew;
  274.     while (sp->next)
  275.         sp = sp->next;
  276.     sp->next = snext;
  277.     } else
  278.     nukestmt(sp);
  279. }
  280.  
  281.  
  282.  
  283. int stmtcount(sp)
  284. Stmt *sp;
  285. {
  286.     int i = 0;
  287.  
  288.     while (sp) {
  289.         i += 1 + stmtcount(sp->stm1) + stmtcount(sp->stm2);
  290.         sp = sp->next;
  291.     }
  292.     return i;
  293. }
  294.  
  295.  
  296.  
  297.  
  298.  
  299. Stmt *close_files_to_ctx(ctx)
  300. Meaning *ctx;
  301. {
  302.     Meaning *ctx2, *mp;
  303.     Stmt *splist = NULL, *sp;
  304.  
  305.     ctx2 = curctx;
  306.     while (ctx2 && ctx2 != ctx && ctx2->kind == MK_FUNCTION) {
  307.     for (mp = ctx2->cbase; mp; mp = mp->cnext) {
  308.         if (mp->kind == MK_VAR &&
  309.         isfiletype(mp->type, -1) && !mp->istemporary) {
  310.         var_reference(mp);
  311.         sp = makestmt_if(makeexpr_rel(EK_NE,
  312.                           filebasename(makeexpr_var(mp)),
  313.                           makeexpr_nil()),
  314.                  makestmt_call(
  315.                      makeexpr_bicall_1("fclose", tp_void,
  316.                                filebasename(makeexpr_var(mp)))),
  317.                  NULL);
  318.         splist = makestmt_seq(splist, sp);
  319.         }
  320.     }
  321.     ctx2 = ctx2->ctx;
  322.     }
  323.     return splist;
  324. }
  325.  
  326.  
  327.  
  328.  
  329. int simplewith(ex)
  330. Expr *ex;
  331. {
  332.     switch (ex->kind) {
  333.         case EK_VAR:
  334.         case EK_CONST:
  335.             return 1;
  336.         case EK_DOT:
  337.             return simplewith(ex->args[0]);
  338.         default:
  339.             return 0;
  340.     }
  341. }
  342.  
  343.  
  344. int simplefor(sp, ex)
  345. Stmt *sp;
  346. Expr *ex;
  347. {
  348.     return (exprspeed(sp->exp2) <= 3 &&
  349.             !checkexprchanged(sp->stm1, sp->exp2) &&
  350.         !exproccurs(sp->exp2, ex));
  351. }
  352.  
  353.  
  354.  
  355. int tryfuncmacro(exp, mp)
  356. Expr **exp;
  357. Meaning *mp;
  358. {
  359.     char *name;
  360.     Strlist *lp;
  361.     Expr *ex = *exp, *ex2;
  362.  
  363.     ex2 = (mp) ? mp->constdefn : NULL;
  364.     if (!ex2) {
  365.     if (ex->kind == EK_BICALL || ex->kind == EK_NAME)
  366.         name = ex->val.s;
  367.     else if (ex->kind == EK_FUNCTION)
  368.         name = ((Meaning *)ex->val.i)->name;
  369.     else
  370.         return 0;
  371.     lp = strlist_cifind(funcmacros, name);
  372.     ex2 = (lp) ? (Expr *)lp->value : NULL;
  373.     }
  374.     if (ex2) {
  375.         *exp = replacemacargs(copyexpr(ex2), ex);
  376.     freeexpr(ex);
  377.         return 1;
  378.     }
  379.     return 0;
  380. }
  381.  
  382.  
  383.  
  384.  
  385.  
  386. #define addstmt(kind)   \
  387.     *spp = sp = makestmt(kind),   \
  388.     spp = &(sp->next)
  389.  
  390. #define newstmt(kind)   \
  391.     addstmt(kind),   \
  392.     steal_comments(firstserial, sp->serial, sflags & SF_FIRST),   \
  393.     sflags &= ~SF_FIRST
  394.  
  395.  
  396.  
  397. #define SF_FUNC    0x1
  398. #define SF_SAVESER 0x2
  399. #define SF_FIRST   0x4
  400. #define SF_IF       0x8
  401.  
  402. Static Stmt *p_stmt(slist, sflags)
  403. Stmt *slist;
  404. int sflags;
  405. {
  406.     Stmt *sbase = NULL, **spp = &sbase, **spp2, **spp3, **savespp;
  407.     Stmt *defsp, **defsphook;
  408.     register Stmt *sp;
  409.     Stmt *sp2;
  410.     long li1, li2, firstserial = 0, saveserial = 0, saveserial2;
  411.     int i, forfixed, offset, line1, line2, toobig, isunsafe;
  412.     Token savetok;
  413.     char *name;
  414.     Expr *ep, *ep2, *ep3, *forstep, *range, *swexpr, *trueswexpr;
  415.     Type *tp;
  416.     Meaning *mp, *tvar, *tempmark;
  417.     Symbol *sym;
  418.     enum exprkind ekind;
  419.     Stmt *(*prochandler)();
  420.     Strlist *cmt;
  421.  
  422.     tempmark = markstmttemps();
  423. again:
  424.     while (findlabelsym()) {
  425.         newstmt(SK_LABEL);
  426.         sp->exp1 = makeexpr_name(format_s(name_LABEL, curtokmeaning->name), tp_integer);
  427.         gettok();
  428.         wneedtok(TOK_COLON);
  429.     }
  430.     firstserial = curserial;
  431.     checkkeyword(TOK_TRY);
  432.     checkkeyword(TOK_INLINE);
  433.     checkkeyword(TOK_LOOP);
  434.     checkkeyword(TOK_RETURN);
  435.     if (modula2) {
  436.     if (sflags & SF_SAVESER)
  437.         goto stmtSeq;
  438.     }
  439.     switch (curtok) {
  440.  
  441.         case TOK_BEGIN:
  442.         stmtSeq:
  443.         if (sflags & (SF_FUNC|SF_SAVESER)) {
  444.         saveserial = curserial;
  445.         cmt = grabcomment(CMT_ONBEGIN);
  446.         if (sflags & SF_FUNC)
  447.             cmt = fixbeginendcomment(cmt);
  448.         strlist_mix(&curcomments, cmt);
  449.         }
  450.         i = sflags & SF_FIRST;
  451.             do {
  452.         if (modula2) {
  453.             if (curtok == TOK_BEGIN || curtok == TOK_SEMI)
  454.             gettok();
  455.             checkkeyword(TOK_ELSIF);
  456.             if (curtok == TOK_ELSE || curtok == TOK_ELSIF)
  457.             break;
  458.         } else
  459.             gettok();
  460.                 *spp = p_stmt(sbase, i);
  461.         i = 0;
  462.                 while (*spp)
  463.                     spp = &((*spp)->next);
  464.             } while (curtok == TOK_SEMI);
  465.         if (sflags & (SF_FUNC|SF_SAVESER)) {
  466.         cmt = grabcomment(CMT_ONEND);
  467.         changecomments(cmt, -1, -1, -1, saveserial);
  468.         if (sflags & SF_FUNC)
  469.             cmt = fixbeginendcomment(cmt);
  470.         strlist_mix(&curcomments, cmt);
  471.         if (sflags & SF_FUNC)
  472.             changecomments(curcomments, -1, saveserial, -1, 10000);
  473.         curserial = saveserial;
  474.         }
  475.         checkkeyword(TOK_ELSIF);
  476.         if (modula2 && (sflags & SF_IF)) {
  477.         break;
  478.         }
  479.         if (curtok == TOK_VBAR)
  480.         break;
  481.             if (!wneedtok(TOK_END))
  482.         skippasttoken(TOK_END);
  483.             break;
  484.  
  485.         case TOK_CASE:
  486.             gettok();
  487.             swexpr = trueswexpr = p_ord_expr();
  488.             if (nosideeffects(swexpr, 1)) {
  489.                 tvar = NULL;
  490.             } else {
  491.                 tvar = makestmttempvar(swexpr->val.type, name_TEMP);
  492.                 swexpr = makeexpr_var(tvar);
  493.             }
  494.             savespp = spp;
  495.             newstmt(SK_CASE);
  496.         saveserial2 = curserial;
  497.             sp->exp1 = trueswexpr;
  498.             spp2 = &sp->stm1;
  499.             tp = swexpr->val.type;
  500.             defsp = NULL;
  501.             defsphook = &defsp;
  502.             if (!wneedtok(TOK_OF)) {
  503.         skippasttoken(TOK_END);
  504.         break;
  505.         }
  506.         i = 1;
  507.         while (curtok == TOK_VBAR)
  508.         gettok();
  509.         checkkeyword(TOK_OTHERWISE);
  510.             while (curtok != TOK_END && curtok != TOK_OTHERWISE && curtok != TOK_ELSE) {
  511.                 spp3 = spp2;
  512.         saveserial = curserial;
  513.                 *spp2 = sp = makestmt(SK_CASELABEL);
  514.         steal_comments(saveserial, sp->serial, i);
  515.                 spp2 = &sp->next;
  516.                 range = NULL;
  517.                 toobig = 0;
  518.                 for (;;) {
  519.                     ep = gentle_cast(p_expr(tp), tp);
  520.                     if (curtok == TOK_DOTS) {
  521.                         li1 = ord_value(eval_expr(ep));
  522.                         gettok();
  523.                         ep2 = gentle_cast(p_expr(tp), tp);
  524.                         li2 = ord_value(eval_expr(ep2));
  525.                         range = makeexpr_or(range,
  526.                                             makeexpr_range(copyexpr(swexpr),
  527.                                                            ep, ep2, 1));
  528.                         if (li2 - li1 >= caselimit)
  529.                             toobig = 1;
  530.                         if (!toobig) {
  531.                             for (;;) {
  532.                                 sp->exp1 = makeexpr_val(make_ord(tp, li1));
  533.                                 if (li1 >= li2) break;
  534.                                 li1++;
  535.                 serialcount--;   /* make it reuse the count */
  536.                                 sp->stm1 = makestmt(SK_CASELABEL);
  537.                                 sp = sp->stm1;
  538.                             }
  539.                         }
  540.                     } else {
  541.                         sp->exp1 = copyexpr(ep);
  542.                         range = makeexpr_or(range,
  543.                                             makeexpr_rel(EK_EQ, 
  544.                                                          copyexpr(swexpr),
  545.                                                          ep));
  546.                     }
  547.                     if (curtok == TOK_COMMA) {
  548.                         gettok();
  549.             serialcount--;   /* make it reuse the count */
  550.                         sp->stm1 = makestmt(SK_CASELABEL);
  551.                         sp = sp->stm1;
  552.                     } else
  553.                         break;
  554.                 }
  555.                 wneedtok(TOK_COLON);
  556.                 if (toobig) {
  557.                     free_stmt(*spp3);
  558.                     spp2 = spp3;
  559.                     *defsphook = makestmt_if(range, p_stmt(NULL, SF_SAVESER),
  560.                          NULL);
  561.                     if (defsphook != &defsp && elseif != 0)
  562.                         (*defsphook)->exp2 = makeexpr_long(1);
  563.                     defsphook = &((*defsphook)->stm2);
  564.                 } else {
  565.                     freeexpr(range);
  566.                     sp->stm1 = p_stmt(NULL, SF_SAVESER);
  567.                 }
  568.         i = 0;
  569.         checkkeyword(TOK_OTHERWISE);
  570.                 if (curtok != TOK_END && curtok != TOK_OTHERWISE && curtok != TOK_ELSE) {
  571.             if (curtok == TOK_VBAR) {
  572.             while (curtok == TOK_VBAR)
  573.                 gettok();
  574.             } else
  575.             wneedtok(TOK_SEMI);
  576.             checkkeyword(TOK_OTHERWISE);
  577.         }
  578.             }
  579.             if (defsp) {
  580.                 *spp2 = defsp;
  581.                 spp2 = defsphook;
  582.                 if (tvar) {
  583.                     sp = makestmt_assign(makeexpr_var(tvar), trueswexpr);
  584.                     sp->next = *savespp;
  585.                     *savespp = sp;
  586.                     sp->next->exp1 = swexpr;
  587.                 }
  588.             } else {
  589.                 if (tvar) {
  590.                     canceltempvar(tvar);
  591.                     freeexpr(swexpr);
  592.                 }
  593.             }
  594.             if (curtok == TOK_OTHERWISE || curtok == TOK_ELSE) {
  595.                 gettok();
  596.                 while (curtok == TOK_SEMI)
  597.                     gettok();
  598. /*        changecomments(curcomments, CMT_TRAIL, curserial,
  599.                                 CMT_POST, -1);   */
  600.         i = SF_FIRST;
  601.         while (curtok != TOK_END) {
  602.                     *spp2 = p_stmt(NULL, i);
  603.                     while (*spp2)
  604.                         spp2 = &((*spp2)->next);
  605.             i = 0;
  606.                     if (curtok != TOK_SEMI)
  607.                         break;
  608.                     gettok();
  609.                 }
  610.                 if (!wexpecttok(TOK_END))
  611.             skiptotoken(TOK_END);
  612.             } else if (casecheck == 1 || (casecheck == 2 && range_flag)) {
  613.                 *spp2 = makestmt(SK_CASECHECK);
  614.             }
  615.         curserial = saveserial2;
  616.         strlist_mix(&curcomments, grabcomment(CMT_ONEND));
  617.             gettok();
  618.             break;
  619.  
  620.         case TOK_FOR:
  621.             forfixed = fixedflag;
  622.             gettok();
  623.             newstmt(SK_FOR);
  624.             ep = p_expr(tp_integer);
  625.             if (!wneedtok(TOK_ASSIGN)) {
  626.         skippasttoken(TOK_DO);
  627.         break;
  628.         }
  629.             ep2 = makeexpr_charcast(p_expr(ep->val.type));
  630.             if (curtok != TOK_DOWNTO) {
  631.         if (!wexpecttok(TOK_TO)) {
  632.             skippasttoken(TOK_DO);
  633.             break;
  634.         }
  635.         }
  636.             savetok = curtok;
  637.             gettok();
  638.             sp->exp2 = makeexpr_charcast(p_expr(ep->val.type));
  639.         checkkeyword(TOK_BY);
  640.         if (curtok == TOK_BY) {
  641.         gettok();
  642.         forstep = p_expr(tp_integer);
  643.         i = possiblesigns(forstep);
  644.         if ((i & 5) == 5) {
  645.             if (expr_is_neg(forstep)) {
  646.             ekind = EK_GE;
  647.             note("Assuming FOR loop step is negative [252]");
  648.             } else {
  649.             ekind = EK_LE;
  650.             note("Assuming FOR loop step is positive [252]");
  651.             }
  652.         } else {
  653.             if (!(i & 1))
  654.             ekind = EK_LE;
  655.             else
  656.             ekind = EK_GE;
  657.         }
  658.         } else {
  659.         if (savetok == TOK_DOWNTO) {
  660.             ekind = EK_GE;
  661.             forstep = makeexpr_long(-1);
  662.         } else {
  663.             ekind = EK_LE;
  664.             forstep = makeexpr_long(1);
  665.         }
  666.         }
  667.             tvar = NULL;
  668.         swexpr = NULL;
  669.             if (ep->kind == EK_VAR) {
  670.                 tp = findbasetype(ep->val.type, ODECL_NOPRES);
  671.                 if ((tp == tp_char || tp == tp_schar || tp == tp_uchar ||
  672.                      tp == tp_abyte || tp == tp_sbyte || tp == tp_ubyte ||
  673.              tp == tp_boolean) &&
  674.                     ((checkconst(sp->exp2, 0) &&
  675.               tp != tp_sbyte && tp != tp_schar) ||
  676.                      checkconst(sp->exp2, -128) ||
  677.                      (checkconst(sp->exp2, 127) &&
  678.               tp != tp_ubyte && tp != tp_uchar) ||
  679.                      checkconst(sp->exp2, 255) ||
  680.                      (tp == tp_char &&
  681.                       (useAnyptrMacros == 1 || unsignedchar != 1) &&
  682.                       isliteralconst(sp->exp2, NULL) == 2 &&
  683.                       sp->exp2->val.i >= 128))) {
  684.                     swexpr = ep;
  685.                     tvar = makestmttempvar(tp_sshort, name_TEMP);
  686.                     ep = makeexpr_var(tvar);
  687.                 } else if (((tp == tp_sshort &&
  688.                              (checkconst(sp->exp2, -32768) ||
  689.                               checkconst(sp->exp2, 32767))) ||
  690.                             (tp == tp_ushort &&
  691.                              (checkconst(sp->exp2, 0) ||
  692.                               checkconst(sp->exp2, 65535))))) {
  693.                     swexpr = ep;
  694.                     tvar = makestmttempvar(tp_integer, name_TEMP);
  695.                     ep = makeexpr_var(tvar);
  696.                 } else if (tp == tp_integer &&
  697.                (checkconst(sp->exp2, LONG_MAX) ||
  698.                 (sp->exp2->kind == EK_VAR &&
  699.                  sp->exp2->val.i == (long)mp_maxint))) {
  700.                     swexpr = ep;
  701.                     tvar = makestmttempvar(tp_unsigned, name_TEMP);
  702.                     ep = makeexpr_var(tvar);
  703.                 }
  704.             }
  705.         sp->exp3 = makeexpr_assign(copyexpr(ep),
  706.                        makeexpr_inc(copyexpr(ep),
  707.                             copyexpr(forstep)));
  708.             wneedtok(TOK_DO);
  709.             forfixed = (fixedflag != forfixed);
  710.             mp = makestmttempvar(ep->val.type, name_FOR);
  711.             sp->stm1 = p_stmt(NULL, SF_SAVESER);
  712.             if (tvar) {
  713.                 if (checkexprchanged(sp->stm1, swexpr))
  714.                     note(format_s("Rewritten FOR loop won't work if it meddles with %s [253]",
  715.                                   ((Meaning *)swexpr->val.i)->name));
  716.                 sp->stm1 = makestmt_seq(makestmt_assign(swexpr, makeexpr_var(tvar)),
  717.                                         sp->stm1);
  718.             } else if (offsetforloops && ep->kind == EK_VAR) {
  719.         offset = checkvaroffset(sp->stm1, (Meaning *)ep->val.i);
  720.         if (offset != 0) {
  721.             ep3 = makeexpr_inc(copyexpr(ep), makeexpr_long(-offset));
  722.             replaceexpr(sp->stm1, ep, ep3);
  723.             freeexpr(ep3);
  724.             ep2 = makeexpr_plus(ep2, makeexpr_long(offset));
  725.             sp->exp2 = makeexpr_inc(sp->exp2, makeexpr_long(offset));
  726.         }
  727.         }
  728.             if (!exprsame(ep, ep2, 1))
  729.                 sp->exp1 = makeexpr_assign(copyexpr(ep), copyexpr(ep2));
  730.         isunsafe = ((!nodependencies(ep2, 2) &&
  731.              !nosideeffects(sp->exp2, 1)) ||
  732.             (!nodependencies(sp->exp2, 2) &&
  733.              !nosideeffects(ep2, 1)));
  734.             if (forfixed || (simplefor(sp, ep) && !isunsafe)) {
  735.                 canceltempvar(mp);
  736.                 sp->exp2 = makeexpr_rel(ekind, ep, sp->exp2);
  737.             } else {
  738.         ep3 = makeexpr_neg(copyexpr(forstep));
  739.         if ((checkconst(forstep, 1) || checkconst(forstep, -1)) &&
  740.             sp->exp2->kind == EK_PLUS &&
  741.             exprsame(sp->exp2->args[sp->exp2->nargs-1], ep3, 2)) {
  742.             sp->exp2 = makeexpr_inc(sp->exp2, forstep);
  743.         } else {
  744.             freeexpr(forstep);
  745.             freeexpr(ep3);
  746.             ep3 = makeexpr_long(0);
  747.         }
  748.         if (forevalorder && isunsafe) {
  749.             if (exprdepends(sp->exp2, ep)) {
  750.             tvar = makestmttempvar(mp->type, name_TEMP);
  751.             sp->exp1 = makeexpr_comma(
  752.                      makeexpr_comma(
  753.                        makeexpr_assign(makeexpr_var(tvar),
  754.                                copyexpr(ep2)),
  755.                        makeexpr_assign(makeexpr_var(mp),
  756.                                sp->exp2)),
  757.                      makeexpr_assign(copyexpr(ep),
  758.                              makeexpr_var(tvar)));
  759.             } else
  760.             sp->exp1 = makeexpr_comma(
  761.                      sp->exp1,
  762.                      makeexpr_assign(makeexpr_var(mp),
  763.                              sp->exp2));
  764.         } else {
  765.             if (isunsafe)
  766.             note("Evaluating FOR loop limit before initial value [315]");
  767.             sp->exp1 = makeexpr_comma(
  768.                      makeexpr_assign(makeexpr_var(mp),
  769.                          sp->exp2),
  770.                      sp->exp1);
  771.         }
  772.         sp->exp2 = makeexpr_inc(makeexpr_var(mp), ep3);
  773.                 sp->exp2 = makeexpr_rel(ekind, ep, sp->exp2);
  774.             }
  775.         freeexpr(ep2);
  776.             break;
  777.  
  778.         case TOK_GOTO:
  779.             gettok();
  780.             if (findlabelsym()) {
  781.                 if (curtokmeaning->ctx != curctx) {
  782.             curtokmeaning->val.i = 1;
  783.             *spp = close_files_to_ctx(curtokmeaning->ctx);
  784.             while (*spp)
  785.             spp = &((*spp)->next);
  786.             newstmt(SK_ASSIGN);
  787.             var_reference(curtokmeaning->xnext);
  788.             if (curtokmeaning->ctx->kind == MK_MODULE &&
  789.             !curtokmeaning->xnext->wasdeclared) {
  790.             outsection(minorspace);
  791.             declarevar(curtokmeaning->xnext, 0x7);
  792.             curtokmeaning->xnext->wasdeclared = 1;
  793.             outsection(minorspace);
  794.             }
  795.             sp->exp1 = makeexpr_bicall_2("longjmp", tp_void,
  796.                          makeexpr_var(curtokmeaning->xnext),
  797.                          makeexpr_long(1));
  798.         } else {
  799.             newstmt(SK_GOTO);
  800.             sp->exp1 = makeexpr_name(format_s(name_LABEL,
  801.                               curtokmeaning->name),
  802.                          tp_integer);
  803.         }
  804.             } else {
  805.                 warning("Expected a label [263]");
  806.         }
  807.         gettok();
  808.             break;
  809.  
  810.         case TOK_IF:
  811.             gettok();
  812.             newstmt(SK_IF);
  813.         saveserial = curserial;
  814.         curserial = ++serialcount;
  815.             sp->exp1 = p_expr(tp_boolean);
  816.             wneedtok(TOK_THEN);
  817.             sp->stm1 = p_stmt(NULL, SF_SAVESER|SF_IF);
  818.         changecomments(curcomments, -1, saveserial+1, -1, saveserial);
  819.         checkkeyword(TOK_ELSIF);
  820.         while (curtok == TOK_ELSIF) {
  821.         gettok();
  822.         sp->stm2 = makestmt(SK_IF);
  823.         sp = sp->stm2;
  824.         sp->exp1 = p_expr(tp_boolean);
  825.         wneedtok(TOK_THEN);
  826.         sp->stm1 = p_stmt(NULL, SF_SAVESER|SF_IF);
  827.         sp->exp2 = makeexpr_long(1);
  828.         }
  829.         if (curtok == TOK_ELSE) {
  830.                 line1 = inf_lnum;
  831.         strlist_mix(&curcomments, grabcomment(CMT_ONELSE));
  832.                 gettok();
  833.                 line2 = (curtok == TOK_IF) ? inf_lnum : -1;
  834.         saveserial2 = curserial;
  835.                 sp->stm2 = p_stmt(NULL, SF_SAVESER|SF_IF);
  836.         changecomments(curcomments, -1, saveserial2, -1, saveserial+1);
  837.                 if (sp->stm2 && sp->stm2->kind == SK_IF &&
  838.             !sp->stm2->next && !modula2) {
  839.                     sp->stm2->exp2 = makeexpr_long(elseif > 0 ||
  840.                                                    (elseif < 0 && line1 == line2));
  841.                 }
  842.             }
  843.         if (modula2)
  844.         wneedtok(TOK_END);
  845.         curserial = saveserial;
  846.             break;
  847.  
  848.         case TOK_INLINE:
  849.             gettok();
  850.             note("Inline assembly language encountered [254]");
  851.             if (curtok != TOK_LPAR) {   /* Macintosh style */
  852.         newstmt(SK_ASSIGN);
  853.         sp->exp1 = makeexpr_bicall_1("inline", tp_void,
  854.                          p_expr(tp_integer));
  855.         break;
  856.         }
  857.             do {
  858.                 name = getinlinepart();
  859.                 if (!*name)
  860.                     break;
  861.                 newstmt(SK_ASSIGN);
  862.                 sp->exp1 = makeexpr_bicall_1("asm", tp_void,
  863.                             makeexpr_string(format_s(" inline %s", name)));
  864.                 gettok();
  865.             } while (curtok == TOK_SLASH);
  866.             skipcloseparen();
  867.             break;
  868.  
  869.     case TOK_LOOP:
  870.         gettok();
  871.         newstmt(SK_WHILE);
  872.         sp->exp1 = makeexpr_long(1);
  873.             sp->stm1 = p_stmt(NULL, SF_SAVESER);
  874.         break;
  875.  
  876.         case TOK_REPEAT:
  877.             newstmt(SK_REPEAT);
  878.         saveserial = curserial;
  879.             spp2 = &(sp->stm1);
  880.         i = SF_FIRST;
  881.             do {
  882.                 gettok();
  883.                 *spp2 = p_stmt(sp->stm1, i);
  884.         i = 0;
  885.                 while (*spp2)
  886.                     spp2 = &((*spp2)->next);
  887.             } while (curtok == TOK_SEMI);
  888.             if (!wneedtok(TOK_UNTIL))
  889.         skippasttoken(TOK_UNTIL);
  890.             sp->exp1 = makeexpr_not(p_expr(tp_boolean));
  891.         curserial = saveserial;
  892.         strlist_mix(&curcomments, grabcomment(CMT_ONEND));
  893.             break;
  894.  
  895.     case TOK_RETURN:
  896.         gettok();
  897.         newstmt(SK_RETURN);
  898.         if (curctx->isfunction) {
  899.         sp->exp1 = gentle_cast(p_expr(curctx->cbase->type),
  900.                        curctx->cbase->type);
  901.         }
  902.         break;
  903.  
  904.         case TOK_TRY:
  905.         findsymbol("RECOVER")->flags &= ~KWPOSS;
  906.             newstmt(SK_TRY);
  907.             sp->exp1 = makeexpr_long(++trycount);
  908.             spp2 = &(sp->stm1);
  909.         i = SF_FIRST;
  910.             do {
  911.                 gettok();
  912.                 *spp2 = p_stmt(sp->stm1, i);
  913.         i = 0;
  914.                 while (*spp2)
  915.                     spp2 = &((*spp2)->next);
  916.             } while (curtok == TOK_SEMI);
  917.             if (!wneedtok(TOK_RECOVER))
  918.         skippasttoken(TOK_RECOVER);
  919.             sp->stm2 = p_stmt(NULL, SF_SAVESER);
  920.             break;
  921.  
  922.         case TOK_WHILE:
  923.             gettok();
  924.             newstmt(SK_WHILE);
  925.             sp->exp1 = p_expr(tp_boolean);
  926.             wneedtok(TOK_DO);
  927.             sp->stm1 = p_stmt(NULL, SF_SAVESER);
  928.             break;
  929.  
  930.         case TOK_WITH:
  931.             gettok();
  932.             if (withlevel >= MAXWITHS-1)
  933.                 error("Too many nested WITHs");
  934.             ep = p_expr(NULL);
  935.             if (ep->val.type->kind != TK_RECORD)
  936.                 warning("Argument of WITH is not a RECORD [264]");
  937.             withlist[withlevel] = ep->val.type;
  938.             if (simplewith(ep)) {
  939.                 withexprs[withlevel] = ep;
  940.                 mp = NULL;
  941.             } else {           /* need to save a temporary pointer */
  942.                 tp = makepointertype(ep->val.type);
  943.                 mp = makestmttempvar(tp, name_WITH);
  944.                 withexprs[withlevel] = makeexpr_hat(makeexpr_var(mp), 0);
  945.             }
  946.             withlevel++;
  947.             if (curtok == TOK_COMMA) {
  948.                 curtok = TOK_WITH;
  949.                 sp2 = p_stmt(NULL, sflags & SF_FIRST);
  950.             } else {
  951.                 wneedtok(TOK_DO);
  952.                 sp2 = p_stmt(NULL, sflags & SF_FIRST);
  953.             }
  954.             withlevel--;
  955.             if (mp) {    /* if "with p^" for constant p, don't need temp ptr */
  956.                 if (ep->kind == EK_HAT && ep->args[0]->kind == EK_VAR &&
  957.                     !checkvarchanged(sp2, (Meaning *)ep->args[0]->val.i)) {
  958.                     replaceexpr(sp2, withexprs[withlevel]->args[0],
  959.                                      ep->args[0]);
  960.                     freeexpr(ep);
  961.                     canceltempvar(mp);
  962.                 } else {
  963.                     newstmt(SK_ASSIGN);
  964.                     sp->exp1 = makeexpr_assign(makeexpr_var(mp),
  965.                                                makeexpr_addr(ep));
  966.                 }
  967.             }
  968.             freeexpr(withexprs[withlevel]);
  969.             *spp = sp2;
  970.             while (*spp)
  971.                 spp = &((*spp)->next);
  972.             break;
  973.  
  974.         case TOK_INCLUDE:
  975.             badinclude();
  976.             goto again;
  977.  
  978.     case TOK_ADDR:   /* flakey Turbo "@procptr := anyptr" assignment */
  979.         newstmt(SK_ASSIGN);
  980.         ep = p_expr(tp_void);
  981.         if (wneedtok(TOK_ASSIGN))
  982.         sp->exp1 = makeexpr_assign(ep, p_expr(ep->val.type));
  983.         else
  984.         sp->exp1 = ep;
  985.         break;
  986.  
  987.         case TOK_IDENT:
  988.             mp = curtokmeaning;
  989.         if (mp == mp_str_hp)
  990.         mp = curtokmeaning = mp_str_turbo;
  991.         if (mp == mp_val_modula)
  992.         mp = curtokmeaning = mp_val_turbo;
  993.         if (mp == mp_blockread_ucsd)
  994.         mp = curtokmeaning = mp_blockread_turbo;
  995.         if (mp == mp_blockwrite_ucsd)
  996.         mp = curtokmeaning = mp_blockwrite_turbo;
  997.         if (mp == mp_dec_dec)
  998.         mp = curtokmeaning = mp_dec_turbo;
  999.             if (!mp) {
  1000.                 sym = curtoksym;     /* make a guess at what the undefined name is... */
  1001.                 name = stralloc(curtokcase);
  1002.                 gettok();
  1003.                 newstmt(SK_ASSIGN);
  1004.                 if (curtok == TOK_ASSIGN) {
  1005.                     gettok();
  1006.                     ep = p_expr(NULL);
  1007.                     mp = addmeaning(sym, MK_VAR);
  1008.                     mp->name = name;
  1009.                     mp->type = ep->val.type;
  1010.                     sp->exp1 = makeexpr_assign(makeexpr_var(mp), ep);
  1011.                 } else if (curtok == TOK_HAT || curtok == TOK_ADDR ||
  1012.                            curtok == TOK_LBR || curtok == TOK_DOT) {
  1013.                     ep = makeexpr_name(name, tp_integer);
  1014.                     ep = fake_dots_n_hats(ep);
  1015.                     if (wneedtok(TOK_ASSIGN))
  1016.             sp->exp1 = makeexpr_assign(ep, p_expr(NULL));
  1017.             else
  1018.             sp->exp1 = ep;
  1019.                 } else if (curtok == TOK_LPAR) {
  1020.                     ep = makeexpr_bicall_0(name, tp_void);
  1021.                     do {
  1022.                         gettok();
  1023.                         insertarg(&ep, ep->nargs, p_expr(NULL));
  1024.                     } while (curtok == TOK_COMMA);
  1025.                     skipcloseparen();
  1026.                     sp->exp1 = ep;
  1027.                 } else {
  1028.                     sp->exp1 = makeexpr_bicall_0(name, tp_void);
  1029.                 }
  1030.         if (!tryfuncmacro(&sp->exp1, NULL))
  1031.             undefsym(sym);
  1032.             } else if (mp->kind == MK_FUNCTION && !mp->isfunction) {
  1033.                 mp->refcount++;
  1034.                 gettok();
  1035.                 ep = p_funccall(mp);
  1036.                 if (!mp->constdefn)
  1037.                     need_forward_decl(mp);
  1038.                 if (mp->handler && !(mp->sym->flags & LEAVEALONE) &&
  1039.                                    !mp->constdefn) {
  1040.                     prochandler = (Stmt *(*)())mp->handler;
  1041.                     *spp = (*prochandler)(ep, slist);
  1042.                     while (*spp)
  1043.                         spp = &((*spp)->next);
  1044.                 } else {
  1045.                     newstmt(SK_ASSIGN);
  1046.                     sp->exp1 = ep;
  1047.                 }
  1048.             } else if (mp->kind == MK_SPECIAL) {
  1049.                 gettok();
  1050.                 if (mp->handler && !mp->isfunction) {
  1051.                     if ((mp->sym->flags & LEAVEALONE) || mp->constdefn) {
  1052.                         ep = makeexpr_bicall_0(mp->name, tp_void);
  1053.                         if (curtok == TOK_LPAR) {
  1054.                             do {
  1055.                                 gettok();
  1056.                                 insertarg(&ep, ep->nargs, p_expr(NULL));
  1057.                             } while (curtok == TOK_COMMA);
  1058.                             skipcloseparen();
  1059.                         }
  1060.                         newstmt(SK_ASSIGN);
  1061.             tryfuncmacro(&ep, mp);
  1062.             sp->exp1 = ep;
  1063.                     } else {
  1064.                         prochandler = (Stmt *(*)())mp->handler;
  1065.                         *spp = (*prochandler)(mp, slist);
  1066.                         while (*spp)
  1067.                             spp = &((*spp)->next);
  1068.                     }
  1069.                 } else
  1070.                     symclass(curtoksym);
  1071.             } else {
  1072.                 newstmt(SK_ASSIGN);
  1073.                 if (curtokmeaning->kind == MK_FUNCTION &&
  1074.             peeknextchar() != '(') {
  1075.                     mp = curctx;
  1076.                     while (mp && mp != curtokmeaning)
  1077.                         mp = mp->ctx;
  1078.                     if (mp)
  1079.                         curtokmeaning = curtokmeaning->cbase;
  1080.                 }
  1081.                 ep = p_expr(tp_void);
  1082. #if 0
  1083.         if (!(ep->kind == EK_SPCALL ||
  1084.               (ep->kind == EK_COND &&
  1085.                ep->args[1]->kind == EK_SPCALL)))
  1086.             wexpecttok(TOK_ASSIGN);
  1087. #endif
  1088.         if (curtok == TOK_ASSIGN) {
  1089.             gettok();
  1090.             if (curtok == TOK_IDENT && !strcicmp(curtokbuf, "ZERO") &&
  1091.             !curtokmeaning) {   /* VAX Pascal foolishness */
  1092.             gettok();
  1093.             ep2 = makeexpr_sizeof(copyexpr(ep), 0);
  1094.             sp->exp1 = makeexpr_bicall_3("memset", tp_void,
  1095.                              makeexpr_addr(ep),
  1096.                              makeexpr_long(0), ep2);
  1097.             } else
  1098.             sp->exp1 = makeexpr_assign(ep, p_expr(ep->val.type));
  1099.         } else
  1100.             sp->exp1 = ep;
  1101.             }
  1102.             break;
  1103.  
  1104.     default:
  1105.         break;    /* null statement */
  1106.     }
  1107.     freestmttemps(tempmark);
  1108.     if (sflags & SF_SAVESER)
  1109.     curserial = firstserial;
  1110.     return sbase;
  1111. }
  1112.  
  1113.  
  1114.  
  1115.  
  1116.  
  1117.  
  1118.  
  1119. #define BR_NEVER        0x1     /* never use braces */
  1120. #define BR_FUNCTION     0x2     /* function body */
  1121. #define BR_THENPART     0x4     /* before an "else" */
  1122. #define BR_ALWAYS       0x8     /* always use braces */
  1123. #define BR_REPEAT       0x10    /* "do-while" loop */
  1124. #define BR_TRY          0x20    /* in a recover block */
  1125. #define BR_ELSEPART     0x40    /* after an "else" */
  1126. #define BR_CASE         0x80    /* case of a switch stmt */
  1127.  
  1128. Static int usebraces(sp, opts)
  1129. Stmt *sp;
  1130. int opts;
  1131. {
  1132.     if (opts & (BR_FUNCTION|BR_ALWAYS))
  1133.         return 1;
  1134.     if (opts & BR_NEVER)
  1135.         return 0;
  1136.     switch (bracesalways) {
  1137.         case 0:
  1138.             if (sp) {
  1139.                 if (sp->next ||
  1140.                     sp->kind == SK_TRY ||
  1141.                     (sp->kind == SK_IF && !sp->stm2) ||
  1142.                     (opts & BR_REPEAT))
  1143.                     return 1;
  1144.             }
  1145.             break;
  1146.  
  1147.         case 1:
  1148.             return 1;
  1149.  
  1150.         default:
  1151.             if (sp) {
  1152.                 if (sp->next ||
  1153.                     sp->kind == SK_IF ||
  1154.                     sp->kind == SK_WHILE ||
  1155.                     sp->kind == SK_REPEAT ||
  1156.                     sp->kind == SK_TRY ||
  1157.             sp->kind == SK_CASE ||
  1158.                     sp->kind == SK_FOR)
  1159.                     return 1;
  1160.             }
  1161.             break;
  1162.     }
  1163.     if (sp != NULL &&
  1164.     findcomment(curcomments, CMT_NOT | CMT_TRAIL, sp->serial) != NULL)
  1165.     return 1;
  1166.     return 0;
  1167. }
  1168.  
  1169.  
  1170.  
  1171. #define outspnl(spflag) output((spflag) ? " " : "\n")
  1172.  
  1173. #define openbrace()                 \
  1174.     wbraces = (!candeclare);        \
  1175.     if (wbraces) {                  \
  1176.         output("{");                \
  1177.         outspnl(braceline <= 0);    \
  1178.         candeclare = 1;             \
  1179.     }
  1180.  
  1181. #define closebrace()                \
  1182.     if (wbraces) {                  \
  1183.         if (sp->next || braces)     \
  1184.             output("}\n");          \
  1185.         else                        \
  1186.             braces = 1;             \
  1187.     }
  1188.  
  1189.  
  1190.  
  1191. Meaning *outcontext;
  1192.  
  1193. Static void outnl(serial)
  1194. int serial;
  1195. {
  1196.     outtrailcomment(curcomments, serial, commentindent);
  1197. }
  1198.  
  1199.  
  1200. Static void out_block(spbase, opts, serial)
  1201. Stmt *spbase;
  1202. int opts, serial;
  1203. {
  1204.     int i, j, braces, always, trynum, istrail, hascmt;
  1205.     int gotcomments = 0;
  1206.     int saveindent, saveindent2, delta;
  1207.     Stmt *sp = spbase;
  1208.     Stmt *sp2, *sp3;
  1209.     Meaning *ctx, *mp;
  1210.     Strlist *curcmt, *cmt, *savecurcmt = curcomments;
  1211.     Strlist *trailcmt, *begincmt, *endcmt;
  1212.  
  1213.     if (debug>1) { fprintf(outf, "out_block of:\n"); dumpstmt(spbase,5); }
  1214.     if (opts & BR_FUNCTION) {
  1215.     if (outcontext && outcontext->comments) {
  1216.         gotcomments = 1;
  1217.         curcomments = outcontext->comments;
  1218.     }
  1219.     attach_comments(spbase);
  1220.     }
  1221.     braces = usebraces(sp, opts);
  1222.     trailcmt = findcomment(curcomments, CMT_TRAIL, serial);
  1223.     begincmt = findcomment(curcomments, CMT_ONBEGIN, serial);
  1224.     istrail = 1;
  1225.     if (!trailcmt) {
  1226.     trailcmt = begincmt;
  1227.     begincmt = NULL;
  1228.     istrail = 0;
  1229.     }
  1230.     endcmt = findcomment(curcomments, CMT_ONEND, serial);
  1231.     if ((begincmt || endcmt) && !(opts & BR_NEVER))
  1232.     braces = 1;
  1233.     if (opts & BR_ELSEPART) {
  1234.     cmt = findcomment(curcomments, CMT_ONELSE, serial);
  1235.     if (cmt) {
  1236.         if (trailcmt) {
  1237.         out_spaces(bracecommentindent, commentoverindent,
  1238.                commentlen(cmt), 0);
  1239.         output("\001");
  1240.         outcomment(cmt);
  1241.         } else
  1242.         trailcmt = cmt;
  1243.     }
  1244.     }
  1245.     if (braces) {
  1246.     j = (opts & BR_FUNCTION) ? funcopenindent : openbraceindent;
  1247.         if (!line_start()) {
  1248.         if (trailcmt &&
  1249.         cur_column() + commentlen(trailcmt) + 2 > linewidth &&
  1250.         outindent + commentlen(trailcmt) + 2 < linewidth)  /*close enough*/
  1251.         i = 0;
  1252.         else if (opts & BR_ELSEPART)
  1253.         i = ((braceelseline & 2) == 0);
  1254.         else if (braceline >= 0)
  1255.         i = (braceline == 0);
  1256.         else
  1257.                 i = ((opts & BR_FUNCTION) == 0);
  1258.         if (trailcmt && begincmt) {
  1259.         out_spaces(commentindent, commentoverindent,
  1260.                commentlen(trailcmt), j);
  1261.         outcomment(trailcmt);
  1262.         trailcmt = begincmt;
  1263.         begincmt = NULL;
  1264.         istrail = 0;
  1265.         } else
  1266.         outspnl(i);
  1267.         }
  1268.     if (line_start())
  1269.         singleindent(j);
  1270.         output("{");
  1271.         candeclare = 1;
  1272.     } else if (!sp) {
  1273.         if (!line_start())
  1274.             outspnl(!nullstmtline && !(opts & BR_TRY));
  1275.     if (line_start())
  1276.         singleindent(tabsize);
  1277.         output(";");
  1278.     }
  1279.     if (opts & BR_CASE)
  1280.     delta = 0;
  1281.     else {
  1282.     delta = tabsize;
  1283.     if (opts & BR_FUNCTION)
  1284.         delta = adddeltas(delta, bodyindent);
  1285.     else if (braces)
  1286.         delta = adddeltas(delta, blockindent);
  1287.     }
  1288.     futureindent(delta);
  1289.     if (bracecombine && braces)
  1290.     i = applydelta(outindent, delta) - cur_column();
  1291.     else
  1292.     i = -1;
  1293.     if (commentvisible(trailcmt)) {
  1294.     if (line_start()) {
  1295.         singleindent(delta);
  1296.         out_spaces(commentoverindent, 1000, commentlen(trailcmt), 0);
  1297.         outcomment(trailcmt);
  1298.     } else /*if (commentlen(trailcmt) + cur_column() + 1 <= linewidth)*/ {
  1299.         out_spaces(istrail ? commentindent : bracecommentindent,
  1300.                commentoverindent, commentlen(trailcmt), delta);
  1301.         outcomment(trailcmt);
  1302.     } /*else {
  1303.         output("\n");
  1304.         singleindent(delta);
  1305.         out_spaces(commentoverindent, 1000, commentlen(trailcmt), 0);
  1306.         outcomment(trailcmt);
  1307.     }*/
  1308.     i = -9999;
  1309.     }
  1310.     if (i > 0)
  1311.     out_spaces(i, 0, 0, 0);
  1312.     else if (i != -9999)
  1313.     output("\n");
  1314.     saveindent = outindent;
  1315.     moreindent(delta);
  1316.     outcomment(begincmt);
  1317.     while (sp) {
  1318.     flushcomments(NULL, CMT_PRE, sp->serial);
  1319.     if (cmtdebug)
  1320.         output(format_d("[%d] ", sp->serial));
  1321.         switch (sp->kind) {
  1322.  
  1323.             case SK_HEADER:
  1324.                 ctx = (Meaning *)sp->exp1->val.i;
  1325.         eatblanklines();
  1326.                 if (declarevars(ctx, 0))
  1327.                     outsection(minorspace);
  1328.         flushcomments(NULL, CMT_NOT | CMT_ONEND, serial);
  1329.                 if (ctx->kind == MK_MODULE) {
  1330.                     if (ctx->anyvarflag) {
  1331.                         output(format_s(name_MAIN, ""));
  1332.             if (spacefuncs)
  1333.                 output(" ");
  1334.                         output("(argc,");
  1335.             if (spacecommas)
  1336.                 output(" ");
  1337.             output("argv);\n");
  1338.                     } else {
  1339.                         output("static int _was_initialized = 0;\n");
  1340.                         output("if (_was_initialized++)\n");
  1341.             singleindent(tabsize);
  1342.                         output("return;\n");
  1343.                     }
  1344.             while (initialcalls) {
  1345.             output(initialcalls->s);
  1346.             output(";\n");
  1347.             strlist_remove(&initialcalls, initialcalls->s);
  1348.             }
  1349.                 } else {
  1350.                     if (ctx->varstructflag && ctx->ctx->kind == MK_FUNCTION &&
  1351.                                               ctx->ctx->varstructflag) {
  1352.                         output(format_s(name_VARS, ctx->name));
  1353.                         output(".");
  1354.                         output(format_s(name_LINK, ctx->ctx->name));
  1355.                         output(" = ");
  1356.                         output(format_s(name_LINK, ctx->ctx->name));
  1357.                         output(";\n");
  1358.                     }
  1359.             for (mp = ctx->cbase; mp; mp = mp->cnext) {
  1360.             if ((mp->kind == MK_VAR ||    /* these are variables with */
  1361.                  mp->kind == MK_VARREF) &&
  1362.                 ((mp->varstructflag &&      /* initializers which were moved */
  1363.                   mp->cnext &&              /* into a varstruct, so they */
  1364.                   mp->cnext->snext == mp && /* must be initialized now */
  1365.                   mp->cnext->constdefn &&
  1366.                   ctx->kind == MK_FUNCTION) ||
  1367.                  (mp->constdefn &&
  1368.                   mp->type->kind == TK_ARRAY &&
  1369.                   mp->constdefn->val.type->kind == TK_STRING &&
  1370.                   !initpacstrings))) {
  1371.                 if (mp->type->kind == TK_ARRAY) {
  1372.                 output("memcpy(");
  1373.                 out_var(mp, 2);
  1374.                 output(",\002");
  1375.                 if (spacecommas)
  1376.                     output(" ");
  1377.                 if (mp->constdefn) {
  1378.                     output(makeCstring(mp->constdefn->val.s,
  1379.                                mp->constdefn->val.i));
  1380.                     mp->constdefn = NULL;
  1381.                 } else
  1382.                     out_var(mp->cnext, 2);
  1383.                 output(",\002");
  1384.                 if (spacecommas)
  1385.                     output(" ");
  1386.                 output("sizeof(");
  1387.                 out_type(mp->type, 1);
  1388.                 output("))");
  1389.                 } else {
  1390.                 out_var(mp, 2);
  1391.                 output(" = ");
  1392.                 out_var(mp->cnext, 2);
  1393.                 }
  1394.                 output(";\n");
  1395.             }
  1396.             }
  1397.                 }
  1398.                 break;
  1399.  
  1400.             case SK_RETURN:
  1401.                 output("return");
  1402.         if (sp->exp1) {
  1403.             switch (returnparens) {
  1404.             
  1405.               case 0:
  1406.             output(" ");
  1407.             out_expr(sp->exp1);
  1408.             break;
  1409.             
  1410.               case 1:
  1411.             if (spaceexprs != 0)
  1412.                 output(" ");
  1413.             out_expr_parens(sp->exp1);
  1414.             break;
  1415.             
  1416.               default:
  1417.             if (sp->exp1->kind == EK_VAR ||
  1418.                 sp->exp1->kind == EK_CONST ||
  1419.                 sp->exp1->kind == EK_LONGCONST ||
  1420.                 sp->exp1->kind == EK_BICALL) {
  1421.                 output(" ");
  1422.                 out_expr(sp->exp1);
  1423.             } else {
  1424.                 if (spaceexprs != 0)
  1425.                 output(" ");
  1426.                 out_expr_parens(sp->exp1);
  1427.             }
  1428.             break;
  1429.             }
  1430.         }
  1431.         output(";");
  1432.         outnl(sp->serial);
  1433.                 break;
  1434.  
  1435.             case SK_ASSIGN:
  1436.                 out_expr_stmt(sp->exp1);
  1437.                 output(";");
  1438.         outnl(sp->serial);
  1439.                 break;
  1440.  
  1441.             case SK_CASE:
  1442.                 output("switch (");
  1443.                 out_expr(sp->exp1);
  1444.                 output(")");
  1445.                 outspnl(braceline <= 0);
  1446.                 output("{");
  1447.         outnl(sp->serial);
  1448.         saveindent2 = outindent;
  1449.         moreindent(tabsize);
  1450.         moreindent(switchindent);
  1451.                 sp2 = sp->stm1;
  1452.                 while (sp2 && sp2->kind == SK_CASELABEL) {
  1453.                     outsection(casespacing);
  1454.                     sp3 = sp2;
  1455.             i = 0;
  1456.             hascmt = (findcomment(curcomments, -1, sp2->serial) != NULL);
  1457.             singleindent(caseindent);
  1458.             flushcomments(NULL, CMT_PRE, sp2->serial);
  1459.                     for (;;) {
  1460.             if (i)
  1461.                 singleindent(caseindent);
  1462.             i = 0;
  1463.                         output("case ");
  1464.                         out_expr(sp3->exp1);
  1465.                         output(":\001");
  1466.                         sp3 = sp3->stm1;
  1467.                         if (!sp3 || sp3->kind != SK_CASELABEL)
  1468.                             break;
  1469.                         if (casetabs != 1000)
  1470.                             out_spaces(casetabs, 0, 0, 0);
  1471.                         else {
  1472.                             output("\n");
  1473.                 i = 1;
  1474.             }
  1475.                     }
  1476.                     if (sp3)
  1477.                         out_block(sp3, BR_NEVER|BR_CASE, sp2->serial);
  1478.                     else {
  1479.             outnl(sp2->serial);
  1480.             if (!hascmt)
  1481.                 output("/* blank case */\n");
  1482.             }
  1483.                     output("break;\n");
  1484.             flushcomments(NULL, -1, sp2->serial);
  1485.                     sp2 = sp2->next;
  1486.                 }
  1487.                 if (sp2) {
  1488.                     outsection(casespacing);
  1489.             singleindent(caseindent);
  1490.             flushcomments(NULL, CMT_PRE, sp2->serial);
  1491.                     output("default:");
  1492.                     out_block(sp2, BR_NEVER|BR_CASE, sp2->serial);
  1493.                     output("break;\n");
  1494.             flushcomments(NULL, -1, sp2->serial);
  1495.                 }
  1496.                 outindent = saveindent2;
  1497.                 output("}");
  1498.         curcmt = findcomment(curcomments, CMT_ONEND, sp->serial);
  1499.         if (curcmt)
  1500.             outcomment(curcmt);
  1501.         else
  1502.             output("\n");
  1503.                 break;
  1504.  
  1505.             case SK_CASECHECK:
  1506.         output(name_CASECHECK);
  1507.                 output("();   /* CASE value range error */\n");
  1508.                 break;
  1509.  
  1510.             case SK_FOR:
  1511.                 output("for (");
  1512.         if (for_allornone)
  1513.             output("\007");
  1514.                 if (sp->exp1 || sp->exp2 || sp->exp3 || spaceexprs > 0) {
  1515.                     if (sp->exp1)
  1516.                         out_expr_top(sp->exp1);
  1517.                     else if (spaceexprs > 0)
  1518.                         output(" ");
  1519.                     output(";\002 ");
  1520.                     if (sp->exp2)
  1521.                         out_expr(sp->exp2);
  1522.                     output(";\002 ");
  1523.                     if (sp->exp3)
  1524.                         out_expr_top(sp->exp3);
  1525.                 } else {
  1526.                     output(";;");
  1527.                 }
  1528.                 output(")");
  1529.                 out_block(sp->stm1, 0, sp->serial);
  1530.                 break;
  1531.  
  1532.             case SK_LABEL:
  1533.                 if (!line_start())
  1534.                     output("\n");
  1535.         singleindent(labelindent);
  1536.                 out_expr(sp->exp1);
  1537.                 output(":");
  1538.                 if (!sp->next)
  1539.                     output(" ;");
  1540.                 outnl(sp->serial);
  1541.                 break;
  1542.  
  1543.             case SK_GOTO:
  1544.                 /* what about non-local goto's? */
  1545.                 output("goto ");
  1546.                 out_expr(sp->exp1);
  1547.                 output(";");
  1548.         outnl(sp->serial);
  1549.                 break;
  1550.  
  1551.             case SK_IF:
  1552.                 sp2 = sp;
  1553.                 for (;;) {
  1554.                     output("if (");
  1555.                     out_expr_bool(sp2->exp1);
  1556.                     output(")");
  1557.                     if (sp2->stm2) {
  1558.             cmt = findcomment(curcomments, CMT_ONELSE, sp->serial+1);
  1559.                         i = (!cmt && sp2->stm2->kind == SK_IF &&
  1560.                  !sp2->stm2->next &&
  1561.                  ((sp2->stm2->exp2)
  1562.                   ? checkconst(sp2->stm2->exp2, 1)
  1563.                   : (elseif > 0)));
  1564.             if (braceelse &&
  1565.                             (usebraces(sp2->stm1, 0) ||
  1566.                              usebraces(sp2->stm2, 0) || i))
  1567.                             always = BR_ALWAYS;
  1568.                         else
  1569.                             always = 0;
  1570.                         out_block(sp2->stm1, BR_THENPART|always, sp->serial);
  1571.                         output("else");
  1572.                         sp2 = sp2->stm2;
  1573.                         if (i) {
  1574.                             output(" ");
  1575.                         } else {
  1576.                             out_block(sp2, BR_ELSEPART|always, sp->serial+1);
  1577.                             break;
  1578.                         }
  1579.                     } else {
  1580.                         out_block(sp2->stm1, 0, sp->serial);
  1581.                         break;
  1582.                     }
  1583.                 }
  1584.                 break;
  1585.  
  1586.             case SK_REPEAT:
  1587.                 output("do");
  1588.                 out_block(sp->stm1, BR_ALWAYS|BR_REPEAT, sp->serial);
  1589.                 output("while (");
  1590.                 out_expr_bool(sp->exp1);
  1591.                 output(");");
  1592.         cmt = findcomment(curcomments, CMT_ONEND, sp->serial);
  1593.         if (commentvisible(cmt)) {
  1594.             out_spaces(commentindent, commentoverindent,
  1595.                    commentlen(cmt), 0);
  1596.             output("\001");
  1597.             outcomment(cmt);
  1598.         } else
  1599.             output("\n");
  1600.                 break;
  1601.  
  1602.             case SK_TRY:
  1603.                 trynum = sp->exp1->val.i;
  1604.                 output(format_d("TRY(try%d);", trynum));
  1605.                 out_block(sp->stm1, BR_NEVER|BR_TRY, sp->serial);
  1606.                 if (sp->exp2)
  1607.                     output(format_ds("RECOVER2(try%d,%s);", trynum,
  1608.                                      format_s(name_LABEL, format_d("try%d", trynum))));
  1609.                 else
  1610.                     output(format_d("RECOVER(try%d);", trynum));
  1611.                 out_block(sp->stm2, BR_NEVER|BR_TRY, sp->serial);
  1612.                 output(format_d("ENDTRY(try%d);\n", trynum));
  1613.                 break;
  1614.  
  1615.             case SK_WHILE:
  1616.                 output("while (");
  1617.                 out_expr_bool(sp->exp1);
  1618.                 output(")");
  1619.                 out_block(sp->stm1, 0, sp->serial);
  1620.                 break;
  1621.  
  1622.             case SK_BREAK:
  1623.                 output("break;");
  1624.         outnl(sp->serial);
  1625.                 break;
  1626.  
  1627.             case SK_CONTINUE:
  1628.                 output("continue;");
  1629.         outnl(sp->serial);
  1630.                 break;
  1631.  
  1632.         default:
  1633.             intwarning("out_block",
  1634.                format_s("Misplaced statement kind %s [265]",
  1635.                     stmtkindname(sp->kind)));
  1636.         break;
  1637.         }
  1638.     flushcomments(NULL, -1, sp->serial);
  1639.         candeclare = 0;
  1640.         if (debug>1) { fprintf(outf, "in out_block:\n"); dumpstmt(spbase,5); }
  1641.         sp = sp->next;
  1642.     }
  1643.     if (opts & BR_FUNCTION) {
  1644.     cmt = extractcomment(&curcomments, CMT_ONEND, serial);
  1645.     if (findcomment(curcomments, -1, -1) != NULL)  /* check for non-DONE */
  1646.         output("\n");
  1647.     flushcomments(NULL, -1, -1);
  1648.     curcomments = cmt;
  1649.     }
  1650.     outindent = saveindent;
  1651.     if (braces) {
  1652.     if (line_start()) {
  1653.         if (opts & BR_FUNCTION)
  1654.         singleindent(funccloseindent);
  1655.         else
  1656.         singleindent(closebraceindent);
  1657.     }
  1658.         output("}");
  1659.     i = 1;
  1660.     cmt = findcomment(curcomments, CMT_ONEND, serial);
  1661.     if (!(opts & BR_REPEAT) && commentvisible(cmt)) {
  1662.         out_spaces(bracecommentindent, commentoverindent,
  1663.                commentlen(cmt), 0);
  1664.         output("\001");
  1665.         outcomment(cmt);
  1666.         i = 0;
  1667.     }
  1668.     if (i) {
  1669.         outspnl((opts & BR_REPEAT) ||
  1670.             ((opts & BR_THENPART) && (braceelseline & 1) == 0));
  1671.     }
  1672.         candeclare = 0;
  1673.     }
  1674.     if (gotcomments) {
  1675.     outcontext->comments = curcomments;
  1676.     curcomments = savecurcmt;
  1677.     }
  1678. }
  1679.  
  1680.  
  1681.  
  1682.  
  1683.  
  1684. /* Should have a way to convert GOTO's to the end of the function to RETURN's */
  1685.  
  1686.  
  1687. /* Convert "_RETV = foo;" at end of function to "return foo" */
  1688.  
  1689. Static int checkreturns(spp, nearret)
  1690. Stmt **spp;
  1691. int nearret;
  1692. {
  1693.     Stmt *sp;
  1694.     Expr *rvar, *ex;
  1695.     Meaning *mp;
  1696.     int spnearret, spnextreturn;
  1697.     int result = 0;
  1698.  
  1699.     if (debug>2) { fprintf(outf, "checkreturns on:\n"); dumpstmt(*spp, 5); }
  1700.     while ((sp = *spp)) {
  1701.         spnextreturn = (sp->next &&
  1702.                         sp->next->kind == SK_RETURN && sp->next->exp1 &&
  1703.                         isretvar(sp->next->exp1) == curctx->cbase);
  1704.         spnearret = (nearret && !sp->next) || spnextreturn;
  1705.         result = 0;
  1706.         switch (sp->kind) {
  1707.  
  1708.             case SK_ASSIGN:
  1709.                 ex = sp->exp1;
  1710.                 if (ex->kind == EK_ASSIGN || structuredfunc(ex)) {
  1711.                     rvar = ex->args[0];
  1712.                     mp = isretvar(rvar);
  1713.                     if (mp == curctx->cbase && spnearret) {
  1714.                         if (ex->kind == EK_ASSIGN) {
  1715.                             if (mp->kind == MK_VARPARAM) {
  1716.                                 ex = makeexpr_comma(ex, makeexpr_var(mp));
  1717.                             } else {
  1718.                                 ex = grabarg(ex, 1);
  1719.                                 mp->refcount--;
  1720.                             }
  1721.                         }
  1722.                         sp->exp1 = ex;
  1723.                         sp->kind = SK_RETURN;
  1724.                         if (spnextreturn) {
  1725.                             mp->refcount--;
  1726.                             sp->next = sp->next->next;
  1727.                         }
  1728.                         result = 1;
  1729.                     }
  1730.                 }
  1731.                 break;
  1732.  
  1733.             case SK_RETURN:
  1734.             case SK_GOTO:
  1735.                 result = 1;
  1736.                 break;
  1737.  
  1738.             case SK_IF:
  1739.                 result = checkreturns(&sp->stm1, spnearret) &    /* NOT && */
  1740.                          checkreturns(&sp->stm2, spnearret);
  1741.                 break;
  1742.  
  1743.             case SK_TRY:
  1744.                 (void) checkreturns(&sp->stm1, 0);
  1745.                 (void) checkreturns(&sp->stm2, spnearret);
  1746.                 break;
  1747.  
  1748.             /* should handle CASE statements as well */
  1749.  
  1750.             default:
  1751.                 (void) checkreturns(&sp->stm1, 0);
  1752.                 (void) checkreturns(&sp->stm2, 0);
  1753.                 break;
  1754.         }
  1755.         spp = &sp->next;
  1756.     }
  1757.     return result;
  1758. }
  1759.  
  1760.  
  1761.  
  1762.  
  1763.  
  1764.  
  1765.  
  1766. /* Replace all occurrences of one expression with another expression */
  1767.  
  1768. Expr *replaceexprexpr(ex, oldex, newex, keeptype)
  1769. Expr *ex, *oldex, *newex;
  1770. int keeptype;
  1771. {
  1772.     int i;
  1773.     Type *type;
  1774.  
  1775.     for (i = 0; i < ex->nargs; i++)
  1776.         ex->args[i] = replaceexprexpr(ex->args[i], oldex, newex, keeptype);
  1777.     if (exprsame(ex, oldex, 2)) {
  1778.         if (ex->val.type->kind == TK_POINTER &&
  1779.             ex->val.type->basetype == oldex->val.type) {
  1780.             freeexpr(ex);
  1781.             return makeexpr_addr(copyexpr(newex));
  1782.         } else if (oldex->val.type->kind == TK_POINTER &&
  1783.                    oldex->val.type->basetype == ex->val.type) {
  1784.             freeexpr(ex);
  1785.             return makeexpr_hat(copyexpr(newex), 0);
  1786.         } else {
  1787.         type = ex->val.type;
  1788.             freeexpr(ex);
  1789.             ex = copyexpr(newex);
  1790.         if (keeptype)
  1791.         ex->val.type = type;
  1792.         return ex;
  1793.         }
  1794.     }
  1795.     return resimplify(ex);
  1796. }
  1797.  
  1798.  
  1799. void replaceexpr(sp, oldex, newex)
  1800. Stmt *sp;
  1801. Expr *oldex, *newex;
  1802. {
  1803.     while (sp) {
  1804.         replaceexpr(sp->stm1, oldex, newex);
  1805.         replaceexpr(sp->stm2, oldex, newex);
  1806.         if (sp->exp1)
  1807.             sp->exp1 = replaceexprexpr(sp->exp1, oldex, newex, 1);
  1808.         if (sp->exp2)
  1809.             sp->exp2 = replaceexprexpr(sp->exp2, oldex, newex, 1);
  1810.         if (sp->exp3)
  1811.             sp->exp3 = replaceexprexpr(sp->exp3, oldex, newex, 1);
  1812.         sp = sp->next;
  1813.     }
  1814. }
  1815.  
  1816.  
  1817.  
  1818.  
  1819.  
  1820.  
  1821. Stmt *mixassignments(sp, mp)
  1822. Stmt *sp;
  1823. Meaning *mp;
  1824. {
  1825.     if (!sp)
  1826.         return NULL;
  1827.     sp->next = mixassignments(sp->next, mp);
  1828.     if (sp->next &&
  1829.      sp->kind == SK_ASSIGN &&
  1830.          sp->exp1->kind == EK_ASSIGN &&
  1831.          sp->exp1->args[0]->kind == EK_VAR &&
  1832.          (!mp || mp == (Meaning *)sp->exp1->args[0]->val.i) &&
  1833.          ord_type(sp->exp1->args[0]->val.type)->kind == TK_INTEGER &&
  1834.          nodependencies(sp->exp1->args[1], 0) &&
  1835.          sp->next->kind == SK_ASSIGN &&
  1836.          sp->next->exp1->kind == EK_ASSIGN &&
  1837.          (exprsame(sp->exp1->args[0], sp->next->exp1->args[0], 1) ||
  1838.           (mp && mp->istemporary)) &&
  1839.          exproccurs(sp->next->exp1->args[1], sp->exp1->args[0]) == 1) {
  1840.         sp->next->exp1->args[1] = replaceexprexpr(sp->next->exp1->args[1],
  1841.                                                   sp->exp1->args[0],
  1842.                                                   sp->exp1->args[1], 1);
  1843.         if (mp && mp->istemporary)
  1844.             canceltempvar(mp);
  1845.         return sp->next;
  1846.     }
  1847.     return sp;
  1848. }
  1849.  
  1850.  
  1851.  
  1852.  
  1853.  
  1854.  
  1855.  
  1856.  
  1857. /* Do various simple (sometimes necessary) massages on the statements */
  1858.  
  1859.  
  1860. Static Stmt bogusreturn = { SK_RETURN, NULL, NULL, NULL, NULL, NULL, NULL };
  1861.  
  1862.  
  1863.  
  1864. Static int isescape(ex)
  1865. Expr *ex;
  1866. {
  1867.     if (ex->kind == EK_BICALL && (!strcmp(ex->val.s, name_ESCAPE) ||
  1868.                                   !strcmp(ex->val.s, name_ESCIO) ||
  1869.                   !strcmp(ex->val.s, name_OUTMEM) ||
  1870.                   !strcmp(ex->val.s, name_CASECHECK) ||
  1871.                   !strcmp(ex->val.s, name_NILCHECK) ||
  1872.                                   !strcmp(ex->val.s, "_exit") ||
  1873.                                   !strcmp(ex->val.s, "exit")))
  1874.         return 1;
  1875.     if (ex->kind == EK_CAST)
  1876.         return isescape(ex->args[0]);
  1877.     return 0;
  1878. }
  1879.  
  1880.  
  1881. /* check if a block can never exit by falling off the end */
  1882. Static int deadendblock(sp)
  1883. Stmt *sp;
  1884. {
  1885.     if (!sp)
  1886.         return 0;
  1887.     while (sp->next)
  1888.         sp = sp->next;
  1889.     return (sp->kind == SK_GOTO ||
  1890.             sp->kind == SK_BREAK ||
  1891.             sp->kind == SK_CONTINUE ||
  1892.             sp->kind == SK_RETURN ||
  1893.             sp->kind == SK_CASECHECK ||
  1894.             (sp->kind == SK_IF && deadendblock(sp->stm1) &&
  1895.                                   deadendblock(sp->stm2)) ||
  1896.             (sp->kind == SK_ASSIGN && isescape(sp->exp1)));
  1897. }
  1898.  
  1899.  
  1900.  
  1901.  
  1902. int expr_is_bool(ex, want)
  1903. Expr *ex;
  1904. int want;
  1905. {
  1906.     long val;
  1907.  
  1908.     if (ex->val.type == tp_boolean && isconstexpr(ex, &val))
  1909.         return (val == want);
  1910.     return 0;
  1911. }
  1912.  
  1913.  
  1914.  
  1915.  
  1916. /* Returns 1 if c1 implies c2, 0 otherwise */
  1917. /* If not1 is true, then checks if (!c1) implies c2; similarly for not2 */
  1918.  
  1919. /* Identities used:
  1920.         c1 -> (c2a && c2b)      <=>     (c1 -> c2a) && (c1 -> c2b)
  1921.         c1 -> (c2a || c2b)      <=>     (c1 -> c2a) || (c1 -> c2b)
  1922.         (c1a && c1b) -> c2      <=>     (c1a -> c2) || (c1b -> c2)
  1923.         (c1a || c1b) -> c2      <=>     (c1a -> c2) && (c1b -> c2)
  1924.         (!c1) -> (!c2)          <=>     c2 -> c1
  1925.         (a == b) -> c2(b)       <=>     c2(a)
  1926.         !(c1 && c2)             <=>     (!c1) || (!c2)
  1927.         !(c1 || c2)             <=>     (!c1) && (!c2)
  1928. */
  1929. /* This could be smarter about, e.g., (a>5) -> (a>0) */
  1930.  
  1931. int implies(c1, c2, not1, not2)
  1932. Expr *c1, *c2;
  1933. int not1, not2;
  1934. {
  1935.     Expr *ex;
  1936.     int i;
  1937.  
  1938.     if (c1->kind == EK_EQ && c1->args[0]->val.type == tp_boolean) {
  1939.         if (checkconst(c1->args[0], 1)) {     /* things like "flag = true" */
  1940.             return implies(c1->args[1], c2, not1, not2);
  1941.         } else if (checkconst(c1->args[1], 1)) {
  1942.             return implies(c1->args[0], c2, not1, not2);
  1943.         } else if (checkconst(c1->args[0], 0)) {
  1944.             return implies(c1->args[1], c2, !not1, not2);
  1945.         } else if (checkconst(c1->args[1], 0)) {
  1946.             return implies(c1->args[0], c2, !not1, not2);
  1947.         }
  1948.     }
  1949.     if (c2->kind == EK_EQ && c2->args[0]->val.type == tp_boolean) {
  1950.         if (checkconst(c2->args[0], 1)) {
  1951.             return implies(c1, c2->args[1], not1, not2);
  1952.         } else if (checkconst(c2->args[1], 1)) {
  1953.             return implies(c1, c2->args[0], not1, not2);
  1954.         } else if (checkconst(c2->args[0], 0)) {
  1955.             return implies(c1, c2->args[1], not1, !not2);
  1956.         } else if (checkconst(c2->args[1], 0)) {
  1957.             return implies(c1, c2->args[0], not1, !not2);
  1958.         }
  1959.     }
  1960.     switch (c2->kind) {
  1961.  
  1962.         case EK_AND:
  1963.             if (not2)               /* c1 -> (!c2a || !c2b) */
  1964.                 return (implies(c1, c2->args[0], not1, 1) ||
  1965.                         implies(c1, c2->args[1], not1, 1));
  1966.             else                    /* c1 -> (c2a && c2b) */
  1967.                 return (implies(c1, c2->args[0], not1, 0) &&
  1968.                         implies(c1, c2->args[1], not1, 0));
  1969.  
  1970.         case EK_OR:
  1971.             if (not2)               /* c1 -> (!c2a && !c2b) */
  1972.                 return (implies(c1, c2->args[0], not1, 1) &&
  1973.                         implies(c1, c2->args[1], not1, 1));
  1974.             else                    /* c1 -> (c2a || c2b) */
  1975.                 return (implies(c1, c2->args[0], not1, 0) ||
  1976.                         implies(c1, c2->args[1], not1, 0));
  1977.  
  1978.         case EK_NOT:                /* c1 -> (!c2) */
  1979.             return (implies(c1, c2->args[0], not1, !not2));
  1980.  
  1981.         case EK_CONST:
  1982.             if ((c2->val.i != 0) != not2)  /* c1 -> true */
  1983.                 return 1;
  1984.             break;
  1985.  
  1986.     default:
  1987.         break;
  1988.     }
  1989.     switch (c1->kind) {
  1990.  
  1991.         case EK_AND:
  1992.             if (not1)               /* (!c1a || !c1b) -> c2 */
  1993.                 return (implies(c1->args[0], c2, 1, not2) &&
  1994.                         implies(c1->args[1], c2, 1, not2));
  1995.             else                    /* (c1a && c1b) -> c2 */
  1996.                 return (implies(c1->args[0], c2, 0, not2) ||
  1997.                         implies(c1->args[1], c2, 0, not2));
  1998.  
  1999.         case EK_OR:
  2000.             if (not1)               /* (!c1a && !c1b) -> c2 */
  2001.                 return (implies(c1->args[0], c2, 1, not2) ||
  2002.                         implies(c1->args[1], c2, 1, not2));
  2003.             else                    /* (c1a || c1b) -> c2 */
  2004.                 return (implies(c1->args[0], c2, 0, not2) &&
  2005.                         implies(c1->args[1], c2, 0, not2));
  2006.  
  2007.         case EK_NOT:                /* (!c1) -> c2 */
  2008.             return (implies(c1->args[0], c2, !not1, not2));
  2009.  
  2010.         case EK_CONST:
  2011.             if ((c1->val.i != 0) == not1)  /*  false -> c2 */
  2012.                 return 1;
  2013.             break;
  2014.  
  2015.         case EK_EQ:                 /* (a=b) -> c2 */
  2016.         case EK_ASSIGN:             /* (a:=b) -> c2 */
  2017.         case EK_NE:                 /* (a<>b) -> c2 */
  2018.             if ((c1->kind == EK_NE) == not1) {
  2019.                 if (c1->args[0]->kind == EK_VAR) {
  2020.                     ex = replaceexprexpr(copyexpr(c2), c1->args[0], c1->args[1], 1);
  2021.                     i = expr_is_bool(ex, !not2);
  2022.                     freeexpr(ex);
  2023.                     if (i)
  2024.                         return 1;
  2025.                 }
  2026.                 if (c1->args[1]->kind == EK_VAR) {
  2027.                     ex = replaceexprexpr(copyexpr(c2), c1->args[1], c1->args[0], 1);
  2028.                     i = expr_is_bool(ex, !not2);
  2029.                     freeexpr(ex);
  2030.                     if (i)
  2031.                         return 1;
  2032.                 }
  2033.             }
  2034.             break;
  2035.  
  2036.     default:
  2037.         break;
  2038.     }
  2039.     if (not1 == not2 && exprequiv(c1, c2)) {    /* c1 -> c1 */
  2040.         return 1;
  2041.     }
  2042.     return 0;
  2043. }
  2044.  
  2045.  
  2046.  
  2047.  
  2048.  
  2049. void infiniteloop(sp)
  2050. Stmt *sp;
  2051. {
  2052.     switch (infloopstyle) {
  2053.  
  2054.         case 1:      /* write "for (;;) ..." */
  2055.             sp->kind = SK_FOR;
  2056.             freeexpr(sp->exp1);
  2057.             sp->exp1 = NULL;
  2058.             break;
  2059.  
  2060.         case 2:      /* write "while (1) ..." */
  2061.             sp->kind = SK_WHILE;
  2062.             freeexpr(sp->exp1);
  2063.             sp->exp1 = makeexpr_val(make_ord(tp_boolean, 1));
  2064.             break;
  2065.  
  2066.         case 3:      /* write "do ... while (1)" */
  2067.             sp->kind = SK_REPEAT;
  2068.             freeexpr(sp->exp1);
  2069.             sp->exp1 = makeexpr_val(make_ord(tp_boolean, 1));
  2070.             break;
  2071.  
  2072.         default:     /* leave it alone */
  2073.             break;
  2074.  
  2075.     }
  2076. }
  2077.  
  2078.  
  2079.  
  2080.  
  2081.  
  2082. Expr *print_func(ex)
  2083. Expr *ex;
  2084. {
  2085.     if (!ex || ex->kind != EK_BICALL)
  2086.     return NULL;
  2087.     if ((!strcmp(ex->val.s, "printf") &&
  2088.      ex->args[0]->kind == EK_CONST) ||
  2089.     !strcmp(ex->val.s, "putchar") ||
  2090.     !strcmp(ex->val.s, "puts"))
  2091.     return ex_output;
  2092.     if ((!strcmp(ex->val.s, "fprintf") ||
  2093.      !strcmp(ex->val.s, "sprintf")) &&
  2094.     ex->args[1]->kind == EK_CONST)
  2095.     return ex->args[0];
  2096.     if (!strcmp(ex->val.s, "putc") ||
  2097.     !strcmp(ex->val.s, "fputc") ||
  2098.     !strcmp(ex->val.s, "fputs"))
  2099.     return ex->args[1];
  2100.     return NULL;
  2101. }
  2102.  
  2103.  
  2104.  
  2105. int printnl_func(ex)
  2106. Expr *ex;
  2107. {
  2108.     char *cp, ch;
  2109.     int i, len;
  2110.  
  2111.     if (debug>2) { fprintf(outf,"printnl_func("); dumpexpr(ex); fprintf(outf, ")\n"); }
  2112.     if (!strcmp(ex->val.s, "printf") ||
  2113.     !strcmp(ex->val.s, "puts") ||
  2114.     !strcmp(ex->val.s, "fputs")) {
  2115.     if (ex->args[0]->kind != EK_CONST)
  2116.         return 0;
  2117.     cp = ex->args[0]->val.s;
  2118.     len = ex->args[0]->val.i;
  2119.     } else if (!strcmp(ex->val.s, "fprintf")) {
  2120.     if (ex->args[1]->kind != EK_CONST)
  2121.         return 0;
  2122.     cp = ex->args[1]->val.s;
  2123.     len = ex->args[1]->val.i;
  2124.     } else if (!strcmp(ex->val.s, "putchar") ||
  2125.            !strcmp(ex->val.s, "putc") ||
  2126.            !strcmp(ex->val.s, "fputc")) {
  2127.     if (ex->args[0]->kind != EK_CONST)
  2128.         return 0;
  2129.     ch = ex->args[0]->val.i;
  2130.     cp = &ch;
  2131.     len = 1;
  2132.     } else
  2133.     return 0;
  2134.     for (i = 1; i <= len; i++)
  2135.     if (*cp++ != '\n')
  2136.         return 0;
  2137.     return len + (!strcmp(ex->val.s, "puts"));
  2138. }
  2139.  
  2140.  
  2141.  
  2142. Expr *chg_printf(ex)
  2143. Expr *ex;
  2144. {
  2145.     Expr *fex;
  2146.  
  2147.     if (debug>2) { fprintf(outf,"chg_printf("); dumpexpr(ex); fprintf(outf, ")\n"); }
  2148.     if (!strcmp(ex->val.s, "putchar")) {
  2149.     ex = makeexpr_sprintfify(grabarg(ex, 0));
  2150.     canceltempvar(istempvar(ex->args[0]));
  2151.     strchange(&ex->val.s, "printf");
  2152.     delfreearg(&ex, 0);
  2153.     ex->val.type = tp_void;
  2154.     } else if (!strcmp(ex->val.s, "putc") ||
  2155.            !strcmp(ex->val.s, "fputc") ||
  2156.            !strcmp(ex->val.s, "fputs")) {
  2157.     fex = copyexpr(ex->args[1]);
  2158.     ex = makeexpr_sprintfify(grabarg(ex, 0));
  2159.     canceltempvar(istempvar(ex->args[0]));
  2160.     strchange(&ex->val.s, "fprintf");
  2161.     ex->args[0] = fex;
  2162.     ex->val.type = tp_void;
  2163.     } else if (!strcmp(ex->val.s, "puts")) {
  2164.     ex = makeexpr_concat(makeexpr_sprintfify(grabarg(ex, 0)),
  2165.                  makeexpr_string("\n"), 1);
  2166.     strchange(&ex->val.s, "printf");
  2167.     delfreearg(&ex, 0);
  2168.     ex->val.type = tp_void;
  2169.     }
  2170.     if (!strcmp(ex->val.s, "fprintf") && exprsame(ex->args[0], ex_output, 1)) {
  2171.     delfreearg(&ex, 0);
  2172.     strchange(&ex->val.s, "printf");
  2173.     }
  2174.     return ex;
  2175. }
  2176.  
  2177.  
  2178. Expr *mix_printf(ex, ex2)
  2179. Expr *ex, *ex2;
  2180. {
  2181.     int i;
  2182.  
  2183.     ex = chg_printf(ex);
  2184.     if (debug>2) { fprintf(outf,"chg_printf returns "); dumpexpr(ex); fprintf(outf, "\n"); }
  2185.     ex2 = chg_printf(copyexpr(ex2));
  2186.     if (debug>2) { fprintf(outf,"chg_printf returns "); dumpexpr(ex2);fprintf(outf, "\n"); }
  2187.     i = (!strcmp(ex->val.s, "printf")) ? 0 : 1;
  2188.     ex->args[i] = makeexpr_concat(ex->args[i], ex2->args[i], 0);
  2189.     for (i++; i < ex2->nargs; i++) {
  2190.     insertarg(&ex, ex->nargs, ex2->args[i]);
  2191.     }
  2192.     return ex;
  2193. }
  2194.  
  2195.  
  2196.  
  2197.  
  2198.  
  2199.  
  2200. void eatstmt(spp)
  2201. Stmt **spp;
  2202. {
  2203.     Stmt *sp = *spp;
  2204.  
  2205.     if (debug>2) { fprintf(outf, "eatstmt on:\n"); dumpstmt(sp, 5); }
  2206.     *spp = sp->next;
  2207.     sp->next = NULL;
  2208.     free_stmt(sp);
  2209. }
  2210.  
  2211.  
  2212.  
  2213. int haslabels(sp)
  2214. Stmt *sp;
  2215. {
  2216.     if (!sp)
  2217.         return 0;
  2218.     if (haslabels(sp->stm1) || haslabels(sp->stm2))
  2219.         return 1;
  2220.     return (sp->kind == SK_LABEL);
  2221. }
  2222.  
  2223.  
  2224.  
  2225. void fixblock(spp, thereturn)
  2226. Stmt **spp, *thereturn;
  2227. {
  2228.     Stmt *sp, *sp1, *sp2, *sp3, **spp2, *thisreturn;
  2229.     Expr *ex;
  2230.     Meaning *tvar;
  2231.     int save_tryblock;
  2232.     short save_tryflag;
  2233.     int i, j, de1, de2;
  2234.     long saveserial = curserial;
  2235.  
  2236.     while ((sp = *spp)) {
  2237.         sp2 = sp->next;
  2238.         sp->next = NULL;
  2239.         sp = fix_statement(*spp);
  2240.         if (!sp) {
  2241.             *spp = sp2;
  2242.             continue;
  2243.         }
  2244.         *spp = sp;
  2245.         for (sp3 = sp; sp3->next; sp3 = sp3->next) ;
  2246.         sp3->next = sp2;
  2247.         if (!sp->next)
  2248.             thisreturn = thereturn;
  2249.         else if (sp->next->kind == SK_RETURN ||
  2250.                  (sp->next->kind == SK_ASSIGN &&
  2251.                   isescape(sp->next->exp1)))
  2252.             thisreturn = sp->next;
  2253.         else
  2254.             thisreturn = NULL;
  2255.     if (sp->serial >= 0)
  2256.         curserial = sp->serial;
  2257.         switch (sp->kind) {
  2258.  
  2259.             case SK_ASSIGN:
  2260.             if (sp->exp1)
  2261.             sp->exp1 = fixexpr(sp->exp1, ENV_STMT);
  2262.         if (!sp->exp1)
  2263.             intwarning("fixblock", "sp->exp1 == NULL in SK_ASSIGN");
  2264.                 if (!sp->exp1 || nosideeffects(sp->exp1, 1)) {
  2265.             eatstmt(spp);
  2266.             continue;
  2267.                 } else {
  2268.                     switch (sp->exp1->kind) {
  2269.  
  2270.                         case EK_COND:
  2271.                             *spp = makestmt_if(sp->exp1->args[0],
  2272.                                                makestmt_call(sp->exp1->args[1]),
  2273.                                                makestmt_call(sp->exp1->args[2]));
  2274.                             (*spp)->next = sp->next;
  2275.                             continue;    /* ... to fix this new if statement */
  2276.  
  2277.                         case EK_ASSIGN:
  2278.                             if (sp->exp1->args[1]->kind == EK_COND && usecommas != 1) {
  2279.                                 *spp = makestmt_if(sp->exp1->args[1]->args[0],
  2280.                                                    makestmt_assign(copyexpr(sp->exp1->args[0]),
  2281.                                                                    sp->exp1->args[1]->args[1]),
  2282.                                                    makestmt_assign(sp->exp1->args[0],
  2283.                                                                    sp->exp1->args[1]->args[2]));
  2284.                                 (*spp)->next = sp->next;
  2285.                                 continue;
  2286.                             }
  2287.                 if (isescape(sp->exp1->args[1])) {
  2288.                                 sp->exp1 = grabarg(sp->exp1, 1);
  2289.                 continue;
  2290.                             }
  2291.                 if (exprsame(sp->exp1->args[0], sp->exp1->args[1], 1)) {
  2292.                               /*  *spp = sp->next;  */
  2293.                                 sp->exp1 = grabarg(sp->exp1, 0);
  2294.                                 continue;
  2295.                             }
  2296.                 if (sp->exp1->args[1]->kind == EK_BICALL) {
  2297.                 if (!strcmp(sp->exp1->args[1]->val.s,
  2298.                         getfbufname) &&
  2299.                     buildreads == 1 &&
  2300.                     sp->next &&
  2301.                     sp->next->kind == SK_ASSIGN &&
  2302.                     sp->next->exp1->kind == EK_BICALL &&
  2303.                     !strcmp(sp->next->exp1->val.s,
  2304.                         getname) &&
  2305.                     expr_has_address(sp->exp1->args[0]) &&
  2306.                     similartypes(sp->exp1->args[0]->val.type,
  2307.                          filebasetype(sp->exp1->args[1]->args[0]->val.type)) &&
  2308.                     exprsame(sp->exp1->args[1]->args[0],
  2309.                          sp->next->exp1->args[0], 1)) {
  2310.                     eatstmt(&sp->next);
  2311.                     ex = makeexpr_bicall_4("fread", tp_integer,
  2312.                                makeexpr_addr(sp->exp1->args[0]),
  2313.                                makeexpr_sizeof(sp->exp1->args[1]->args[1], 0),
  2314.                                makeexpr_long(1),
  2315.                                sp->exp1->args[1]->args[0]);
  2316.                     FREE(sp->exp1);
  2317.                     sp->exp1 = ex;
  2318.                     continue;
  2319.                 }
  2320.                 if (!strcmp(sp->exp1->args[1]->val.s,
  2321.                         chargetfbufname) &&
  2322.                     buildreads != 0 &&
  2323.                     sp->next &&
  2324.                     sp->next->kind == SK_ASSIGN &&
  2325.                     sp->next->exp1->kind == EK_BICALL &&
  2326.                     !strcmp(sp->next->exp1->val.s,
  2327.                         chargetname) &&
  2328.                     expr_has_address(sp->exp1->args[0]) &&
  2329.                     exprsame(sp->exp1->args[1]->args[0],
  2330.                          sp->next->exp1->args[0], 1)) {
  2331.                     eatstmt(&sp->next);
  2332.                     strchange(&sp->exp1->args[1]->val.s,
  2333.                           "getc");
  2334.                     continue;
  2335.                 }
  2336.                 }
  2337.                             break;
  2338.  
  2339.                         case EK_BICALL:
  2340.                             if (!strcmp(sp->exp1->val.s, name_ESCAPE)) {
  2341.                                 if (fixexpr_tryblock) {
  2342.                                     *spp = makestmt_assign(makeexpr_var(mp_escapecode),
  2343.                                                            grabarg(sp->exp1, 0));
  2344.                                     (*spp)->next = makestmt(SK_GOTO);
  2345.                                     (*spp)->next->exp1 = makeexpr_name(format_s(name_LABEL,
  2346.                                                                                 format_d("try%d",
  2347.                                                                                          fixexpr_tryblock)),
  2348.                                                                        tp_integer);
  2349.                                     (*spp)->next->next = sp->next;
  2350.                                     fixexpr_tryflag = 1;
  2351.                                     continue;
  2352.                                 }
  2353.                             } else if (!strcmp(sp->exp1->val.s, name_ESCIO)) {
  2354.                                 if (fixexpr_tryblock) {
  2355.                                     *spp = makestmt_assign(makeexpr_var(mp_escapecode),
  2356.                                                            makeexpr_long(-10));
  2357.                                     (*spp)->next = makestmt_assign(makeexpr_var(mp_ioresult),
  2358.                                                                    grabarg(sp->exp1, 0));
  2359.                                     (*spp)->next->next = makestmt(SK_GOTO);
  2360.                                     (*spp)->next->next->exp1 = makeexpr_name(format_s(name_LABEL,
  2361.                                                                                       format_d("try%d",
  2362.                                                                                                fixexpr_tryblock)),
  2363.                                                                              tp_integer);
  2364.                                     (*spp)->next->next->next = sp->next;
  2365.                                     fixexpr_tryflag = 1;
  2366.                                     continue;
  2367.                                 }
  2368.                             }
  2369.                 if (!strcmp(sp->exp1->val.s, putfbufname) &&
  2370.                 buildwrites == 1 &&
  2371.                 sp->next &&
  2372.                 sp->next->kind == SK_ASSIGN &&
  2373.                 sp->next->exp1->kind == EK_BICALL &&
  2374.                 !strcmp(sp->next->exp1->val.s,
  2375.                     putname) &&
  2376.                 exprsame(sp->exp1->args[0],
  2377.                      sp->next->exp1->args[0], 1)) {
  2378.                 eatstmt(&sp->next);
  2379.                 if (!expr_has_address(sp->exp1->args[2]) ||
  2380.                     sp->exp1->args[2]->val.type !=
  2381.                         sp->exp1->args[1]->val.type) {
  2382.                     tvar = maketempvar(sp->exp1->args[1]->val.type,
  2383.                                name_TEMP);
  2384.                     sp2 = makestmt_assign(makeexpr_var(tvar),
  2385.                               sp->exp1->args[2]);
  2386.                     sp2->next = sp;
  2387.                     *spp = sp2;
  2388.                     sp->exp1->args[2] = makeexpr_var(tvar);
  2389.                     freetempvar(tvar);
  2390.                 }
  2391.                 ex = makeexpr_bicall_4("fwrite", tp_integer,
  2392.                                makeexpr_addr(sp->exp1->args[2]),
  2393.                                makeexpr_sizeof(sp->exp1->args[1], 0),
  2394.                                makeexpr_long(1),
  2395.                                sp->exp1->args[0]);
  2396.                 FREE(sp->exp1);
  2397.                 sp->exp1 = ex;
  2398.                 continue;
  2399.                 }
  2400.                 if (!strcmp(sp->exp1->val.s, charputfbufname) &&
  2401.                 buildwrites != 0 &&
  2402.                 sp->next &&
  2403.                 sp->next->kind == SK_ASSIGN &&
  2404.                 sp->next->exp1->kind == EK_BICALL &&
  2405.                 !strcmp(sp->next->exp1->val.s,
  2406.                     charputname) &&
  2407.                 exprsame(sp->exp1->args[0],
  2408.                      sp->next->exp1->args[0], 1)) {
  2409.                 eatstmt(&sp->next);
  2410.                 swapexprs(sp->exp1->args[0],
  2411.                       sp->exp1->args[1]);
  2412.                 strchange(&sp->exp1->val.s, "putc");
  2413.                 continue;
  2414.                 }
  2415.                 if ((!strcmp(sp->exp1->val.s, resetbufname) ||
  2416.                  !strcmp(sp->exp1->val.s, setupbufname)) &&
  2417.                 !fileisbuffered(sp->exp1->args[0], 0)) {
  2418.                 eatstmt(spp);
  2419.                 continue;
  2420.                 }
  2421.                 ex = print_func(sp->exp1);
  2422.                 if (ex && sp->next && mixwritelns &&
  2423.                 sp->next->kind == SK_ASSIGN &&
  2424.                 exprsame(ex, print_func(sp->next->exp1), 1) &&
  2425.                 (printnl_func(sp->exp1) ||
  2426.                  printnl_func(sp->next->exp1))) {
  2427.                 sp->exp1 = mix_printf(sp->exp1,
  2428.                               sp->next->exp1);
  2429.                 eatstmt(&sp->next);
  2430.                 continue;
  2431.                 }
  2432.                             break;
  2433.  
  2434.                         case EK_FUNCTION:
  2435.                         case EK_SPCALL:
  2436.                         case EK_POSTINC:
  2437.                         case EK_POSTDEC:
  2438.                         case EK_AND:
  2439.                         case EK_OR:
  2440.                             break;
  2441.  
  2442.                         default:
  2443.                             spp2 = spp;
  2444.                             for (i = 0; i < sp->exp1->nargs; i++) {
  2445.                                 *spp2 = makestmt_call(sp->exp1->args[i]);
  2446.                                 spp2 = &(*spp2)->next;
  2447.                             }
  2448.                             *spp2 = sp->next;
  2449.                             continue;    /* ... to fix these new statements */
  2450.  
  2451.                     }
  2452.                 }
  2453.                 break;
  2454.  
  2455.             case SK_IF:
  2456.                 fixblock(&sp->stm1, thisreturn);
  2457.                 fixblock(&sp->stm2, thisreturn);
  2458.                 if (!sp->stm1) {
  2459.                     if (!sp->stm2) {
  2460.                         sp->kind = SK_ASSIGN;
  2461.                         continue;
  2462.                     } else {
  2463.             if (sp->stm2->kind == SK_IF && sp->stm2->exp2) {
  2464.                 freeexpr(sp->stm2->exp2);
  2465.                 sp->stm2->exp2 = NULL;
  2466.             }
  2467.                         sp->exp1 = makeexpr_not(sp->exp1);   /* if (x) else foo  =>  if (!x) foo */
  2468.                         swapstmts(sp->stm1, sp->stm2);
  2469.             /* Ought to exchange comments for then/else parts */
  2470.                     }
  2471.                 }
  2472.         /* At this point we know sp1 != NULL */
  2473.                 if (thisreturn) {
  2474.                     if (thisreturn->kind == SK_WHILE) {
  2475.                         if (usebreaks) {
  2476.                             sp1 = sp->stm1;
  2477.                             while (sp1->next)
  2478.                                 sp1 = sp1->next;
  2479.                             if (sp->stm2) {
  2480.                 sp2 = sp->stm2;
  2481.                 while (sp2->next)
  2482.                     sp2 = sp2->next;
  2483.                                 i = stmtcount(sp->stm1);
  2484.                                 j = stmtcount(sp->stm2);
  2485.                                 if (j >= breaklimit && i <= 2 && j > i*2 &&
  2486.                                     ((implies(sp->exp1, thisreturn->exp1, 0, 1) &&
  2487.                       !checkexprchanged(sp->stm1, sp->exp1)) ||
  2488.                      (sp1->kind == SK_ASSIGN &&
  2489.                       implies(sp1->exp1, thisreturn->exp1, 0, 1)))) {
  2490.                                     sp1->next = makestmt(SK_BREAK);
  2491.                                 } else if (i >= breaklimit && j <= 2 && i > j*2 &&
  2492.                                            ((implies(sp->exp1, thisreturn->exp1, 1, 1) &&
  2493.                          !checkexprchanged(sp->stm2, sp->exp1)) ||
  2494.                         (sp2->kind == SK_ASSIGN &&
  2495.                          implies(sp2->exp1, thisreturn->exp1, 0, 1)))) {
  2496.                                     sp2->next = makestmt(SK_BREAK);
  2497.                 } else if (!checkconst(sp->exp2, 1)) {
  2498.                     /* not part of an else-if */
  2499.                     if (j >= continuelimit) {
  2500.                     sp1->next = makestmt(SK_CONTINUE);
  2501.                     } else if (i >= continuelimit) {
  2502.                     sp2->next = makestmt(SK_CONTINUE);
  2503.                     }
  2504.                 }
  2505.                 } else {
  2506.                                 i = stmtcount(sp->stm1);
  2507.                                 if (i >= breaklimit &&
  2508.                                     implies(sp->exp1, thisreturn->exp1, 1, 1)) {
  2509.                                     sp->exp1 = makeexpr_not(sp->exp1);
  2510.                                     sp1->next = sp->next;
  2511.                                     sp->next = sp->stm1;
  2512.                                     sp->stm1 = makestmt(SK_BREAK);
  2513.                                 } else if (i >= continuelimit) {
  2514.                                     sp->exp1 = makeexpr_not(sp->exp1);
  2515.                                     sp1->next = sp->next;
  2516.                                     sp->next = sp->stm1;
  2517.                                     sp->stm1 = makestmt(SK_CONTINUE);
  2518.                                 }
  2519.                             }
  2520.                         }
  2521.                     } else {
  2522.                         if (usereturns) {
  2523.                             sp2 = sp->stm1;
  2524.                             while (sp2->next)
  2525.                                 sp2 = sp2->next;
  2526.                             if (sp->stm2) {
  2527.                                 /* if (x) foo; else bar; (return;)  =>  if (x) {foo; return;} bar; */
  2528.                                 if (stmtcount(sp->stm2) >= returnlimit) {
  2529.                     if (!deadendblock(sp->stm1))
  2530.                     sp2->next = copystmt(thisreturn);
  2531.                                 } else if (stmtcount(sp->stm1) >= returnlimit) {
  2532.                                     sp2 = sp->stm2;
  2533.                                     while (sp2->next)
  2534.                                         sp2 = sp2->next;
  2535.                     if (!deadendblock(sp->stm2))
  2536.                     sp2->next = copystmt(thisreturn);
  2537.                                 }
  2538.                             } else {      /* if (x) foo; (return;)  =>  if (!x) return; foo; */
  2539.                                 if (stmtcount(sp->stm1) >= returnlimit) {
  2540.                                     sp->exp1 = makeexpr_not(sp->exp1);
  2541.                                     sp2->next = sp->next;
  2542.                                     sp->next = sp->stm1;
  2543.                                     sp->stm1 = copystmt(thisreturn);
  2544.                                 }
  2545.                             }
  2546.                         }
  2547.                     }
  2548.                 }
  2549.                 if (!checkconst(sp->exp2, 1)) {    /* not part of an else-if */
  2550.                     de1 = deadendblock(sp->stm1);
  2551.                     de2 = deadendblock(sp->stm2);
  2552.                     if (de2 && !de1) {
  2553.                         sp->exp1 = makeexpr_not(sp->exp1);
  2554.                         swapstmts(sp->stm1, sp->stm2);
  2555.                         de1 = 1, de2 = 0;
  2556.                     }
  2557.                     if (de1 && !de2 && sp->stm2) {
  2558.             if (sp->stm2->kind == SK_IF && sp->stm2->exp2) {
  2559.                 freeexpr(sp->stm2->exp2);
  2560.                 sp->stm2->exp2 = NULL;
  2561.             }
  2562.                         for (sp2 = sp->stm2; sp2->next; sp2 = sp2->next) ;
  2563.                         sp2->next = sp->next;
  2564.                         sp->next = sp->stm2;      /* if (x) ESCAPE else foo  =>  if (x) ESCAPE; foo */
  2565.                         sp->stm2 = NULL;
  2566.                     }
  2567.                 }
  2568.                 sp->exp1 = fixexpr(sp->exp1, ENV_BOOL);
  2569.         if (elimdeadcode > 1 && checkconst(sp->exp1, 0)) {
  2570.             note("Eliminated \"if false\" statement [326]");
  2571.             splicestmt(sp, sp->stm2);
  2572.             continue;
  2573.         } else if (elimdeadcode > 1 && checkconst(sp->exp1, 1)) {
  2574.             note("Eliminated \"if true\" statement [327]");
  2575.             splicestmt(sp, sp->stm1);
  2576.             continue;
  2577.         }
  2578.                 break;
  2579.  
  2580.             case SK_WHILE:
  2581.                 if (whilefgets &&    /* handle "while eof(f) do readln(f,...)" */
  2582.             sp->stm1 &&
  2583.             sp->stm1->kind == SK_ASSIGN &&
  2584.             sp->stm1->exp1->kind == EK_BICALL &&
  2585.             !strcmp(sp->stm1->exp1->val.s, "fgets") &&
  2586.             nosideeffects(sp->stm1->exp1->args[0], 1) &&
  2587.             nosideeffects(sp->stm1->exp1->args[1], 1) &&
  2588.             nosideeffects(sp->stm1->exp1->args[2], 1)) {
  2589.             if ((sp->exp1->kind == EK_NOT &&
  2590.              sp->exp1->args[0]->kind == EK_BICALL && *eofname &&
  2591.              !strcmp(sp->exp1->args[0]->val.s, eofname) &&
  2592.              exprsame(sp->exp1->args[0]->args[0],
  2593.                   sp->stm1->exp1->args[2], 1)) ||
  2594.             (sp->exp1->kind == EK_EQ &&
  2595.              sp->exp1->args[0]->kind == EK_BICALL &&
  2596.              !strcmp(sp->exp1->args[0]->val.s, "feof") &&
  2597.              checkconst(sp->exp1->args[1], 0) &&
  2598.              exprsame(sp->exp1->args[0]->args[0],
  2599.                   sp->stm1->exp1->args[2], 1))) {
  2600.             sp->stm1->exp1->val.type = tp_strptr;
  2601.             sp->exp1 = makeexpr_rel(EK_NE,
  2602.                         sp->stm1->exp1,
  2603.                         makeexpr_nil());
  2604.             sp->stm1 = sp->stm1->next;
  2605.             }
  2606.                 }
  2607.                 fixblock(&sp->stm1, sp);
  2608.                 sp->exp1 = fixexpr(sp->exp1, ENV_BOOL);
  2609.                 if (checkconst(sp->exp1, 1))
  2610.                     infiniteloop(sp);
  2611.                 break;
  2612.  
  2613.             case SK_REPEAT:
  2614.                 fixblock(&sp->stm1, NULL);
  2615.                 sp->exp1 = fixexpr(sp->exp1, ENV_BOOL);
  2616.                 if (checkconst(sp->exp1, 1))
  2617.                     infiniteloop(sp);
  2618.                 break;
  2619.  
  2620.             case SK_TRY:
  2621.                 save_tryblock = fixexpr_tryblock;
  2622.                 save_tryflag = fixexpr_tryflag;
  2623.                 fixexpr_tryblock = sp->exp1->val.i;
  2624.                 fixexpr_tryflag = 0;
  2625.                 fixblock(&sp->stm1, NULL);
  2626.                 if (fixexpr_tryflag)
  2627.                     sp->exp2 = makeexpr_long(1);
  2628.                 fixexpr_tryblock = save_tryblock;
  2629.                 fixexpr_tryflag = save_tryflag;
  2630.                 fixblock(&sp->stm2, NULL);
  2631.                 break;
  2632.  
  2633.             case SK_BODY:
  2634.                 fixblock(&sp->stm1, thisreturn);
  2635.                 break;
  2636.  
  2637.             case SK_CASE:
  2638.                 fixblock(&sp->stm1, NULL);
  2639.                 sp->exp1 = fixexpr(sp->exp1, ENV_EXPR);
  2640.                 if (!sp->stm1) {    /* empty case */
  2641.                     sp->kind = SK_ASSIGN;
  2642.                     continue;
  2643.                 } else if (sp->stm1->kind != SK_CASELABEL) {   /* default only */
  2644.                     for (sp2 = sp->stm1; sp2->next; sp2 = sp2->next) ;
  2645.                     sp2->next = sp->next;
  2646.                     sp->next = sp->stm1;
  2647.                     sp->kind = SK_ASSIGN;
  2648.                     sp->stm1 = NULL;
  2649.                     continue;
  2650.                 }
  2651.                 break;
  2652.  
  2653.             default:
  2654.                 fixblock(&sp->stm1, NULL);
  2655.                 fixblock(&sp->stm2, NULL);
  2656.                 sp->exp1 = fixexpr(sp->exp1, ENV_EXPR);
  2657.                 sp->exp2 = fixexpr(sp->exp2, ENV_EXPR);
  2658.                 sp->exp3 = fixexpr(sp->exp3, ENV_EXPR);
  2659.                 if (sp->next &&
  2660.                     (sp->kind == SK_GOTO ||
  2661.                      sp->kind == SK_BREAK ||
  2662.                      sp->kind == SK_CONTINUE ||
  2663.                      sp->kind == SK_RETURN) &&
  2664.                     !haslabels(sp->next)) {
  2665.                     if (elimdeadcode) {
  2666.                         note("Deleting unreachable code [255]");
  2667.                         while (sp->next && !haslabels(sp->next))
  2668.                             eatstmt(&sp->next);
  2669.                     } else {
  2670.                         note("Code is unreachable [256]");
  2671.                     }
  2672.                 } else if (sp->kind == SK_RETURN &&
  2673.                            thisreturn &&
  2674.                            thisreturn->kind == SK_RETURN &&
  2675.                            exprsame(sp->exp1, thisreturn->exp1, 1)) {
  2676.                     eatstmt(spp);
  2677.             continue;
  2678.                 }
  2679.                 break;
  2680.         }
  2681.         spp = &sp->next;
  2682.     }
  2683.     saveserial = curserial;
  2684. }
  2685.  
  2686.  
  2687.  
  2688.  
  2689. /* Convert comma expressions into multiple statements */
  2690.  
  2691. Static int checkcomma_expr(spp, exp)
  2692. Stmt **spp;
  2693. Expr **exp;
  2694. {
  2695.     Stmt *sp;
  2696.     Expr *ex = *exp;
  2697.     int i, res;
  2698.  
  2699.     switch (ex->kind) {
  2700.  
  2701.         case EK_COMMA:
  2702.             if (spp) {
  2703.                 res = checkcomma_expr(spp, &ex->args[ex->nargs-1]);
  2704.                 for (i = ex->nargs-1; --i >= 0; ) {
  2705.                     sp = makestmt(SK_ASSIGN);
  2706.                     sp->exp1 = ex->args[i];
  2707.                     sp->next = *spp;
  2708.                     *spp = sp;
  2709.                     res = checkcomma_expr(spp, &ex->args[i]);
  2710.                 }
  2711.                 *exp = ex->args[ex->nargs-1];
  2712.             }
  2713.             return 1;
  2714.  
  2715.         case EK_COND:
  2716.             if (isescape(ex->args[1]) && spp &&
  2717.                 !isescape(ex->args[2])) {
  2718.                 swapexprs(ex->args[1], ex->args[2]);
  2719.                 ex->args[0] = makeexpr_not(ex->args[0]);
  2720.             }
  2721.             if (isescape(ex->args[2])) {
  2722.                 if (spp) {
  2723.                     res = checkcomma_expr(spp, &ex->args[1]);
  2724.                     if (ex->args[0]->kind == EK_ASSIGN) {
  2725.                         sp = makestmt(SK_ASSIGN);
  2726.                         sp->exp1 = copyexpr(ex->args[0]);
  2727.                         sp->next = makestmt(SK_IF);
  2728.                         sp->next->next = *spp;
  2729.                         *spp = sp;
  2730.                         res = checkcomma_expr(spp, &sp->exp1);
  2731.                         ex->args[0] = grabarg(ex->args[0], 0);
  2732.                         sp = sp->next;
  2733.                     } else {
  2734.                         sp = makestmt(SK_IF);
  2735.                         sp->next = *spp;
  2736.                         *spp = sp;
  2737.                     }
  2738.                     sp->exp1 = makeexpr_not(ex->args[0]);
  2739.                     sp->stm1 = makestmt(SK_ASSIGN);
  2740.                     sp->stm1->exp1 = eatcasts(ex->args[2]);
  2741.                     res = checkcomma_expr(&sp->stm1, &ex->args[2]);
  2742.                     res = checkcomma_expr(spp, &sp->exp1);
  2743.                     *exp = ex->args[1];
  2744.                 }
  2745.                 return 1;
  2746.             }
  2747.             return checkcomma_expr(spp, &ex->args[0]);
  2748.  
  2749.         case EK_AND:
  2750.         case EK_OR:
  2751.             return checkcomma_expr(spp, &ex->args[0]);
  2752.  
  2753.     default:
  2754.         res = 0;
  2755.         for (i = ex->nargs; --i >= 0; ) {
  2756.         res += checkcomma_expr(spp, &ex->args[i]);
  2757.         }
  2758.         return res;
  2759.  
  2760.     }
  2761. }
  2762.  
  2763.  
  2764.  
  2765. Static void checkcommas(spp)
  2766. Stmt **spp;
  2767. {
  2768.     Stmt *sp;
  2769.     int res;
  2770.  
  2771.     while ((sp = *spp)) {
  2772.         checkcommas(&sp->stm1);
  2773.         checkcommas(&sp->stm2);
  2774.         switch (sp->kind) {
  2775.  
  2776.             case SK_ASSIGN:
  2777.             case SK_IF:
  2778.             case SK_CASE:
  2779.             case SK_RETURN:
  2780.                 if (sp->exp1)
  2781.                     res = checkcomma_expr(spp, &sp->exp1);
  2782.                 break;
  2783.  
  2784.             case SK_WHILE:
  2785.                 /* handle the argument */
  2786.                 break;
  2787.  
  2788.             case SK_REPEAT:
  2789.                 /* handle the argument */
  2790.                 break;
  2791.  
  2792.             case SK_FOR:
  2793.         if (sp->exp1)
  2794.             res = checkcomma_expr(spp, &sp->exp1);
  2795.                 /* handle the other arguments */
  2796.                 break;
  2797.  
  2798.         default:
  2799.         break;
  2800.         }
  2801.         spp = &sp->next;
  2802.     }
  2803. }
  2804.  
  2805.  
  2806.  
  2807.  
  2808. Static int checkvarchangeable(ex, mp)
  2809. Expr *ex;
  2810. Meaning *mp;
  2811. {
  2812.     switch (ex->kind) {
  2813.  
  2814.         case EK_VAR:
  2815.             return (mp == (Meaning *)ex->val.i);
  2816.  
  2817.         case EK_DOT:
  2818.         case EK_INDEX:
  2819.             return checkvarchangeable(ex->args[0], mp);
  2820.  
  2821.     default:
  2822.         return 0;
  2823.     }
  2824. }
  2825.  
  2826.  
  2827.  
  2828. int checkvarchangedexpr(ex, mp, addrokay)
  2829. Expr *ex;
  2830. Meaning *mp;
  2831. int addrokay;
  2832. {
  2833.     int i;
  2834.     Meaning *mp3;
  2835.     unsigned int safemask = 0;
  2836.  
  2837.     switch (ex->kind) {
  2838.  
  2839.         case EK_FUNCTION:
  2840.         case EK_SPCALL:
  2841.             if (ex->kind == EK_FUNCTION) {
  2842.                 i = 0;
  2843.                 mp3 = ((Meaning *)ex->val.i)->type->fbase;
  2844.             } else {
  2845.                 i = 1;
  2846.                 if (ex->args[0]->val.type->kind != TK_PROCPTR)
  2847.                     return 1;
  2848.                 mp3 = ex->args[0]->val.type->basetype->fbase;
  2849.             }
  2850.             for ( ; i < ex->nargs && i < 16; i++) {
  2851.                 if (!mp3) {
  2852.                     intwarning("checkvarchangedexpr", "Too many arguments for EK_FUNCTION [266]");
  2853.                     break;
  2854.                 }
  2855.                 if (mp3->kind == MK_PARAM &&
  2856.                     (mp3->type->kind == TK_ARRAY ||
  2857.                      mp3->type->kind == TK_STRING ||
  2858.                      mp3->type->kind == TK_SET))
  2859.                     safemask |= 1<<i;
  2860.                 if (mp3->kind == MK_VARPARAM &&
  2861.                     mp3->type == tp_strptr && mp3->anyvarflag)
  2862.                     i++;
  2863.                 mp3 = mp3->xnext;
  2864.             }
  2865.             if (mp3)
  2866.                 intwarning("checkvarchangedexpr", "Too few arguments for EK_FUNCTION [267]");
  2867.             break;
  2868.  
  2869.         case EK_VAR:
  2870.             if (mp == (Meaning *)ex->val.i) {
  2871.                 if ((mp->type->kind == TK_ARRAY ||
  2872.                      mp->type->kind == TK_STRING ||
  2873.                      mp->type->kind == TK_SET) &&
  2874.                     ex->val.type->kind == TK_POINTER && !addrokay)
  2875.                     return 1;   /* must be an implicit & */
  2876.             }
  2877.             break;
  2878.  
  2879.         case EK_ADDR:
  2880.         case EK_ASSIGN:
  2881.         case EK_POSTINC:
  2882.         case EK_POSTDEC:
  2883.             if (checkvarchangeable(ex->args[0], mp))
  2884.                 return 1;
  2885.             break;
  2886.  
  2887.         case EK_BICALL:
  2888.             if (structuredfunc(ex) && checkvarchangeable(ex->args[0], mp))
  2889.                 return 1;
  2890.             safemask = safemask_bicall(ex->val.s);
  2891.             break;
  2892.             /* In case calls to these functions were lazy and passed
  2893.                the array rather than its (implicit) address.  Other
  2894.                BICALLs had better be careful about their arguments. */
  2895.  
  2896.         case EK_PLUS:
  2897.             if (addrokay)         /* to keep from being scared by pointer */
  2898.                 safemask = ~0;    /*  arithmetic on string being passed */
  2899.             break;                /*  to functions. */
  2900.  
  2901.     default:
  2902.         break;
  2903.     }
  2904.     for (i = 0; i < ex->nargs; i++) {
  2905.         if (checkvarchangedexpr(ex->args[i], mp, safemask&1))
  2906.             return 1;
  2907.         safemask >>= 1;
  2908.     }
  2909.     return 0;
  2910. }
  2911.  
  2912.  
  2913.  
  2914. int checkvarchanged(sp, mp)
  2915. Stmt *sp;
  2916. Meaning *mp;
  2917. {
  2918.     if (mp->constqual)
  2919.     return 0;
  2920.     if (mp->varstructflag || !mp->ctx || mp->ctx->kind != MK_FUNCTION ||
  2921.         mp->volatilequal || alwayscopyvalues)
  2922.         return 1;
  2923.     while (sp) {
  2924.         if (/* sp->kind == SK_GOTO || */
  2925.         sp->kind == SK_LABEL ||
  2926.             checkvarchanged(sp->stm1, mp) ||
  2927.             checkvarchanged(sp->stm2, mp) ||
  2928.             (sp->exp1 && checkvarchangedexpr(sp->exp1, mp, 1)) ||
  2929.             (sp->exp2 && checkvarchangedexpr(sp->exp2, mp, 1)) ||
  2930.             (sp->exp3 && checkvarchangedexpr(sp->exp3, mp, 1)))
  2931.             return 1;
  2932.         sp = sp->next;
  2933.     }
  2934.     return 0;
  2935. }
  2936.  
  2937.  
  2938.  
  2939. int checkexprchanged(sp, ex)
  2940. Stmt *sp;
  2941. Expr *ex;
  2942. {
  2943.     Meaning *mp;
  2944.     int i;
  2945.  
  2946.     for (i = 0; i < ex->nargs; i++) {
  2947.         if (checkexprchanged(sp, ex->args[i]))
  2948.             return 1;
  2949.     }
  2950.     switch (ex->kind) {
  2951.  
  2952.         case EK_VAR:
  2953.             mp = (Meaning *)ex->val.i;
  2954.             if (mp->kind == MK_CONST)
  2955.                 return 0;
  2956.             else
  2957.                 return checkvarchanged(sp, mp);
  2958.  
  2959.         case EK_HAT:
  2960.         case EK_INDEX:
  2961.         case EK_SPCALL:
  2962.             return 1;
  2963.  
  2964.         case EK_FUNCTION:
  2965.         case EK_BICALL:
  2966.             return !nosideeffects_func(ex);
  2967.  
  2968.     default:
  2969.         return 0;
  2970.     }
  2971. }
  2972.  
  2973.  
  2974.  
  2975.  
  2976.  
  2977. /* Check if a variable always occurs with a certain offset added, e.g. "i+1" */
  2978.  
  2979. Static int theoffset, numoffsets, numzerooffsets;
  2980. #define BadOffset  (-999)
  2981.  
  2982. void checkvaroffsetexpr(ex, mp, myoffset)
  2983. Expr *ex;
  2984. Meaning *mp;
  2985. int myoffset;
  2986. {
  2987.     int i, nextoffset = 0;
  2988.     Expr *ex2;
  2989.  
  2990.     if (!ex)
  2991.     return;
  2992.     switch (ex->kind) {
  2993.  
  2994.       case EK_VAR:
  2995.     if (ex->val.i == (long)mp) {
  2996.         if (myoffset == 0)
  2997.         numzerooffsets++;
  2998.         else if (numoffsets == 0 || myoffset == theoffset) {
  2999.         theoffset = myoffset;
  3000.         numoffsets++;
  3001.         } else
  3002.         theoffset = BadOffset;
  3003.     }
  3004.     break;
  3005.  
  3006.       case EK_PLUS:
  3007.     ex2 = ex->args[ex->nargs-1];
  3008.     if (ex2->kind == EK_CONST &&
  3009.         ex2->val.type->kind == TK_INTEGER) {
  3010.         nextoffset = ex2->val.i;
  3011.     }
  3012.     break;
  3013.  
  3014.       case EK_HAT:
  3015.       case EK_POSTINC:
  3016.       case EK_POSTDEC:
  3017.     nextoffset = BadOffset;
  3018.     break;
  3019.  
  3020.       case EK_ASSIGN:
  3021.     checkvaroffsetexpr(ex->args[0], mp, BadOffset);
  3022.     checkvaroffsetexpr(ex->args[1], mp, 0);
  3023.     return;
  3024.  
  3025.       default:
  3026.     break;
  3027.     }
  3028.     i = ex->nargs;
  3029.     while (--i >= 0)
  3030.     checkvaroffsetexpr(ex->args[i], mp, nextoffset);
  3031. }
  3032.  
  3033.  
  3034. void checkvaroffsetstmt(sp, mp)
  3035. Stmt *sp;
  3036. Meaning *mp;
  3037. {
  3038.     while (sp) {
  3039.     checkvaroffsetstmt(sp->stm1, mp);
  3040.     checkvaroffsetstmt(sp->stm1, mp);
  3041.     checkvaroffsetexpr(sp->exp1, mp, 0);
  3042.     checkvaroffsetexpr(sp->exp2, mp, 0);
  3043.     checkvaroffsetexpr(sp->exp3, mp, 0);
  3044.     sp = sp->next;
  3045.     }
  3046. }
  3047.  
  3048.  
  3049. int checkvaroffset(sp, mp)
  3050. Stmt *sp;
  3051. Meaning *mp;
  3052. {
  3053.     if (mp->varstructflag || !mp->ctx || mp->ctx->kind != MK_FUNCTION)
  3054.     return 0;
  3055.     numoffsets = 0;
  3056.     numzerooffsets = 0;
  3057.     checkvaroffsetstmt(sp, mp);
  3058.     if (numoffsets == 0 || theoffset == BadOffset ||
  3059.     numoffsets <= numzerooffsets * 3)
  3060.     return 0;
  3061.     else
  3062.     return theoffset;
  3063. }
  3064.  
  3065.  
  3066.  
  3067.  
  3068. Expr *initfilevar(ex)
  3069. Expr *ex;
  3070. {
  3071.     Expr *ex2;
  3072.     Meaning *mp;
  3073.     char *name;
  3074.  
  3075.     if (ex->val.type->kind == TK_BIGFILE) {
  3076.     ex2 = copyexpr(ex);
  3077.     if (ex->kind == EK_VAR &&
  3078.         (mp = (Meaning *)ex->val.i)->kind == MK_VAR &&
  3079.         mp->ctx->kind != MK_FUNCTION &&
  3080.         !is_std_file(ex) &&
  3081.         literalfilesflag > 0 &&
  3082.         (literalfilesflag == 1 ||
  3083.          strlist_cifind(literalfiles, mp->name)))
  3084.         name = mp->name;
  3085.     else
  3086.         name = "";
  3087.     return makeexpr_comma(makeexpr_assign(filebasename(ex),
  3088.                           makeexpr_nil()),
  3089.                   makeexpr_assign(makeexpr_dotq(ex2, "name",
  3090.                                 tp_str255),
  3091.                           makeexpr_string(name)));
  3092.     } else {
  3093.     return makeexpr_assign(ex, makeexpr_nil());
  3094.     }
  3095. }
  3096.  
  3097.  
  3098. void initfilevars(mp, sppp, exbase)
  3099. Meaning *mp;
  3100. Stmt ***sppp;
  3101. Expr *exbase;
  3102. {
  3103.     Stmt *sp;
  3104.     Type *tp;
  3105.     Expr *ex;
  3106.  
  3107.     while (mp) {
  3108.     if ((mp->kind == MK_VAR && mp->refcount > 0 && !mp->istemporary) ||
  3109.         mp->kind == MK_FIELD) {
  3110.         tp = mp->type;
  3111.         if (isfiletype(tp, -1)) {
  3112.         mp->refcount++;
  3113.         sp = makestmt(SK_ASSIGN);
  3114.         sp->next = **sppp;
  3115.         **sppp = sp;
  3116.         if (exbase)
  3117.             ex = makeexpr_dot(copyexpr(exbase), mp);
  3118.         else
  3119.             ex = makeexpr_var(mp);
  3120.         sp->exp1 = initfilevar(copyexpr(ex));
  3121.         } else if (tp->kind == TK_RECORD) {
  3122.         if (exbase)
  3123.             ex = makeexpr_dot(copyexpr(exbase), mp);
  3124.         else
  3125.             ex = makeexpr_var(mp);
  3126.         initfilevars(tp->fbase, sppp, ex);
  3127.         freeexpr(ex);
  3128.         } else if (tp->kind == TK_ARRAY) {
  3129.         while (tp->kind == TK_ARRAY)
  3130.             tp = tp->basetype;
  3131.         if (isfiletype(tp, -1))
  3132.             note(format_s("Array of files %s should be initialized [257]",
  3133.                   mp->name));
  3134.         }
  3135.     }
  3136.     mp = mp->cnext;
  3137.     }
  3138. }
  3139.  
  3140.  
  3141.  
  3142.  
  3143.  
  3144. Static Stmt *p_body()
  3145. {
  3146.     Stmt *sp, **spp, *spbody, **sppbody, *spbase, *thereturn;
  3147.     Meaning *mp;
  3148.     Expr *ex;
  3149.     int haspostamble;
  3150.     long saveserial;
  3151.  
  3152.     if (verbose)
  3153.     fprintf(logf, "%s, %d/%d: Translating %s (in %s)\n",
  3154.         infname, inf_lnum, outf_lnum,
  3155.         curctx->name, curctx->ctx->name);
  3156.     notephase = 1;
  3157.     spp = &spbase;
  3158.     addstmt(SK_HEADER);
  3159.     sp->exp1 = makeexpr_var(curctx);
  3160.     checkkeyword(TOK_INLINE);
  3161.     if (curtok != TOK_END && curtok != TOK_BEGIN && curtok != TOK_INLINE) {
  3162.     if (curctx->kind == MK_FUNCTION || curctx->anyvarflag)
  3163.         wexpecttok(TOK_BEGIN);
  3164.     else
  3165.         wexpecttok(TOK_END);
  3166.     skiptotoken2(TOK_BEGIN, TOK_END);
  3167.     }
  3168.     if (curtok == TOK_END) {
  3169.     gettok();
  3170.     spbody = NULL;
  3171.     } else {
  3172.     spbody = p_stmt(NULL, SF_FUNC);  /* parse the procedure/program body */
  3173.     }
  3174.     if (curtok == TOK_IDENT && curtokmeaning == curctx) {
  3175.     gettok();    /* Modula-2 */
  3176.     }
  3177.     notephase = 2;
  3178.     saveserial = curserial;
  3179.     curserial = 10000;
  3180.     if (curctx->kind == MK_FUNCTION) {     /* handle copy parameters */
  3181.         for (mp = curctx->type->fbase; mp; mp = mp->xnext) {
  3182.             if (!mp->othername && mp->varstructflag) {
  3183.                 mp->othername = stralloc(format_s(name_COPYPAR, mp->name));
  3184.                 mp->rectype = mp->type;
  3185.                 addstmt(SK_ASSIGN);
  3186.                 sp->exp1 = makeexpr_assign(makeexpr_var(mp), 
  3187.                                            makeexpr_name(mp->othername, mp->rectype));
  3188.                 mp->refcount++;
  3189.             } else if (mp->othername) {
  3190.                 if (checkvarchanged(spbody, mp)) {
  3191.                     addstmt(SK_ASSIGN);
  3192.                     sp->exp1 = makeexpr_assign(makeexpr_var(mp),
  3193.                                                makeexpr_hat(makeexpr_name(mp->othername,
  3194.                                                                           mp->rectype), 0));
  3195.                     mp->refcount++;
  3196.                 } else {           /* don't need to copy it after all */
  3197.                     strchange(&mp->othername, mp->name);
  3198.                     ex = makeexpr_var(mp);
  3199.                     ex->val.type = mp->rectype;
  3200.                     replaceexpr(spbody, makeexpr_var(mp), makeexpr_hat(ex, 0));
  3201.                 }
  3202.             }
  3203.         }
  3204.     }
  3205.     for (mp = curctx->cbase; mp; mp = mp->cnext) {
  3206.     if (mp->kind == MK_LABEL && mp->val.i) {
  3207.         addstmt(SK_IF);
  3208.         sp->exp1 = makeexpr_bicall_1("setjmp", tp_int,
  3209.                      makeexpr_var(mp->xnext));
  3210.         sp->stm1 = makestmt(SK_GOTO);
  3211.         sp->stm1->exp1 = makeexpr_name(format_s(name_LABEL, mp->name),
  3212.                        tp_integer);
  3213.     }
  3214.     }
  3215.     *spp = spbody;
  3216.     sppbody = spp;
  3217.     while (*spp)
  3218.         spp = &((*spp)->next);
  3219.     haspostamble = 0;
  3220.     initfilevars(curctx->cbase, &sppbody, NULL);
  3221.     for (mp = curctx->cbase; mp; mp = mp->cnext) {
  3222.         if (mp->kind == MK_VAR && mp->refcount > 0 &&
  3223.         isfiletype(mp->type, -1) &&
  3224.         !mp->istemporary) {
  3225.             if (curctx->kind != MK_MODULE || curctx->anyvarflag) {
  3226.                 addstmt(SK_IF);                    /* close file variables */
  3227.                 sp->exp1 = makeexpr_rel(EK_NE, filebasename(makeexpr_var(mp)),
  3228.                     makeexpr_nil());
  3229.                 sp->stm1 = makestmt(SK_ASSIGN);
  3230.                 sp->stm1->exp1 = makeexpr_bicall_1("fclose", tp_void,
  3231.                            filebasename(makeexpr_var(mp)));
  3232.             }
  3233.             haspostamble = 1;
  3234.         }
  3235.     }
  3236.     thereturn = &bogusreturn;
  3237.     if (curctx->kind == MK_FUNCTION && curctx->type->basetype != tp_void) {
  3238.         if ((haspostamble || !checkreturns(&spbase, 1)) &&
  3239.             curctx->cbase->refcount > 0) {      /* add function return code */
  3240.             addstmt(SK_RETURN);
  3241.             sp->exp1 = makeexpr_var(curctx->cbase);
  3242.         }
  3243.         thereturn = NULL;
  3244.     } else if (curctx->kind == MK_MODULE && curctx->anyvarflag) {
  3245.         addstmt(SK_ASSIGN);
  3246.         sp->exp1 = makeexpr_bicall_1("exit", tp_void,
  3247.                      makeexpr_name("EXIT_SUCCESS",
  3248.                            tp_integer));
  3249.         thereturn = NULL;
  3250.     }
  3251.     if (debug>2) { fprintf(outf, "calling fixblock/usecommas on:\n"); dumpstmt(spbase, 5); }
  3252.     curserial = saveserial;
  3253.     sp = makestmt(SK_BODY);
  3254.     sp->stm1 = spbase;
  3255.     fixblock(&sp, thereturn);           /* finishing touches to statements and expressions */
  3256.     spbase = sp->stm1;
  3257.     FREE(sp);
  3258.     if (usecommas != 1)
  3259.         checkcommas(&spbase);    /* unroll ugly EK_COMMA and EK_COND expressions */
  3260.     if (debug>1) { fprintf(outf, "p_body returns:\n"); dumpstmt(spbase, 5); }
  3261.     notephase = 0;
  3262.     return spbase;
  3263. }
  3264.  
  3265.  
  3266.  
  3267.  
  3268. #define checkWord()  if (anywords) output(" "); anywords = 1
  3269.  
  3270. Static void out_function(func)
  3271. Meaning *func;
  3272. {
  3273.     Meaning *mp;
  3274.     Symbol *sym;
  3275.     int opts, anywords, spacing, saveindent;
  3276.  
  3277.     if (func->varstructflag) {
  3278.         makevarstruct(func);
  3279.     }
  3280.     if (collectnest) {
  3281.     for (mp = func->cbase; mp; mp = mp->cnext) {
  3282.         if (mp->kind == MK_FUNCTION && mp->isforward) {
  3283.         forward_decl(mp, 0);
  3284.         }
  3285.     }
  3286.     for (mp = func->cbase; mp; mp = mp->cnext) {
  3287.         if (mp->kind == MK_FUNCTION && mp->type && !mp->exported) {
  3288.         pushctx(mp);
  3289.         out_function(mp);    /* generate the sub-procedures first */
  3290.         popctx();
  3291.         }
  3292.     }
  3293.     }
  3294.     spacing = functionspace;
  3295.     for (mp = func; mp->ctx->kind == MK_FUNCTION; mp = mp->ctx) {
  3296.         if (spacing > minfuncspace)
  3297.             spacing--;
  3298.     }
  3299.     outsection(spacing);
  3300.     flushcomments(&func->comments, -1, 0);
  3301.     if (usePPMacros == 1) {
  3302.         forward_decl(func, 0);
  3303.         outsection(minorspace);
  3304.     }
  3305.     opts = ODECL_HEADER;
  3306.     anywords = 0;
  3307.     if (func->namedfile) {
  3308.     checkWord();
  3309.     if (useAnyptrMacros || ansiC < 2)
  3310.         output("Inline");
  3311.     else
  3312.         output("inline");
  3313.     }
  3314.     if (!func->exported) {
  3315.     if (func->ctx->kind == MK_FUNCTION) {
  3316.         if (useAnyptrMacros) {
  3317.         checkWord();
  3318.         output("Local");
  3319.         } else if (use_static) {
  3320.         checkWord();
  3321.         output("static");
  3322.         }
  3323.     } else if ((findsymbol(func->name)->flags & NEEDSTATIC) ||
  3324.            (use_static != 0 && !useAnyptrMacros)) {
  3325.         checkWord();
  3326.         output("static");
  3327.     } else if (useAnyptrMacros) {
  3328.         checkWord();
  3329.         output("Static");
  3330.     }
  3331.     }
  3332.     if (func->type->basetype != tp_void || ansiC != 0) {
  3333.     checkWord();
  3334.         outbasetype(func->type, 0);
  3335.     }
  3336.     if (anywords) {
  3337.         if (newlinefunctions)
  3338.             opts |= ODECL_FUNCTION;
  3339.         else
  3340.             output(" ");
  3341.     }
  3342.     outdeclarator(func->type, func->name, opts);
  3343.     if (fullprototyping == 0) {
  3344.     saveindent = outindent;
  3345.     moreindent(argindent);
  3346.         out_argdecls(func->type);
  3347.     outindent = saveindent;
  3348.     }
  3349.     for (mp = func->type->fbase; mp; mp = mp->xnext) {
  3350.         if (mp->othername && strcmp(mp->name, mp->othername))
  3351.             mp->wasdeclared = 0;    /* make sure we also declare the copy */
  3352.     }
  3353.     func->wasdeclared = 1;
  3354.     outcontext = func;
  3355.     out_block((Stmt *)func->val.i, BR_FUNCTION, 10000);
  3356.     if (useundef) {
  3357.     anywords = 0;
  3358.     for (mp = func->cbase; mp; mp = mp->cnext) {
  3359.         if (mp->kind == MK_CONST &&
  3360.         mp->isreturn) {    /* the was-#defined flag */
  3361.         if (!anywords)
  3362.             outsection(minorspace);
  3363.         anywords++;
  3364.         output(format_s("#undef %s\n", mp->name));
  3365.         sym = findsymbol(mp->name);
  3366.         sym->flags &= ~AVOIDNAME;
  3367.         }
  3368.     }
  3369.     }
  3370.     if (conserve_mem) {
  3371.     free_stmt((Stmt *)func->val.i);   /* is this safe? */
  3372.     func->val.i = 0;
  3373.     forget_ctx(func, 0);
  3374.     }
  3375.     outsection(spacing);
  3376. }
  3377.  
  3378.  
  3379.  
  3380.  
  3381. void movetoend(mp)
  3382. Meaning *mp;
  3383. {
  3384.     Meaning **mpp;
  3385.  
  3386.     if (mp->ctx != curctx) {
  3387.         intwarning("movetoend", "curctx is wrong [268]");
  3388.     } else {
  3389.         mpp = &mp->ctx->cbase;     /* move a meaning to end of its parent context */
  3390.         while (*mpp != mp) {
  3391.         if (!*mpp) {
  3392.         intwarning("movetoend", "meaning not on its context list [269]");
  3393.         return;
  3394.         }
  3395.             mpp = &(*mpp)->cnext;
  3396.     }
  3397.         *mpp = mp->cnext;    /* Remove from present position in list */
  3398.         while (*mpp)
  3399.             mpp = &(*mpp)->cnext;
  3400.         *mpp = mp;           /* Insert at end of list */
  3401.         mp->cnext = NULL;
  3402.         curctxlast = mp;
  3403.     }
  3404. }
  3405.  
  3406.  
  3407.  
  3408. Static void scanfwdparams(mp)
  3409. Meaning *mp;
  3410. {
  3411.     Symbol *sym;
  3412.  
  3413.     mp = mp->type->fbase;
  3414.     while (mp) {
  3415.     sym = findsymbol(mp->name);
  3416.     sym->flags |= FWDPARAM;
  3417.     mp = mp->xnext;
  3418.     }
  3419. }
  3420.  
  3421.  
  3422.  
  3423. Static void p_function(isfunc)
  3424. int isfunc;
  3425. {
  3426.     Meaning *func;
  3427.     Type *type;
  3428.     Stmt *sp;
  3429.     Strlist *sl, *comments, *savecmt;
  3430.     int initializeattr = 0, isinline = 0;
  3431.  
  3432.     if ((sl = strlist_find(attrlist, "INITIALIZE")) != NULL) {
  3433.     initializeattr = 1;
  3434.     strlist_delete(&attrlist, sl);
  3435.     }
  3436.     if ((sl = strlist_find(attrlist, "OPTIMIZE")) != NULL &&
  3437.     sl->value != -1 &&
  3438.     !strcmp((char *)(sl->value), "INLINE")) {
  3439.     isinline = 1;
  3440.     strlist_delete(&attrlist, sl);
  3441.     }
  3442.     ignore_attributes();
  3443.     comments = extractcomment(&curcomments, -1, curserial);
  3444.     changecomments(comments, -1, -1, -1, 0);
  3445.     if (curctx->kind == MK_FUNCTION) {    /* sub-procedure */
  3446.     savecmt = curcomments;
  3447.     } else {
  3448.     savecmt = NULL;
  3449.     flushcomments(&curcomments, -1, -1);
  3450.     }
  3451.     curcomments = comments;
  3452.     curserial = serialcount = 1;
  3453.     gettok();
  3454.     if (!wexpecttok(TOK_IDENT))
  3455.     skiptotoken(TOK_IDENT);
  3456.     if (curtokmeaning && curtokmeaning->ctx == curctx &&
  3457.         curtokmeaning->kind == MK_FUNCTION) {
  3458.         func = curtokmeaning;
  3459.         if (!func->isforward || func->val.i)
  3460.             warning(format_s("Redeclaration of function %s [270]", func->name));
  3461.     skiptotoken(TOK_SEMI);
  3462.         movetoend(func);
  3463.         pushctx(func);
  3464.         type = func->type;
  3465.     } else {
  3466.         func = addmeaning(curtoksym, MK_FUNCTION);
  3467.         gettok();
  3468.         func->val.i = 0;
  3469.         pushctx(func);
  3470.         func->type = type = p_funcdecl(&isfunc, 0);
  3471.         func->isfunction = isfunc;
  3472.     func->namedfile = isinline;
  3473.         type->meaning = func;
  3474.     }
  3475.     if (blockkind == TOK_EXPORT)
  3476.     flushcomments(NULL, -1, -1);
  3477.     wneedtok(TOK_SEMI);
  3478.     if (initializeattr) {
  3479.     sl = strlist_append(&initialcalls, format_s("%s()", func->name));
  3480.     sl->value = 1;
  3481.     }
  3482.     if (curtok == TOK_IDENT && !strcmp(curtokbuf, "C")) {
  3483.     gettok();
  3484.     wneedtok(TOK_SEMI);
  3485.     }
  3486.     if (blockkind == TOK_IMPORT) {
  3487.     strlist_empty(&curcomments);
  3488.     if (curtok == TOK_IDENT &&
  3489.         (!strcicmp(curtokbuf, "FORWARD") ||
  3490.          strlist_cifind(externwords, curtokbuf) ||
  3491.          strlist_cifind(cexternwords, curtokbuf))) {
  3492.         gettok();
  3493.         while (curtok == TOK_IDENT)
  3494.         gettok();
  3495.         wneedtok(TOK_SEMI);
  3496.     }
  3497.         /* do nothing more */
  3498.     } else if (blockkind == TOK_EXPORT) {
  3499.         func->isforward = 1;
  3500.     scanfwdparams(func);
  3501.         forward_decl(func, 1);
  3502.     } else {
  3503.     checkkeyword(TOK_INTERRUPT);
  3504.     checkkeyword(TOK_INLINE);
  3505.         if (curtok == TOK_INTERRUPT) {
  3506.             note("Ignoring INTERRUPT keyword [258]");
  3507.             gettok();
  3508.             wneedtok(TOK_SEMI);
  3509.         }
  3510.         if (curtok == TOK_IDENT && !strcicmp(curtokbuf, "FORWARD")) {
  3511.             func->isforward = 1;
  3512.         scanfwdparams(func);
  3513.             gettok();
  3514.             if (func->ctx->kind != MK_FUNCTION) {
  3515.                 outsection(minorspace);
  3516.         flushcomments(NULL, -1, -1);
  3517.                 forward_decl(func, 0);
  3518.                 outsection(minorspace);
  3519.             }
  3520.         } else if (curtok == TOK_IDENT &&
  3521.            (strlist_cifind(externwords, curtokbuf) ||
  3522.             strlist_cifind(cexternwords, curtokbuf))) {
  3523.             if (*externalias && my_strchr(externalias, '%')) {
  3524.                 strchange(&func->name, format_s(externalias, func->name));
  3525.             } else if (strlist_cifind(cexternwords, curtokbuf)) {
  3526.         if (func->name[0] == '_')
  3527.             strchange(&func->name, func->name + 1);
  3528.         if (func->name[strlen(func->name)-1] == '_')
  3529.             func->name[strlen(func->name)-1] = 0;
  3530.         }
  3531.         func->isforward = 1;    /* for Oregon Software Pascal-2 */
  3532.         func->exported = 1;
  3533.             gettok();
  3534.         while (curtok == TOK_IDENT)
  3535.         gettok();
  3536.             outsection(minorspace);
  3537.         flushcomments(NULL, -1, -1);
  3538.         scanfwdparams(func);
  3539.             forward_decl(func, 1);
  3540.             outsection(minorspace);
  3541.     } else if (curtok == TOK_IDENT) {
  3542.         wexpecttok(TOK_BEGIN);   /* print warning */
  3543.         gettok();
  3544.             outsection(minorspace);
  3545.         flushcomments(NULL, -1, -1);
  3546.         scanfwdparams(func);
  3547.             forward_decl(func, 1);
  3548.             outsection(minorspace);
  3549.         } else {
  3550.             if (func->ctx->kind == MK_FUNCTION)
  3551.                 func->ctx->needvarstruct = 1;
  3552.         func->comments = curcomments;
  3553.         curcomments = NULL;
  3554.             p_block(TOK_FUNCTION);
  3555.             echoprocname(func);
  3556.         changecomments(curcomments, -1, curserial, -1, 10000);
  3557.             sp = p_body();
  3558.             func->ctx->needvarstruct = 0;
  3559.             func->val.i = (long)sp;
  3560.         strlist_mix(&func->comments, curcomments);
  3561.         curcomments = NULL;
  3562.             if (func->ctx->kind != MK_FUNCTION || !collectnest) {
  3563.                 out_function(func);    /* output top-level procedures immediately */
  3564.             }                          /*  (sub-procedures are output later) */
  3565.         }
  3566.         if (!wneedtok(TOK_SEMI))
  3567.         skippasttoken(TOK_SEMI);
  3568.     }
  3569.     strlist_mix(&curcomments, savecmt);
  3570.     popctx();
  3571. }
  3572.  
  3573.  
  3574.  
  3575. Static void out_include(name, quoted)
  3576. char *name;
  3577. int quoted;
  3578. {
  3579.     if (*name == '"' || *name == '<')
  3580.     output(format_s("#include %s\n", name));
  3581.     else if (quoted)
  3582.         output(format_s("#include \"%s\"\n", name));
  3583.     else
  3584.         output(format_s("#include <%s>\n", name));
  3585. }
  3586.  
  3587.  
  3588. Static void cleanheadername(dest, name)
  3589. char *dest, *name;
  3590. {
  3591.     char *cp;
  3592.     int len;
  3593.  
  3594.     if (*name == '<' || *name == '"')
  3595.     name++;
  3596.     cp = my_strrchr(name, '/');
  3597.     if (cp)
  3598.     cp++;
  3599.     else
  3600.     cp = name;
  3601.     strcpy(dest, cp);
  3602.     len = strlen(dest);
  3603.     if (dest[len-1] == '>' || dest[len-1] == '"')
  3604.     dest[len-1] = 0;
  3605. }
  3606.  
  3607.  
  3608.  
  3609.  
  3610. Static int tryimport(sym, fname, ext, need)
  3611. Symbol *sym;
  3612. char *fname, *ext;
  3613. int need;
  3614. {
  3615.     int found = 0;
  3616.     Meaning *savectx, *savectxlast;
  3617.  
  3618.     savectx = curctx;
  3619.     savectxlast = curctxlast;
  3620.     curctx = nullctx;
  3621.     curctxlast = curctx->cbase;
  3622.     while (curctxlast && curctxlast->cnext)
  3623.         curctxlast = curctxlast->cnext;
  3624.     if (p_search(fname, ext, need)) {
  3625.         curtokmeaning = sym->mbase;
  3626.         while (curtokmeaning && !curtokmeaning->isactive)
  3627.             curtokmeaning = curtokmeaning->snext;
  3628.         if (curtokmeaning)
  3629.             found = 1;
  3630.     }
  3631.     curctx = savectx;
  3632.     curctxlast = savectxlast;
  3633.     return found;
  3634. }
  3635.  
  3636.  
  3637.  
  3638. Static void p_import(inheader)
  3639. int inheader;
  3640. {
  3641.     Strlist *sl;
  3642.     Symbol *sym;
  3643.     char *name;
  3644.     int found, isfrom = (curtok == TOK_FROM);
  3645.  
  3646.     outsection(minorspace);
  3647.     do {
  3648.         gettok();
  3649.         if (!wexpecttok(TOK_IDENT)) {
  3650.         skiptotoken(TOK_SEMI);
  3651.         break;
  3652.     }
  3653.         sym = curtoksym;
  3654.         if (curtokmeaning && curtokmeaning->kind == MK_MODULE) {
  3655.             found = 1;
  3656.     } else if (strlist_cifind(permimports, sym->name)) {
  3657.             found = 2;   /* built-in module, there already! */
  3658.         } else {
  3659.             found = 0;
  3660.             sl = strlist_cifind(importfrom, sym->name);
  3661.             name = (sl) ? format_none((char *)sl->value) : NULL;
  3662.             if (name) {
  3663.                 if (tryimport(sym, name, "pas", 1))
  3664.                     found = 1;
  3665.             } else {
  3666.                 for (sl = importdirs; sl && !found; sl = sl->next) {
  3667.                     if (tryimport(sym, format_s(sl->s, curtokcase), NULL, 0))
  3668.                         found = 1;
  3669.                 }
  3670.             }
  3671.         }
  3672.         if (found == 1) {
  3673.             if (!inheader) {
  3674.                 sl = strlist_cifind(includefrom, curtokmeaning->name);
  3675.                 name = (sl) ? (char *)sl->value :
  3676.             format_ss(*headerfnfmt2 ? headerfnfmt2 : headerfnfmt,
  3677.                   infname, curtokmeaning->name);
  3678.                 if (name && !strlist_find(includedfiles, name)) {
  3679.                     strlist_insert(&includedfiles, name);
  3680.                     if (*name_HSYMBOL)
  3681.                         output(format_s("#ifndef %s\n", format_s(name_HSYMBOL, sym->name)));
  3682.             out_include(name, quoteincludes);
  3683.                     if (*name_HSYMBOL)
  3684.                         output("#endif\n");
  3685.                     outsection(minorspace);
  3686.                 }
  3687.             }
  3688.             import_ctx(curtokmeaning);
  3689.     } else if (curtokmeaning) {
  3690.         /* Modula-2, importing a single ident */
  3691.         /* Ignored for now, since we always import whole modules */
  3692.         } else if (found == 0) {
  3693.             warning(format_s("Could not find module %s [271]", sym->name));
  3694.             if (!inheader) {
  3695.                 out_include(format_ss(*headerfnfmt2?headerfnfmt2:headerfnfmt,
  3696.                       sym->name, sym->name),
  3697.                 quoteincludes);
  3698.             }
  3699.         }
  3700.         gettok();
  3701.     } while (curtok == TOK_COMMA);
  3702.     if (isfrom) {
  3703.     checkkeyword(TOK_IMPORT);
  3704.     if (wneedtok(TOK_IMPORT)) {
  3705.         do {
  3706.         gettok();
  3707.         if (curtok == TOK_IDENT)
  3708.             gettok();
  3709.         } while (curtok == TOK_COMMA);
  3710.     }
  3711.     }
  3712.     if (!wneedtok(TOK_SEMI))
  3713.     skippasttoken(TOK_SEMI);
  3714.     outsection(minorspace);
  3715. }
  3716.  
  3717.  
  3718.  
  3719.  
  3720. void do_include(blkind)
  3721. Token blkind;
  3722. {
  3723.     FILE *oldfile = outf;
  3724.     int savelnum = outf_lnum;
  3725.     char fname[256];
  3726.  
  3727.     outsection(majorspace);
  3728.     strcpy(fname, curtokbuf);
  3729.     removesuffix(fname);
  3730.     strcat(fname, ".c");
  3731.     if (!strcmp(fname, codefname)) {
  3732.         warning("Include file name conflict! [272]");
  3733.         badinclude();
  3734.         return;
  3735.     }
  3736.     saveoldfile(fname);
  3737.     outf = fopen(fname, "w");
  3738.     if (!outf) {
  3739.         outf = oldfile;
  3740.         perror(fname);
  3741.         badinclude();
  3742.         return;
  3743.     }
  3744.     outf_lnum = 1;
  3745.     if (nobanner)
  3746.     output("\n");
  3747.     else
  3748.     output(format_ss("\n/* Include file %s from %s */\n\n",
  3749.              fname, codefname));
  3750.     if (blkind == TOK_END)
  3751.         gettok();
  3752.     else
  3753.         curtok = blkind;
  3754.     p_block(blockkind);
  3755.     if (nobanner)
  3756.     output("\n");
  3757.     else
  3758.     output("\n\n/* End. */\n\n");
  3759.     fclose(outf);
  3760.     outf = oldfile;
  3761.     outf_lnum = savelnum;
  3762.     if (curtok != TOK_EOF) {
  3763.         warning("Junk at end of include file ignored [273]");
  3764.     }
  3765.     outsection(majorspace);
  3766.     if (*includefnfmt)
  3767.     out_include(format_s(includefnfmt, fname), 1);
  3768.     else
  3769.     out_include(fname, 1);
  3770.     outsection(majorspace);
  3771.     pop_input();
  3772.     getline();
  3773.     gettok();
  3774. }
  3775.  
  3776.  
  3777.  
  3778.  
  3779. /* blockkind is one of:
  3780.        TOK_PROGRAM:     Global declarations of a program
  3781.        TOK_FUNCTION:    Declarations local to a procedure or function
  3782.        TOK_IMPORT:      Import text read from a module
  3783.        TOK_EXPORT:      Export section of a module
  3784.        TOK_IMPLEMENT:   Implementation section of a module
  3785.        TOK_END:         None of the above
  3786. */
  3787.  
  3788. void p_block(blkind)
  3789. Token blkind;
  3790. {
  3791.     Token saveblockkind = blockkind;
  3792.     Token lastblockkind = TOK_END;
  3793.  
  3794.     blockkind = blkind;
  3795.     for (;;) {
  3796.     while (curtok == TOK_INTFONLY) {
  3797.         include_as_import();
  3798.         gettok();
  3799.     }
  3800.         if (curtok == TOK_CONST || curtok == TOK_TYPE ||
  3801.         curtok == TOK_VAR || curtok == TOK_VALUE) {
  3802.             while (curtok == TOK_CONST || curtok == TOK_TYPE ||
  3803.            curtok == TOK_VAR || curtok == TOK_VALUE) {
  3804.                 lastblockkind = curtok;
  3805.                 switch (curtok) {
  3806.  
  3807.                     case TOK_CONST:
  3808.                         p_constdecl();
  3809.                         break;
  3810.  
  3811.                     case TOK_TYPE:
  3812.                         p_typedecl();
  3813.                         break;
  3814.  
  3815.                     case TOK_VAR:
  3816.                         p_vardecl();
  3817.                         break;
  3818.  
  3819.             case TOK_VALUE:
  3820.             p_valuedecl();
  3821.             break;
  3822.  
  3823.             default:
  3824.             break;
  3825.                 }
  3826.             }
  3827.             if ((blkind == TOK_PROGRAM ||
  3828.                  blkind == TOK_EXPORT ||
  3829.                  blkind == TOK_IMPLEMENT) &&
  3830.                 (curtok != TOK_BEGIN || !mainlocals)) {
  3831.                 outsection(majorspace);
  3832.                 if (declarevars(curctx, 0))
  3833.                     outsection(majorspace);
  3834.             }
  3835.         } else {
  3836.         checkmodulewords();
  3837.         checkkeyword(TOK_SEGMENT);
  3838.         if (curtok == TOK_SEGMENT) {
  3839.         note("SEGMENT or OVERLAY keyword ignored [259]");
  3840.         gettok();
  3841.         }
  3842.         p_attributes();
  3843.             switch (curtok) {
  3844.  
  3845.                 case TOK_LABEL:
  3846.                     p_labeldecl();
  3847.                     break;
  3848.  
  3849.                 case TOK_IMPORT:
  3850.                 case TOK_FROM:
  3851.                     p_import(0);
  3852.                     break;
  3853.  
  3854.         case TOK_EXPORT:
  3855.             do {
  3856.             gettok();
  3857.             checkkeyword(TOK_QUALIFIED);
  3858.             if (curtok == TOK_QUALIFIED)
  3859.                 gettok();
  3860.             wneedtok(TOK_IDENT);
  3861.             } while (curtok == TOK_COMMA);
  3862.             if (!wneedtok(TOK_SEMI))
  3863.             skippasttoken(TOK_SEMI);
  3864.             break;
  3865.  
  3866.                 case TOK_MODULE:
  3867.             p_nested_module();
  3868.                     break;
  3869.  
  3870.                 case TOK_PROCEDURE:
  3871.                     p_function(0);
  3872.                     break;
  3873.  
  3874.                 case TOK_FUNCTION:
  3875.                     p_function(1);
  3876.                     break;
  3877.  
  3878.                 case TOK_INCLUDE:
  3879.                     if (blockkind == TOK_PROGRAM ||
  3880.                         blockkind == TOK_IMPLEMENT ||
  3881.             (blockkind == TOK_FUNCTION && !collectnest)) {
  3882.                         do_include(lastblockkind);
  3883.                     } else {
  3884.                         badinclude();
  3885.                     }
  3886.                     break;
  3887.  
  3888.                 default:
  3889.             if (curtok == TOK_BEGIN && blockkind == TOK_IMPORT) {
  3890.             warning("BEGIN encountered in interface text [274]");
  3891.             skipparens();
  3892.             if (curtok == TOK_SEMI)
  3893.                 gettok();
  3894.             break;
  3895.             }
  3896.                     blockkind = saveblockkind;
  3897.                     return;
  3898.             }
  3899.             lastblockkind = TOK_END;
  3900.         }
  3901.     }
  3902. }
  3903.  
  3904.  
  3905.  
  3906.  
  3907. Static void skipunitheader()
  3908. {
  3909.     if (curtok == TOK_LPAR || curtok == TOK_LBR) {
  3910.     skipparens();
  3911.     }
  3912. }
  3913.  
  3914.  
  3915. Static void skiptomodule()
  3916. {
  3917.     skipping_module++;
  3918.     while (curtok != TOK_MODULE) {
  3919.         if (curtok == TOK_END) {
  3920.             gettok();
  3921.             if (curtok == TOK_DOT)
  3922.                 break;
  3923.         } else
  3924.             gettok();
  3925.     }
  3926.     skipping_module--;
  3927. }
  3928.  
  3929.  
  3930.  
  3931. Static void p_moduleinit(mod)
  3932. Meaning *mod;
  3933. {
  3934.     Stmt *sp;
  3935.     Strlist *sl;
  3936.  
  3937.     if (curtok != TOK_BEGIN && curtok != TOK_END) {
  3938.     wexpecttok(TOK_END);
  3939.     skiptotoken2(TOK_BEGIN, TOK_END);
  3940.     }
  3941.     if (curtok == TOK_BEGIN || initialcalls) {
  3942.     echoprocname(mod);
  3943.     sp = p_body();
  3944.     strlist_mix(&mod->comments, curcomments);
  3945.     curcomments = NULL;
  3946.     if (ansiC != 0)
  3947.         output("void ");
  3948.     output(format_s(name_UNITINIT, mod->name));
  3949.     if (void_args)
  3950.         output("(void)\n");
  3951.     else
  3952.         output("()\n");
  3953.     outcontext = mod;
  3954.     out_block(sp, BR_FUNCTION, 10000);
  3955.     free_stmt(sp);
  3956.     /* The following must come after out_block! */
  3957.     sl = strlist_append(&initialcalls,
  3958.                 format_s("%s()",
  3959.                      format_s(name_UNITINIT, mod->name)));
  3960.     sl->value = 1;
  3961.     } else
  3962.     wneedtok(TOK_END);
  3963. }
  3964.  
  3965.  
  3966.  
  3967. Static void p_nested_module()
  3968. {
  3969.     Meaning *mp;
  3970.  
  3971.     if (!modula2) {
  3972.     note("Ignoring nested module [260]");
  3973.     p_module(1, 0);
  3974.     return;
  3975.     }
  3976.     note("Nested modules not fully supported [261]");
  3977.     checkmodulewords();
  3978.     wneedtok(TOK_MODULE);
  3979.     wexpecttok(TOK_IDENT);
  3980.     mp = addmeaning(curtoksym, MK_MODULE);
  3981.     mp->anyvarflag = 0;
  3982.     gettok();
  3983.     skipunitheader();
  3984.     wneedtok(TOK_SEMI);
  3985.     p_block(TOK_IMPLEMENT);
  3986.     p_moduleinit(mp);
  3987.     if (curtok == TOK_IDENT)
  3988.     gettok();
  3989.     wneedtok(TOK_SEMI);
  3990. }
  3991.  
  3992.  
  3993.  
  3994. Static int p_module(ignoreit, isdefn)
  3995. int ignoreit;
  3996. int isdefn;    /* Modula-2: 0=local module, 1=DEFINITION, 2=IMPLEMENTATION */
  3997. {
  3998.     Meaning *mod, *mp;
  3999.     Strlist *sl;
  4000.     int kind;
  4001.     char *cp;
  4002.  
  4003.     checkmodulewords();
  4004.     wneedtok(TOK_MODULE);
  4005.     wexpecttok(TOK_IDENT);
  4006.     if (curtokmeaning && curtokmeaning->kind == MK_MODULE && isdefn == 2) {
  4007.     mod = curtokmeaning;
  4008.     import_ctx(mod);
  4009.     for (mp = mod->cbase; mp; mp = mp->cnext)
  4010.         if (mp->kind == MK_FUNCTION)
  4011.         mp->isforward = 1;
  4012.     } else {
  4013.     mod = addmeaning(curtoksym, MK_MODULE);
  4014.     }
  4015.     mod->anyvarflag = 0;
  4016.     pushctx(mod);
  4017.     gettok();
  4018.     skipunitheader();
  4019.     wneedtok(TOK_SEMI);
  4020.     if (ignoreit || 
  4021.         (requested_module && strcicmp(requested_module, mod->name))) {
  4022.         if (!quietmode)
  4023.         if (outf == stdout)
  4024.         fprintf(stderr, "Skipping over module \"%s\"\n", mod->name);
  4025.         else
  4026.         printf("Skipping over module \"%s\"\n", mod->name);
  4027.     checkmodulewords();
  4028.         while (curtok == TOK_IMPORT || curtok == TOK_FROM)
  4029.             p_import(1);
  4030.     checkmodulewords();
  4031.     if (curtok == TOK_EXPORT)
  4032.         gettok();
  4033.         strlist_empty(&curcomments);
  4034.         p_block(TOK_IMPORT);
  4035.         setup_module(mod->sym->name, 0);
  4036.     checkmodulewords();
  4037.         if (curtok == TOK_IMPLEMENT) {
  4038.             skiptomodule();
  4039.         } else {
  4040.             if (!wneedtok(TOK_END))
  4041.         skippasttoken(TOK_END);
  4042.             if (curtok == TOK_SEMI)
  4043.                 gettok();
  4044.         }
  4045.         popctx();
  4046.         strlist_empty(&curcomments);
  4047.         return 0;
  4048.     }
  4049.     found_module = 1;
  4050.     if (isdefn != 2) {
  4051.     if (!*hdrfname) {
  4052.         sl = strlist_cifind(includefrom, mod->name);
  4053.         if (sl)
  4054.         cleanheadername(hdrfname, (char *)sl->value);
  4055.         else
  4056.         strcpy(hdrfname, format_ss(headerfnfmt, infname, mod->name));
  4057.     }
  4058.     saveoldfile(hdrfname);
  4059.     hdrf = fopen(hdrfname, "w");
  4060.     if (!hdrf) {
  4061.         perror(hdrfname);
  4062.         error("Could not open output file for header");
  4063.     }
  4064.     outsection(majorspace);
  4065.     if (usevextern && my_strchr(name_GSYMBOL, '%'))
  4066.         output(format_s("#define %s\n", format_s(name_GSYMBOL, mod->sym->name)));
  4067.     if (*selfincludefmt)
  4068.         cp = format_s(selfincludefmt, hdrfname);
  4069.     else
  4070.         cp = hdrfname;
  4071.     out_include(cp, quoteincludes);
  4072.     outsection(majorspace);
  4073.     select_outfile(hdrf);
  4074.     if (nobanner)
  4075.         output("\n");
  4076.     else
  4077.         output(format_s("/* Header for module %s, generated by p2c */\n",
  4078.                 mod->name));
  4079.     if (*name_HSYMBOL) {
  4080.         cp = format_s(name_HSYMBOL, mod->sym->name);
  4081.         output(format_ss("#ifndef %s\n#define %s\n", cp, cp));
  4082.     }
  4083.     outsection(majorspace);
  4084.     checkmodulewords();
  4085.     while (curtok == TOK_IMPORT || curtok == TOK_FROM)
  4086.         p_import(0);
  4087.     checkmodulewords();
  4088.     if (curtok == TOK_EXPORT)
  4089.         gettok();
  4090.     checkmodulewords();
  4091.     while (curtok == TOK_IMPORT || curtok == TOK_FROM)
  4092.         p_import(0);
  4093.     outsection(majorspace);
  4094.     if (usevextern) {
  4095.         output(format_s("#ifdef %s\n# define vextern\n#else\n",
  4096.                 format_s(name_GSYMBOL, mod->sym->name)));
  4097.         output("# define vextern extern\n#endif\n");
  4098.     }
  4099.     checkmodulewords();
  4100.     p_block(TOK_EXPORT);
  4101.     flushcomments(NULL, -1, -1);
  4102.     setup_module(mod->sym->name, 1);
  4103.     outsection(majorspace);
  4104.     if (usevextern)
  4105.         output("#undef vextern\n");
  4106.     outsection(minorspace);
  4107.     if (*name_HSYMBOL)
  4108.         output(format_s("#endif /*%s*/\n", format_s(name_HSYMBOL, mod->sym->name)));
  4109.     if (nobanner)
  4110.         output("\n");
  4111.     else
  4112.         output("\n/* End. */\n\n");
  4113.     select_outfile(codef);
  4114.     fclose(hdrf);
  4115.     *hdrfname = 0;
  4116.     redeclarevars(mod);
  4117.     declarevars(mod, 0);
  4118.     }
  4119.     checkmodulewords();
  4120.     if (curtok != TOK_END) {
  4121.     if (!modula2 && !implementationmodules)
  4122.         wneedtok(TOK_IMPLEMENT);
  4123.     import_ctx(mod);
  4124.         p_block(TOK_IMPLEMENT);
  4125.     flushcomments(NULL, -1, -1);
  4126.     p_moduleinit(mod);
  4127.         kind = 1;
  4128.     } else {
  4129.         kind = 0;
  4130.         if (!wneedtok(TOK_END))
  4131.         skippasttoken(TOK_END);
  4132.     }
  4133.     if (curtok == TOK_IDENT)
  4134.     gettok();
  4135.     if (curtok == TOK_SEMI)
  4136.         gettok();
  4137.     popctx();
  4138.     return kind;
  4139. }
  4140.  
  4141.  
  4142.  
  4143.  
  4144. int p_search(fname, ext, need)
  4145. char *fname, *ext;
  4146. int need;
  4147. {
  4148.     char infnbuf[300];
  4149.     FILE *fp;
  4150.     Meaning *mod;
  4151.     int savesysprog, savecopysource;
  4152.     int outerimportmark, importmark, mypermflag;
  4153.  
  4154.     strcpy(infnbuf, fname);
  4155.     fixfname(infnbuf, ext);
  4156.     fp = fopen(infnbuf, "r");
  4157.     if (!fp) {
  4158.         if (need)
  4159.             perror(infnbuf);
  4160.     if (logf)
  4161.         fprintf(logf, "(Unable to open search file \"%s\")\n", infnbuf);
  4162.         return 0;
  4163.     }
  4164.     flushcomments(NULL, -1, -1);
  4165.     ignore_directives++;
  4166.     savesysprog = sysprog_flag;
  4167.     sysprog_flag |= 3;
  4168.     savecopysource = copysource;
  4169.     copysource = 0;
  4170.     outerimportmark = numimports;   /*obsolete*/
  4171.     importmark = push_imports();
  4172.     clearprogress();
  4173.     push_input_file(fp, infnbuf, 0);
  4174.     do {
  4175.     strlist_empty(&curcomments);
  4176.     checkmodulewords();
  4177.     permflag = 0;
  4178.     if (curtok == TOK_DEFINITION) {
  4179.         gettok();
  4180.         checkmodulewords();
  4181.     } else if (curtok == TOK_IMPLEMENT && modula2) {
  4182.         gettok();
  4183.         checkmodulewords();
  4184.         warning("IMPLEMENTATION module in search text! [275]");
  4185.     }
  4186.         if (!wneedtok(TOK_MODULE))
  4187.         break;
  4188.         if (!wexpecttok(TOK_IDENT))
  4189.         break;
  4190.         mod = addmeaning(curtoksym, MK_MODULE);
  4191.         mod->anyvarflag = 0;
  4192.         if (!quietmode && !showprogress)
  4193.         if (outf == stdout)
  4194.         fprintf(stderr, "Reading import text for \"%s\"\n", mod->name);
  4195.         else
  4196.         printf("Reading import text for \"%s\"\n", mod->name);
  4197.     if (verbose)
  4198.         fprintf(logf, "%s, %d/%d: Reading import text for \"%s\"\n",
  4199.             infname, inf_lnum, outf_lnum, mod->name);
  4200.         pushctx(mod);
  4201.         gettok();
  4202.         skipunitheader();
  4203.         wneedtok(TOK_SEMI);
  4204.     mypermflag = permflag;
  4205.         if (debug>0) printf("Found module %s\n", mod->name);
  4206.     checkmodulewords();
  4207.         while (curtok == TOK_IMPORT || curtok == TOK_FROM)
  4208.             p_import(1);
  4209.     checkmodulewords();
  4210.     if (curtok == TOK_EXPORT)
  4211.         gettok();
  4212.         strlist_empty(&curcomments);
  4213.         p_block(TOK_IMPORT);
  4214.         setup_module(mod->sym->name, 0);
  4215.     if (mypermflag) {
  4216.         strlist_add(&permimports, mod->sym->name)->value = (long)mod;
  4217.         perm_import(mod);
  4218.     }
  4219.     checkmodulewords();
  4220.     if (curtok == TOK_END) {
  4221.         gettok();
  4222.         if (curtok == TOK_SEMI)
  4223.         gettok();
  4224.     } else {
  4225.         wexpecttok(TOK_IMPLEMENT);
  4226.         if (importall) {
  4227.         skiptomodule();
  4228.             }
  4229.         }
  4230.         popctx();
  4231.     } while (curtok == TOK_MODULE);
  4232.     pop_imports(importmark);
  4233.     unimport(outerimportmark);
  4234.     sysprog_flag = savesysprog;
  4235.     copysource = savecopysource;
  4236.     ignore_directives--;
  4237.     pop_input();
  4238.     strlist_empty(&curcomments);
  4239.     clearprogress();
  4240.     return 1;
  4241. }
  4242.  
  4243.  
  4244.  
  4245.  
  4246. void p_program()
  4247. {
  4248.     Meaning *prog;
  4249.     Stmt *sp;
  4250.     int nummods, isdefn = 0;
  4251.  
  4252.     flushcomments(NULL, -1, -1);
  4253.     output(format_s("\n#include %s\n", p2c_h_name));
  4254.     outsection(majorspace);
  4255.     p_attributes();
  4256.     ignore_attributes();
  4257.     checkmodulewords();
  4258.     if (modula2) {
  4259.     if (curtok == TOK_MODULE) {
  4260.         curtok = TOK_PROGRAM;
  4261.     } else {
  4262.         if (curtok == TOK_DEFINITION) {
  4263.         isdefn = 1;
  4264.         gettok();
  4265.         checkmodulewords();
  4266.         } else if (curtok == TOK_IMPLEMENT) {
  4267.         isdefn = 2;
  4268.         gettok();
  4269.         checkmodulewords();
  4270.         }
  4271.     }
  4272.     }
  4273.     switch (curtok) {
  4274.  
  4275.         case TOK_MODULE:
  4276.         if (implementationmodules)
  4277.         isdefn = 2;
  4278.             nummods = 0;
  4279.             while (curtok == TOK_MODULE) {
  4280.                 if (p_module(0, isdefn)) {
  4281.                     nummods++;
  4282.                     if (nummods == 2 && !requested_module)
  4283.                         warning("Multiple modules in one source file may not work correctly [276]");
  4284.                 }
  4285.             }
  4286.         wneedtok(TOK_DOT);
  4287.             break;
  4288.  
  4289.         default:
  4290.             if (curtok == TOK_PROGRAM) {
  4291.                 gettok();
  4292.                 if (!wexpecttok(TOK_IDENT))
  4293.             skiptotoken(TOK_IDENT);
  4294.                 prog = addmeaning(curtoksym, MK_MODULE);
  4295.                 gettok();
  4296.                 if (curtok == TOK_LPAR) {
  4297.                     while (curtok != TOK_RPAR) {
  4298.                         if (curtok == TOK_IDENT &&
  4299.                             strcicmp(curtokbuf, "INPUT") &&
  4300.                             strcicmp(curtokbuf, "OUTPUT") &&
  4301.                 strcicmp(curtokbuf, "KEYBOARD") &&
  4302.                 strcicmp(curtokbuf, "LISTING")) {
  4303.                 if (literalfilesflag == 2) {
  4304.                 strlist_add(&literalfiles, curtokbuf);
  4305.                 } else
  4306.                 note(format_s("Unexpected name \"%s\" in program header [262]",
  4307.                           curtokcase));
  4308.                         }
  4309.                         gettok();
  4310.                     }
  4311.                     gettok();
  4312.                 }
  4313.         if (curtok == TOK_LBR)
  4314.             skipparens();
  4315.                 wneedtok(TOK_SEMI);
  4316.             } else {
  4317.                 prog = addmeaning(findsymbol("program"), MK_MODULE);
  4318.             }
  4319.             prog->anyvarflag = 1;
  4320.             if (requested_module && strcicmp(requested_module, prog->name) &&
  4321.                                     strcicmp(requested_module, "program")) {
  4322.                 for (;;) {
  4323.                     skiptomodule();
  4324.                     if (curtok == TOK_DOT)
  4325.                         break;
  4326.                      (void)p_module(0, 2);
  4327.                 }
  4328.         gettok();
  4329.                 break;
  4330.             }
  4331.             pushctx(prog);
  4332.             p_block(TOK_PROGRAM);
  4333.             echoprocname(prog);
  4334.         flushcomments(NULL, -1, -1);
  4335.         if (curtok != TOK_EOF) {
  4336.         sp = p_body();
  4337.         strlist_mix(&prog->comments, curcomments);
  4338.         curcomments = NULL;
  4339.         if (fullprototyping > 0) {
  4340.             output(format_sss("main%s(int argc,%s%s *argv[])",
  4341.                       spacefuncs ? " " : "",
  4342.                       spacecommas ? " " : "",
  4343.                       charname));
  4344.         } else {
  4345.             output("main");
  4346.             if (spacefuncs)
  4347.             output(" ");
  4348.             output("(argc,");
  4349.             if (spacecommas)
  4350.             output(" ");
  4351.             output("argv)\n");
  4352.             singleindent(argindent);
  4353.             output("int argc;\n");
  4354.             singleindent(argindent);
  4355.             output(format_s("%s *argv[];\n", charname));
  4356.         }
  4357.         outcontext = prog;
  4358.         out_block(sp, BR_FUNCTION, 10000);
  4359.         free_stmt(sp);
  4360.         popctx();
  4361.         if (curtok == TOK_SEMI)
  4362.             gettok();
  4363.         else 
  4364.             wneedtok(TOK_DOT);
  4365.         }
  4366.             break;
  4367.  
  4368.     }
  4369.     if (curtok != TOK_EOF) {
  4370.         warning("Junk at end of input file ignored [277]");
  4371.     }
  4372. }
  4373.  
  4374.  
  4375.  
  4376.  
  4377.  
  4378. /* End. */
  4379.  
  4380.  
  4381.