/* "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 define_globals
#define PROTO_TRANS_C
#include "trans.h"

#include <time.h>


/* Roadmap:

    trans.h         Declarations for all public global variables, types,
                    and macros.  Functions are declared in separate
                    files p2c.{proto,hdrs} which are created
                    mechanically by the makeproto program.

    trans.c         Main program.  Parses the p2crc file.  Also reserves
                    storage for public globals in trans.h.

    stuff.c         Miscellaneous support routines.

    out.c           Routines to handle the writing of C code to the output
                    file.  This includes line breaking and indentation
		    support.

    comment.c       Routines for managing comments and comment lists.

    lex.c           Lexical analyzer.  Manages input files and streams,
                    splits input stream into Pascal tokens.  Parses
		    compiler directives and special comments.  Also keeps
		    the symbol table.

    parse.c         Parsing and writing statements and blocks.

    decl.c          Parsing and writing declarations.

    expr.c          Manipulating expressions.

    pexpr.c         Parsing and writing expressions.

    funcs.c         Built-in special functions and procedures.

    dir.c           Interface file to "external" functions and procedures
		    such as hpmods and citmods.

    hpmods.c        Definitions for HP-supplied Pascal modules.

    citmods.c       Definitions for some Caltech-local Pascal modules.
                    (Outside of Caltech this file is mostly useful
                    as a large body of examples of how to write your
                    own translator extensions.)


    p2crc           Control file (read when p2c starts up).

    p2c.h           Header file used by translated programs.

    p2clib.c        Run-time library used by translated programs.

*/


Static Strlist *tweaksymbols, *synonyms;
Strlist *addmacros;


Static void initrc()
{
    int i;

    for (i = 0; i < numparams; i++) {
        switch (rctable[i].kind) {
            case 'S':
	    case 'B':
                *((short *)rctable[i].ptr) = rctable[i].def;
                break;
            case 'I':
	    case 'D':
                *((int *)rctable[i].ptr) = rctable[i].def;
                break;
            case 'L':
                *((long *)rctable[i].ptr) = rctable[i].def;
                break;
            case 'R':
                *((double *)rctable[i].ptr) = rctable[i].def/100.0;
                break;
            case 'U':
            case 'C':
                *((char *)rctable[i].ptr) = 0;
                break;
            case 'A':
                *((Strlist **)rctable[i].ptr) = NULL;
		break;
	    case 'X':
		if (rctable[i].def == 1)
		    *((Strlist **)rctable[i].ptr) = NULL;
		break;
        }
        rcprevvalues[i] = NULL;
    }
    tweaksymbols = NULL;
    synonyms = NULL;
    addmacros = NULL;
    varmacros = NULL;
    constmacros = NULL;
    fieldmacros = NULL;
    funcmacros = NULL;
}


Static int readrc(rcname, need)
char *rcname;
int need;
{
    FILE *rc;
    char buf[500], *cp, *cp2;
    long val = 0;
    int i;
    Strlist *sl;

    rc = fopen(rcname, "r");
    if (!rc) {
        if (need)
            perror(rcname);
        return 0;
    }
    while (fgets(buf, 500, rc)) {
        cp = my_strtok(buf, " =\t\n");
        if (cp && *cp != '#') {
            upc(cp);
            i = numparams;
            while (--i >= 0 && strcmp(rctable[i].name, cp)) ;
            if (i >= 0) {
                if (rctable[i].kind != 'M') {
                    cp = my_strtok(NULL, " =\t\n");
                    if (cp && *cp == '#')
                        cp = NULL;
                    if (cp && (isdigit(*cp) || *cp == '-' || *cp == '+'))
                        val = atol(cp);
                    else
                        val = rctable[i].def;
                }
                switch (rctable[i].kind) {

                    case 'S':
                        *((short *)rctable[i].ptr) = val;
                        break;

                    case 'I':
                        *((int *)rctable[i].ptr) = val;
                        break;

                    case 'D':
                        *((int *)rctable[i].ptr) =
			    parsedelta(cp, rctable[i].def);
                        break;

                    case 'L':
                        *((long *)rctable[i].ptr) = val;
                        break;

		    case 'R':
			if (cp && (isdigit(*cp) || *cp == '-' || *cp == '.'))
			    *((double *)rctable[i].ptr) = atof(cp);
			else
			    *((double *)rctable[i].ptr) = rctable[i].def/100.0;
			break;

                    case 'U':
                        if (cp)
                            upc(cp);

                    /* fall through */
                    case 'C':
                        val = rctable[i].def;
                        strncpy((char *)rctable[i].ptr, cp ? cp : "", val-1);
                        ((char *)rctable[i].ptr)[val-1] = 0;
                        break;

                    case 'F':
                        while (cp && *cp != '#') {
                            sl = strlist_append(&tweaksymbols,
						format_s("*%s", cp));
                            sl->value = rctable[i].def;
                            cp = my_strtok(NULL, " \t\n");
                        }
                        break;

                    case 'G':
                        while (cp && *cp != '#') {
                            sl = strlist_append(&tweaksymbols, cp);
                            sl->value = rctable[i].def;
                            cp = my_strtok(NULL, " \t\n");
                        }
                        break;

                    case 'A':
                        while (cp && *cp != '#') {
                            strlist_insert((Strlist **)rctable[i].ptr, cp);
                            cp = my_strtok(NULL, " \t\n");
                        }
                        break;

                    case 'M':
                        cp = my_strtok(NULL, "\n");
                        if (cp) {
                            while (isspace(*cp)) cp++;
                            for (cp2 = cp; *cp2 && *cp2 != '#'; cp2++) ;
                            *cp2 = 0;
                            if (*cp) {
                                sl = strlist_append(&addmacros, cp);
                                sl->value = rctable[i].def;
                            }
                        }
                        break;

		    case 'B':
			if (cp)
			    val = parse_breakstr(cp);
			if (val != -1)
			    *((short *)rctable[i].ptr) = val;
			break;

                    case 'X':
                        switch (rctable[i].def) {

                            case 1:     /* strlist with string values */
                                if (cp) {
                                    sl = strlist_append((Strlist **)rctable[i].ptr, cp);
                                    cp = my_strtok(NULL, " =\t\n");
                                    if (cp && *cp != '#')
                                        sl->value = (long)stralloc(cp);
                                }
                                break;

                            case 2:     /* Include */
                                if (cp)
                                    readrc(format_s(cp, infname), 1);
                                break;

			    case 3:     /* Synonym */
				if (cp) {
				    sl = strlist_append(&synonyms, cp);
				    cp = my_strtok(NULL, " =\t\n");
				    if (cp && *cp != '#')
					sl->value = (long)stralloc(cp);
				}
				break;

                        }
                }
            } else
                fprintf(stderr, "warning: can't understand %s in %s\n", cp, rcname);
        }
    }
    fclose(rc);
    return 1;
}


