Logo Search packages:      
Sourcecode: heaplayers version File versions

parse.c

/* "p2c", a Pascal to C translator.
   Copyright (C) 1989, 1990, 1991 Free Software Foundation.
   Author's address: daveg@csvax.caltech.edu; 256-80 Caltech/Pasadena CA 91125.

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation (any version).

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; see the file COPYING.  If not, write to
the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */



#define PROTO_PARSE_C
#include "trans.h"



Static short candeclare;
Static int trycount;
Static Strlist *includedfiles;
Static char echo_first;
Static int echo_pos;



void setup_parse()
{
    candeclare = 0;
    trycount = 0;
    includedfiles = NULL;
    echo_first = 1;
    echo_pos = 0;
    fixexpr_tryblock = 0;
}



void echobreak()
{
    if (echo_pos > 0) {
      printf("\n");
      echo_pos = 0;
      echo_first = 0;
    }
}


void echoword(name, comma)
char *name;
int comma;
{
    FILE *f = (outf == stdout) ? stderr : stdout;

    if (quietmode || showprogress)
        return;
    if (!echo_first) {
      if (comma) {
          fprintf(f, ",");
          echo_pos++;
      }
        if (echo_pos + strlen(name) > 77) {
            fprintf(f, "\n");
            echo_pos = 0;
        } else {
            fprintf(f, " ");
            echo_pos++;
        }
    }
    echo_first = 0;
    fprintf(f, "%s", name);
    echo_pos += strlen(name);
    fflush(f);
}



void echoprocname(mp)
Meaning *mp;
{
    echoword(mp->name, 1);
}





Static void forward_decl(func, isextern)
Meaning *func;
int isextern;
{
    if (func->wasdeclared)
        return;
    if (isextern && func->constdefn && !checkvarmac(func))
      return;
    if (isextern) {
        output("extern ");
    } else if (func->ctx->kind == MK_FUNCTION) {
      if (useAnyptrMacros)
          output("Local ");
      else
          output("static ");
    } else if ((use_static != 0 && !useAnyptrMacros) ||
             (findsymbol(func->name)->flags & NEEDSTATIC)) {
      output("static ");
    } else if (useAnyptrMacros) {
      output("Static ");
    }
    if (func->type->basetype != tp_void || ansiC != 0) {
        outbasetype(func->type, ODECL_FORWARD);
        output(" ");
    }
    outdeclarator(func->type, func->name, ODECL_FORWARD);
    output(";\n");
    func->wasdeclared = 1;
}




/* Check if calling a parent procedure, whose body must */
/*   be declared forward */

void need_forward_decl(func)
Meaning *func;
{
    Meaning *mp;

    if (func->wasdeclared)
        return;
    for (mp = curctx->ctx; mp; mp = mp->ctx) {
        if (mp == func) {
          if (func->ctx->kind == MK_FUNCTION)
            func->isforward = 1;
          else
            forward_decl(func, 0);
            return;
        }
    }
}




void free_stmt(sp)
register Stmt *sp;
{
    if (sp) {
        free_stmt(sp->stm1);
        free_stmt(sp->stm2);
        free_stmt(sp->next);
        freeexpr(sp->exp1);
        freeexpr(sp->exp2);
        freeexpr(sp->exp3);
        FREE(sp);
    }
}




Stmt *makestmt(kind)
enum stmtkind kind;
{
    Stmt *sp;

    sp = ALLOC(1, Stmt, stmts);
    sp->kind = kind;
    sp->next = NULL;
    sp->stm1 = NULL;
    sp->stm2 = NULL;
    sp->exp1 = NULL;
    sp->exp2 = NULL;
    sp->exp3 = NULL;
    sp->serial = curserial = ++serialcount;
    return sp;
}



Stmt *makestmt_call(call)
Expr *call;
{
    Stmt *sp = makestmt(SK_ASSIGN);
    sp->exp1 = call;
    return sp;
}



Stmt *makestmt_assign(lhs, rhs)
Expr *lhs, *rhs;
{
    Stmt *sp = makestmt(SK_ASSIGN);
    sp->exp1 = makeexpr_assign(lhs, rhs);
    return sp;
}



Stmt *makestmt_if(cond, thn, els)
Expr *cond;
Stmt *thn, *els;
{
    Stmt *sp = makestmt(SK_IF);
    sp->exp1 = cond;
    sp->stm1 = thn;
    sp->stm2 = els;
    return sp;
}



Stmt *makestmt_seq(s1, s2)
Stmt *s1, *s2;
{
    Stmt *s1a;

    if (!s1)
        return s2;
    if (!s2)
        return s1;
    for (s1a = s1; s1a->next; s1a = s1a->next) ;
    s1a->next = s2;
    return s1;
}



Stmt *copystmt(sp)
Stmt *sp;
{
    Stmt *sp2;

    if (sp) {
        sp2 = makestmt(sp->kind);
        sp2->stm1 = copystmt(sp->stm1);
        sp2->stm2 = copystmt(sp->stm2);
        sp2->exp1 = copyexpr(sp->exp1);
        sp2->exp2 = copyexpr(sp->exp2);
        sp2->exp3 = copyexpr(sp->exp3);
        return sp2;
    } else
        return NULL;
}



void nukestmt(sp)
Stmt *sp;
{
    if (sp) {
        sp->kind = SK_ASSIGN;
        sp->exp1 = makeexpr_long(0);
    }
}



void splicestmt(sp, spnew)
Stmt *sp, *spnew;
{
    Stmt *snext;

    if (spnew) {
      snext = sp->next;
      *sp = *spnew;
      while (sp->next)
          sp = sp->next;
      sp->next = snext;
    } else
      nukestmt(sp);
}



int stmtcount(sp)
Stmt *sp;
{
    int i = 0;

    while (sp) {
        i += 1 + stmtcount(sp->stm1) + stmtcount(sp->stm2);
        sp = sp->next;
    }
    return i;
}





Stmt *close_files_to_ctx(ctx)
Meaning *ctx;
{
    Meaning *ctx2, *mp;
    Stmt *splist = NULL, *sp;

    ctx2 = curctx;
    while (ctx2 && ctx2 != ctx && ctx2->kind == MK_FUNCTION) {
      for (mp = ctx2->cbase; mp; mp = mp->cnext) {
          if (mp->kind == MK_VAR &&
            isfiletype(mp->type, -1) && !mp->istemporary) {
            var_reference(mp);
            sp = makestmt_if(makeexpr_rel(EK_NE,
                                    filebasename(makeexpr_var(mp)),
                                    makeexpr_nil()),
                         makestmt_call(
                             makeexpr_bicall_1("fclose", tp_void,
                                           filebasename(makeexpr_var(mp)))),
                         NULL);
            splist = makestmt_seq(splist, sp);
          }
      }
      ctx2 = ctx2->ctx;
    }
    return splist;
}




int simplewith(ex)
Expr *ex;
{
    switch (ex->kind) {
        case EK_VAR:
        case EK_CONST:
            return 1;
        case EK_DOT:
            return simplewith(ex->args[0]);
        default:
            return 0;
    }
}


int simplefor(sp, ex)
Stmt *sp;
Expr *ex;
{
    return (exprspeed(sp->exp2) <= 3 &&
            !checkexprchanged(sp->stm1, sp->exp2) &&
          !exproccurs(sp->exp2, ex));
}



int tryfuncmacro(exp, mp)
Expr **exp;
Meaning *mp;
{
    char *name;
    Strlist *lp;
    Expr *ex = *exp, *ex2;

    ex2 = (mp) ? mp->constdefn : NULL;
    if (!ex2) {
      if (ex->kind == EK_BICALL || ex->kind == EK_NAME)
          name = ex->val.s;
      else if (ex->kind == EK_FUNCTION)
          name = ((Meaning *)ex->val.i)->name;
      else
          return 0;
      lp = strlist_cifind(funcmacros, name);
      ex2 = (lp) ? (Expr *)lp->value : NULL;
    }
    if (ex2) {
        *exp = replacemacargs(copyexpr(ex2), ex);
      freeexpr(ex);
        return 1;
    }
    return 0;
}





#define addstmt(kind)   \
    *spp = sp = makestmt(kind),   \
    spp = &(sp->next)

#define newstmt(kind)   \
    addstmt(kind),   \
    steal_comments(firstserial, sp->serial, sflags & SF_FIRST),   \
    sflags &= ~SF_FIRST



#define SF_FUNC    0x1
#define SF_SAVESER 0x2
#define SF_FIRST   0x4
#define SF_IF        0x8

