This is trans.c in view mode; [Download] [Up]
/* "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 (*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. */
These are the contents of the former NiCE NeXT User Group NeXTSTEP/OpenStep software archive, currently hosted by Netfuture.ch.