Static void postrc()
{
    int longbits;
    unsigned long val;

    which_unix = UNIX_ANY;
    if (!strcmp(target, "CHIPMUNK") ||
        !strcmp(target, "HPUX-300") ||
        !strcmp(target, "SUN-68K") ||
        !strcmp(target, "BSD-VAX")) {
        signedchars = 1;
        sizeof_char = 8;
        sizeof_short = 16;
        sizeof_int = sizeof_long = sizeof_pointer = 32;
        sizeof_enum = 32;
	sizeof_float = 32;
        sizeof_double = 64;
        if (!strcmp(target, "CHIPMUNK") ||
            !strcmp(target, "HPUX-300"))
            which_unix = UNIX_SYSV;
        else
            which_unix = UNIX_BSD;
    } else if (!strcmp(target, "LSC-MAC")) {
        signedchars = 1;
        if (prototypes < 0)
            prototypes = 1;
        if (fullprototyping < 0)
            fullprototyping = 0;
        if (voidstar < 0)
            voidstar = 1;
        sizeof_char = 8;
        sizeof_short = sizeof_int = 16;
        sizeof_long = sizeof_pointer = 32;
    } else if (!strcmp(target, "BSD")) {
        which_unix = UNIX_BSD;
    } else if (!strcmp(target, "SYSV")) {
        which_unix = UNIX_SYSV;
    } else if (*target) {
        fprintf(stderr, "p2c: warning: don't understand target name %s\n", target);
    }
    if (ansiC > 0) {
        if (sprintf_value < 0)
            sprintf_value = 0;
        if (castnull < 0)
            castnull = 0;
    }
    if (useenum < 0)
        useenum = (ansiC != 0) ? 1 : 0;
    if (void_args < 0)
        void_args = (ansiC > 0 && prototypes != 0) ? 1 : 0;
    if (prototypes < 0)
        prototypes = (cplus > 0) ? 2 : (ansiC > 0) ? 1 : 0;
    if (prototypes == 0)
        fullprototyping = 0;
    else if (fullprototyping < 0)
        fullprototyping = 1;
    if (useAnyptrMacros < 0)
	useAnyptrMacros = (ansiC > 0 || cplus > 0) ? 2 : 1;
    if (usePPMacros < 0)
	usePPMacros = (ansiC > 0 || cplus > 0) ? 0 : 2;
    if (voidstar < 0)
        voidstar = (ansiC > 0 || cplus > 0) ? 1 : 0;
    if (hassignedchar < 0)
        hassignedchar = (ansiC > 0) ? 1 : 0;
    if (useconsts < 0)
        useconsts = (ansiC > 0 || cplus > 0) ? 1 : 0;
    if (copystructs < 0)
        copystructs = (ansiC != 0 || cplus > 0) ? 3 : 0;
    if (copystructfuncs < 0)
        copystructfuncs = (ansiC > 0 || cplus > 0) ? 0 : 1;
    if (starfunctions < 0)
        starfunctions = (ansiC > 0) ? 0 : 1;
    if (variablearrays < 0)
	variablearrays = (ansiC > 1) ? 1 : 0;
    if (initpacstrings < 0)
	initpacstrings = (ansiC > 0) ? 1 : 0;
    if (*memcpyname) {
        if (ansiC > 0 || which_unix == UNIX_SYSV)
            strcpy(memcpyname, "memcpy");
        else if (which_unix == UNIX_BSD)
            strcpy(memcpyname, "bcopy");
    }
    sizeof_integer = (sizeof_int >= 32) ? sizeof_int : sizeof_long;
    integername = (sizeof_int >= 32) ? "int" : "long";
    if (sizeof_integer && sizeof_integer < 32)
        fprintf(stderr, "Warning: long integers have less than 32 bits\n");
    if (sizeof_int >= 32 && sizeof_long > sizeof_int && prototypes == 0)
        fprintf(stderr, "Warning: translated code assumes int and long are the same");
    if (setbits < 0)
        setbits = (sizeof_integer > 0) ? sizeof_integer : 32;
    ucharname = (*name_UCHAR) ? name_UCHAR :
                (signedchars == 0) ? "char" : "unsigned char";
    scharname = (*name_SCHAR) ? name_SCHAR :
                (signedchars == 1) ? "char" : 
                (useAnyptrMacros == 1) ? "Signed char" : "signed char";
    for (longbits = 1, val = LONG_MAX; val >>= 1; longbits++) ;
    if (sizeof_char) {
        if (sizeof_char < 8 && ansiC > 0)
            fprintf(stderr, "Warning: chars have less than 8 bits\n");
        if (sizeof_char > longbits) {
            min_schar = LONG_MIN;
            max_schar = LONG_MAX;
        } else {
            min_schar = - (1<<(sizeof_char-1));
            max_schar = (1<<(sizeof_char-1)) - 1;
        }
        if (sizeof_char >= longbits)
            max_uchar = LONG_MAX;
        else
            max_uchar = (1<<sizeof_char) - 1;
    } else {
        min_schar = -128;      /* Ansi-required minimum maxima */
        max_schar = 127;
        max_uchar = 255;
    }
    if (sizeof_short) {
        if (sizeof_short < 16 && ansiC > 0)
            fprintf(stderr, "Warning: shorts have less than 16 bits\n");
        if (sizeof_short > longbits) {
            min_sshort = LONG_MIN;
            max_sshort = LONG_MAX;
        } else {
            min_sshort = - (1<<(sizeof_short-1));
            max_sshort = (1<<(sizeof_short-1)) - 1;
        }
        if (sizeof_short >= longbits)
            max_ushort = LONG_MAX;
        else
            max_ushort = (1<<sizeof_short) - 1;
    } else {
        min_sshort = -32768;   /* Ansi-required minimum maxima */
        max_sshort = 32767;
        max_ushort = 65535;
    }
    if (symcase < 0)
        symcase = 1;
    if (smallsetconst == -2)
        smallsetconst = (*name_SETBITS) ? -1 : 1;
    hpux_lang = 0;
    if (!strcmp(language, "TURBO")) {
        which_lang = LANG_TURBO;
    } else if (!strcmp(language, "UCSD")) {
        which_lang = LANG_UCSD;
    } else if (!strcmp(language, "MPW")) {
        which_lang = LANG_MPW;
    } else if (!strcmp(language, "HPUX") || !strcmp(language, "HP-UX")) {
	which_lang = LANG_HP;
	hpux_lang = 1;
    } else if (!strcmp(language, "OREGON")) {
	which_lang = LANG_OREGON;
    } else if (!strcmp(language, "VAX") || !strcmp(language, "VMS")) {
	which_lang = LANG_VAX;
    } else if (!strncmp(language, "MODULA", 6)) {
	which_lang = LANG_MODULA;
    } else if (!strncmp(language, "BERK", 4) ||
	       !strcmp(language, "SUN")) {
	which_lang = LANG_BERK;
    } else {
        if (*language && strcmp(language, "HP") && strcmp(language, "MODCAL"))
            fprintf(stderr, "Warning: Language %s not recognized, using HP\n", language);
        which_lang = LANG_HP;
    }
    if (modula2 < 0)
	modula2 = (which_lang == LANG_MODULA) ? 1 : 0;
    if (pascalcasesens < 0)
	pascalcasesens = (which_lang == LANG_MODULA) ? 2 :
	                 (which_lang == LANG_BERK) ? 3 : 0;
    if (implementationmodules < 0)
	implementationmodules = (which_lang == LANG_VAX) ? 1 : 0;
    if (integer16 < 0)
        integer16 = (which_lang == LANG_TURBO ||
		     which_lang == LANG_MPW) ? 1 : 0;
    if (doublereals < 0)
	doublereals = (hpux_lang ||
		       which_lang == LANG_OREGON ||
		       which_lang == LANG_VAX) ? 0 : 1;
    if (pascalenumsize < 0)
	pascalenumsize = (which_lang == LANG_HP) ? 16 : 8;
    if (storefilenames < 0)
        storefilenames = (which_lang == LANG_TURBO) ? 1 : 0;
    if (charfiletext < 0)
        charfiletext = (which_lang == LANG_BERK) ? 1 : 0;
    if (readwriteopen < 0)
	readwriteopen = (which_lang == LANG_TURBO) ? 1 : 0;
    if (literalfilesflag < 0)
	literalfilesflag = (which_lang == LANG_BERK) ? 2 : 0;
    if (newlinespace < 0)
        newlinespace = (which_lang == LANG_TURBO) ? 0 : 1;
    if (nestedcomments < 0)
        nestedcomments = (which_lang == LANG_TURBO ||
			  which_lang == LANG_MPW ||
			  which_lang == LANG_UCSD ||
			  which_lang == LANG_BERK) ? 2 : 0;
    if (importall < 0)
        importall = (which_lang == LANG_HP) ? 1 : 0;
    if (seek_base < 0)
        seek_base = (which_lang == LANG_TURBO ||
			  which_lang == LANG_MPW ||
		     which_lang == LANG_UCSD) ? 0 : 1;
    if (unsignedchar < 0 && signedchars == 0)
        unsignedchar = 2;
    if (hasstaticlinks < 0)
	hasstaticlinks = (which_lang == LANG_HP) ? 1 : 0;
    if (dollar_idents < 0)
	dollar_idents = (which_lang == LANG_OREGON ||
			 which_lang == LANG_VAX) ? 1 : 0;
    if (ignorenonalpha < 0)
	ignorenonalpha = (which_lang == LANG_UCSD) ? 1 : 0;
    if (stringtrunclimit < 0)
	stringtrunclimit = (which_lang == LANG_TURBO) ? 80 : 0;
    if (defaultsetsize < 0)
	defaultsetsize = (which_lang == LANG_VAX) ? 256 :
			 (which_lang == LANG_BERK) ? 128 :
	                 (which_lang == LANG_MPW) ? 2040 : 8192;
    if (enumbyte < 0)
	enumbyte = (which_lang == LANG_HP) ? 0 : 1;
    if (!*filenamefilter && (which_lang == LANG_OREGON ||
			     which_lang == LANG_BERK))
	strcpy(filenamefilter, "P_trimname");
    charname = (useAnyptrMacros) ? "Char" :
               (unsignedchar == 1) ? ucharname :
               (unsignedchar == 0) ? scharname : "char";
    if (!*memcpyname)
        strcpy(memcpyname, "memcpy");
    if (!*mallocname)
        strcpy(mallocname, "malloc");
    if (!*freename)
        strcpy(freename, "free");
    fix_parameters();
}