Static Stmt *p_stmt(slist, sflags)
Stmt *slist;
int sflags;
{
    Stmt *sbase = NULL, **spp = &sbase, **spp2, **spp3, **savespp;
    Stmt *defsp, **defsphook;
    register Stmt *sp;
    Stmt *sp2;
    long li1, li2, firstserial = 0, saveserial = 0, saveserial2;
    int i, forfixed, offset, line1, line2, toobig, isunsafe;
    Token savetok;
    char *name;
    Expr *ep, *ep2, *ep3, *forstep, *range, *swexpr, *trueswexpr;
    Type *tp;
    Meaning *mp, *tvar, *tempmark;
    Symbol *sym;
    enum exprkind ekind;
    Stmt *(*prochandler)();
    Strlist *cmt;

    tempmark = markstmttemps();
again:
    while (findlabelsym()) {
        newstmt(SK_LABEL);
        sp->exp1 = makeexpr_name(format_s(name_LABEL, curtokmeaning->name), tp_integer);
        gettok();
        wneedtok(TOK_COLON);
    }
    firstserial = curserial;
    checkkeyword(TOK_TRY);
    checkkeyword(TOK_INLINE);
    checkkeyword(TOK_LOOP);
    checkkeyword(TOK_RETURN);
    if (modula2) {
      if (sflags & SF_SAVESER)
          goto stmtSeq;
    }
    switch (curtok) {

        case TOK_BEGIN:
        stmtSeq:
          if (sflags & (SF_FUNC|SF_SAVESER)) {
            saveserial = curserial;
            cmt = grabcomment(CMT_ONBEGIN);
            if (sflags & SF_FUNC)
                cmt = fixbeginendcomment(cmt);
            strlist_mix(&curcomments, cmt);
          }
          i = sflags & SF_FIRST;
            do {
            if (modula2) {
                if (curtok == TOK_BEGIN || curtok == TOK_SEMI)
                  gettok();
                checkkeyword(TOK_ELSIF);
                if (curtok == TOK_ELSE || curtok == TOK_ELSIF)
                  break;
            } else
                gettok();
                *spp = p_stmt(sbase, i);
            i = 0;
                while (*spp)
                    spp = &((*spp)->next);
            } while (curtok == TOK_SEMI);
          if (sflags & (SF_FUNC|SF_SAVESER)) {
            cmt = grabcomment(CMT_ONEND);
            changecomments(cmt, -1, -1, -1, saveserial);
            if (sflags & SF_FUNC)
                cmt = fixbeginendcomment(cmt);
            strlist_mix(&curcomments, cmt);
            if (sflags & SF_FUNC)
                changecomments(curcomments, -1, saveserial, -1, 10000);
            curserial = saveserial;
          }
          checkkeyword(TOK_ELSIF);
          if (modula2 && (sflags & SF_IF)) {
            break;
          }
          if (curtok == TOK_VBAR)
            break;
            if (!wneedtok(TOK_END))
            skippasttoken(TOK_END);
            break;

        case TOK_CASE:
            gettok();
            swexpr = trueswexpr = p_ord_expr();
            if (nosideeffects(swexpr, 1)) {
                tvar = NULL;
            } else {
                tvar = makestmttempvar(swexpr->val.type, name_TEMP);
                swexpr = makeexpr_var(tvar);
            }
            savespp = spp;
            newstmt(SK_CASE);
          saveserial2 = curserial;
            sp->exp1 = trueswexpr;
            spp2 = &sp->stm1;
            tp = swexpr->val.type;
            defsp = NULL;
            defsphook = &defsp;
            if (!wneedtok(TOK_OF)) {
            skippasttoken(TOK_END);
            break;
          }
          i = 1;
          while (curtok == TOK_VBAR)
            gettok();
          checkkeyword(TOK_OTHERWISE);
            while (curtok != TOK_END && curtok != TOK_OTHERWISE && curtok != TOK_ELSE) {
                spp3 = spp2;
            saveserial = curserial;
                *spp2 = sp = makestmt(SK_CASELABEL);
            steal_comments(saveserial, sp->serial, i);
                spp2 = &sp->next;
                range = NULL;
                toobig = 0;
                for (;;) {
                    ep = gentle_cast(p_expr(tp), tp);
                    if (curtok == TOK_DOTS) {
                        li1 = ord_value(eval_expr(ep));
                        gettok();
                        ep2 = gentle_cast(p_expr(tp), tp);
                        li2 = ord_value(eval_expr(ep2));
                        range = makeexpr_or(range,
                                            makeexpr_range(copyexpr(swexpr),
                                                           ep, ep2, 1));
                        if (li2 - li1 >= caselimit)
                            toobig = 1;
                        if (!toobig) {
                            for (;;) {
                                sp->exp1 = makeexpr_val(make_ord(tp, li1));
                                if (li1 >= li2) break;
                                li1++;
                        serialcount--;   /* make it reuse the count */
                                sp->stm1 = makestmt(SK_CASELABEL);
                                sp = sp->stm1;
                            }
                        }
                    } else {
                        sp->exp1 = copyexpr(ep);
                        range = makeexpr_or(range,
                                            makeexpr_rel(EK_EQ, 
                                                         copyexpr(swexpr),
                                                         ep));
                    }
                    if (curtok == TOK_COMMA) {
                        gettok();
                  serialcount--;   /* make it reuse the count */
                        sp->stm1 = makestmt(SK_CASELABEL);
                        sp = sp->stm1;
                    } else
                        break;
                }
                wneedtok(TOK_COLON);
                if (toobig) {
                    free_stmt(*spp3);
                    spp2 = spp3;
                    *defsphook = makestmt_if(range, p_stmt(NULL, SF_SAVESER),
                                   NULL);
                    if (defsphook != &defsp && elseif != 0)
                        (*defsphook)->exp2 = makeexpr_long(1);
                    defsphook = &((*defsphook)->stm2);
                } else {
                    freeexpr(range);
                    sp->stm1 = p_stmt(NULL, SF_SAVESER);
                }
            i = 0;
            checkkeyword(TOK_OTHERWISE);
                if (curtok != TOK_END && curtok != TOK_OTHERWISE && curtok != TOK_ELSE) {
                if (curtok == TOK_VBAR) {
                  while (curtok == TOK_VBAR)
                      gettok();
                } else
                  wneedtok(TOK_SEMI);
                checkkeyword(TOK_OTHERWISE);
            }
            }
            if (defsp) {
                *spp2 = defsp;
                spp2 = defsphook;
                if (tvar) {
                    sp = makestmt_assign(makeexpr_var(tvar), trueswexpr);
                    sp->next = *savespp;
                    *savespp = sp;
                    sp->next->exp1 = swexpr;
                }
            } else {
                if (tvar) {
                    canceltempvar(tvar);
                    freeexpr(swexpr);
                }
            }
            if (curtok == TOK_OTHERWISE || curtok == TOK_ELSE) {
                gettok();
                while (curtok == TOK_SEMI)
                    gettok();
/*          changecomments(curcomments, CMT_TRAIL, curserial,
                                      CMT_POST, -1);   */
            i = SF_FIRST;
            while (curtok != TOK_END) {
                    *spp2 = p_stmt(NULL, i);
                    while (*spp2)
                        spp2 = &((*spp2)->next);
                i = 0;
                    if (curtok != TOK_SEMI)
                        break;
                    gettok();
                }
                if (!wexpecttok(TOK_END))
                skiptotoken(TOK_END);
            } else if (casecheck == 1 || (casecheck == 2 && range_flag)) {
                *spp2 = makestmt(SK_CASECHECK);
            }
          curserial = saveserial2;
          strlist_mix(&curcomments, grabcomment(CMT_ONEND));
            gettok();
            break;

        case TOK_FOR:
            forfixed = fixedflag;
            gettok();
            newstmt(SK_FOR);
            ep = p_expr(tp_integer);
            if (!wneedtok(TOK_ASSIGN)) {
            skippasttoken(TOK_DO);
            break;
          }
            ep2 = makeexpr_charcast(p_expr(ep->val.type));
            if (curtok != TOK_DOWNTO) {
            if (!wexpecttok(TOK_TO)) {
                skippasttoken(TOK_DO);
                break;
            }
          }
            savetok = curtok;
            gettok();
            sp->exp2 = makeexpr_charcast(p_expr(ep->val.type));
          checkkeyword(TOK_BY);
          if (curtok == TOK_BY) {
            gettok();
            forstep = p_expr(tp_integer);
            i = possiblesigns(forstep);
            if ((i & 5) == 5) {
                if (expr_is_neg(forstep)) {
                  ekind = EK_GE;
                  note("Assuming FOR loop step is negative [252]");
                } else {
                  ekind = EK_LE;
                  note("Assuming FOR loop step is positive [252]");
                }
            } else {
                if (!(i & 1))
                  ekind = EK_LE;
                else
                  ekind = EK_GE;
            }
          } else {
            if (savetok == TOK_DOWNTO) {
                ekind = EK_GE;
                forstep = makeexpr_long(-1);
            } else {
                ekind = EK_LE;
                forstep = makeexpr_long(1);
            }
          }
            tvar = NULL;
          swexpr = NULL;
            if (ep->kind == EK_VAR) {
                tp = findbasetype(ep->val.type, ODECL_NOPRES);
                if ((tp == tp_char || tp == tp_schar || tp == tp_uchar ||
                     tp == tp_abyte || tp == tp_sbyte || tp == tp_ubyte ||
                 tp == tp_boolean) &&
                    ((checkconst(sp->exp2, 0) &&
                  tp != tp_sbyte && tp != tp_schar) ||
                     checkconst(sp->exp2, -128) ||
                     (checkconst(sp->exp2, 127) &&
                  tp != tp_ubyte && tp != tp_uchar) ||
                     checkconst(sp->exp2, 255) ||
                     (tp == tp_char &&
                      (useAnyptrMacros == 1 || unsignedchar != 1) &&
                      isliteralconst(sp->exp2, NULL) == 2 &&
                      sp->exp2->val.i >= 128))) {
                    swexpr = ep;
                    tvar = makestmttempvar(tp_sshort, name_TEMP);
                    ep = makeexpr_var(tvar);
                } else if (((tp == tp_sshort &&
                             (checkconst(sp->exp2, -32768) ||
                              checkconst(sp->exp2, 32767))) ||
                            (tp == tp_ushort &&
                             (checkconst(sp->exp2, 0) ||
                              checkconst(sp->exp2, 65535))))) {
                    swexpr = ep;
                    tvar = makestmttempvar(tp_integer, name_TEMP);
                    ep = makeexpr_var(tvar);
                } else if (tp == tp_integer &&
                     (checkconst(sp->exp2, LONG_MAX) ||
                      (sp->exp2->kind == EK_VAR &&
                       sp->exp2->val.i == (long)mp_maxint))) {
                    swexpr = ep;
                    tvar = makestmttempvar(tp_unsigned, name_TEMP);
                    ep = makeexpr_var(tvar);
                }
            }
          sp->exp3 = makeexpr_assign(copyexpr(ep),
                               makeexpr_inc(copyexpr(ep),
                                        copyexpr(forstep)));
            wneedtok(TOK_DO);
            forfixed = (fixedflag != forfixed);
            mp = makestmttempvar(ep->val.type, name_FOR);
            sp->stm1 = p_stmt(NULL, SF_SAVESER);
            if (tvar) {
                if (checkexprchanged(sp->stm1, swexpr))
                    note(format_s("Rewritten FOR loop won't work if it meddles with %s [253]",
                                  ((Meaning *)swexpr->val.i)->name));
                sp->stm1 = makestmt_seq(makestmt_assign(swexpr, makeexpr_var(tvar)),
                                        sp->stm1);
            } else if (offsetforloops && ep->kind == EK_VAR) {
            offset = checkvaroffset(sp->stm1, (Meaning *)ep->val.i);
            if (offset != 0) {
                ep3 = makeexpr_inc(copyexpr(ep), makeexpr_long(-offset));
                replaceexpr(sp->stm1, ep, ep3);
                freeexpr(ep3);
                ep2 = makeexpr_plus(ep2, makeexpr_long(offset));
                sp->exp2 = makeexpr_inc(sp->exp2, makeexpr_long(offset));
            }
          }
            if (!exprsame(ep, ep2, 1))
                sp->exp1 = makeexpr_assign(copyexpr(ep), copyexpr(ep2));
          isunsafe = ((!nodependencies(ep2, 2) &&
                   !nosideeffects(sp->exp2, 1)) ||
                  (!nodependencies(sp->exp2, 2) &&
                   !nosideeffects(ep2, 1)));
            if (forfixed || (simplefor(sp, ep) && !isunsafe)) {
                canceltempvar(mp);
                sp->exp2 = makeexpr_rel(ekind, ep, sp->exp2);
            } else {
            ep3 = makeexpr_neg(copyexpr(forstep));
            if ((checkconst(forstep, 1) || checkconst(forstep, -1)) &&
                sp->exp2->kind == EK_PLUS &&
                exprsame(sp->exp2->args[sp->exp2->nargs-1], ep3, 2)) {
                sp->exp2 = makeexpr_inc(sp->exp2, forstep);
            } else {
                freeexpr(forstep);
                freeexpr(ep3);
                ep3 = makeexpr_long(0);
            }
            if (forevalorder && isunsafe) {
                if (exprdepends(sp->exp2, ep)) {
                  tvar = makestmttempvar(mp->type, name_TEMP);
                  sp->exp1 = makeexpr_comma(
                             makeexpr_comma(
                               makeexpr_assign(makeexpr_var(tvar),
                                           copyexpr(ep2)),
                               makeexpr_assign(makeexpr_var(mp),
                                           sp->exp2)),
                             makeexpr_assign(copyexpr(ep),
                                         makeexpr_var(tvar)));
                } else
                  sp->exp1 = makeexpr_comma(
                             sp->exp1,
                             makeexpr_assign(makeexpr_var(mp),
                                         sp->exp2));
            } else {
                if (isunsafe)
                  note("Evaluating FOR loop limit before initial value [315]");
                sp->exp1 = makeexpr_comma(
                           makeexpr_assign(makeexpr_var(mp),
                                     sp->exp2),
                           sp->exp1);
            }
            sp->exp2 = makeexpr_inc(makeexpr_var(mp), ep3);
                sp->exp2 = makeexpr_rel(ekind, ep, sp->exp2);
            }
          freeexpr(ep2);
            break;

        case TOK_GOTO:
            gettok();
            if (findlabelsym()) {
                if (curtokmeaning->ctx != curctx) {
                curtokmeaning->val.i = 1;
                *spp = close_files_to_ctx(curtokmeaning->ctx);
                while (*spp)
                  spp = &((*spp)->next);
                newstmt(SK_ASSIGN);
                var_reference(curtokmeaning->xnext);
                if (curtokmeaning->ctx->kind == MK_MODULE &&
                  !curtokmeaning->xnext->wasdeclared) {
                  outsection(minorspace);
                  declarevar(curtokmeaning->xnext, 0x7);
                  curtokmeaning->xnext->wasdeclared = 1;
                  outsection(minorspace);
                }
                sp->exp1 = makeexpr_bicall_2("longjmp", tp_void,
                                     makeexpr_var(curtokmeaning->xnext),
                                     makeexpr_long(1));
            } else {
                newstmt(SK_GOTO);
                sp->exp1 = makeexpr_name(format_s(name_LABEL,
                                          curtokmeaning->name),
                                   tp_integer);
            }
            } else {
                warning("Expected a label [263]");
          }
          gettok();
            break;

        case TOK_IF:
            gettok();
            newstmt(SK_IF);
          saveserial = curserial;
          curserial = ++serialcount;
            sp->exp1 = p_expr(tp_boolean);
            wneedtok(TOK_THEN);
            sp->stm1 = p_stmt(NULL, SF_SAVESER|SF_IF);
          changecomments(curcomments, -1, saveserial+1, -1, saveserial);
          checkkeyword(TOK_ELSIF);
          while (curtok == TOK_ELSIF) {
            gettok();
            sp->stm2 = makestmt(SK_IF);
            sp = sp->stm2;
            sp->exp1 = p_expr(tp_boolean);
            wneedtok(TOK_THEN);
            sp->stm1 = p_stmt(NULL, SF_SAVESER|SF_IF);
            sp->exp2 = makeexpr_long(1);
          }
          if (curtok == TOK_ELSE) {
                line1 = inf_lnum;
            strlist_mix(&curcomments, grabcomment(CMT_ONELSE));
                gettok();
                line2 = (curtok == TOK_IF) ? inf_lnum : -1;
            saveserial2 = curserial;
                sp->stm2 = p_stmt(NULL, SF_SAVESER|SF_IF);
            changecomments(curcomments, -1, saveserial2, -1, saveserial+1);
                if (sp->stm2 && sp->stm2->kind == SK_IF &&
                !sp->stm2->next && !modula2) {
                    sp->stm2->exp2 = makeexpr_long(elseif > 0 ||
                                                   (elseif < 0 && line1 == line2));
                }
            }
          if (modula2)
            wneedtok(TOK_END);
          curserial = saveserial;
            break;

        case TOK_INLINE:
            gettok();
            note("Inline assembly language encountered [254]");
            if (curtok != TOK_LPAR) {   /* Macintosh style */
            newstmt(SK_ASSIGN);
            sp->exp1 = makeexpr_bicall_1("inline", tp_void,
                                   p_expr(tp_integer));
            break;
          }
            do {
                name = getinlinepart();
                if (!*name)
                    break;
                newstmt(SK_ASSIGN);
                sp->exp1 = makeexpr_bicall_1("asm", tp_void,
                            makeexpr_string(format_s(" inline %s", name)));
                gettok();
            } while (curtok == TOK_SLASH);
            skipcloseparen();
            break;

      case TOK_LOOP:
          gettok();
          newstmt(SK_WHILE);
          sp->exp1 = makeexpr_long(1);
            sp->stm1 = p_stmt(NULL, SF_SAVESER);
          break;

        case TOK_REPEAT:
            newstmt(SK_REPEAT);
          saveserial = curserial;
            spp2 = &(sp->stm1);
          i = SF_FIRST;
            do {
                gettok();
                *spp2 = p_stmt(sp->stm1, i);
            i = 0;
                while (*spp2)
                    spp2 = &((*spp2)->next);
            } while (curtok == TOK_SEMI);
            if (!wneedtok(TOK_UNTIL))
            skippasttoken(TOK_UNTIL);
            sp->exp1 = makeexpr_not(p_expr(tp_boolean));
          curserial = saveserial;
          strlist_mix(&curcomments, grabcomment(CMT_ONEND));
            break;

      case TOK_RETURN:
          gettok();
          newstmt(SK_RETURN);
          if (curctx->isfunction) {
            sp->exp1 = gentle_cast(p_expr(curctx->cbase->type),
                               curctx->cbase->type);
          }
          break;

        case TOK_TRY:
          findsymbol("RECOVER")->flags &= ~KWPOSS;
            newstmt(SK_TRY);
            sp->exp1 = makeexpr_long(++trycount);
            spp2 = &(sp->stm1);
          i = SF_FIRST;
            do {
                gettok();
                *spp2 = p_stmt(sp->stm1, i);
            i = 0;
                while (*spp2)
                    spp2 = &((*spp2)->next);
            } while (curtok == TOK_SEMI);
            if (!wneedtok(TOK_RECOVER))
            skippasttoken(TOK_RECOVER);
            sp->stm2 = p_stmt(NULL, SF_SAVESER);
            break;

        case TOK_WHILE:
            gettok();
            newstmt(SK_WHILE);
            sp->exp1 = p_expr(tp_boolean);
            wneedtok(TOK_DO);
            sp->stm1 = p_stmt(NULL, SF_SAVESER);
            break;

        case TOK_WITH:
            gettok();
            if (withlevel >= MAXWITHS-1)
                error("Too many nested WITHs");
            ep = p_expr(NULL);
            if (ep->val.type->kind != TK_RECORD)
                warning("Argument of WITH is not a RECORD [264]");
            withlist[withlevel] = ep->val.type;
            if (simplewith(ep)) {
                withexprs[withlevel] = ep;
                mp = NULL;
            } else {           /* need to save a temporary pointer */
                tp = makepointertype(ep->val.type);
                mp = makestmttempvar(tp, name_WITH);
                withexprs[withlevel] = makeexpr_hat(makeexpr_var(mp), 0);
            }
            withlevel++;
            if (curtok == TOK_COMMA) {
                curtok = TOK_WITH;
                sp2 = p_stmt(NULL, sflags & SF_FIRST);
            } else {
                wneedtok(TOK_DO);
                sp2 = p_stmt(NULL, sflags & SF_FIRST);
            }
            withlevel--;
            if (mp) {    /* if "with p^" for constant p, don't need temp ptr */
                if (ep->kind == EK_HAT && ep->args[0]->kind == EK_VAR &&
                    !checkvarchanged(sp2, (Meaning *)ep->args[0]->val.i)) {
                    replaceexpr(sp2, withexprs[withlevel]->args[0],
                                     ep->args[0]);
                    freeexpr(ep);
                    canceltempvar(mp);
                } else {
                    newstmt(SK_ASSIGN);
                    sp->exp1 = makeexpr_assign(makeexpr_var(mp),
                                               makeexpr_addr(ep));
                }
            }
            freeexpr(withexprs[withlevel]);
            *spp = sp2;
            while (*spp)
                spp = &((*spp)->next);
            break;

        case TOK_INCLUDE:
            badinclude();
            goto again;

      case TOK_ADDR:   /* flakey Turbo "@procptr := anyptr" assignment */
          newstmt(SK_ASSIGN);
          ep = p_expr(tp_void);
          if (wneedtok(TOK_ASSIGN))
            sp->exp1 = makeexpr_assign(ep, p_expr(ep->val.type));
          else
            sp->exp1 = ep;
          break;

        case TOK_IDENT:
            mp = curtokmeaning;
          if (mp == mp_str_hp)
            mp = curtokmeaning = mp_str_turbo;
          if (mp == mp_val_modula)
            mp = curtokmeaning = mp_val_turbo;
          if (mp == mp_blockread_ucsd)
            mp = curtokmeaning = mp_blockread_turbo;
          if (mp == mp_blockwrite_ucsd)
            mp = curtokmeaning = mp_blockwrite_turbo;
          if (mp == mp_dec_dec)
            mp = curtokmeaning = mp_dec_turbo;
            if (!mp) {
                sym = curtoksym;     /* make a guess at what the undefined name is... */
                name = stralloc(curtokcase);
                gettok();
                newstmt(SK_ASSIGN);
                if (curtok == TOK_ASSIGN) {
                    gettok();
                    ep = p_expr(NULL);
                    mp = addmeaning(sym, MK_VAR);
                    mp->name = name;
                    mp->type = ep->val.type;
                    sp->exp1 = makeexpr_assign(makeexpr_var(mp), ep);
                } else if (curtok == TOK_HAT || curtok == TOK_ADDR ||
                           curtok == TOK_LBR || curtok == TOK_DOT) {
                    ep = makeexpr_name(name, tp_integer);
                    ep = fake_dots_n_hats(ep);
                    if (wneedtok(TOK_ASSIGN))
                  sp->exp1 = makeexpr_assign(ep, p_expr(NULL));
                else
                  sp->exp1 = ep;
                } else if (curtok == TOK_LPAR) {
                    ep = makeexpr_bicall_0(name, tp_void);
                    do {
                        gettok();
                        insertarg(&ep, ep->nargs, p_expr(NULL));
                    } while (curtok == TOK_COMMA);
                    skipcloseparen();
                    sp->exp1 = ep;
                } else {
                    sp->exp1 = makeexpr_bicall_0(name, tp_void);
                }
            if (!tryfuncmacro(&sp->exp1, NULL))
                undefsym(sym);
            } else if (mp->kind == MK_FUNCTION && !mp->isfunction) {
                mp->refcount++;
                gettok();
                ep = p_funccall(mp);
                if (!mp->constdefn)
                    need_forward_decl(mp);
                if (mp->handler && !(mp->sym->flags & LEAVEALONE) &&
                                   !mp->constdefn) {
                    prochandler = (Stmt *(*)())mp->handler;
                    *spp = (*prochandler)(ep, slist);
                    while (*spp)
                        spp = &((*spp)->next);
                } else {
                    newstmt(SK_ASSIGN);
                    sp->exp1 = ep;
                }
            } else if (mp->kind == MK_SPECIAL) {
                gettok();
                if (mp->handler && !mp->isfunction) {
                    if ((mp->sym->flags & LEAVEALONE) || mp->constdefn) {
                        ep = makeexpr_bicall_0(mp->name, tp_void);
                        if (curtok == TOK_LPAR) {
                            do {
                                gettok();
                                insertarg(&ep, ep->nargs, p_expr(NULL));
                            } while (curtok == TOK_COMMA);
                            skipcloseparen();
                        }
                        newstmt(SK_ASSIGN);
                  tryfuncmacro(&ep, mp);
                  sp->exp1 = ep;
                    } else {
                        prochandler = (Stmt *(*)())mp->handler;
                        *spp = (*prochandler)(mp, slist);
                        while (*spp)
                            spp = &((*spp)->next);
                    }
                } else
                    symclass(curtoksym);
            } else {
                newstmt(SK_ASSIGN);
                if (curtokmeaning->kind == MK_FUNCTION &&
                peeknextchar() != '(') {
                    mp = curctx;
                    while (mp && mp != curtokmeaning)
                        mp = mp->ctx;
                    if (mp)
                        curtokmeaning = curtokmeaning->cbase;
                }
                ep = p_expr(tp_void);
#if 0
            if (!(ep->kind == EK_SPCALL ||
                  (ep->kind == EK_COND &&
                   ep->args[1]->kind == EK_SPCALL)))
                wexpecttok(TOK_ASSIGN);
#endif
            if (curtok == TOK_ASSIGN) {
                gettok();
                if (curtok == TOK_IDENT && !strcicmp(curtokbuf, "ZERO") &&
                  !curtokmeaning) {   /* VAX Pascal foolishness */
                  gettok();
                  ep2 = makeexpr_sizeof(copyexpr(ep), 0);
                  sp->exp1 = makeexpr_bicall_3("memset", tp_void,
                                         makeexpr_addr(ep),
                                         makeexpr_long(0), ep2);
                } else
                  sp->exp1 = makeexpr_assign(ep, p_expr(ep->val.type));
            } else
                sp->exp1 = ep;
            }
            break;

      default:
          break;    /* null statement */
    }
    freestmttemps(tempmark);
    if (sflags & SF_SAVESER)
      curserial = firstserial;
    return sbase;
}







