/* "p2c", a Pascal to C translator.
   Copyright (C) 1989 David Gillespie.
   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_PARSE4_C
#include "trans.h"

extern Stmt bogusreturn;
extern Meaning *outcontext;
extern Strlist *includedfiles;

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

#define SF_FUNC    0x1

#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 */

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)) {
		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 = makeexpr_assign(copyexpr(ex), makeexpr_nil());
	    } 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))
		    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(logf, "%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) &&
             !mp->istemporary) {
            if (curctx->kind != MK_MODULE || curctx->anyvarflag) {
                addstmt(SK_IF);                    /* close file variables */
                sp->exp1 = makeexpr_rel(EK_NE, makeexpr_var(mp), makeexpr_nil());
                sp->stm1 = makestmt(SK_ASSIGN);
                sp->stm1->exp1 = makeexpr_bicall_1("fclose", tp_void, 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_long(0));
        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) {
		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;
    }
    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))) {
	    gettok();
	    while (curtok == TOK_IDENT)
		gettok();
	    wneedtok(TOK_SEMI);
	}
        /* do nothing more */
    } else if (blockkind == TOK_EXPORT) {
        func->isforward = 1;
	scanfwdparams(func);
	flushcomments(NULL, -1, -1);
        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 (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)));
                    if (*name == '"' || *name == '<')
                        output(format_s("#include %s\n", name));
                    else
                        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;
    output(format_ss("\n/* Include file %s from %s */\n\n", fname, codefname));
    if (blkind == TOK_END)
        gettok();
    else
        curtok = blkind;
    p_block(blockkind);
    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)));
	out_include(hdrfname, quoteincludes);
	outsection(majorspace);
	select_outfile(hdrf);
	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);
	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)));
	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 (logf)
	    fprintf(logf, "(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(logf, "%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_s("main(int argc, %s *argv[])", charname));
		} else {
		    output("main(argc, 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. */