void saveoldfile(fname)
char *fname;
{
#if defined(unix) || defined(__unix) || defined(CAN_LINK)
    (void) unlink(format_s("%s~", fname));
    if (link(fname, format_s("%s~", fname)) == 0)
        (void) unlink(fname);
#endif
}


#ifndef __STDC__
# ifdef NO_GETENV
#  define getenv(x) NULL
# else
extern char *getenv PP((char *));
# endif
#endif

Static long starting_time;

Static void openlogfile()
{
    char *name, *uname;

    if (*codefname == '<')
	name = format_ss(logfnfmt, infname, infname);
    else
	name = format_ss(logfnfmt, infname, codefname);
    if (!name)
	name = format_s("%s.log", codefname);
    saveoldfile(name);
    logf = fopen(name, "w");
    if (logf) {
	fprintf(logf, "\nTranslation of %s to %s by p2c %s\n",
		infname, codefname, P2C_VERSION);
	fprintf(logf, "Translated");
	uname = getenv("USER");
	if (uname)
	    fprintf(logf, " by %s", uname);
	time(&starting_time);
	fprintf(logf, " on %s", ctime(&starting_time));
	fprintf(logf, "\n\n");
    } else {
	perror(name);
	verbose = 0;
    }
}


void closelogfile()
{
    long ending_time;

    if (logf) {
	fprintf(logf, "\n\n");
#if defined(unix) || defined(__unix)
	fprintf(logf, "Total memory used: %ld bytes.\n", (long)sbrk(0));
#endif
	time(&ending_time);
	fprintf(logf, "Processed %d source lines in %ld:%ld seconds.\n",
		inf_ltotal,
		(ending_time - starting_time) / 60,
		(ending_time - starting_time) % 60);
	fprintf(logf, "\n\nTranslation completed on %s", ctime(&ending_time));
	fclose(logf);
    }
}