#define BR_NEVER        0x1     /* never use braces */
#define BR_FUNCTION     0x2     /* function body */
#define BR_THENPART     0x4     /* before an "else" */
#define BR_ALWAYS       0x8     /* always use braces */
#define BR_REPEAT       0x10    /* "do-while" loop */
#define BR_TRY          0x20    /* in a recover block */
#define BR_ELSEPART     0x40    /* after an "else" */
#define BR_CASE         0x80    /* case of a switch stmt */

Static int usebraces(sp, opts)
Stmt *sp;
int opts;
{
    if (opts & (BR_FUNCTION|BR_ALWAYS))
        return 1;
    if (opts & BR_NEVER)
        return 0;
    switch (bracesalways) {
        case 0:
            if (sp) {
                if (sp->next ||
                    sp->kind == SK_TRY ||
                    (sp->kind == SK_IF && !sp->stm2) ||
                    (opts & BR_REPEAT))
                    return 1;
            }
            break;

        case 1:
            return 1;

        default:
            if (sp) {
                if (sp->next ||
                    sp->kind == SK_IF ||
                    sp->kind == SK_WHILE ||
                    sp->kind == SK_REPEAT ||
                    sp->kind == SK_TRY ||
                sp->kind == SK_CASE ||
                    sp->kind == SK_FOR)
                    return 1;
            }
            break;
    }
    if (sp != NULL &&
      findcomment(curcomments, CMT_NOT | CMT_TRAIL, sp->serial) != NULL)
      return 1;
    return 0;
}



#define outspnl(spflag) output((spflag) ? " " : "\n")

#define openbrace()                 \
    wbraces = (!candeclare);        \
    if (wbraces) {                  \
        output("{");                \
        outspnl(braceline <= 0);    \
        candeclare = 1;             \
    }

#define closebrace()                \
    if (wbraces) {                  \
        if (sp->next || braces)     \
            output("}\n");          \
        else                        \
            braces = 1;             \
    }



Meaning *outcontext;

Static void outnl(serial)
int serial;
{
    outtrailcomment(curcomments, serial, commentindent);
}


Static void out_block(spbase, opts, serial)
Stmt *spbase;
int opts, serial;
{
    int i, j, braces, always, trynum, istrail, hascmt;
    int gotcomments = 0;
    int saveindent, saveindent2, delta;
    Stmt *sp = spbase;
    Stmt *sp2, *sp3;
    Meaning *ctx, *mp;
    Strlist *curcmt, *cmt, *savecurcmt = curcomments;
    Strlist *trailcmt, *begincmt, *endcmt;

    if (debug>1) { fprintf(outf, "out_block of:\n"); dumpstmt(spbase,5); }
    if (opts & BR_FUNCTION) {
      if (outcontext && outcontext->comments) {
          gotcomments = 1;
          curcomments = outcontext->comments;
      }
      attach_comments(spbase);
    }
    braces = usebraces(sp, opts);
    trailcmt = findcomment(curcomments, CMT_TRAIL, serial);
    begincmt = findcomment(curcomments, CMT_ONBEGIN, serial);
    istrail = 1;
    if (!trailcmt) {
      trailcmt = begincmt;
      begincmt = NULL;
      istrail = 0;
    }
    endcmt = findcomment(curcomments, CMT_ONEND, serial);
    if ((begincmt || endcmt) && !(opts & BR_NEVER))
      braces = 1;
    if (opts & BR_ELSEPART) {
      cmt = findcomment(curcomments, CMT_ONELSE, serial);
      if (cmt) {
          if (trailcmt) {
            out_spaces(bracecommentindent, commentoverindent,
                     commentlen(cmt), 0);
            output("\001");
            outcomment(cmt);
          } else
            trailcmt = cmt;
      }
    }
    if (braces) {
      j = (opts & BR_FUNCTION) ? funcopenindent : openbraceindent;
        if (!line_start()) {
          if (trailcmt &&
            cur_column() + commentlen(trailcmt) + 2 > linewidth &&
            outindent + commentlen(trailcmt) + 2 < linewidth)  /*close enough*/
            i = 0;
          else if (opts & BR_ELSEPART)
            i = ((braceelseline & 2) == 0);
          else if (braceline >= 0)
            i = (braceline == 0);
          else
                i = ((opts & BR_FUNCTION) == 0);
          if (trailcmt && begincmt) {
            out_spaces(commentindent, commentoverindent,
                     commentlen(trailcmt), j);
            outcomment(trailcmt);
            trailcmt = begincmt;
            begincmt = NULL;
            istrail = 0;
          } else
            outspnl(i);
        }
      if (line_start())
          singleindent(j);
        output("{");
        candeclare = 1;
    } else if (!sp) {
        if (!line_start())
            outspnl(!nullstmtline && !(opts & BR_TRY));
      if (line_start())
          singleindent(tabsize);
        output(";");
    }
    if (opts & BR_CASE)
      delta = 0;
    else {
      delta = tabsize;
      if (opts & BR_FUNCTION)
          delta = adddeltas(delta, bodyindent);
      else if (braces)
          delta = adddeltas(delta, blockindent);
    }
    futureindent(delta);
    if (bracecombine && braces)
      i = applydelta(outindent, delta) - cur_column();
    else
      i = -1;
    if (commentvisible(trailcmt)) {
      if (line_start()) {
          singleindent(delta);
          out_spaces(commentoverindent, 1000, commentlen(trailcmt), 0);
          outcomment(trailcmt);
      } else /*if (commentlen(trailcmt) + cur_column() + 1 <= linewidth)*/ {
          out_spaces(istrail ? commentindent : bracecommentindent,
                   commentoverindent, commentlen(trailcmt), delta);
          outcomment(trailcmt);
      } /*else {
          output("\n");
          singleindent(delta);
          out_spaces(commentoverindent, 1000, commentlen(trailcmt), 0);
          outcomment(trailcmt);
      }*/
      i = -9999;
    }
    if (i > 0)
      out_spaces(i, 0, 0, 0);
    else if (i != -9999)
      output("\n");
    saveindent = outindent;
    moreindent(delta);
    outcomment(begincmt);
    while (sp) {
      flushcomments(NULL, CMT_PRE, sp->serial);
      if (cmtdebug)
          output(format_d("[%d] ", sp->serial));
        switch (sp->kind) {

            case SK_HEADER:
                ctx = (Meaning *)sp->exp1->val.i;
            eatblanklines();
                if (declarevars(ctx, 0))
                    outsection(minorspace);
            flushcomments(NULL, CMT_NOT | CMT_ONEND, serial);
                if (ctx->kind == MK_MODULE) {
                    if (ctx->anyvarflag) {
                        output(format_s(name_MAIN, ""));
                  if (spacefuncs)
                      output(" ");
                        output("(argc,");
                  if (spacecommas)
                      output(" ");
                  output("argv);\n");
                    } else {
                        output("static int _was_initialized = 0;\n");
                        output("if (_was_initialized++)\n");
                  singleindent(tabsize);
                        output("return;\n");
                    }
                while (initialcalls) {
                  output(initialcalls->s);
                  output(";\n");
                  strlist_remove(&initialcalls, initialcalls->s);
                }
                } else {
                    if (ctx->varstructflag && ctx->ctx->kind == MK_FUNCTION &&
                                              ctx->ctx->varstructflag) {
                        output(format_s(name_VARS, ctx->name));
                        output(".");
                        output(format_s(name_LINK, ctx->ctx->name));
                        output(" = ");
                        output(format_s(name_LINK, ctx->ctx->name));
                        output(";\n");
                    }
                for (mp = ctx->cbase; mp; mp = mp->cnext) {
                  if ((mp->kind == MK_VAR ||    /* these are variables with */
                       mp->kind == MK_VARREF) &&
                      ((mp->varstructflag &&      /* initializers which were moved */
                        mp->cnext &&              /* into a varstruct, so they */
                        mp->cnext->snext == mp && /* must be initialized now */
                        mp->cnext->constdefn &&
                        ctx->kind == MK_FUNCTION) ||
                       (mp->constdefn &&
                        mp->type->kind == TK_ARRAY &&
                        mp->constdefn->val.type->kind == TK_STRING &&
                        !initpacstrings))) {
                      if (mp->type->kind == TK_ARRAY) {
                        output("memcpy(");
                        out_var(mp, 2);
                        output(",\002");
                        if (spacecommas)
                            output(" ");
                        if (mp->constdefn) {
                            output(makeCstring(mp->constdefn->val.s,
                                           mp->constdefn->val.i));
                            mp->constdefn = NULL;
                        } else
                            out_var(mp->cnext, 2);
                        output(",\002");
                        if (spacecommas)
                            output(" ");
                        output("sizeof(");
                        out_type(mp->type, 1);
                        output("))");
                      } else {
                        out_var(mp, 2);
                        output(" = ");
                        out_var(mp->cnext, 2);
                      }
                      output(";\n");
                  }
                }
                }
                break;

            case SK_RETURN:
                output("return");
            if (sp->exp1) {
                switch (returnparens) {
                  
                  case 0:
                  output(" ");
                  out_expr(sp->exp1);
                  break;
                  
                  case 1:
                  if (spaceexprs != 0)
                      output(" ");
                  out_expr_parens(sp->exp1);
                  break;
                  
                  default:
                  if (sp->exp1->kind == EK_VAR ||
                      sp->exp1->kind == EK_CONST ||
                      sp->exp1->kind == EK_LONGCONST ||
                      sp->exp1->kind == EK_BICALL) {
                      output(" ");
                      out_expr(sp->exp1);
                  } else {
                      if (spaceexprs != 0)
                        output(" ");
                      out_expr_parens(sp->exp1);
                  }
                  break;
                }
            }
            output(";");
            outnl(sp->serial);
                break;

            case SK_ASSIGN:
                out_expr_stmt(sp->exp1);
                output(";");
            outnl(sp->serial);
                break;

            case SK_CASE:
                output("switch (");
                out_expr(sp->exp1);
                output(")");
                outspnl(braceline <= 0);
                output("{");
            outnl(sp->serial);
            saveindent2 = outindent;
            moreindent(tabsize);
            moreindent(switchindent);
                sp2 = sp->stm1;
                while (sp2 && sp2->kind == SK_CASELABEL) {
                    outsection(casespacing);
                    sp3 = sp2;
                i = 0;
                hascmt = (findcomment(curcomments, -1, sp2->serial) != NULL);
                singleindent(caseindent);
                flushcomments(NULL, CMT_PRE, sp2->serial);
                    for (;;) {
                  if (i)
                      singleindent(caseindent);
                  i = 0;
                        output("case ");
                        out_expr(sp3->exp1);
                        output(":\001");
                        sp3 = sp3->stm1;
                        if (!sp3 || sp3->kind != SK_CASELABEL)
                            break;
                        if (casetabs != 1000)
                            out_spaces(casetabs, 0, 0, 0);
                        else {
                            output("\n");
                      i = 1;
                  }
                    }
                    if (sp3)
                        out_block(sp3, BR_NEVER|BR_CASE, sp2->serial);
                    else {
                  outnl(sp2->serial);
                  if (!hascmt)
                      output("/* blank case */\n");
                }
                    output("break;\n");
                flushcomments(NULL, -1, sp2->serial);
                    sp2 = sp2->next;
                }
                if (sp2) {
                    outsection(casespacing);
                singleindent(caseindent);
                flushcomments(NULL, CMT_PRE, sp2->serial);
                    output("default:");
                    out_block(sp2, BR_NEVER|BR_CASE, sp2->serial);
                    output("break;\n");
                flushcomments(NULL, -1, sp2->serial);
                }
                outindent = saveindent2;
                output("}");
            curcmt = findcomment(curcomments, CMT_ONEND, sp->serial);
            if (curcmt)
                outcomment(curcmt);
            else
                output("\n");
                break;

            case SK_CASECHECK:
            output(name_CASECHECK);
                output("();   /* CASE value range error */\n");
                break;

            case SK_FOR:
                output("for (");
            if (for_allornone)
                output("\007");
                if (sp->exp1 || sp->exp2 || sp->exp3 || spaceexprs > 0) {
                    if (sp->exp1)
                        out_expr_top(sp->exp1);
                    else if (spaceexprs > 0)
                        output(" ");
                    output(";\002 ");
                    if (sp->exp2)
                        out_expr(sp->exp2);
                    output(";\002 ");
                    if (sp->exp3)
                        out_expr_top(sp->exp3);
                } else {
                    output(";;");
                }
                output(")");
                out_block(sp->stm1, 0, sp->serial);
                break;

            case SK_LABEL:
                if (!line_start())
                    output("\n");
            singleindent(labelindent);
                out_expr(sp->exp1);
                output(":");
                if (!sp->next)
                    output(" ;");
                outnl(sp->serial);
                break;

            case SK_GOTO:
                /* what about non-local goto's? */
                output("goto ");
                out_expr(sp->exp1);
                output(";");
            outnl(sp->serial);
                break;

            case SK_IF:
                sp2 = sp;
                for (;;) {
                    output("if (");
                    out_expr_bool(sp2->exp1);
                    output(")");
                    if (sp2->stm2) {
                  cmt = findcomment(curcomments, CMT_ONELSE, sp->serial+1);
                        i = (!cmt && sp2->stm2->kind == SK_IF &&
                       !sp2->stm2->next &&
                       ((sp2->stm2->exp2)
                        ? checkconst(sp2->stm2->exp2, 1)
                        : (elseif > 0)));
                  if (braceelse &&
                            (usebraces(sp2->stm1, 0) ||
                             usebraces(sp2->stm2, 0) || i))
                            always = BR_ALWAYS;
                        else
                            always = 0;
                        out_block(sp2->stm1, BR_THENPART|always, sp->serial);
                        output("else");
                        sp2 = sp2->stm2;
                        if (i) {
                            output(" ");
                        } else {
                            out_block(sp2, BR_ELSEPART|always, sp->serial+1);
                            break;
                        }
                    } else {
                        out_block(sp2->stm1, 0, sp->serial);
                        break;
                    }
                }
                break;

            case SK_REPEAT:
                output("do");
                out_block(sp->stm1, BR_ALWAYS|BR_REPEAT, sp->serial);
                output("while (");
                out_expr_bool(sp->exp1);
                output(");");
            cmt = findcomment(curcomments, CMT_ONEND, sp->serial);
            if (commentvisible(cmt)) {
                out_spaces(commentindent, commentoverindent,
                         commentlen(cmt), 0);
                output("\001");
                outcomment(cmt);
            } else
                output("\n");
                break;

            case SK_TRY:
                trynum = sp->exp1->val.i;
                output(format_d("TRY(try%d);", trynum));
                out_block(sp->stm1, BR_NEVER|BR_TRY, sp->serial);
                if (sp->exp2)
                    output(format_ds("RECOVER2(try%d,%s);", trynum,
                                     format_s(name_LABEL, format_d("try%d", trynum))));
                else
                    output(format_d("RECOVER(try%d);", trynum));
                out_block(sp->stm2, BR_NEVER|BR_TRY, sp->serial);
                output(format_d("ENDTRY(try%d);\n", trynum));
                break;

            case SK_WHILE:
                output("while (");
                out_expr_bool(sp->exp1);
                output(")");
                out_block(sp->stm1, 0, sp->serial);
                break;

            case SK_BREAK:
                output("break;");
            outnl(sp->serial);
                break;

            case SK_CONTINUE:
                output("continue;");
            outnl(sp->serial);
                break;

          default:
              intwarning("out_block",
                     format_s("Misplaced statement kind %s [265]",
                            stmtkindname(sp->kind)));
            break;
        }
      flushcomments(NULL, -1, sp->serial);
        candeclare = 0;
        if (debug>1) { fprintf(outf, "in out_block:\n"); dumpstmt(spbase,5); }
        sp = sp->next;
    }
    if (opts & BR_FUNCTION) {
      cmt = extractcomment(&curcomments, CMT_ONEND, serial);
      if (findcomment(curcomments, -1, -1) != NULL)  /* check for non-DONE */
          output("\n");
      flushcomments(NULL, -1, -1);
      curcomments = cmt;
    }
    outindent = saveindent;
    if (braces) {
      if (line_start()) {
          if (opts & BR_FUNCTION)
            singleindent(funccloseindent);
          else
            singleindent(closebraceindent);
      }
        output("}");
      i = 1;
      cmt = findcomment(curcomments, CMT_ONEND, serial);
      if (!(opts & BR_REPEAT) && commentvisible(cmt)) {
          out_spaces(bracecommentindent, commentoverindent,
                   commentlen(cmt), 0);
          output("\001");
          outcomment(cmt);
          i = 0;
      }
      if (i) {
          outspnl((opts & BR_REPEAT) ||
                ((opts & BR_THENPART) && (braceelseline & 1) == 0));
      }
        candeclare = 0;
    }
    if (gotcomments) {
      outcontext->comments = curcomments;
      curcomments = savecurcmt;
    }
}





