/* "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 /* 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< 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< %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, ""); 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, ""); 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, "", 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("", (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("", (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("", (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("", (int) kind); } void dumptype(tp) Type *tp; { if (!tp) { fprintf(outf, "\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, "\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 : ""), 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, ""); 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, ""); 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, "\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. */