void showinitfile()
{
    FILE *f;
    int ch;
    char *name;

    name = format_s("%H/%s", "p2crc");
    printf("# Copy of file %%H/p2crc => %s:\n\n", name);
    f = fopen(name, "r");
    if (!f) {
	perror(name);
	exit(1);
    }
    while ((ch = getc(f)) != EOF)
	putchar(ch);
    fclose(f);
    exit(0);
}


void usage()
{
    fprintf(stderr, "usage: p2c [options] file [modulename] [-h file.h] [-o file.c]\n");
    exit(EXIT_FAILURE);
}


int main(argc, argv)
int argc;
char **argv;
{
    int numsearch;
    char *searchlist[50];
    char infnbuf[200], codefnbuf[200], hdrfnbuf[200], *cp;
    Symbol *sp;
    Strlist *sl;
    int i, nobuffer = 0, savequiet;
    
    i = 0;
    while (i < argc && strcmp(argv[i], "-H")) i++;
    if (i < argc-1)
	p2c_home = argv[i+1];
    else {
	cp = getenv("P2C_HOME");
	if (cp)
	    p2c_home = cp;
    }
    init_stuff();
    i = 0;
    while (i < argc && strcmp(argv[i], "-i")) i++;
    if (i < argc)
	showinitfile();
    initrc();
    setup_dir();
    infname = infnbuf;
    *infname = 0;
    i = 0;
    while (i < argc && argv[i][0] == '-') i++;
    if (i >= argc)
	strcpy(infname, argv[i]);
    i = 0;
    while (i < argc && strcmp(argv[i], "-v")) i++;
    if (i >= argc) {
	cp = getenv("P2CRC");
	if (cp)
	    readrc(cp, 1);
	else
	    readrc(format_s("%H/%s", "p2crc"), 1);
    }
    i = 0;
    while (i < argc && strcmp(argv[i], "-c")) i++;
    if (i < argc-1) {
        if (strcmp(argv[i+1], "-"))
            readrc(argv[i+1], 1);
    } else
        if (!readrc("p2crc", 0))
            readrc(".p2crc", 0);
    codefname = codefnbuf;
    *codefname = 0;
    hdrfname = hdrfnbuf;
    *hdrfname = 0;
    requested_module = NULL;
    found_module = 0;
    error_crash = 0;
#ifdef CONSERVE_MEMORY
    conserve_mem = CONSERVE_MEMORY;
#else
    conserve_mem = 1;
#endif
    regression = 0;
    verbose = 0;
    partialdump = 1;
    numsearch = 0;
    argc--, argv++;
    while (argc > 0) {
        if (**argv == '-' && (*argv)[1]) {
            if (!strcmp(*argv, "-a")) {
                ansiC = 1;
	    } else if (argv[0][1] == 'L') {
		if (strlen(*argv) == 2 && argc > 1) {
		    strcpy(language, ++*argv);
		    --argc;
		} else
		    strcpy(language, *argv + 2);
		upc(language);
            } else if (!strcmp(*argv, "-q")) {
                quietmode = 1;
            } else if (!strcmp(*argv, "-o")) {
                if (*codefname || --argc <= 0)
                    usage();
                strcpy(codefname, *++argv);
            } else if (!strcmp(*argv, "-h")) {
                if (*hdrfname || --argc <= 0)
                    usage();
                strcpy(hdrfname, *++argv);
            } else if (!strcmp(*argv, "-s")) {
                if (--argc <= 0)
                    usage();
                cp = *++argv;
                if (!strcmp(cp, "-"))
                    librfiles = NULL;
                else
                    searchlist[numsearch++] = cp;
            } else if (!strcmp(*argv, "-c")) {
                if (--argc <= 0)
                    usage();
                argv++;
                /* already done above */
            } else if (!strcmp(*argv, "-v")) {
                /* already done above */
            } else if (!strcmp(*argv, "-H")) {
                /* already done above */
	    } else if (argv[0][1] == 'I') {
		if (strlen(*argv) == 2 && argc > 1) {
		    strlist_append(&importdirs, ++*argv);
		    --argc;
		} else
		    strlist_append(&importdirs, *argv + 2);
            } else if (argv[0][1] == 'p') {
                if (strlen(*argv) == 2)
                    showprogress = 25;
                else
                    showprogress = atoi(*argv + 2);
		nobuffer = 1;
            } else if (!strcmp(*argv, "-e")) {
                copysource++;
            } else if (!strcmp(*argv, "-t")) {
                tokentrace++;
            } else if (!strcmp(*argv, "-x")) {
                error_crash++;
	    } else if (argv[0][1] == 'E') {
		if (strlen(*argv) == 2)
		    maxerrors = 0;
		else
		    maxerrors = atoi(*argv + 2);
            } else if (!strcmp(*argv, "-F")) {
                partialdump = 0;
            } else if (argv[0][1] == 'd') {
		nobuffer = 1;
                if (strlen(*argv) == 2)
                    debug = 1;
                else
                    debug = atoi(*argv + 2);
	    } else if (argv[0][1] == 'B') {
		if (strlen(*argv) == 2)
		    i = 1;
		else
		    i = atoi(*argv + 2);
		if (argc == 2 &&
		    strlen(argv[1]) > 2 &&
		    !strcmp(argv[1] + strlen(argv[1]) - 2, ".c")) {
		    testlinebreaker(i, argv[1]);
		    exit(EXIT_SUCCESS);
		} else
		    testlinebreaker(i, NULL);
	    } else if (argv[0][1] == 'C') {
		if (strlen(*argv) == 2)
		    cmtdebug = 1;
		else
		    cmtdebug = atoi(*argv + 2);
            } else if (!strcmp(*argv, "-R")) {
		regression = 1;
            } else if (argv[0][1] == 'V') {
		if (strlen(*argv) == 2)
		    verbose = 1;
		else
		    verbose = atoi(*argv + 2);
            } else if (argv[0][1] == 'M') {
		if (strlen(*argv) == 2)
		    conserve_mem = 1;
		else
		    conserve_mem = atoi(*argv + 2);
	    } else
                usage();
        } else if (!*infname) {
            strcpy(infname, *argv);
        } else if (!requested_module) {
            requested_module = stralloc(*argv);
        } else
            usage();
        argc--, argv++;
    }
    if (requested_module && !*codefname)
	strcpy(codefname, format_ss(modulefnfmt, infname, requested_module));
    if (*infname && strcmp(infname, "-")) {
	if (strlen(infname) > 2 &&
	    !strcmp(infname + strlen(infname) - 2, ".c")) {
	    fprintf(stderr, "What is wrong with this picture?\n");
	    exit(EXIT_FAILURE);
	}
        inf = fopen(infname, "r");
        if (!inf) {
            perror(infname);
            exit(EXIT_FAILURE);
        }
        if (!*codefname)
            strcpy(codefname, format_s(codefnfmt, infname));
    } else {
        strcpy(infname, "<stdin>");
        inf = stdin;
        if (!*codefname)
            strcpy(codefname, "-");
    }
    if (strcmp(codefname, "-")) {
        saveoldfile(codefname);
        codef = fopen(codefname, "w");
        if (!codef) {
            perror(codefname);
            exit(EXIT_FAILURE);
        }
        fprintf(codef, "/* Output from p2c, the Pascal-to-C translator */\n");
    } else {
        strcpy(codefname, "<stdout>");
        codef = stdout;
    }
    if (nobuffer)
        setbuf(codef, NULL);      /* for debugging */
    outf = codef;
    outf_lnum = 1;
    logf = NULL;
    if (verbose)
	openlogfile();
    setup_complete = 0;
    init_lex();
    leadingcomments();
    postrc();
    setup_comment();  /* must call this first */
    setup_lex();      /* must call this second */
    setup_out();
    setup_decl();     /* must call *after* setup_lex() */
    setup_parse();
    setup_funcs();
    for (sl = tweaksymbols; sl; sl = sl->next) {
	cp = sl->s;
	if (*cp == '*') {
	    cp++;
	    if (!pascalcasesens)
		upc(cp);
	}
        sp = findsymbol(cp);
	if (sl->value & FUNCBREAK)
	    sp->flags &= ~FUNCBREAK;
        sp->flags |= sl->value;
    }
    strlist_empty(&tweaksymbols);
    for (sl = synonyms; sl; sl = sl->next) {
	if (!pascalcasesens)
	    upc(sl->s);
	sp = findsymbol(sl->s);
	sp->flags |= SSYNONYM;
	if (sl->value) {
	    if (!pascalcasesens)
		upc((char *)sl->value);
	    strlist_append(&sp->symbolnames, "===")->value =
		(long)findsymbol((char *)sl->value);
	} else
	    strlist_append(&sp->symbolnames, "===")->value = 0;
    }
    strlist_empty(&synonyms);
    for (sl = addmacros; sl; sl = sl->next) {
        defmacro(sl->s, sl->value, "<macro>", 0);
    }
    strlist_empty(&addmacros);
    handle_nameof();
    setup_complete = 1;
    savequiet = quietmode;
    quietmode = 1;
    for (sl = librfiles; sl; sl = sl->next)
        (void)p_search(format_none(sl->s), "pas", 0);
    for (i = 0; i < numsearch; i++)
        (void)p_search(format_none(searchlist[i]), "pas", 1);
    quietmode = savequiet;
    p_program();
    end_source();
    flushcomments(NULL, -1, -1);
    showendnotes();
    check_unused_macros();
    printf("\n");
    if (!showprogress)
	fprintf(stderr, "\n");
    output("\n");
    if (requested_module && !found_module)
        error(format_s("Module \"%s\" not found in file", requested_module));
    if (codef != stdout)
        output("\n\n/* End. */\n");
    if (inf != stdin)
        fclose(inf);
    if (codef != stdout)
        fclose(codef);
    closelogfile();
    mem_summary();
    if (!quietmode)
        fprintf(stderr, "Translation completed.\n");
    exit(EXIT_SUCCESS);
}