/* Should have a way to convert GOTO's to the end of the function to RETURN's */


/* Convert "_RETV = foo;" at end of function to "return foo" */

Static int checkreturns(spp, nearret)
Stmt **spp;
int nearret;
{
    Stmt *sp;
    Expr *rvar, *ex;
    Meaning *mp;
    int spnearret, spnextreturn;
    int result = 0;

    if (debug>2) { fprintf(outf, "checkreturns on:\n"); dumpstmt(*spp, 5); }
    while ((sp = *spp)) {
        spnextreturn = (sp->next &&
                        sp->next->kind == SK_RETURN && sp->next->exp1 &&
                        isretvar(sp->next->exp1) == curctx->cbase);
        spnearret = (nearret && !sp->next) || spnextreturn;
        result = 0;
        switch (sp->kind) {

            case SK_ASSIGN:
                ex = sp->exp1;
                if (ex->kind == EK_ASSIGN || structuredfunc(ex)) {
                    rvar = ex->args[0];
                    mp = isretvar(rvar);
                    if (mp == curctx->cbase && spnearret) {
                        if (ex->kind == EK_ASSIGN) {
                            if (mp->kind == MK_VARPARAM) {
                                ex = makeexpr_comma(ex, makeexpr_var(mp));
                            } else {
                                ex = grabarg(ex, 1);
                                mp->refcount--;
                            }
                        }
                        sp->exp1 = ex;
                        sp->kind = SK_RETURN;
                        if (spnextreturn) {
                            mp->refcount--;
                            sp->next = sp->next->next;
                        }
                        result = 1;
                    }
                }
                break;

            case SK_RETURN:
            case SK_GOTO:
                result = 1;
                break;

            case SK_IF:
                result = checkreturns(&sp->stm1, spnearret) &    /* NOT && */
                         checkreturns(&sp->stm2, spnearret);
                break;

            case SK_TRY:
                (void) checkreturns(&sp->stm1, 0);
                (void) checkreturns(&sp->stm2, spnearret);
                break;

            /* should handle CASE statements as well */

            default:
                (void) checkreturns(&sp->stm1, 0);
                (void) checkreturns(&sp->stm2, 0);
                break;
        }
        spp = &sp->next;
    }
    return result;
}







/* Replace all occurrences of one expression with another expression */

Expr *replaceexprexpr(ex, oldex, newex, keeptype)
Expr *ex, *oldex, *newex;
int keeptype;
{
    int i;
    Type *type;

    for (i = 0; i < ex->nargs; i++)
        ex->args[i] = replaceexprexpr(ex->args[i], oldex, newex, keeptype);
    if (exprsame(ex, oldex, 2)) {
        if (ex->val.type->kind == TK_POINTER &&
            ex->val.type->basetype == oldex->val.type) {
            freeexpr(ex);
            return makeexpr_addr(copyexpr(newex));
        } else if (oldex->val.type->kind == TK_POINTER &&
                   oldex->val.type->basetype == ex->val.type) {
            freeexpr(ex);
            return makeexpr_hat(copyexpr(newex), 0);
        } else {
          type = ex->val.type;
            freeexpr(ex);
            ex = copyexpr(newex);
          if (keeptype)
            ex->val.type = type;
          return ex;
        }
    }
    return resimplify(ex);
}


void replaceexpr(sp, oldex, newex)
Stmt *sp;
Expr *oldex, *newex;
{
    while (sp) {
        replaceexpr(sp->stm1, oldex, newex);
        replaceexpr(sp->stm2, oldex, newex);
        if (sp->exp1)
            sp->exp1 = replaceexprexpr(sp->exp1, oldex, newex, 1);
        if (sp->exp2)
            sp->exp2 = replaceexprexpr(sp->exp2, oldex, newex, 1);
        if (sp->exp3)
            sp->exp3 = replaceexprexpr(sp->exp3, oldex, newex, 1);
        sp = sp->next;
    }
}






Stmt *mixassignments(sp, mp)
Stmt *sp;
Meaning *mp;
{
    if (!sp)
        return NULL;
    sp->next = mixassignments(sp->next, mp);
    if (sp->next &&
       sp->kind == SK_ASSIGN &&
         sp->exp1->kind == EK_ASSIGN &&
         sp->exp1->args[0]->kind == EK_VAR &&
         (!mp || mp == (Meaning *)sp->exp1->args[0]->val.i) &&
         ord_type(sp->exp1->args[0]->val.type)->kind == TK_INTEGER &&
         nodependencies(sp->exp1->args[1], 0) &&
         sp->next->kind == SK_ASSIGN &&
         sp->next->exp1->kind == EK_ASSIGN &&
         (exprsame(sp->exp1->args[0], sp->next->exp1->args[0], 1) ||
          (mp && mp->istemporary)) &&
         exproccurs(sp->next->exp1->args[1], sp->exp1->args[0]) == 1) {
        sp->next->exp1->args[1] = replaceexprexpr(sp->next->exp1->args[1],
                                                  sp->exp1->args[0],
                                                  sp->exp1->args[1], 1);
        if (mp && mp->istemporary)
            canceltempvar(mp);
        return sp->next;
    }
    return sp;
}








/* Do various simple (sometimes necessary) massages on the statements */


Static Stmt bogusreturn = { SK_RETURN, NULL, NULL, NULL, NULL, NULL, NULL };



Static int isescape(ex)
Expr *ex;
{
    if (ex->kind == EK_BICALL && (!strcmp(ex->val.s, name_ESCAPE) ||
                                  !strcmp(ex->val.s, name_ESCIO) ||
                          !strcmp(ex->val.s, name_OUTMEM) ||
                          !strcmp(ex->val.s, name_CASECHECK) ||
                          !strcmp(ex->val.s, name_NILCHECK) ||
                                  !strcmp(ex->val.s, "_exit") ||
                                  !strcmp(ex->val.s, "exit")))
        return 1;
    if (ex->kind == EK_CAST)
        return isescape(ex->args[0]);
    return 0;
}


/* check if a block can never exit by falling off the end */
Static int deadendblock(sp)
Stmt *sp;
{
    if (!sp)
        return 0;
    while (sp->next)
        sp = sp->next;
    return (sp->kind == SK_GOTO ||
            sp->kind == SK_BREAK ||
            sp->kind == SK_CONTINUE ||
            sp->kind == SK_RETURN ||
            sp->kind == SK_CASECHECK ||
            (sp->kind == SK_IF && deadendblock(sp->stm1) &&
                                  deadendblock(sp->stm2)) ||
            (sp->kind == SK_ASSIGN && isescape(sp->exp1)));
}




int expr_is_bool(ex, want)
Expr *ex;
int want;
{
    long val;

    if (ex->val.type == tp_boolean && isconstexpr(ex, &val))
        return (val == want);
    return 0;
}




/* Returns 1 if c1 implies c2, 0 otherwise */
/* If not1 is true, then checks if (!c1) implies c2; similarly for not2 */

/* Identities used:
        c1 -> (c2a && c2b)      <=>     (c1 -> c2a) && (c1 -> c2b)
        c1 -> (c2a || c2b)      <=>     (c1 -> c2a) || (c1 -> c2b)
        (c1a && c1b) -> c2      <=>     (c1a -> c2) || (c1b -> c2)
        (c1a || c1b) -> c2      <=>     (c1a -> c2) && (c1b -> c2)
        (!c1) -> (!c2)          <=>     c2 -> c1
        (a == b) -> c2(b)       <=>     c2(a)
        !(c1 && c2)             <=>     (!c1) || (!c2)
        !(c1 || c2)             <=>     (!c1) && (!c2)
*/
/* This could be smarter about, e.g., (a>5) -> (a>0) */

int implies(c1, c2, not1, not2)
Expr *c1, *c2;
int not1, not2;
{
    Expr *ex;
    int i;

    if (c1->kind == EK_EQ && c1->args[0]->val.type == tp_boolean) {
        if (checkconst(c1->args[0], 1)) {     /* things like "flag = true" */
            return implies(c1->args[1], c2, not1, not2);
        } else if (checkconst(c1->args[1], 1)) {
            return implies(c1->args[0], c2, not1, not2);
        } else if (checkconst(c1->args[0], 0)) {
            return implies(c1->args[1], c2, !not1, not2);
        } else if (checkconst(c1->args[1], 0)) {
            return implies(c1->args[0], c2, !not1, not2);
        }
    }
    if (c2->kind == EK_EQ && c2->args[0]->val.type == tp_boolean) {
        if (checkconst(c2->args[0], 1)) {
            return implies(c1, c2->args[1], not1, not2);
        } else if (checkconst(c2->args[1], 1)) {
            return implies(c1, c2->args[0], not1, not2);
        } else if (checkconst(c2->args[0], 0)) {
            return implies(c1, c2->args[1], not1, !not2);
        } else if (checkconst(c2->args[1], 0)) {
            return implies(c1, c2->args[0], not1, !not2);
        }
    }
    switch (c2->kind) {

        case EK_AND:
            if (not2)               /* c1 -> (!c2a || !c2b) */
                return (implies(c1, c2->args[0], not1, 1) ||
                        implies(c1, c2->args[1], not1, 1));
            else                    /* c1 -> (c2a && c2b) */
                return (implies(c1, c2->args[0], not1, 0) &&
                        implies(c1, c2->args[1], not1, 0));

        case EK_OR:
            if (not2)               /* c1 -> (!c2a && !c2b) */
                return (implies(c1, c2->args[0], not1, 1) &&
                        implies(c1, c2->args[1], not1, 1));
            else                    /* c1 -> (c2a || c2b) */
                return (implies(c1, c2->args[0], not1, 0) ||
                        implies(c1, c2->args[1], not1, 0));

        case EK_NOT:                /* c1 -> (!c2) */
            return (implies(c1, c2->args[0], not1, !not2));

        case EK_CONST:
            if ((c2->val.i != 0) != not2)  /* c1 -> true */
                return 1;
            break;

      default:
          break;
    }
    switch (c1->kind) {

        case EK_AND:
            if (not1)               /* (!c1a || !c1b) -> c2 */
                return (implies(c1->args[0], c2, 1, not2) &&
                        implies(c1->args[1], c2, 1, not2));
            else                    /* (c1a && c1b) -> c2 */
                return (implies(c1->args[0], c2, 0, not2) ||
                        implies(c1->args[1], c2, 0, not2));

        case EK_OR:
            if (not1)               /* (!c1a && !c1b) -> c2 */
                return (implies(c1->args[0], c2, 1, not2) ||
                        implies(c1->args[1], c2, 1, not2));
            else                    /* (c1a || c1b) -> c2 */
                return (implies(c1->args[0], c2, 0, not2) &&
                        implies(c1->args[1], c2, 0, not2));

        case EK_NOT:                /* (!c1) -> c2 */
            return (implies(c1->args[0], c2, !not1, not2));

        case EK_CONST:
            if ((c1->val.i != 0) == not1)  /*  false -> c2 */
                return 1;
            break;

        case EK_EQ:                 /* (a=b) -> c2 */
        case EK_ASSIGN:             /* (a:=b) -> c2 */
        case EK_NE:                 /* (a<>b) -> c2 */
            if ((c1->kind == EK_NE) == not1) {
                if (c1->args[0]->kind == EK_VAR) {
                    ex = replaceexprexpr(copyexpr(c2), c1->args[0], c1->args[1], 1);
                    i = expr_is_bool(ex, !not2);
                    freeexpr(ex);
                    if (i)
                        return 1;
                }
                if (c1->args[1]->kind == EK_VAR) {
                    ex = replaceexprexpr(copyexpr(c2), c1->args[1], c1->args[0], 1);
                    i = expr_is_bool(ex, !not2);
                    freeexpr(ex);
                    if (i)
                        return 1;
                }
            }
            break;

      default:
          break;
    }
    if (not1 == not2 && exprequiv(c1, c2)) {    /* c1 -> c1 */
        return 1;
    }
    return 0;
}





void infiniteloop(sp)
Stmt *sp;
{
    switch (infloopstyle) {

        case 1:      /* write "for (;;) ..." */
            sp->kind = SK_FOR;
            freeexpr(sp->exp1);
            sp->exp1 = NULL;
            break;

        case 2:      /* write "while (1) ..." */
            sp->kind = SK_WHILE;
            freeexpr(sp->exp1);
            sp->exp1 = makeexpr_val(make_ord(tp_boolean, 1));
            break;

        case 3:      /* write "do ... while (1)" */
            sp->kind = SK_REPEAT;
            freeexpr(sp->exp1);
            sp->exp1 = makeexpr_val(make_ord(tp_boolean, 1));
            break;

        default:     /* leave it alone */
            break;

    }
}





Expr *print_func(ex)
Expr *ex;
{
    if (!ex || ex->kind != EK_BICALL)
      return NULL;
    if ((!strcmp(ex->val.s, "printf") &&
       ex->args[0]->kind == EK_CONST) ||
      !strcmp(ex->val.s, "putchar") ||
      !strcmp(ex->val.s, "puts"))
      return ex_output;
    if ((!strcmp(ex->val.s, "fprintf") ||
       !strcmp(ex->val.s, "sprintf")) &&
      ex->args[1]->kind == EK_CONST)
      return ex->args[0];
    if (!strcmp(ex->val.s, "putc") ||
      !strcmp(ex->val.s, "fputc") ||
      !strcmp(ex->val.s, "fputs"))
      return ex->args[1];
    return NULL;
}



int printnl_func(ex)
Expr *ex;
{
    char *cp, ch;
    int i, len;

    if (debug>2) { fprintf(outf,"printnl_func("); dumpexpr(ex); fprintf(outf, ")\n"); }
    if (!strcmp(ex->val.s, "printf") ||
      !strcmp(ex->val.s, "puts") ||
      !strcmp(ex->val.s, "fputs")) {
      if (ex->args[0]->kind != EK_CONST)
          return 0;
      cp = ex->args[0]->val.s;
      len = ex->args[0]->val.i;
    } else if (!strcmp(ex->val.s, "fprintf")) {
      if (ex->args[1]->kind != EK_CONST)
          return 0;
      cp = ex->args[1]->val.s;
      len = ex->args[1]->val.i;
    } else if (!strcmp(ex->val.s, "putchar") ||
             !strcmp(ex->val.s, "putc") ||
             !strcmp(ex->val.s, "fputc")) {
      if (ex->args[0]->kind != EK_CONST)
          return 0;
      ch = ex->args[0]->val.i;
      cp = &ch;
      len = 1;
    } else
      return 0;
    for (i = 1; i <= len; i++)
      if (*cp++ != '\n')
          return 0;
    return len + (!strcmp(ex->val.s, "puts"));
}



Expr *chg_printf(ex)
Expr *ex;
{
    Expr *fex;

    if (debug>2) { fprintf(outf,"chg_printf("); dumpexpr(ex); fprintf(outf, ")\n"); }
    if (!strcmp(ex->val.s, "putchar")) {
      ex = makeexpr_sprintfify(grabarg(ex, 0));
      canceltempvar(istempvar(ex->args[0]));
      strchange(&ex->val.s, "printf");
      delfreearg(&ex, 0);
      ex->val.type = tp_void;
    } else if (!strcmp(ex->val.s, "putc") ||
             !strcmp(ex->val.s, "fputc") ||
             !strcmp(ex->val.s, "fputs")) {
      fex = copyexpr(ex->args[1]);
      ex = makeexpr_sprintfify(grabarg(ex, 0));
      canceltempvar(istempvar(ex->args[0]));
      strchange(&ex->val.s, "fprintf");
      ex->args[0] = fex;
      ex->val.type = tp_void;
    } else if (!strcmp(ex->val.s, "puts")) {
      ex = makeexpr_concat(makeexpr_sprintfify(grabarg(ex, 0)),
                       makeexpr_string("\n"), 1);
      strchange(&ex->val.s, "printf");
      delfreearg(&ex, 0);
      ex->val.type = tp_void;
    }
    if (!strcmp(ex->val.s, "fprintf") && exprsame(ex->args[0], ex_output, 1)) {
      delfreearg(&ex, 0);
      strchange(&ex->val.s, "printf");
    }
    return ex;
}


Expr *mix_printf(ex, ex2)
Expr *ex, *ex2;
{
    int i;

    ex = chg_printf(ex);
    if (debug>2) { fprintf(outf,"chg_printf returns "); dumpexpr(ex); fprintf(outf, "\n"); }
    ex2 = chg_printf(copyexpr(ex2));
    if (debug>2) { fprintf(outf,"chg_printf returns "); dumpexpr(ex2);fprintf(outf, "\n"); }
    i = (!strcmp(ex->val.s, "printf")) ? 0 : 1;
    ex->args[i] = makeexpr_concat(ex->args[i], ex2->args[i], 0);
    for (i++; i < ex2->nargs; i++) {
      insertarg(&ex, ex->nargs, ex2->args[i]);
    }
    return ex;
}