int outmem()
{
    fprintf(stderr, "p2c: Out of memory!\n");
    exit(EXIT_FAILURE);
}


#if !defined(NO_ISBOGUS) && (defined(mc68000) || defined(m68k) || defined(vax))
int ISBOGUS(p)
char *p;
{
    unsigned long ip = (unsigned long)p;

    if (ip < 0) {
	if (ip < (unsigned long)&ip)
	    return 1;    /* below the start of the stack */
    } else if (ip >= 512) {
	if (ip > (unsigned long)sbrk(0))
	    return 1;    /* past the end of memory */
    } else
	return 1;
    return 0;
}
#else
#define ISBOGUS(p) 0
#endif


char *meaningkindname(kind)
enum meaningkind kind;
{
#ifdef HASDUMPS
    if ((unsigned int)kind < (unsigned int)MK_LAST)
        return meaningkindnames[(int) kind];
    else
#endif /*HASDUMPS*/
        return format_d("<meaning %d>", (int) kind);
}

char *typekindname(kind)
enum typekind kind;
{
#ifdef HASDUMPS
    if ((unsigned int)kind < (unsigned int)TK_LAST)
        return typekindnames[(int) kind];
    else
#endif /*HASDUMPS*/
        return format_d("<type %d>", (int) kind);
}

char *exprkindname(kind)
enum exprkind kind;
{
#ifdef HASDUMPS
    if ((unsigned int)kind < (unsigned int)EK_LAST)
        return exprkindnames[(int) kind];
    else
#endif /*HASDUMPS*/
        return format_d("<expr %d>", (int) kind);
}

char *stmtkindname(kind)
enum stmtkind kind;
{
#ifdef HASDUMPS
    if ((unsigned int)kind < (unsigned int)SK_LAST)
        return stmtkindnames[(int) kind];
    else
#endif /*HASDUMPS*/
        return format_d("<stmt %d>", (int) kind);
}


void dumptype(tp)
Type *tp;
{
    if (!tp) {
        fprintf(outf, "<NULL>\n");
        return;
    }
    if (ISBOGUS(tp)) {
	fprintf(outf, "0x%lX\n", tp);
	return;
    }
    fprintf(outf, "      Type %lx, kind=%s", tp, typekindname(tp->kind));
#ifdef HASDUMPS
    fprintf(outf, ", meaning=%lx, basetype=%lx, indextype=%lx\n",
            tp->meaning, tp->basetype, tp->indextype);
    tp->dumped = 1;
    if (tp->basetype)
	dumptype(tp->basetype);
    if (tp->indextype)
	dumptype(tp->indextype);
#else
    fprintf(outf, "\n");
#endif /*HASDUMPS*/
}


void dumpmeaning(mp)
Meaning *mp;
{
    if (!mp) {
        fprintf(outf, "<NULL>\n");
        return;
    }
    if (ISBOGUS(mp)) {
	fprintf(outf, "0x%lX\n", mp);
	return;
    }
    fprintf(outf, "   Meaning %lx, name=%s, kind=%s", mp, ((mp->name) ? mp->name : "<null>"),
                                                     meaningkindname(mp->kind));
#ifdef HASDUMPS
    fprintf(outf, ", ctx=%lx, cbase=%lx, cnext=%lx, type=%lx\n",
            mp->ctx, mp->cbase, mp->cnext, mp->type);
    if (mp->type && !mp->type->dumped)
	dumptype(mp->type);
    mp->dumped = 1;
#else
    fprintf(outf, "\n");
#endif /*HASDUMPS*/
}


void dumpsymtable(sym)
Symbol *sym;
{
    Meaning *mp;

    if (sym) {
	dumpsymtable(sym->left);
#ifdef HASDUMPS
	if ((sym->mbase && !sym->mbase->dumped) ||
	    (sym->fbase && !sym->fbase->dumped))
#endif
	    {
		fprintf(outf, "Symbol %s:\n", sym->name);
		for (mp = sym->mbase; mp; mp = mp->snext)
		    dumpmeaning(mp);
		for (mp = sym->fbase; mp; mp = mp->snext)
		    dumpmeaning(mp);
		fprintf(outf, "\n");
	    }
	dumpsymtable(sym->right);
    }
}