void eatstmt(spp)
Stmt **spp;
{
    Stmt *sp = *spp;

    if (debug>2) { fprintf(outf, "eatstmt on:\n"); dumpstmt(sp, 5); }
    *spp = sp->next;
    sp->next = NULL;
    free_stmt(sp);
}



int haslabels(sp)
Stmt *sp;
{
    if (!sp)
        return 0;
    if (haslabels(sp->stm1) || haslabels(sp->stm2))
        return 1;
    return (sp->kind == SK_LABEL);
}



void fixblock(spp, thereturn)
Stmt **spp, *thereturn;
{
    Stmt *sp, *sp1, *sp2, *sp3, **spp2, *thisreturn;
    Expr *ex;
    Meaning *tvar;
    int save_tryblock;
    short save_tryflag;
    int i, j, de1, de2;
    long saveserial = curserial;

    while ((sp = *spp)) {
        sp2 = sp->next;
        sp->next = NULL;
        sp = fix_statement(*spp);
        if (!sp) {
            *spp = sp2;
            continue;
        }
        *spp = sp;
        for (sp3 = sp; sp3->next; sp3 = sp3->next) ;
        sp3->next = sp2;
        if (!sp->next)
            thisreturn = thereturn;
        else if (sp->next->kind == SK_RETURN ||
                 (sp->next->kind == SK_ASSIGN &&
                  isescape(sp->next->exp1)))
            thisreturn = sp->next;
        else
            thisreturn = NULL;
      if (sp->serial >= 0)
          curserial = sp->serial;
        switch (sp->kind) {

            case SK_ASSIGN:
              if (sp->exp1)
                sp->exp1 = fixexpr(sp->exp1, ENV_STMT);
            if (!sp->exp1)
                intwarning("fixblock", "sp->exp1 == NULL in SK_ASSIGN");
                if (!sp->exp1 || nosideeffects(sp->exp1, 1)) {
                eatstmt(spp);
                continue;
                } else {
                    switch (sp->exp1->kind) {

                        case EK_COND:
                            *spp = makestmt_if(sp->exp1->args[0],
                                               makestmt_call(sp->exp1->args[1]),
                                               makestmt_call(sp->exp1->args[2]));
                            (*spp)->next = sp->next;
                            continue;    /* ... to fix this new if statement */

                        case EK_ASSIGN:
                            if (sp->exp1->args[1]->kind == EK_COND && usecommas != 1) {
                                *spp = makestmt_if(sp->exp1->args[1]->args[0],
                                                   makestmt_assign(copyexpr(sp->exp1->args[0]),
                                                                   sp->exp1->args[1]->args[1]),
                                                   makestmt_assign(sp->exp1->args[0],
                                                                   sp->exp1->args[1]->args[2]));
                                (*spp)->next = sp->next;
                                continue;
                            }
                      if (isescape(sp->exp1->args[1])) {
                                sp->exp1 = grabarg(sp->exp1, 1);
                        continue;
                            }
                      if (exprsame(sp->exp1->args[0], sp->exp1->args[1], 1)) {
                              /*  *spp = sp->next;  */
                                sp->exp1 = grabarg(sp->exp1, 0);
                                continue;
                            }
                      if (sp->exp1->args[1]->kind == EK_BICALL) {
                        if (!strcmp(sp->exp1->args[1]->val.s,
                                  getfbufname) &&
                            buildreads == 1 &&
                            sp->next &&
                            sp->next->kind == SK_ASSIGN &&
                            sp->next->exp1->kind == EK_BICALL &&
                            !strcmp(sp->next->exp1->val.s,
                                  getname) &&
                            expr_has_address(sp->exp1->args[0]) &&
                            similartypes(sp->exp1->args[0]->val.type,
                                     filebasetype(sp->exp1->args[1]->args[0]->val.type)) &&
                            exprsame(sp->exp1->args[1]->args[0],
                                   sp->next->exp1->args[0], 1)) {
                            eatstmt(&sp->next);
                            ex = makeexpr_bicall_4("fread", tp_integer,
                                             makeexpr_addr(sp->exp1->args[0]),
                                             makeexpr_sizeof(sp->exp1->args[1]->args[1], 0),
                                             makeexpr_long(1),
                                             sp->exp1->args[1]->args[0]);
                            FREE(sp->exp1);
                            sp->exp1 = ex;
                            continue;
                        }
                        if (!strcmp(sp->exp1->args[1]->val.s,
                                  chargetfbufname) &&
                            buildreads != 0 &&
                            sp->next &&
                            sp->next->kind == SK_ASSIGN &&
                            sp->next->exp1->kind == EK_BICALL &&
                            !strcmp(sp->next->exp1->val.s,
                                  chargetname) &&
                            expr_has_address(sp->exp1->args[0]) &&
                            exprsame(sp->exp1->args[1]->args[0],
                                   sp->next->exp1->args[0], 1)) {
                            eatstmt(&sp->next);
                            strchange(&sp->exp1->args[1]->val.s,
                                    "getc");
                            continue;
                        }
                      }
                            break;

                        case EK_BICALL:
                            if (!strcmp(sp->exp1->val.s, name_ESCAPE)) {
                                if (fixexpr_tryblock) {
                                    *spp = makestmt_assign(makeexpr_var(mp_escapecode),
                                                           grabarg(sp->exp1, 0));
                                    (*spp)->next = makestmt(SK_GOTO);
                                    (*spp)->next->exp1 = makeexpr_name(format_s(name_LABEL,
                                                                                format_d("try%d",
                                                                                         fixexpr_tryblock)),
                                                                       tp_integer);
                                    (*spp)->next->next = sp->next;
                                    fixexpr_tryflag = 1;
                                    continue;
                                }
                            } else if (!strcmp(sp->exp1->val.s, name_ESCIO)) {
                                if (fixexpr_tryblock) {
                                    *spp = makestmt_assign(makeexpr_var(mp_escapecode),
                                                           makeexpr_long(-10));
                                    (*spp)->next = makestmt_assign(makeexpr_var(mp_ioresult),
                                                                   grabarg(sp->exp1, 0));
                                    (*spp)->next->next = makestmt(SK_GOTO);
                                    (*spp)->next->next->exp1 = makeexpr_name(format_s(name_LABEL,
                                                                                      format_d("try%d",
                                                                                               fixexpr_tryblock)),
                                                                             tp_integer);
                                    (*spp)->next->next->next = sp->next;
                                    fixexpr_tryflag = 1;
                                    continue;
                                }
                            }
                      if (!strcmp(sp->exp1->val.s, putfbufname) &&
                        buildwrites == 1 &&
                        sp->next &&
                        sp->next->kind == SK_ASSIGN &&
                        sp->next->exp1->kind == EK_BICALL &&
                        !strcmp(sp->next->exp1->val.s,
                              putname) &&
                        exprsame(sp->exp1->args[0],
                               sp->next->exp1->args[0], 1)) {
                        eatstmt(&sp->next);
                        if (!expr_has_address(sp->exp1->args[2]) ||
                            sp->exp1->args[2]->val.type !=
                                sp->exp1->args[1]->val.type) {
                            tvar = maketempvar(sp->exp1->args[1]->val.type,
                                             name_TEMP);
                            sp2 = makestmt_assign(makeexpr_var(tvar),
                                            sp->exp1->args[2]);
                            sp2->next = sp;
                            *spp = sp2;
                            sp->exp1->args[2] = makeexpr_var(tvar);
                            freetempvar(tvar);
                        }
                        ex = makeexpr_bicall_4("fwrite", tp_integer,
                                           makeexpr_addr(sp->exp1->args[2]),
                                           makeexpr_sizeof(sp->exp1->args[1], 0),
                                           makeexpr_long(1),
                                           sp->exp1->args[0]);
                        FREE(sp->exp1);
                        sp->exp1 = ex;
                        continue;
                      }
                      if (!strcmp(sp->exp1->val.s, charputfbufname) &&
                        buildwrites != 0 &&
                        sp->next &&
                        sp->next->kind == SK_ASSIGN &&
                        sp->next->exp1->kind == EK_BICALL &&
                        !strcmp(sp->next->exp1->val.s,
                              charputname) &&
                        exprsame(sp->exp1->args[0],
                               sp->next->exp1->args[0], 1)) {
                        eatstmt(&sp->next);
                        swapexprs(sp->exp1->args[0],
                                sp->exp1->args[1]);
                        strchange(&sp->exp1->val.s, "putc");
                        continue;
                      }
                      if ((!strcmp(sp->exp1->val.s, resetbufname) ||
                         !strcmp(sp->exp1->val.s, setupbufname)) &&
                        !fileisbuffered(sp->exp1->args[0], 0)) {
                        eatstmt(spp);
                        continue;
                      }
                      ex = print_func(sp->exp1);
                      if (ex && sp->next && mixwritelns &&
                        sp->next->kind == SK_ASSIGN &&
                        exprsame(ex, print_func(sp->next->exp1), 1) &&
                        (printnl_func(sp->exp1) ||
                         printnl_func(sp->next->exp1))) {
                        sp->exp1 = mix_printf(sp->exp1,
                                          sp->next->exp1);
                        eatstmt(&sp->next);
                        continue;
                      }
                            break;

                        case EK_FUNCTION:
                        case EK_SPCALL:
                        case EK_POSTINC:
                        case EK_POSTDEC:
                        case EK_AND:
                        case EK_OR:
                            break;

                        default:
                            spp2 = spp;
                            for (i = 0; i < sp->exp1->nargs; i++) {
                                *spp2 = makestmt_call(sp->exp1->args[i]);
                                spp2 = &(*spp2)->next;
                            }
                            *spp2 = sp->next;
                            continue;    /* ... to fix these new statements */

                    }
                }
                break;

            case SK_IF:
                fixblock(&sp->stm1, thisreturn);
                fixblock(&sp->stm2, thisreturn);
                if (!sp->stm1) {
                    if (!sp->stm2) {
                        sp->kind = SK_ASSIGN;
                        continue;
                    } else {
                  if (sp->stm2->kind == SK_IF && sp->stm2->exp2) {
                      freeexpr(sp->stm2->exp2);
                      sp->stm2->exp2 = NULL;
                  }
                        sp->exp1 = makeexpr_not(sp->exp1);   /* if (x) else foo  =>  if (!x) foo */
                        swapstmts(sp->stm1, sp->stm2);
                  /* Ought to exchange comments for then/else parts */
                    }
                }
            /* At this point we know sp1 != NULL */
                if (thisreturn) {
                    if (thisreturn->kind == SK_WHILE) {
                        if (usebreaks) {
                            sp1 = sp->stm1;
                            while (sp1->next)
                                sp1 = sp1->next;
                            if (sp->stm2) {
                        sp2 = sp->stm2;
                        while (sp2->next)
                            sp2 = sp2->next;
                                i = stmtcount(sp->stm1);
                                j = stmtcount(sp->stm2);
                                if (j >= breaklimit && i <= 2 && j > i*2 &&
                                    ((implies(sp->exp1, thisreturn->exp1, 0, 1) &&
                              !checkexprchanged(sp->stm1, sp->exp1)) ||
                             (sp1->kind == SK_ASSIGN &&
                              implies(sp1->exp1, thisreturn->exp1, 0, 1)))) {
                                    sp1->next = makestmt(SK_BREAK);
                                } else if (i >= breaklimit && j <= 2 && i > j*2 &&
                                           ((implies(sp->exp1, thisreturn->exp1, 1, 1) &&
                                   !checkexprchanged(sp->stm2, sp->exp1)) ||
                                  (sp2->kind == SK_ASSIGN &&
                                   implies(sp2->exp1, thisreturn->exp1, 0, 1)))) {
                                    sp2->next = makestmt(SK_BREAK);
                        } else if (!checkconst(sp->exp2, 1)) {
                            /* not part of an else-if */
                            if (j >= continuelimit) {
                              sp1->next = makestmt(SK_CONTINUE);
                            } else if (i >= continuelimit) {
                              sp2->next = makestmt(SK_CONTINUE);
                            }
                        }
                      } else {
                                i = stmtcount(sp->stm1);
                                if (i >= breaklimit &&
                                    implies(sp->exp1, thisreturn->exp1, 1, 1)) {
                                    sp->exp1 = makeexpr_not(sp->exp1);
                                    sp1->next = sp->next;
                                    sp->next = sp->stm1;
                                    sp->stm1 = makestmt(SK_BREAK);
                                } else if (i >= continuelimit) {
                                    sp->exp1 = makeexpr_not(sp->exp1);
                                    sp1->next = sp->next;
                                    sp->next = sp->stm1;
                                    sp->stm1 = makestmt(SK_CONTINUE);
                                }
                            }
                        }
                    } else {
                        if (usereturns) {
                            sp2 = sp->stm1;
                            while (sp2->next)
                                sp2 = sp2->next;
                            if (sp->stm2) {
                                /* if (x) foo; else bar; (return;)  =>  if (x) {foo; return;} bar; */
                                if (stmtcount(sp->stm2) >= returnlimit) {
                            if (!deadendblock(sp->stm1))
                              sp2->next = copystmt(thisreturn);
                                } else if (stmtcount(sp->stm1) >= returnlimit) {
                                    sp2 = sp->stm2;
                                    while (sp2->next)
                                        sp2 = sp2->next;
                            if (!deadendblock(sp->stm2))
                              sp2->next = copystmt(thisreturn);
                                }
                            } else {      /* if (x) foo; (return;)  =>  if (!x) return; foo; */
                                if (stmtcount(sp->stm1) >= returnlimit) {
                                    sp->exp1 = makeexpr_not(sp->exp1);
                                    sp2->next = sp->next;
                                    sp->next = sp->stm1;
                                    sp->stm1 = copystmt(thisreturn);
                                }
                            }
                        }
                    }
                }
                if (!checkconst(sp->exp2, 1)) {    /* not part of an else-if */
                    de1 = deadendblock(sp->stm1);
                    de2 = deadendblock(sp->stm2);
                    if (de2 && !de1) {
                        sp->exp1 = makeexpr_not(sp->exp1);
                        swapstmts(sp->stm1, sp->stm2);
                        de1 = 1, de2 = 0;
                    }
                    if (de1 && !de2 && sp->stm2) {
                  if (sp->stm2->kind == SK_IF && sp->stm2->exp2) {
                      freeexpr(sp->stm2->exp2);
                      sp->stm2->exp2 = NULL;
                  }
                        for (sp2 = sp->stm2; sp2->next; sp2 = sp2->next) ;
                        sp2->next = sp->next;
                        sp->next = sp->stm2;      /* if (x) ESCAPE else foo  =>  if (x) ESCAPE; foo */
                        sp->stm2 = NULL;
                    }
                }
                sp->exp1 = fixexpr(sp->exp1, ENV_BOOL);
            if (elimdeadcode > 1 && checkconst(sp->exp1, 0)) {
                note("Eliminated \"if false\" statement [326]");
                splicestmt(sp, sp->stm2);
                continue;
            } else if (elimdeadcode > 1 && checkconst(sp->exp1, 1)) {
                note("Eliminated \"if true\" statement [327]");
                splicestmt(sp, sp->stm1);
                continue;
            }
                break;

            case SK_WHILE:
                if (whilefgets &&    /* handle "while eof(f) do readln(f,...)" */
                sp->stm1 &&
                sp->stm1->kind == SK_ASSIGN &&
                sp->stm1->exp1->kind == EK_BICALL &&
                !strcmp(sp->stm1->exp1->val.s, "fgets") &&
                nosideeffects(sp->stm1->exp1->args[0], 1) &&
                nosideeffects(sp->stm1->exp1->args[1], 1) &&
                nosideeffects(sp->stm1->exp1->args[2], 1)) {
                if ((sp->exp1->kind == EK_NOT &&
                   sp->exp1->args[0]->kind == EK_BICALL && *eofname &&
                   !strcmp(sp->exp1->args[0]->val.s, eofname) &&
                   exprsame(sp->exp1->args[0]->args[0],
                          sp->stm1->exp1->args[2], 1)) ||
                  (sp->exp1->kind == EK_EQ &&
                   sp->exp1->args[0]->kind == EK_BICALL &&
                   !strcmp(sp->exp1->args[0]->val.s, "feof") &&
                   checkconst(sp->exp1->args[1], 0) &&
                   exprsame(sp->exp1->args[0]->args[0],
                          sp->stm1->exp1->args[2], 1))) {
                  sp->stm1->exp1->val.type = tp_strptr;
                  sp->exp1 = makeexpr_rel(EK_NE,
                                    sp->stm1->exp1,
                                    makeexpr_nil());
                  sp->stm1 = sp->stm1->next;
                }
                }
                fixblock(&sp->stm1, sp);
                sp->exp1 = fixexpr(sp->exp1, ENV_BOOL);
                if (checkconst(sp->exp1, 1))
                    infiniteloop(sp);
                break;

            case SK_REPEAT:
                fixblock(&sp->stm1, NULL);
                sp->exp1 = fixexpr(sp->exp1, ENV_BOOL);
                if (checkconst(sp->exp1, 1))
                    infiniteloop(sp);
                break;

            case SK_TRY:
                save_tryblock = fixexpr_tryblock;
                save_tryflag = fixexpr_tryflag;
                fixexpr_tryblock = sp->exp1->val.i;
                fixexpr_tryflag = 0;
                fixblock(&sp->stm1, NULL);
                if (fixexpr_tryflag)
                    sp->exp2 = makeexpr_long(1);
                fixexpr_tryblock = save_tryblock;
                fixexpr_tryflag = save_tryflag;
                fixblock(&sp->stm2, NULL);
                break;

            case SK_BODY:
                fixblock(&sp->stm1, thisreturn);
                break;

            case SK_CASE:
                fixblock(&sp->stm1, NULL);
                sp->exp1 = fixexpr(sp->exp1, ENV_EXPR);
                if (!sp->stm1) {    /* empty case */
                    sp->kind = SK_ASSIGN;
                    continue;
                } else if (sp->stm1->kind != SK_CASELABEL) {   /* default only */
                    for (sp2 = sp->stm1; sp2->next; sp2 = sp2->next) ;
                    sp2->next = sp->next;
                    sp->next = sp->stm1;
                    sp->kind = SK_ASSIGN;
                    sp->stm1 = NULL;
                    continue;
                }
                break;

            default:
                fixblock(&sp->stm1, NULL);
                fixblock(&sp->stm2, NULL);
                sp->exp1 = fixexpr(sp->exp1, ENV_EXPR);
                sp->exp2 = fixexpr(sp->exp2, ENV_EXPR);
                sp->exp3 = fixexpr(sp->exp3, ENV_EXPR);
                if (sp->next &&
                    (sp->kind == SK_GOTO ||
                     sp->kind == SK_BREAK ||
                     sp->kind == SK_CONTINUE ||
                     sp->kind == SK_RETURN) &&
                    !haslabels(sp->next)) {
                    if (elimdeadcode) {
                        note("Deleting unreachable code [255]");
                        while (sp->next && !haslabels(sp->next))
                            eatstmt(&sp->next);
                    } else {
                        note("Code is unreachable [256]");
                    }
                } else if (sp->kind == SK_RETURN &&
                           thisreturn &&
                           thisreturn->kind == SK_RETURN &&
                           exprsame(sp->exp1, thisreturn->exp1, 1)) {
                    eatstmt(spp);
                continue;
                }
                break;
        }
        spp = &sp->next;
    }
    saveserial = curserial;
}