void dumptypename(tp, waddr)
Type *tp;
int waddr;
{
#ifdef HASDUMPS
    if (!tp) {
	fprintf(outf, "<NULL>");
	return;
    }
    if (ISBOGUS(tp)) {
	fprintf(outf, "0x%lX", tp);
	return;
    }
    if (tp == tp_int)             fprintf(outf, "I");
    else if (tp == tp_sint)       fprintf(outf, "SI");
    else if (tp == tp_uint)       fprintf(outf, "UI");
    else if (tp == tp_integer)    fprintf(outf, "L");
    else if (tp == tp_unsigned)   fprintf(outf, "UL");
    else if (tp == tp_char)       fprintf(outf, "C");
    else if (tp == tp_schar)      fprintf(outf, "UC");
    else if (tp == tp_uchar)      fprintf(outf, "SC");
    else if (tp == tp_boolean)    fprintf(outf, "B");
    else if (tp == tp_longreal)   fprintf(outf, "R");
    else if (tp == tp_real)       fprintf(outf, "F");
    else if (tp == tp_anyptr)     fprintf(outf, "A");
    else if (tp == tp_void)       fprintf(outf, "V");
    else if (tp == tp_text)       fprintf(outf, "T");
    else if (tp == tp_bigtext)    fprintf(outf, "BT");
    else if (tp == tp_sshort)     fprintf(outf, "SS");
    else if (tp == tp_ushort)     fprintf(outf, "US");
    else if (tp == tp_abyte)      fprintf(outf, "AB");
    else if (tp == tp_sbyte)      fprintf(outf, "SB");
    else if (tp == tp_ubyte)      fprintf(outf, "UB");
    else if (tp == tp_str255)     fprintf(outf, "S");
    else if (tp == tp_strptr)     fprintf(outf, "SP");
    else if (tp == tp_charptr)    fprintf(outf, "CP");
    else if (tp == tp_smallset)   fprintf(outf, "SMS");
    else if (tp == tp_proc)       fprintf(outf, "PR");
    else if (tp == tp_jmp_buf)    fprintf(outf, "JB");
    else {
	if (tp->meaning && !ISBOGUS(tp->meaning) &&
	    tp->meaning->name && !ISBOGUS(tp->meaning->name) &&
	    tp->meaning->name[0]) {
	    fprintf(outf, "%s", tp->meaning->name);
	    if (tp->dumped)
		return;
	    fprintf(outf, "=");
	    waddr = 1;
	}
	if (waddr) {
	    fprintf(outf, "%lX", tp);
	    if (tp->dumped)
		return;
	    fprintf(outf, ":");
	    tp->dumped = 1;
	}
	switch (tp->kind) {
	    
	  case TK_STRING:
	    fprintf(outf, "Str");
	    if (tp->structdefd)
		fprintf(outf, "Conf");
	    break;

	  case TK_SUBR:
	    dumptypename(tp->basetype, 0);
	    break;

	  case TK_POINTER:
	    fprintf(outf, "^");
	    dumptypename(tp->basetype, 0);
	    break;

	  case TK_SMALLARRAY:
	    fprintf(outf, "Sm");
	    /* fall through */

	  case TK_ARRAY:
	    fprintf(outf, "Ar");
	    if (tp->structdefd)
		fprintf(outf, "Conf");
	    fprintf(outf, "{");
	    dumptypename(tp->indextype, 0);
	    fprintf(outf, "}");
	    if (tp->smin) {
		fprintf(outf, "Skip(");
		dumpexpr(tp->smin);
		fprintf(outf, ")");
	    }
	    if (tp->smax) {
		fprintf(outf, "/");
		if (!ISBOGUS(tp->smax))
		    dumptypename(tp->smax->val.type, 0);
		fprintf(outf, "{%d%s}", tp->escale,
			tp->issigned ? "S" : "U");
	    }
	    fprintf(outf, ":");
	    dumptypename(tp->basetype, 0);
	    break;
		    
	  case TK_SMALLSET:
	    fprintf(outf, "Sm");
	    /* fall through */

	  case TK_SET:
	    fprintf(outf, "Set{");
	    dumptypename(tp->indextype, 0);
	    fprintf(outf, "}");
	    break;

	  case TK_FILE:
	    fprintf(outf, "File{");
	    dumptypename(tp->basetype, 0);
	    fprintf(outf, "}");
	    break;

	  case TK_BIGFILE:
	    fprintf(outf, "BigFile{");
	    dumptypename(tp->basetype, 0);
	    fprintf(outf, "}");
	    break;

	  case TK_FUNCTION:
	    fprintf(outf, "Func");
	    if (tp->issigned)
		fprintf(outf, "Link");
	    fprintf(outf, "{");
	    dumptypename(tp->basetype, 0);
	    fprintf(outf, "}");
	    break;

	  case TK_CPROCPTR:
	    fprintf(outf, "C");
	    /* fall through */

	  case TK_PROCPTR:
	    fprintf(outf, "Proc%d{", tp->escale);
	    dumptypename(tp->basetype, 0);
	    fprintf(outf, "}");
	    break;

	  default:
	    fprintf(outf, "%s", typekindname(tp->kind));
	    break;
		    
	}
	if (tp->kind != TK_ARRAY && tp->kind != TK_SMALLARRAY &&
	    (tp->smin || tp->smax)) {
	    fprintf(outf, "{");
	    dumpexpr(tp->smin);
	    fprintf(outf, "..");
	    dumpexpr(tp->smax);
	    fprintf(outf, "}");
	}
    }
#else
    fprintf(outf, "%lX", tp);
#endif
}


void dumptypename_file(f, tp)
FILE *f;
Type *tp;
{
    FILE *save = outf;
    outf = f;
    dumptypename(tp, 1);
    outf = save;
}


void dumpexpr(ex)
Expr *ex;
{
    int i;
    Type *type;
    char *name;

    if (!ex) {
        fprintf(outf, "<NULL>");
        return;
    }
    if (ISBOGUS(ex)) {
	fprintf(outf, "0x%lX", ex);
	return;
    }
    if (ex->kind == EK_CONST && ex->val.type == tp_integer &&
	ex->nargs == 0 && !ex->val.s) {
	fprintf(outf, "%ld", ex->val.i);
	return;
    }
    if (ex->kind == EK_LONGCONST && ex->val.type == tp_integer &&
	ex->nargs == 0 && !ex->val.s) {
	fprintf(outf, "%ldL", ex->val.i);
	return;
    }
    name = exprkindname(ex->kind);
    if (!strncmp(name, "EK_", 3))
	name += 3;
    fprintf(outf, "%s", name);
#ifdef HASDUMPS

    type = ex->val.type;
    fprintf(outf, "/");
    dumptypename(type, 1);
    if (ex->val.i) {
        switch (ex->kind) {

            case EK_VAR:
            case EK_FUNCTION:
            case EK_CTX:
	        if (ISBOGUS(ex->val.i))
		    fprintf(outf, "[0x%lX]", ex->val.i);
		else
		    fprintf(outf, "[\"%s\"]", ((Meaning *)ex->val.i)->name);
                break;

            default:
                fprintf(outf, "[i=%ld]", ex->val.i);
                break;
        }
    }
    if (ISBOGUS(ex->val.s))
	fprintf(outf, "[0x%lX]", ex->val.s);
    else if (ex->val.s) {
        switch (ex->kind) {

            case EK_BICALL:
            case EK_NAME:
            case EK_DOT:
	        fprintf(outf, "[s=\"%s\"]", ex->val.s);
                break;

            default:
                switch (ex->val.type ? ex->val.type->kind : TK_VOID) {
                    case TK_STRING:
                        fprintf(outf, "[s=%s]", makeCstring(ex->val.s, ex->val.i));
                        break;
                    case TK_REAL:
                        fprintf(outf, "[s=%s]", ex->val.s);
                        break;
                    default:
                        fprintf(outf, "[s=%lx]", ex->val.s);
                }
                break;
        }
    }
    if (ex->nargs > 0) {
        fprintf(outf, "(");
        if (ex->nargs < 10) {
            for (i = 0; i < ex->nargs; i++) {
                if (i)
                    fprintf(outf, ", ");
                dumpexpr(ex->args[i]);
            }
        } else
            fprintf(outf, "...");
        fprintf(outf, ")");
    }
#endif
}


void dumpexpr_file(f, ex)
FILE *f;
Expr *ex;
{
    FILE *save = outf;
    outf = f;
    dumpexpr(ex);
    outf = save;
}


void innerdumpstmt(sp, indent)
Stmt *sp;
int indent;
{
#ifdef HASDUMPS
    if (!sp) {
        fprintf(outf, "<NULL>\n");
        return;
    }
    while (sp) {
	if (ISBOGUS(sp)) {
	    fprintf(outf, "0x%lX\n", sp);
	    return;
	}
        fprintf(outf, "%s", stmtkindname(sp->kind));
        if (sp->exp1) {
            fprintf(outf, ", exp1=");
            dumpexpr(sp->exp1);
        }
        if (sp->exp2) {
            fprintf(outf, ", exp2=");
            dumpexpr(sp->exp2);
        }
        if (sp->exp3) {
            fprintf(outf, ", exp3=");
            dumpexpr(sp->exp3);
        }
        fprintf(outf, "\n");
        if (sp->stm1) {
            fprintf(outf, "%*sstm1=", indent, "");
            innerdumpstmt(sp->stm1, indent+5);
        }
        if (sp->stm2) {
            fprintf(outf, "%*sstm2=", indent, "");
            innerdumpstmt(sp->stm2, indent+5);
        }
        sp = sp->next;
        if (sp) {
            if (indent > 5)
                fprintf(outf, "%*s", indent-5, "");
            fprintf(outf, "next=");
        }
    }
#endif
}


void dumpstmt(sp, indent)
Stmt *sp;
int indent;
{
    fprintf(outf, "%*s", indent, "");
    innerdumpstmt(sp, indent);
}


void dumpstmt_file(f, sp)
FILE *f;
Stmt *sp;
{
    FILE *save = outf;
    Stmt *savenext = NULL;
    outf = f;
    if (sp) {
	savenext = sp->next;
	sp->next = NULL;
    }
    dumpstmt(sp, 5);
    if (sp)
	sp->next = savenext;
    outf = save;
}


void wrapup()
{
    int i;

    for (i = 0; i < SYMHASHSIZE; i++)
        dumpsymtable(symtab[i]);
}


void mem_summary()
{
#ifdef TEST_MALLOC
    printf("Summary of memory allocated but not freed:\n");
    printf("Total bytes = %d of %d\n", final_bytes, total_bytes);
    printf("Expressions = %d of %d\n", final_exprs, total_exprs);
    printf("Meanings =    %d of %d (%d of %d)\n",
	   final_meanings, total_meanings,
	   final_meanings / sizeof(Meaning),
	   total_meanings / sizeof(Meaning));
    printf("Strings =     %d of %d\n", final_strings, total_strings);
    printf("Symbols =     %d of %d\n", final_symbols, total_symbols);
    printf("Types =       %d of %d (%d of %d)\n", final_types, total_types,
	   final_types / sizeof(Type), total_types / sizeof(Type));
    printf("Statements =  %d of %d (%d of %d)\n", final_stmts, total_stmts,
	   final_stmts / sizeof(Stmt), total_stmts / sizeof(Stmt));
    printf("Strlists =    %d of %d\n", final_strlists, total_strlists);
    printf("Literals =    %d of %d\n", final_literals, total_literals);
    printf("Ctxstacks =   %d of %d\n", final_ctxstacks, total_ctxstacks);
    printf("Temp vars =   %d of %d\n", final_tempvars, total_tempvars);
    printf("Input recs =  %d of %d\n", final_inprecs, total_inprecs);
    printf("Parens =      %d of %d\n", final_parens, total_parens);
    printf("Ptr Descs =   %d of %d\n", final_ptrdescs, total_ptrdescs);
    printf("Other =       %d of %d\n", final_misc, total_misc);
    printf("\n");
#endif
}


#ifdef TEST_MALLOC

anyptr memlist;

anyptr test_malloc(size, total, final)
int size, *total, *final;
{
    anyptr p;

    p = malloc(size + 3*sizeof(long));
#if 1
    ((anyptr *)p)[0] = memlist;
    memlist = p;
    ((long *)p)[1] = size;
    ((int **)p)[2] = final;
    total_bytes += size;
    final_bytes += size;
    *total += size;
    *final += size;
#endif
    return (anyptr)((long *)p + 3);
}

void test_free(p)
anyptr p;
{
#if 1
    final_bytes -= ((long *)p)[1-3];
    *((int **)p)[2-3] -= ((long *)p)[1-3];
    ((long *)p)[1-3] *= -1;
#endif
}

anyptr test_realloc(p, size)
anyptr p;
int size;
{
    anyptr p2;

    p2 = test_malloc(size, &total_misc, &final_misc);
    memcpy(p2, p, size);
    test_free(p);
    return p2;
}

#endif  /* TEST_MALLOC */


/* End. */