/* Convert comma expressions into multiple statements */

Static int checkcomma_expr(spp, exp)
Stmt **spp;
Expr **exp;
{
    Stmt *sp;
    Expr *ex = *exp;
    int i, res;

    switch (ex->kind) {

        case EK_COMMA:
            if (spp) {
                res = checkcomma_expr(spp, &ex->args[ex->nargs-1]);
                for (i = ex->nargs-1; --i >= 0; ) {
                    sp = makestmt(SK_ASSIGN);
                    sp->exp1 = ex->args[i];
                    sp->next = *spp;
                    *spp = sp;
                    res = checkcomma_expr(spp, &ex->args[i]);
                }
                *exp = ex->args[ex->nargs-1];
            }
            return 1;

        case EK_COND:
            if (isescape(ex->args[1]) && spp &&
                !isescape(ex->args[2])) {
                swapexprs(ex->args[1], ex->args[2]);
                ex->args[0] = makeexpr_not(ex->args[0]);
            }
            if (isescape(ex->args[2])) {
                if (spp) {
                    res = checkcomma_expr(spp, &ex->args[1]);
                    if (ex->args[0]->kind == EK_ASSIGN) {
                        sp = makestmt(SK_ASSIGN);
                        sp->exp1 = copyexpr(ex->args[0]);
                        sp->next = makestmt(SK_IF);
                        sp->next->next = *spp;
                        *spp = sp;
                        res = checkcomma_expr(spp, &sp->exp1);
                        ex->args[0] = grabarg(ex->args[0], 0);
                        sp = sp->next;
                    } else {
                        sp = makestmt(SK_IF);
                        sp->next = *spp;
                        *spp = sp;
                    }
                    sp->exp1 = makeexpr_not(ex->args[0]);
                    sp->stm1 = makestmt(SK_ASSIGN);
                    sp->stm1->exp1 = eatcasts(ex->args[2]);
                    res = checkcomma_expr(&sp->stm1, &ex->args[2]);
                    res = checkcomma_expr(spp, &sp->exp1);
                    *exp = ex->args[1];
                }
                return 1;
            }
            return checkcomma_expr(spp, &ex->args[0]);

        case EK_AND:
        case EK_OR:
            return checkcomma_expr(spp, &ex->args[0]);

      default:
          res = 0;
          for (i = ex->nargs; --i >= 0; ) {
            res += checkcomma_expr(spp, &ex->args[i]);
          }
          return res;

    }
}



Static void checkcommas(spp)
Stmt **spp;
{
    Stmt *sp;
    int res;

    while ((sp = *spp)) {
        checkcommas(&sp->stm1);
        checkcommas(&sp->stm2);
        switch (sp->kind) {

            case SK_ASSIGN:
            case SK_IF:
            case SK_CASE:
            case SK_RETURN:
                if (sp->exp1)
                    res = checkcomma_expr(spp, &sp->exp1);
                break;

            case SK_WHILE:
                /* handle the argument */
                break;

            case SK_REPEAT:
                /* handle the argument */
                break;

            case SK_FOR:
            if (sp->exp1)
                res = checkcomma_expr(spp, &sp->exp1);
                /* handle the other arguments */
                break;

          default:
            break;
        }
        spp = &sp->next;
    }
}




Static int checkvarchangeable(ex, mp)
Expr *ex;
Meaning *mp;
{
    switch (ex->kind) {

        case EK_VAR:
            return (mp == (Meaning *)ex->val.i);

        case EK_DOT:
        case EK_INDEX:
            return checkvarchangeable(ex->args[0], mp);

      default:
          return 0;
    }
}



int checkvarchangedexpr(ex, mp, addrokay)
Expr *ex;
Meaning *mp;
int addrokay;
{
    int i;
    Meaning *mp3;
    unsigned int safemask = 0;

    switch (ex->kind) {

        case EK_FUNCTION:
        case EK_SPCALL:
            if (ex->kind == EK_FUNCTION) {
                i = 0;
                mp3 = ((Meaning *)ex->val.i)->type->fbase;
            } else {
                i = 1;
                if (ex->args[0]->val.type->kind != TK_PROCPTR)
                    return 1;
                mp3 = ex->args[0]->val.type->basetype->fbase;
            }
            for ( ; i < ex->nargs && i < 16; i++) {
                if (!mp3) {
                    intwarning("checkvarchangedexpr", "Too many arguments for EK_FUNCTION [266]");
                    break;
                }
                if (mp3->kind == MK_PARAM &&
                    (mp3->type->kind == TK_ARRAY ||
                     mp3->type->kind == TK_STRING ||
                     mp3->type->kind == TK_SET))
                    safemask |= 1<<i;
                if (mp3->kind == MK_VARPARAM &&
                    mp3->type == tp_strptr && mp3->anyvarflag)
                    i++;
                mp3 = mp3->xnext;
            }
            if (mp3)
                intwarning("checkvarchangedexpr", "Too few arguments for EK_FUNCTION [267]");
            break;

        case EK_VAR:
            if (mp == (Meaning *)ex->val.i) {
                if ((mp->type->kind == TK_ARRAY ||
                     mp->type->kind == TK_STRING ||
                     mp->type->kind == TK_SET) &&
                    ex->val.type->kind == TK_POINTER && !addrokay)
                    return 1;   /* must be an implicit & */
            }
            break;

        case EK_ADDR:
        case EK_ASSIGN:
        case EK_POSTINC:
        case EK_POSTDEC:
            if (checkvarchangeable(ex->args[0], mp))
                return 1;
            break;

        case EK_BICALL:
            if (structuredfunc(ex) && checkvarchangeable(ex->args[0], mp))
                return 1;
            safemask = safemask_bicall(ex->val.s);
            break;
            /* In case calls to these functions were lazy and passed
               the array rather than its (implicit) address.  Other
               BICALLs had better be careful about their arguments. */

        case EK_PLUS:
            if (addrokay)         /* to keep from being scared by pointer */
                safemask = ~0;    /*  arithmetic on string being passed */
            break;                /*  to functions. */

      default:
          break;
    }
    for (i = 0; i < ex->nargs; i++) {
        if (checkvarchangedexpr(ex->args[i], mp, safemask&1))
            return 1;
        safemask >>= 1;
    }
    return 0;
}



int checkvarchanged(sp, mp)
Stmt *sp;
Meaning *mp;
{
    if (mp->constqual)
      return 0;
    if (mp->varstructflag || !mp->ctx || mp->ctx->kind != MK_FUNCTION ||
        mp->volatilequal || alwayscopyvalues)
        return 1;
    while (sp) {
        if (/* sp->kind == SK_GOTO || */
          sp->kind == SK_LABEL ||
            checkvarchanged(sp->stm1, mp) ||
            checkvarchanged(sp->stm2, mp) ||
            (sp->exp1 && checkvarchangedexpr(sp->exp1, mp, 1)) ||
            (sp->exp2 && checkvarchangedexpr(sp->exp2, mp, 1)) ||
            (sp->exp3 && checkvarchangedexpr(sp->exp3, mp, 1)))
            return 1;
        sp = sp->next;
    }
    return 0;
}



int checkexprchanged(sp, ex)
Stmt *sp;
Expr *ex;
{
    Meaning *mp;
    int i;

    for (i = 0; i < ex->nargs; i++) {
        if (checkexprchanged(sp, ex->args[i]))
            return 1;
    }
    switch (ex->kind) {

        case EK_VAR:
            mp = (Meaning *)ex->val.i;
            if (mp->kind == MK_CONST)
                return 0;
            else
                return checkvarchanged(sp, mp);

        case EK_HAT:
        case EK_INDEX:
        case EK_SPCALL:
            return 1;

        case EK_FUNCTION:
        case EK_BICALL:
            return !nosideeffects_func(ex);

      default:
          return 0;
    }
}





/* Check if a variable always occurs with a certain offset added, e.g. "i+1" */

Static int theoffset, numoffsets, numzerooffsets;
#define BadOffset  (-999)

void checkvaroffsetexpr(ex, mp, myoffset)
Expr *ex;
Meaning *mp;
int myoffset;
{
    int i, nextoffset = 0;
    Expr *ex2;

    if (!ex)
      return;
    switch (ex->kind) {

      case EK_VAR:
      if (ex->val.i == (long)mp) {
          if (myoffset == 0)
            numzerooffsets++;
          else if (numoffsets == 0 || myoffset == theoffset) {
            theoffset = myoffset;
            numoffsets++;
          } else
            theoffset = BadOffset;
      }
      break;

      case EK_PLUS:
      ex2 = ex->args[ex->nargs-1];
      if (ex2->kind == EK_CONST &&
          ex2->val.type->kind == TK_INTEGER) {
          nextoffset = ex2->val.i;
      }
      break;

      case EK_HAT:
      case EK_POSTINC:
      case EK_POSTDEC:
      nextoffset = BadOffset;
      break;

      case EK_ASSIGN:
      checkvaroffsetexpr(ex->args[0], mp, BadOffset);
      checkvaroffsetexpr(ex->args[1], mp, 0);
      return;

      default:
      break;
    }
    i = ex->nargs;
    while (--i >= 0)
      checkvaroffsetexpr(ex->args[i], mp, nextoffset);
}


void checkvaroffsetstmt(sp, mp)
Stmt *sp;
Meaning *mp;
{
    while (sp) {
      checkvaroffsetstmt(sp->stm1, mp);
      checkvaroffsetstmt(sp->stm1, mp);
      checkvaroffsetexpr(sp->exp1, mp, 0);
      checkvaroffsetexpr(sp->exp2, mp, 0);
      checkvaroffsetexpr(sp->exp3, mp, 0);
      sp = sp->next;
    }
}


int checkvaroffset(sp, mp)
Stmt *sp;
Meaning *mp;
{
    if (mp->varstructflag || !mp->ctx || mp->ctx->kind != MK_FUNCTION)
      return 0;
    numoffsets = 0;
    numzerooffsets = 0;
    checkvaroffsetstmt(sp, mp);
    if (numoffsets == 0 || theoffset == BadOffset ||
      numoffsets <= numzerooffsets * 3)
      return 0;
    else
      return theoffset;
}




Expr *initfilevar(ex)
Expr *ex;
{
    Expr *ex2;
    Meaning *mp;
    char *name;

    if (ex->val.type->kind == TK_BIGFILE) {
      ex2 = copyexpr(ex);
      if (ex->kind == EK_VAR &&
          (mp = (Meaning *)ex->val.i)->kind == MK_VAR &&
          mp->ctx->kind != MK_FUNCTION &&
          !is_std_file(ex) &&
          literalfilesflag > 0 &&
          (literalfilesflag == 1 ||
           strlist_cifind(literalfiles, mp->name)))
          name = mp->name;
      else
          name = "";
      return makeexpr_comma(makeexpr_assign(filebasename(ex),
                                    makeexpr_nil()),
                        makeexpr_assign(makeexpr_dotq(ex2, "name",
                                              tp_str255),
                                    makeexpr_string(name)));
    } else {
      return makeexpr_assign(ex, makeexpr_nil());
    }
}


void initfilevars(mp, sppp, exbase)
Meaning *mp;
Stmt ***sppp;
Expr *exbase;
{
    Stmt *sp;
    Type *tp;
    Expr *ex;

    while (mp) {
      if ((mp->kind == MK_VAR && mp->refcount > 0 && !mp->istemporary) ||
          mp->kind == MK_FIELD) {
          tp = mp->type;
          if (isfiletype(tp, -1)) {
            mp->refcount++;
            sp = makestmt(SK_ASSIGN);
            sp->next = **sppp;
            **sppp = sp;
            if (exbase)
                ex = makeexpr_dot(copyexpr(exbase), mp);
            else
                ex = makeexpr_var(mp);
            sp->exp1 = initfilevar(copyexpr(ex));
          } else if (tp->kind == TK_RECORD) {
            if (exbase)
                ex = makeexpr_dot(copyexpr(exbase), mp);
            else
                ex = makeexpr_var(mp);
            initfilevars(tp->fbase, sppp, ex);
            freeexpr(ex);
          } else if (tp->kind == TK_ARRAY) {
            while (tp->kind == TK_ARRAY)
                tp = tp->basetype;
            if (isfiletype(tp, -1))
                note(format_s("Array of files %s should be initialized [257]",
                          mp->name));
          }
      }
      mp = mp->cnext;
    }
}





Static Stmt *p_body()
{
    Stmt *sp, **spp, *spbody, **sppbody, *spbase, *thereturn;
    Meaning *mp;
    Expr *ex;
    int haspostamble;
    long saveserial;

    if (verbose)
      fprintf(logfile, "%s, %d/%d: Translating %s (in %s)\n",
            infname, inf_lnum, outf_lnum,
            curctx->name, curctx->ctx->name);
    notephase = 1;
    spp = &spbase;
    addstmt(SK_HEADER);
    sp->exp1 = makeexpr_var(curctx);
    checkkeyword(TOK_INLINE);
    if (curtok != TOK_END && curtok != TOK_BEGIN && curtok != TOK_INLINE) {
      if (curctx->kind == MK_FUNCTION || curctx->anyvarflag)
          wexpecttok(TOK_BEGIN);
      else
          wexpecttok(TOK_END);
      skiptotoken2(TOK_BEGIN, TOK_END);
    }
    if (curtok == TOK_END) {
      gettok();
      spbody = NULL;
    } else {
      spbody = p_stmt(NULL, SF_FUNC);  /* parse the procedure/program body */
    }
    if (curtok == TOK_IDENT && curtokmeaning == curctx) {
      gettok();    /* Modula-2 */
    }
    notephase = 2;
    saveserial = curserial;
    curserial = 10000;
    if (curctx->kind == MK_FUNCTION) {     /* handle copy parameters */
        for (mp = curctx->type->fbase; mp; mp = mp->xnext) {
            if (!mp->othername && mp->varstructflag) {
                mp->othername = stralloc(format_s(name_COPYPAR, mp->name));
                mp->rectype = mp->type;
                addstmt(SK_ASSIGN);
                sp->exp1 = makeexpr_assign(makeexpr_var(mp), 
                                           makeexpr_name(mp->othername, mp->rectype));
                mp->refcount++;
            } else if (mp->othername) {
                if (checkvarchanged(spbody, mp)) {
                    addstmt(SK_ASSIGN);
                    sp->exp1 = makeexpr_assign(makeexpr_var(mp),
                                               makeexpr_hat(makeexpr_name(mp->othername,
                                                                          mp->rectype), 0));
                    mp->refcount++;
                } else {           /* don't need to copy it after all */
                    strchange(&mp->othername, mp->name);
                    ex = makeexpr_var(mp);
                    ex->val.type = mp->rectype;
                    replaceexpr(spbody, makeexpr_var(mp), makeexpr_hat(ex, 0));
                }
            }
        }
    }
    for (mp = curctx->cbase; mp; mp = mp->cnext) {
      if (mp->kind == MK_LABEL && mp->val.i) {
          addstmt(SK_IF);
          sp->exp1 = makeexpr_bicall_1("setjmp", tp_int,
                               makeexpr_var(mp->xnext));
          sp->stm1 = makestmt(SK_GOTO);
          sp->stm1->exp1 = makeexpr_name(format_s(name_LABEL, mp->name),
                                 tp_integer);
      }
    }
    *spp = spbody;
    sppbody = spp;
    while (*spp)
        spp = &((*spp)->next);
    haspostamble = 0;
    initfilevars(curctx->cbase, &sppbody, NULL);
    for (mp = curctx->cbase; mp; mp = mp->cnext) {
        if (mp->kind == MK_VAR && mp->refcount > 0 &&
          isfiletype(mp->type, -1) &&
          !mp->istemporary) {
            if (curctx->kind != MK_MODULE || curctx->anyvarflag) {
                addstmt(SK_IF);                    /* close file variables */
                sp->exp1 = makeexpr_rel(EK_NE, filebasename(makeexpr_var(mp)),
                              makeexpr_nil());
                sp->stm1 = makestmt(SK_ASSIGN);
                sp->stm1->exp1 = makeexpr_bicall_1("fclose", tp_void,
                                       filebasename(makeexpr_var(mp)));
            }
            haspostamble = 1;
        }
    }
    thereturn = &bogusreturn;
    if (curctx->kind == MK_FUNCTION && curctx->type->basetype != tp_void) {
        if ((haspostamble || !checkreturns(&spbase, 1)) &&
            curctx->cbase->refcount > 0) {      /* add function return code */
            addstmt(SK_RETURN);
            sp->exp1 = makeexpr_var(curctx->cbase);
        }
        thereturn = NULL;
    } else if (curctx->kind == MK_MODULE && curctx->anyvarflag) {
        addstmt(SK_ASSIGN);
        sp->exp1 = makeexpr_bicall_1("exit", tp_void,
                             makeexpr_name("EXIT_SUCCESS",
                                       tp_integer));
        thereturn = NULL;
    }
    if (debug>2) { fprintf(outf, "calling fixblock/usecommas on:\n"); dumpstmt(spbase, 5); }
    curserial = saveserial;
    sp = makestmt(SK_BODY);
    sp->stm1 = spbase;
    fixblock(&sp, thereturn);           /* finishing touches to statements and expressions */
    spbase = sp->stm1;
    FREE(sp);
    if (usecommas != 1)
        checkcommas(&spbase);    /* unroll ugly EK_COMMA and EK_COND expressions */
    if (debug>1) { fprintf(outf, "p_body returns:\n"); dumpstmt(spbase, 5); }
    notephase = 0;
    return spbase;
}




#define checkWord()  if (anywords) output(" "); anywords = 1

Static void out_function(func)
Meaning *func;
{
    Meaning *mp;
    Symbol *sym;
    int opts, anywords, spacing, saveindent;

    if (func->varstructflag) {
        makevarstruct(func);
    }
    if (collectnest) {
      for (mp = func->cbase; mp; mp = mp->cnext) {
          if (mp->kind == MK_FUNCTION && mp->isforward) {
            forward_decl(mp, 0);
          }
      }
      for (mp = func->cbase; mp; mp = mp->cnext) {
          if (mp->kind == MK_FUNCTION && mp->type && !mp->exported) {
            pushctx(mp);
            out_function(mp);    /* generate the sub-procedures first */
            popctx();
          }
      }
    }
    spacing = functionspace;
    for (mp = func; mp->ctx->kind == MK_FUNCTION; mp = mp->ctx) {
        if (spacing > minfuncspace)
            spacing--;
    }
    outsection(spacing);
    flushcomments(&func->comments, -1, 0);
    if (usePPMacros == 1) {
        forward_decl(func, 0);
        outsection(minorspace);
    }
    opts = ODECL_HEADER;
    anywords = 0;
    if (func->namedfile) {
      checkWord();
      if (useAnyptrMacros || ansiC < 2)
          output("Inline");
      else
          output("inline");
    }
    if (!func->exported) {
      if (func->ctx->kind == MK_FUNCTION) {
          if (useAnyptrMacros) {
            checkWord();
            output("Local");
          } else if (use_static) {
            checkWord();
            output("static");
          }
      } else if ((findsymbol(func->name)->flags & NEEDSTATIC) ||
               (use_static != 0 && !useAnyptrMacros)) {
          checkWord();
          output("static");
      } else if (useAnyptrMacros) {
          checkWord();
          output("Static");
      }
    }
    if (func->type->basetype != tp_void || ansiC != 0) {
      checkWord();
        outbasetype(func->type, 0);
    }
    if (anywords) {
        if (newlinefunctions)
            opts |= ODECL_FUNCTION;
        else
            output(" ");
    }
    outdeclarator(func->type, func->name, opts);
    if (fullprototyping == 0) {
      saveindent = outindent;
      moreindent(argindent);
        out_argdecls(func->type);
      outindent = saveindent;
    }
    for (mp = func->type->fbase; mp; mp = mp->xnext) {
        if (mp->othername && strcmp(mp->name, mp->othername))
            mp->wasdeclared = 0;    /* make sure we also declare the copy */
    }
    func->wasdeclared = 1;
    outcontext = func;
    out_block((Stmt *)func->val.i, BR_FUNCTION, 10000);
    if (useundef) {
      anywords = 0;
      for (mp = func->cbase; mp; mp = mp->cnext) {
          if (mp->kind == MK_CONST &&
            mp->isreturn) {    /* the was-#defined flag */
            if (!anywords)
                outsection(minorspace);
            anywords++;
            output(format_s("#undef %s\n", mp->name));
            sym = findsymbol(mp->name);
            sym->flags &= ~AVOIDNAME;
          }
      }
    }
    if (conserve_mem) {
      free_stmt((Stmt *)func->val.i);   /* is this safe? */
      func->val.i = 0;
      forget_ctx(func, 0);
    }
    outsection(spacing);
}




void movetoend(mp)
Meaning *mp;
{
    Meaning **mpp;

    if (mp->ctx != curctx) {
        intwarning("movetoend", "curctx is wrong [268]");
    } else {
        mpp = &mp->ctx->cbase;     /* move a meaning to end of its parent context */
        while (*mpp != mp) {
          if (!*mpp) {
            intwarning("movetoend", "meaning not on its context list [269]");
            return;
          }
            mpp = &(*mpp)->cnext;
      }
        *mpp = mp->cnext;    /* Remove from present position in list */
        while (*mpp)
            mpp = &(*mpp)->cnext;
        *mpp = mp;           /* Insert at end of list */
        mp->cnext = NULL;
        curctxlast = mp;
    }
}



Static void scanfwdparams(mp)
Meaning *mp;
{
    Symbol *sym;

    mp = mp->type->fbase;
    while (mp) {
      sym = findsymbol(mp->name);
      sym->flags |= FWDPARAM;
      mp = mp->xnext;
    }
}



Static void p_function(isfunc)
int isfunc;
{
    Meaning *func;
    Type *type;
    Stmt *sp;
    Strlist *sl, *comments, *savecmt;
    int initializeattr = 0, isinline = 0;

    if ((sl = strlist_find(attrlist, "INITIALIZE")) != NULL) {
      initializeattr = 1;
      strlist_delete(&attrlist, sl);
    }
    if ((sl = strlist_find(attrlist, "OPTIMIZE")) != NULL &&
      sl->value != -1 &&
      !strcmp((char *)(sl->value), "INLINE")) {
      isinline = 1;
      strlist_delete(&attrlist, sl);
    }
    ignore_attributes();
    comments = extractcomment(&curcomments, -1, curserial);
    changecomments(comments, -1, -1, -1, 0);
    if (curctx->kind == MK_FUNCTION) {    /* sub-procedure */
      savecmt = curcomments;
    } else {
      savecmt = NULL;
      flushcomments(&curcomments, -1, -1);
    }
    curcomments = comments;
    curserial = serialcount = 1;
    gettok();
    if (!wexpecttok(TOK_IDENT))
      skiptotoken(TOK_IDENT);
    if (curtokmeaning && curtokmeaning->ctx == curctx &&
        curtokmeaning->kind == MK_FUNCTION) {
        func = curtokmeaning;
        if (!func->isforward || func->val.i)
            warning(format_s("Redeclaration of function %s [270]", func->name));
      skiptotoken(TOK_SEMI);
        movetoend(func);
        pushctx(func);
        type = func->type;
    } else {
        func = addmeaning(curtoksym, MK_FUNCTION);
        gettok();
        func->val.i = 0;
        pushctx(func);
        func->type = type = p_funcdecl(&isfunc, 0);
        func->isfunction = isfunc;
      func->namedfile = isinline;
        type->meaning = func;
    }
    if (blockkind == TOK_EXPORT)
      flushcomments(NULL, -1, -1);
    wneedtok(TOK_SEMI);
    if (initializeattr) {
      sl = strlist_append(&initialcalls, format_s("%s()", func->name));
      sl->value = 1;
    }
    if (curtok == TOK_IDENT && !strcmp(curtokbuf, "C")) {
      gettok();
      wneedtok(TOK_SEMI);
    }
    if (blockkind == TOK_IMPORT) {
      strlist_empty(&curcomments);
      if (curtok == TOK_IDENT &&
          (!strcicmp(curtokbuf, "FORWARD") ||
           strlist_cifind(externwords, curtokbuf) ||
           strlist_cifind(cexternwords, curtokbuf))) {
          gettok();
          while (curtok == TOK_IDENT)
            gettok();
          wneedtok(TOK_SEMI);
      }
        /* do nothing more */
    } else if (blockkind == TOK_EXPORT) {
        func->isforward = 1;
      scanfwdparams(func);
        forward_decl(func, 1);
    } else {
      checkkeyword(TOK_INTERRUPT);
      checkkeyword(TOK_INLINE);
        if (curtok == TOK_INTERRUPT) {
            note("Ignoring INTERRUPT keyword [258]");
            gettok();
            wneedtok(TOK_SEMI);
        }
        if (curtok == TOK_IDENT && !strcicmp(curtokbuf, "FORWARD")) {
            func->isforward = 1;
          scanfwdparams(func);
            gettok();
            if (func->ctx->kind != MK_FUNCTION) {
                outsection(minorspace);
            flushcomments(NULL, -1, -1);
                forward_decl(func, 0);
                outsection(minorspace);
            }
        } else if (curtok == TOK_IDENT &&
               (strlist_cifind(externwords, curtokbuf) ||
                strlist_cifind(cexternwords, curtokbuf))) {
            if (*externalias && my_strchr(externalias, '%')) {
                strchange(&func->name, format_s(externalias, func->name));
            } else if (strlist_cifind(cexternwords, curtokbuf)) {
            if (func->name[0] == '_')
                strchange(&func->name, func->name + 1);
            if (func->name[strlen(func->name)-1] == '_')
                func->name[strlen(func->name)-1] = 0;
          }
          func->isforward = 1;    /* for Oregon Software Pascal-2 */
          func->exported = 1;
            gettok();
          while (curtok == TOK_IDENT)
            gettok();
            outsection(minorspace);
          flushcomments(NULL, -1, -1);
          scanfwdparams(func);
            forward_decl(func, 1);
            outsection(minorspace);
      } else if (curtok == TOK_IDENT) {
          wexpecttok(TOK_BEGIN);   /* print warning */
          gettok();
            outsection(minorspace);
          flushcomments(NULL, -1, -1);
          scanfwdparams(func);
            forward_decl(func, 1);
            outsection(minorspace);
        } else {
            if (func->ctx->kind == MK_FUNCTION)
                func->ctx->needvarstruct = 1;
          func->comments = curcomments;
          curcomments = NULL;
            p_block(TOK_FUNCTION);
            echoprocname(func);
          changecomments(curcomments, -1, curserial, -1, 10000);
            sp = p_body();
            func->ctx->needvarstruct = 0;
            func->val.i = (long)sp;
          strlist_mix(&func->comments, curcomments);
          curcomments = NULL;
            if (func->ctx->kind != MK_FUNCTION || !collectnest) {
                out_function(func);    /* output top-level procedures immediately */
            }                          /*  (sub-procedures are output later) */
        }
        if (!wneedtok(TOK_SEMI))
          skippasttoken(TOK_SEMI);
    }
    strlist_mix(&curcomments, savecmt);
    popctx();
}



Static void out_include(name, quoted)
char *name;
int quoted;
{
    if (*name == '"' || *name == '<')
      output(format_s("#include %s\n", name));
    else if (quoted)
        output(format_s("#include \"%s\"\n", name));
    else
        output(format_s("#include <%s>\n", name));
}


Static void cleanheadername(dest, name)
char *dest, *name;
{
    char *cp;
    int len;

    if (*name == '<' || *name == '"')
      name++;
    cp = my_strrchr(name, '/');
    if (cp)
      cp++;
    else
      cp = name;
    strcpy(dest, cp);
    len = strlen(dest);
    if (dest[len-1] == '>' || dest[len-1] == '"')
      dest[len-1] = 0;
}




Static int tryimport(sym, fname, ext, need)
Symbol *sym;
char *fname, *ext;
int need;
{
    int found = 0;
    Meaning *savectx, *savectxlast;

    savectx = curctx;
    savectxlast = curctxlast;
    curctx = nullctx;
    curctxlast = curctx->cbase;
    while (curctxlast && curctxlast->cnext)
        curctxlast = curctxlast->cnext;
    if (p_search(fname, ext, need)) {
        curtokmeaning = sym->mbase;
        while (curtokmeaning && !curtokmeaning->isactive)
            curtokmeaning = curtokmeaning->snext;
        if (curtokmeaning)
            found = 1;
    }
    curctx = savectx;
    curctxlast = savectxlast;
    return found;
}



Static void p_import(inheader)
int inheader;
{
    Strlist *sl;
    Symbol *sym;
    char *name;
    int found, isfrom = (curtok == TOK_FROM);

    outsection(minorspace);
    do {
        gettok();
        if (!wexpecttok(TOK_IDENT)) {
          skiptotoken(TOK_SEMI);
          break;
      }
        sym = curtoksym;
        if (curtokmeaning && curtokmeaning->kind == MK_MODULE) {
            found = 1;
      } else if (strlist_cifind(permimports, sym->name)) {
            found = 2;   /* built-in module, there already! */
        } else {
            found = 0;
            sl = strlist_cifind(importfrom, sym->name);
            name = (sl) ? format_none((char *)sl->value) : NULL;
            if (name) {
                if (tryimport(sym, name, "pas", 1))
                    found = 1;
            } else {
                for (sl = importdirs; sl && !found; sl = sl->next) {
                    if (tryimport(sym, format_s(sl->s, curtokcase), NULL, 0))
                        found = 1;
                }
            }
        }
        if (found == 1) {
            if (!inheader) {
                sl = strlist_cifind(includefrom, curtokmeaning->name);
                name = (sl) ? (char *)sl->value :
                format_ss(*headerfnfmt2 ? headerfnfmt2 : headerfnfmt,
                        infname, curtokmeaning->name);
                if (name && !strlist_find(includedfiles, name)) {
                    strlist_insert(&includedfiles, name);
                    if (*name_HSYMBOL)
                        output(format_s("#ifndef %s\n", format_s(name_HSYMBOL, sym->name)));
                out_include(name, quoteincludes);
                    if (*name_HSYMBOL)
                        output("#endif\n");
                    outsection(minorspace);
                }
            }
            import_ctx(curtokmeaning);
      } else if (curtokmeaning) {
          /* Modula-2, importing a single ident */
          /* Ignored for now, since we always import whole modules */
        } else if (found == 0) {
            warning(format_s("Could not find module %s [271]", sym->name));
            if (!inheader) {
                out_include(format_ss(*headerfnfmt2?headerfnfmt2:headerfnfmt,
                              sym->name, sym->name),
                      quoteincludes);
            }
        }
        gettok();
    } while (curtok == TOK_COMMA);
    if (isfrom) {
      checkkeyword(TOK_IMPORT);
      if (wneedtok(TOK_IMPORT)) {
          do {
            gettok();
            if (curtok == TOK_IDENT)
                gettok();
          } while (curtok == TOK_COMMA);
      }
    }
    if (!wneedtok(TOK_SEMI))
      skippasttoken(TOK_SEMI);
    outsection(minorspace);
}




void do_include(blkind)
Token blkind;
{
    FILE *oldfile = outf;
    int savelnum = outf_lnum;
    char fname[256];

    outsection(majorspace);
    strcpy(fname, curtokbuf);
    removesuffix(fname);
    strcat(fname, ".c");
    if (!strcmp(fname, codefname)) {
        warning("Include file name conflict! [272]");
        badinclude();
        return;
    }
    saveoldfile(fname);
    outf = fopen(fname, "w");
    if (!outf) {
        outf = oldfile;
        perror(fname);
        badinclude();
        return;
    }
    outf_lnum = 1;
    if (nobanner)
      output("\n");
    else
      output(format_ss("\n/* Include file %s from %s */\n\n",
                   fname, codefname));
    if (blkind == TOK_END)
        gettok();
    else
        curtok = blkind;
    p_block(blockkind);
    if (nobanner)
      output("\n");
    else
      output("\n\n/* End. */\n\n");
    fclose(outf);
    outf = oldfile;
    outf_lnum = savelnum;
    if (curtok != TOK_EOF) {
        warning("Junk at end of include file ignored [273]");
    }
    outsection(majorspace);
    if (*includefnfmt)
      out_include(format_s(includefnfmt, fname), 1);
    else
      out_include(fname, 1);
    outsection(majorspace);
    pop_input();
    getline();
    gettok();
}




/* blockkind is one of:
       TOK_PROGRAM:     Global declarations of a program
       TOK_FUNCTION:    Declarations local to a procedure or function
       TOK_IMPORT:      Import text read from a module
       TOK_EXPORT:      Export section of a module
       TOK_IMPLEMENT:   Implementation section of a module
       TOK_END:         None of the above
*/

void p_block(blkind)
Token blkind;
{
    Token saveblockkind = blockkind;
    Token lastblockkind = TOK_END;

    blockkind = blkind;
    for (;;) {
      while (curtok == TOK_INTFONLY) {
          include_as_import();
          gettok();
      }
        if (curtok == TOK_CONST || curtok == TOK_TYPE ||
          curtok == TOK_VAR || curtok == TOK_VALUE) {
            while (curtok == TOK_CONST || curtok == TOK_TYPE ||
               curtok == TOK_VAR || curtok == TOK_VALUE) {
                lastblockkind = curtok;
                switch (curtok) {

                    case TOK_CONST:
                        p_constdecl();
                        break;

                    case TOK_TYPE:
                        p_typedecl();
                        break;

                    case TOK_VAR:
                        p_vardecl();
                        break;

                case TOK_VALUE:
                  p_valuedecl();
                  break;

                default:
                  break;
                }
            }
            if ((blkind == TOK_PROGRAM ||
                 blkind == TOK_EXPORT ||
                 blkind == TOK_IMPLEMENT) &&
                (curtok != TOK_BEGIN || !mainlocals)) {
                outsection(majorspace);
                if (declarevars(curctx, 0))
                    outsection(majorspace);
            }
        } else {
          checkmodulewords();
          checkkeyword(TOK_SEGMENT);
          if (curtok == TOK_SEGMENT) {
            note("SEGMENT or OVERLAY keyword ignored [259]");
            gettok();
          }
          p_attributes();
            switch (curtok) {

                case TOK_LABEL:
                    p_labeldecl();
                    break;

                case TOK_IMPORT:
                case TOK_FROM:
                    p_import(0);
                    break;

            case TOK_EXPORT:
                do {
                  gettok();
                  checkkeyword(TOK_QUALIFIED);
                  if (curtok == TOK_QUALIFIED)
                      gettok();
                  wneedtok(TOK_IDENT);
                } while (curtok == TOK_COMMA);
                if (!wneedtok(TOK_SEMI))
                  skippasttoken(TOK_SEMI);
                break;

                case TOK_MODULE:
                p_nested_module();
                    break;

                case TOK_PROCEDURE:
                    p_function(0);
                    break;

                case TOK_FUNCTION:
                    p_function(1);
                    break;

                case TOK_INCLUDE:
                    if (blockkind == TOK_PROGRAM ||
                        blockkind == TOK_IMPLEMENT ||
                  (blockkind == TOK_FUNCTION && !collectnest)) {
                        do_include(lastblockkind);
                    } else {
                        badinclude();
                    }
                    break;

                default:
                if (curtok == TOK_BEGIN && blockkind == TOK_IMPORT) {
                  warning("BEGIN encountered in interface text [274]");
                  skipparens();
                  if (curtok == TOK_SEMI)
                      gettok();
                  break;
                }
                    blockkind = saveblockkind;
                    return;
            }
            lastblockkind = TOK_END;
        }
    }
}




Static void skipunitheader()
{
    if (curtok == TOK_LPAR || curtok == TOK_LBR) {
      skipparens();
    }
}


Static void skiptomodule()
{
    skipping_module++;
    while (curtok != TOK_MODULE) {
        if (curtok == TOK_END) {
            gettok();
            if (curtok == TOK_DOT)
                break;
        } else
            gettok();
    }
    skipping_module--;
}



Static void p_moduleinit(mod)
Meaning *mod;
{
    Stmt *sp;
    Strlist *sl;

    if (curtok != TOK_BEGIN && curtok != TOK_END) {
      wexpecttok(TOK_END);
      skiptotoken2(TOK_BEGIN, TOK_END);
    }
    if (curtok == TOK_BEGIN || initialcalls) {
      echoprocname(mod);
      sp = p_body();
      strlist_mix(&mod->comments, curcomments);
      curcomments = NULL;
      if (ansiC != 0)
          output("void ");
      output(format_s(name_UNITINIT, mod->name));
      if (void_args)
          output("(void)\n");
      else
          output("()\n");
      outcontext = mod;
      out_block(sp, BR_FUNCTION, 10000);
      free_stmt(sp);
      /* The following must come after out_block! */
      sl = strlist_append(&initialcalls,
                      format_s("%s()",
                             format_s(name_UNITINIT, mod->name)));
      sl->value = 1;
    } else
      wneedtok(TOK_END);
}



Static void p_nested_module()
{
    Meaning *mp;

    if (!modula2) {
      note("Ignoring nested module [260]");
      p_module(1, 0);
      return;
    }
    note("Nested modules not fully supported [261]");
    checkmodulewords();
    wneedtok(TOK_MODULE);
    wexpecttok(TOK_IDENT);
    mp = addmeaning(curtoksym, MK_MODULE);
    mp->anyvarflag = 0;
    gettok();
    skipunitheader();
    wneedtok(TOK_SEMI);
    p_block(TOK_IMPLEMENT);
    p_moduleinit(mp);
    if (curtok == TOK_IDENT)
      gettok();
    wneedtok(TOK_SEMI);
}



Static int p_module(ignoreit, isdefn)
int ignoreit;
int isdefn;    /* Modula-2: 0=local module, 1=DEFINITION, 2=IMPLEMENTATION */
{
    Meaning *mod, *mp;
    Strlist *sl;
    int kind;
    char *cp;

    checkmodulewords();
    wneedtok(TOK_MODULE);
    wexpecttok(TOK_IDENT);
    if (curtokmeaning && curtokmeaning->kind == MK_MODULE && isdefn == 2) {
      mod = curtokmeaning;
      import_ctx(mod);
      for (mp = mod->cbase; mp; mp = mp->cnext)
          if (mp->kind == MK_FUNCTION)
            mp->isforward = 1;
    } else {
      mod = addmeaning(curtoksym, MK_MODULE);
    }
    mod->anyvarflag = 0;
    pushctx(mod);
    gettok();
    skipunitheader();
    wneedtok(TOK_SEMI);
    if (ignoreit || 
        (requested_module && strcicmp(requested_module, mod->name))) {
        if (!quietmode)
          if (outf == stdout)
            fprintf(stderr, "Skipping over module \"%s\"\n", mod->name);
          else
            printf("Skipping over module \"%s\"\n", mod->name);
      checkmodulewords();
        while (curtok == TOK_IMPORT || curtok == TOK_FROM)
            p_import(1);
      checkmodulewords();
      if (curtok == TOK_EXPORT)
          gettok();
        strlist_empty(&curcomments);
        p_block(TOK_IMPORT);
        setup_module(mod->sym->name, 0);
      checkmodulewords();
        if (curtok == TOK_IMPLEMENT) {
            skiptomodule();
        } else {
            if (!wneedtok(TOK_END))
            skippasttoken(TOK_END);
            if (curtok == TOK_SEMI)
                gettok();
        }
        popctx();
        strlist_empty(&curcomments);
        return 0;
    }
    found_module = 1;
    if (isdefn != 2) {
      if (!*hdrfname) {
          sl = strlist_cifind(includefrom, mod->name);
          if (sl)
            cleanheadername(hdrfname, (char *)sl->value);
          else
            strcpy(hdrfname, format_ss(headerfnfmt, infname, mod->name));
      }
      saveoldfile(hdrfname);
      hdrf = fopen(hdrfname, "w");
      if (!hdrf) {
          perror(hdrfname);
          error("Could not open output file for header");
      }
      outsection(majorspace);
      if (usevextern && my_strchr(name_GSYMBOL, '%'))
          output(format_s("#define %s\n", format_s(name_GSYMBOL, mod->sym->name)));
      if (*selfincludefmt)
          cp = format_s(selfincludefmt, hdrfname);
      else
          cp = hdrfname;
      out_include(cp, quoteincludes);
      outsection(majorspace);
      select_outfile(hdrf);
      if (nobanner)
          output("\n");
      else
          output(format_s("/* Header for module %s, generated by p2c */\n",
                      mod->name));
      if (*name_HSYMBOL) {
          cp = format_s(name_HSYMBOL, mod->sym->name);
          output(format_ss("#ifndef %s\n#define %s\n", cp, cp));
      }
      outsection(majorspace);
      checkmodulewords();
      while (curtok == TOK_IMPORT || curtok == TOK_FROM)
          p_import(0);
      checkmodulewords();
      if (curtok == TOK_EXPORT)
          gettok();
      checkmodulewords();
      while (curtok == TOK_IMPORT || curtok == TOK_FROM)
          p_import(0);
      outsection(majorspace);
      if (usevextern) {
          output(format_s("#ifdef %s\n# define vextern\n#else\n",
                      format_s(name_GSYMBOL, mod->sym->name)));
          output("# define vextern extern\n#endif\n");
      }
      checkmodulewords();
      p_block(TOK_EXPORT);
      flushcomments(NULL, -1, -1);
      setup_module(mod->sym->name, 1);
      outsection(majorspace);
      if (usevextern)
          output("#undef vextern\n");
      outsection(minorspace);
      if (*name_HSYMBOL)
          output(format_s("#endif /*%s*/\n", format_s(name_HSYMBOL, mod->sym->name)));
      if (nobanner)
          output("\n");
      else
          output("\n/* End. */\n\n");
      select_outfile(codef);
      fclose(hdrf);
      *hdrfname = 0;
      redeclarevars(mod);
      declarevars(mod, 0);
    }
    checkmodulewords();
    if (curtok != TOK_END) {
      if (!modula2 && !implementationmodules)
          wneedtok(TOK_IMPLEMENT);
      import_ctx(mod);
        p_block(TOK_IMPLEMENT);
      flushcomments(NULL, -1, -1);
      p_moduleinit(mod);
        kind = 1;
    } else {
        kind = 0;
        if (!wneedtok(TOK_END))
          skippasttoken(TOK_END);
    }
    if (curtok == TOK_IDENT)
      gettok();
    if (curtok == TOK_SEMI)
        gettok();
    popctx();
    return kind;
}




int p_search(fname, ext, need)
char *fname, *ext;
int need;
{
    char infnbuf[300];
    FILE *fp;
    Meaning *mod;
    int savesysprog, savecopysource;
    int outerimportmark, importmark, mypermflag;

    strcpy(infnbuf, fname);
    fixfname(infnbuf, ext);
    fp = fopen(infnbuf, "r");
    if (!fp) {
        if (need)
            perror(infnbuf);
      if (logfile)
          fprintf(logfile, "(Unable to open search file \"%s\")\n", infnbuf);
        return 0;
    }
    flushcomments(NULL, -1, -1);
    ignore_directives++;
    savesysprog = sysprog_flag;
    sysprog_flag |= 3;
    savecopysource = copysource;
    copysource = 0;
    outerimportmark = numimports;   /*obsolete*/
    importmark = push_imports();
    clearprogress();
    push_input_file(fp, infnbuf, 0);
    do {
      strlist_empty(&curcomments);
      checkmodulewords();
      permflag = 0;
      if (curtok == TOK_DEFINITION) {
          gettok();
          checkmodulewords();
      } else if (curtok == TOK_IMPLEMENT && modula2) {
          gettok();
          checkmodulewords();
          warning("IMPLEMENTATION module in search text! [275]");
      }
        if (!wneedtok(TOK_MODULE))
          break;
        if (!wexpecttok(TOK_IDENT))
          break;
        mod = addmeaning(curtoksym, MK_MODULE);
        mod->anyvarflag = 0;
        if (!quietmode && !showprogress)
          if (outf == stdout)
            fprintf(stderr, "Reading import text for \"%s\"\n", mod->name);
          else
            printf("Reading import text for \"%s\"\n", mod->name);
      if (verbose)
          fprintf(logfile, "%s, %d/%d: Reading import text for \"%s\"\n",
                infname, inf_lnum, outf_lnum, mod->name);
        pushctx(mod);
        gettok();
        skipunitheader();
        wneedtok(TOK_SEMI);
      mypermflag = permflag;
        if (debug>0) printf("Found module %s\n", mod->name);
      checkmodulewords();
        while (curtok == TOK_IMPORT || curtok == TOK_FROM)
            p_import(1);
      checkmodulewords();
      if (curtok == TOK_EXPORT)
          gettok();
        strlist_empty(&curcomments);
        p_block(TOK_IMPORT);
        setup_module(mod->sym->name, 0);
      if (mypermflag) {
          strlist_add(&permimports, mod->sym->name)->value = (long)mod;
          perm_import(mod);
      }
      checkmodulewords();
      if (curtok == TOK_END) {
          gettok();
          if (curtok == TOK_SEMI)
            gettok();
      } else {
          wexpecttok(TOK_IMPLEMENT);
          if (importall) {
            skiptomodule();
            }
        }
        popctx();
    } while (curtok == TOK_MODULE);
    pop_imports(importmark);
    unimport(outerimportmark);
    sysprog_flag = savesysprog;
    copysource = savecopysource;
    ignore_directives--;
    pop_input();
    strlist_empty(&curcomments);
    clearprogress();
    return 1;
}




void p_program()
{
    Meaning *prog;
    Stmt *sp;
    int nummods, isdefn = 0;

    flushcomments(NULL, -1, -1);
    output(format_s("\n#include %s\n", p2c_h_name));
    outsection(majorspace);
    p_attributes();
    ignore_attributes();
    checkmodulewords();
    if (modula2) {
      if (curtok == TOK_MODULE) {
          curtok = TOK_PROGRAM;
      } else {
          if (curtok == TOK_DEFINITION) {
            isdefn = 1;
            gettok();
            checkmodulewords();
          } else if (curtok == TOK_IMPLEMENT) {
            isdefn = 2;
            gettok();
            checkmodulewords();
          }
      }
    }
    switch (curtok) {

        case TOK_MODULE:
          if (implementationmodules)
            isdefn = 2;
            nummods = 0;
            while (curtok == TOK_MODULE) {
                if (p_module(0, isdefn)) {
                    nummods++;
                    if (nummods == 2 && !requested_module)
                        warning("Multiple modules in one source file may not work correctly [276]");
                }
            }
          wneedtok(TOK_DOT);
            break;

        default:
            if (curtok == TOK_PROGRAM) {
                gettok();
                if (!wexpecttok(TOK_IDENT))
                skiptotoken(TOK_IDENT);
                prog = addmeaning(curtoksym, MK_MODULE);
                gettok();
                if (curtok == TOK_LPAR) {
                    while (curtok != TOK_RPAR) {
                        if (curtok == TOK_IDENT &&
                            strcicmp(curtokbuf, "INPUT") &&
                            strcicmp(curtokbuf, "OUTPUT") &&
                      strcicmp(curtokbuf, "KEYBOARD") &&
                      strcicmp(curtokbuf, "LISTING")) {
                      if (literalfilesflag == 2) {
                        strlist_add(&literalfiles, curtokbuf);
                      } else
                        note(format_s("Unexpected name \"%s\" in program header [262]",
                                    curtokcase));
                        }
                        gettok();
                    }
                    gettok();
                }
            if (curtok == TOK_LBR)
                skipparens();
                wneedtok(TOK_SEMI);
            } else {
                prog = addmeaning(findsymbol("program"), MK_MODULE);
            }
            prog->anyvarflag = 1;
            if (requested_module && strcicmp(requested_module, prog->name) &&
                                    strcicmp(requested_module, "program")) {
                for (;;) {
                    skiptomodule();
                    if (curtok == TOK_DOT)
                        break;
                     (void)p_module(0, 2);
                }
            gettok();
                break;
            }
            pushctx(prog);
            p_block(TOK_PROGRAM);
            echoprocname(prog);
          flushcomments(NULL, -1, -1);
          if (curtok != TOK_EOF) {
            sp = p_body();
            strlist_mix(&prog->comments, curcomments);
            curcomments = NULL;
            if (fullprototyping > 0) {
                output(format_sss("main%s(int argc,%s%s *argv[])",
                              spacefuncs ? " " : "",
                              spacecommas ? " " : "",
                              charname));
            } else {
                output("main");
                if (spacefuncs)
                  output(" ");
                output("(argc,");
                if (spacecommas)
                  output(" ");
                output("argv)\n");
                singleindent(argindent);
                output("int argc;\n");
                singleindent(argindent);
                output(format_s("%s *argv[];\n", charname));
            }
            outcontext = prog;
            out_block(sp, BR_FUNCTION, 10000);
            free_stmt(sp);
            popctx();
            if (curtok == TOK_SEMI)
                gettok();
            else 
                wneedtok(TOK_DOT);
          }
            break;

    }
    if (curtok != TOK_EOF) {
        warning("Junk at end of input file ignored [277]");
    }
}





/* End. */



Generated by  Doxygen 1.6.0   Back to index