Amiga-Request@cs.odu.edu (Amiga Sources/Binaries Moderator) (01/18/90)
Submitted-by: Olaf 'Rhialto' Seibert <U211344@HNYKUN11.BITNET>
Posting-number: Volume 90, Issue 026
Archive-name: unix/cpp/part05
#!/bin/sh
# This is a shell archive. Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file". To overwrite existing
# files, type "sh file -c". You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g.. If this archive is complete, you
# will see the following message at the end:
# "End of archive 5 (of 5)."
# Contents: Cpp6.c
# Wrapped by tadguy@xanth on Wed Jan 17 19:17:38 1990
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'Cpp6.c' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'Cpp6.c'\"
else
echo shar: Extracting \"'Cpp6.c'\" \(33823 characters\)
sed "s/^X//" >'Cpp6.c' <<'END_OF_FILE'
X/*
X * C P P 6 . C
X * S u p p o r t R o u t i n e s
X *
X * Edit History
X * 25-May-84 MM Added 8-bit support to type table.
X * 30-May-84 ARF sharp() should output filename in quotes
X * 02-Aug-84 MM Newline and #line hacking. sharp() now in cpp1.c
X * 31-Aug-84 MM USENET net.sources release
X * 11-Sep-84 ado/MM Keepcomments, also line number pathological
X * 12-Sep-84 ado/MM bug if comment changes to space and we unget later.
X * 03-Oct-84 gkr/MM Fixed scannumber bug for '.e' (as in struct.element).
X * 04-Oct-84 MM Added ungetstring() for token concatenation
X * 08-Oct-84 MM Yet another attack on number scanning
X * 31-Oct-84 ado Parameterized $ in identifiers
X * 2-Nov-84 MM Token concatenation is messier than I thought
X * 6-Dec-84 MM \<nl> is everywhere invisible.
X * 21-Oct-85 RMS Rename `token' to `tokenbuf'.
X * Dynamically allocate it, and make it as big as needed.
X * 23-Oct-85 RMS Fix bugs storing into tokenbuf as it gets bigger.
X * Change error msg to cpp: "FILE", line LINE: MSG
X * 24-Oct-85 RMS Turn off warnings about / then * inside a comment.
X * 16-Mar-86 FNF Incorporate macro based C debugging package.
X * Port to Commodore Amiga.
X * 20-Aug-88 Ois Added time routines (or actually deleted stubs).
X * 20-Aug-88 Ois Changed handling of token following ## to match Cpp4.
X */
X
X#include <stdio.h>
X#include <ctype.h>
X#include "cppdef.h"
X#include "cpp.h"
X
X/*
X * skipnl() skips over input text to the end of the line.
X * skipws() skips over "whitespace" (spaces or tabs), but
X * not skip over the end of the line. It skips over
X * TOK_SEP, however (though that shouldn't happen).
X * scanid() reads the next token (C identifier) into tokenbuf.
X * The caller has already read the first character of
X * the identifier. Unlike macroid(), the token is
X * never expanded.
X * macroid() reads the next token (C identifier) into tokenbuf.
X * If it is a #defined macro, it is expanded, and
X * macroid() returns TRUE, otherwise, FALSE.
X * catenate() Does the dirty work of token concatenation, TRUE if it did.
X * scanstring() Reads a string from the input stream, calling
X * a user-supplied function for each character.
X * This function may be output() to write the
X * string to the output file, or save() to save
X * the string in the work buffer.
X * scannumber() Reads a C numeric constant from the input stream,
X * calling the user-supplied function for each
X * character. (output() or save() as noted above.)
X * save() Save one character in the work[] buffer.
X * savestring() Saves a string in malloc() memory.
X * getfile() Initialize a new FILEINFO structure, called when
X * #include opens a new file, or a macro is to be
X * expanded.
X * getmem() Get a specified number of bytes from malloc memory.
X * output() Write one character to stdout (calling putchar) --
X * implemented as a function so its address may be
X * passed to scanstring() and scannumber().
X * lookid() Scans the next token (identifier) from the input
X * stream. Looks for it in the #defined symbol table.
X * Returns a pointer to the definition, if found, or NULL
X * if not present. The identifier is stored in tokenbuf.
X * defnedel() Define enter/delete subroutine. Updates the
X * symbol table.
X * get() Read the next byte from the current input stream,
X * handling end of (macro/file) input and embedded
X * comments appropriately. Note that the global
X * instring is -- essentially -- a parameter to get().
X * cget() Like get(), but skip over TOK_SEP.
X * unget() Push last gotten character back on the input stream.
X * cerror(), cwarn(), cfatal(), cierror(), ciwarn()
X * These routines format an print messages to the user.
X * cerror & cwarn take a format and a single string argument.
X * cierror & ciwarn take a format and a single int (char) argument.
X * cfatal takes a format and a single string argument.
X */
X
X/*
X * This table must be rewritten for a non-Ascii machine.
X *
X * Note that several "non-visible" characters have special meaning:
X * Hex 1C QUOTE_PARM --a flag for # stringifying
X * Hex 1D DEF_MAGIC -- a flag to prevent #define recursion.
X * Hex 1E TOK_SEP -- a delimiter for ## token concatenation
X * Hex 1F COM_SEP -- a zero-width whitespace for comment concatenation
X */
X#if TOK_SEP != 0x1E || COM_SEP != 0x1F || DEF_MAGIC != 0x1D
X << error type table isn't correct >>
X#endif
X
X#if OK_DOLLAR
X#define DOL LET
X#else
X#define DOL 000
X#endif
X
Xchar type[256] = { /* Character type codes Hex */
X END, 000, 000, 000, 000, 000, 000, 000, /* 00 */
X 000, SPA, 000, 000, 000, 000, 000, 000, /* 08 */
X 000, 000, 000, 000, 000, 000, 000, 000, /* 10 */
X 000, 000, 000, 000, 000, LET, 000, SPA, /* 18 */
X SPA,OP_NOT, QUO, 000, DOL,OP_MOD,OP_AND, QUO, /* 20 !"#$%&' */
XOP_LPA,OP_RPA,OP_MUL,OP_ADD, 000,OP_SUB, DOT,OP_DIV, /* 28 ()*+,-./ */
X DIG, DIG, DIG, DIG, DIG, DIG, DIG, DIG, /* 30 01234567 */
X DIG, DIG,OP_COL, 000, OP_LT, OP_EQ, OP_GT,OP_QUE, /* 38 89:;<=>? */
X 000, LET, LET, LET, LET, LET, LET, LET, /* 40 @ABCDEFG */
X LET, LET, LET, LET, LET, LET, LET, LET, /* 48 HIJKLMNO */
X LET, LET, LET, LET, LET, LET, LET, LET, /* 50 PQRSTUVW */
X LET, LET, LET, 000, BSH, 000,OP_XOR, LET, /* 58 XYZ[\]^_ */
X 000, LET, LET, LET, LET, LET, LET, LET, /* 60 `abcdefg */
X LET, LET, LET, LET, LET, LET, LET, LET, /* 68 hijklmno */
X LET, LET, LET, LET, LET, LET, LET, LET, /* 70 pqrstuvw */
X LET, LET, LET, 000, OP_OR, 000,OP_NOT, 000, /* 78 xyz{|}~ */
X 000, 000, 000, 000, 000, 000, 000, 000, /* 80 .. FF */
X 000, 000, 000, 000, 000, 000, 000, 000, /* 80 .. FF */
X 000, 000, 000, 000, 000, 000, 000, 000, /* 80 .. FF */
X 000, 000, 000, 000, 000, 000, 000, 000, /* 80 .. FF */
X 000, 000, 000, 000, 000, 000, 000, 000, /* 80 .. FF */
X 000, 000, 000, 000, 000, 000, 000, 000, /* 80 .. FF */
X 000, 000, 000, 000, 000, 000, 000, 000, /* 80 .. FF */
X 000, 000, 000, 000, 000, 000, 000, 000, /* 80 .. FF */
X};
X
Xskipnl()
X/*
X * Skip to the end of the current input line.
X */
X{
X register int c;
X
X DBUG_ENTER ("skipnl");
X do { /* Skip to newline */
X c = get();
X } while (c != '\n' && c != EOF_CHAR);
X DBUG_VOID_RETURN;
X}
X
Xint
Xskipws()
X/*
X * Skip over whitespace
X */
X{
X register int c;
X
X DBUG_ENTER ("skipws");
X do { /* Skip whitespace */
X c = get();
X#if COMMENT_INVISIBLE
X } while (type[c] == SPA || c == COM_SEP);
X#else
X } while (type[c] == SPA);
X#endif
X DBUG_RETURN (c);
X}
X
Xscanid(c)
Xregister int c; /* First char of id */
X/*
X * Get the next token (an id) into the token buffer.
X * Note: this code is duplicated in lookid().
X * Change one, change both.
X */
X{
X register int ct;
X
X DBUG_ENTER ("scanid");
X if (c == DEF_MAGIC) /* Eat the magic token */
X c = get(); /* undefiner. */
X ct = 0;
X do
X {
X if (ct == tokenbsize)
X#ifdef amiga
X /*
X * Duplicate the action of incmem, which grows the area
X * to the new size, reallocating and copying if necessary.
X * The disadvantage of this emulation is that the copy is
X * always done because we have no realloc().
X */
X {
X extern char *malloc ();
X extern char *memcpy ();
X char *new = malloc ((unsigned) (1 + (tokenbsize *= 2)));
X if (new == NULL) {
X cfatal("Out of memory", NULLST);
X } else {
X memcpy (new, tokenbuf, ct);
X free (tokenbuf);
X tokenbuf = new;
X }
X }
X#else
X tokenbuf = incmem (tokenbuf, 1 + (tokenbsize *= 2));
X#endif
X tokenbuf[ct++] = c;
X c = get();
X }
X while (type[c] == LET || type[c] == DIG);
X unget();
X tokenbuf[ct] = EOS;
X DBUG_VOID_RETURN;
X}
X
Xint
Xmacroid(c)
Xregister int c;
X/*
X * If c is a letter, scan the id. if it's #defined, expand it and scan
X * the next character and try again.
X *
X * Else, return the character. If type[c] is a LET, the token is in tokenbuf.
X */
X{
X register DEFBUF *dp;
X
X DBUG_ENTER ("macroid");
X if (infile != NULL && infile->fp != NULL)
X recursion = 0;
X while (type[c] == LET && (dp = lookid(c)) != NULL) {
X expand(dp);
X c = get();
X }
X DBUG_RETURN (c);
X}
X
Xint
Xcatenate()
X/*
X * A token was just read (via macroid).
X * If the next character is TOK_SEP, concatenate the next token
X * return TRUE -- which should recall macroid after refreshing
X * macroid's argument. If it is not TOK_SEP, unget() the character
X * and return FALSE.
X */
X{
X#if OK_CONCAT
X register int c;
X register char *token1;
X int save();
X#endif
X
X DBUG_ENTER ("catenate");
X#if OK_CONCAT
X if (get() != TOK_SEP) { /* Token concatenation */
X unget();
X DBUG_RETURN (FALSE);
X }
X else {
X token1 = savestring(tokenbuf); /* Save first token */
X c = macroid(get()); /* Scan next token */
X switch(type[c]) { /* What was it? */
X case LET: /* An identifier, ... */
X if (strlen(token1) + strlen(tokenbuf) >= NWORK)
X cfatal("work buffer overflow doing %s ##", token1);
X sprintf(work, "%s%s", token1, tokenbuf);
X break;
X
X case DIG: /* A number */
X case DOT: /* Or maybe a float */
X strcpy(work, token1);
X workp = work + strlen(work);
X#if 0
X do {
X save(c);
X } while ((c = get()) != TOK_SEP);
X#else
X scannumber(c, save);
X#endif
X save(EOS);
X break;
X
X default: /* An error, ... */
X if (isprint(c))
X cierror("Strange character '%c' after ##", c);
X else
X cierror("Strange character (%d.) after ##", c);
X strcpy(work, token1);
X unget();
X break;
X }
X /*
X * work has the concatenated token and token1 has
X * the first token (no longer needed). Unget the
X * new (concatenated) token after freeing token1.
X * Finally, setup to read the new token.
X */
X free(token1); /* Free up memory */
X ungetstring(work); /* Unget the new thing, */
X DBUG_RETURN (TRUE);
X }
X#else
X DBUG_RETURN (FALSE); /* Not supported */
X#endif
X}
X
Xint
Xscanstring(delim, outfun)
Xregister int delim; /* ' or " */
Xint (*outfun)(); /* Output function */
X/*
X * Scan off a string. Warning if terminated by newline or EOF.
X * outfun() outputs the character -- to a buffer if in a macro.
X * TRUE if ok, FALSE if error.
X */
X{
X register int c;
X
X DBUG_ENTER ("scanstring");
X instring = TRUE; /* Don't strip comments */
X (*outfun)(delim);
X while ((c = get()) != delim
X && c != '\n'
X && c != EOF_CHAR) {
X (*outfun)(c);
X if (c == '\\')
X (*outfun)(get());
X }
X instring = FALSE;
X if (c == delim) {
X (*outfun)(c);
X DBUG_RETURN (TRUE);
X }
X else {
X cerror("Unterminated string", NULLST);
X unget();
X DBUG_RETURN (FALSE);
X }
X}
X
Xscannumber(c, outfun)
Xregister int c; /* First char of number */
Xregister int (*outfun)(); /* Output/store func */
X/*
X * Process a number. We know that c is from 0 to 9 or dot.
X * Algorithm from Dave Conroy's Decus C.
X */
X{
X register int radix; /* 8, 10, or 16 */
X int expseen; /* 'e' seen in floater */
X int signseen; /* '+' or '-' seen */
X int octal89; /* For bad octal test */
X int dotflag; /* TRUE if '.' was seen */
X
X DBUG_ENTER ("scannumber");
X expseen = FALSE; /* No exponent seen yet */
X signseen = TRUE; /* No +/- allowed yet */
X octal89 = FALSE; /* No bad octal yet */
X radix = 10; /* Assume decimal */
X if ((dotflag = (c == '.')) != FALSE) { /* . something? */
X (*outfun)('.'); /* Always out the dot */
X if (type[(c = get())] != DIG) { /* If not a float numb, */
X unget(); /* Rescan strange char */
X DBUG_VOID_RETURN; /* All done for now */
X }
X } /* End of float test */
X else if (c == '0') { /* Octal or hex? */
X (*outfun)(c); /* Stuff initial zero */
X radix = 8; /* Assume it's octal */
X c = get(); /* Look for an 'x' */
X if (c == 'x' || c == 'X') { /* Did we get one? */
X radix = 16; /* Remember new radix */
X (*outfun)(c); /* Stuff the 'x' */
X c = get(); /* Get next character */
X }
X }
X for (;;) { /* Process curr. char. */
X /*
X * Note that this algorithm accepts "012e4" and "03.4"
X * as legitimate floating-point numbers.
X */
X if (radix != 16 && (c == 'e' || c == 'E')) {
X if (expseen) /* Already saw 'E'? */
X break; /* Exit loop, bad nbr. */
X expseen = TRUE; /* Set exponent seen */
X signseen = FALSE; /* We can read '+' now */
X radix = 10; /* Decimal exponent */
X }
X else if (radix != 16 && c == '.') {
X if (dotflag) /* Saw dot already? */
X break; /* Exit loop, two dots */
X dotflag = TRUE; /* Remember the dot */
X radix = 10; /* Decimal fraction */
X }
X else if (c == '+' || c == '-') { /* 1.0e+10 */
X if (signseen) /* Sign in wrong place? */
X break; /* Exit loop, not nbr. */
X /* signseen = TRUE; */ /* Remember we saw it */
X }
X else { /* Check the digit */
X switch (c) {
X case '8': case '9': /* Sometimes wrong */
X octal89 = TRUE; /* Do check later */
X case '0': case '1': case '2': case '3':
X case '4': case '5': case '6': case '7':
X break; /* Always ok */
X
X case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
X case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
X if (radix == 16) /* Alpha's are ok only */
X break; /* if reading hex. */
X default: /* At number end */
X goto done; /* Break from for loop */
X } /* End of switch */
X } /* End general case */
X (*outfun)(c); /* Accept the character */
X signseen = TRUE; /* Don't read sign now */
X c = get(); /* Read another char */
X } /* End of scan loop */
X /*
X * When we break out of the scan loop, c contains the first
X * character (maybe) not in the number. If the number is an
X * integer, allow a trailing 'L' for long and/or a trailing 'U'
X * for unsigned. If not those, push the trailing character back
X * on the input stream. Floating point numbers accept a trailing
X * 'L' for "long double".
X */
Xdone: if (dotflag || expseen) { /* Floating point? */
X if (c == 'l' || c == 'L') {
X (*outfun)(c);
X c = get(); /* Ungotten later */
X }
X }
X else { /* Else it's an integer */
X /*
X * We know that dotflag and expseen are both zero, now:
X * dotflag signals "saw 'L'", and
X * expseen signals "saw 'U'".
X */
X for (;;) {
X switch (c) {
X case 'l':
X case 'L':
X if (dotflag)
X goto nomore;
X dotflag = TRUE;
X break;
X
X case 'u':
X case 'U':
X if (expseen)
X goto nomore;
X expseen = TRUE;
X break;
X
X default:
X goto nomore;
X }
X (*outfun)(c); /* Got 'L' or 'U'. */
X c = get(); /* Look at next, too. */
X }
X }
Xnomore: unget(); /* Not part of a number */
X if (octal89 && radix == 8)
X cwarn("Illegal digit in octal number", NULLST);
X DBUG_VOID_RETURN;
X}
X
Xsave(c)
Xregister int c;
X{
X if (workp >= &work[NWORK])
X cfatal("Work buffer overflow", NULLST);
X else *workp++ = c;
X}
X
Xchar *
Xsavestring(text)
Xchar *text;
X/*
X * Store a string into free memory.
X */
X{
X register char *result;
X
X DBUG_ENTER ("savestring");
X result = getmem(strlen(text) + 1);
X strcpy(result, text);
X DBUG_RETURN (result);
X}
X
XFILEINFO *
Xgetfile(bufsize, name)
Xint bufsize; /* Line or define buffer size */
Xchar *name; /* File or macro name string */
X/*
X * Common FILEINFO buffer initialization for a new file or macro.
X */
X{
X register FILEINFO *file;
X register int size;
X
X DBUG_ENTER ("getfile");
X size = strlen(name); /* File/macro name */
X file = (FILEINFO *) getmem((int)(sizeof (FILEINFO) + bufsize + size));
X file->parent = infile; /* Chain files together */
X file->fp = NULL; /* No file yet */
X file->filename = savestring(name); /* Save file/macro name */
X file->progname = NULL; /* No #line seen yet */
X file->unrecur = 0; /* No macro fixup */
X file->bptr = file->buffer; /* Initialize line ptr */
X file->buffer[0] = EOS; /* Force first read */
X file->line = 0; /* (Not used just yet) */
X if (infile != NULL) /* If #include file */
X infile->line = line; /* Save current line */
X infile = file; /* New current file */
X line = 1; /* Note first line */
X DBUG_RETURN (file); /* All done. */
X}
X
Xchar *
Xgetmem(size)
Xint size;
X/*
X * Get a block of free memory.
X */
X{
X register char *result;
X extern char *malloc();
X
X DBUG_ENTER ("getmem");
X if ((result = malloc((unsigned) size)) == NULL)
X cfatal("Out of memory", NULLST);
X DBUG_RETURN (result);
X}
X
X#ifndef amiga
Xchar *
Xincmem(obj,size)
Xchar *obj;
Xint size;
X/*
X * Get a block of free memory.
X */
X{
X register char *result;
X extern char *realloc();
X
X DBUG_ENTER ("incmem");
X if ((result = realloc(obj, (unsigned) size)) == NULL)
X cfatal("Out of memory", NULLST);
X DBUG_RETURN (result);
X}
X#endif /* amiga */
X
X/*
X * C P P S y m b o l T a b l e s
X */
X
X/*
X * SBSIZE defines the number of hash-table slots for the symbol table.
X * It must be a power of 2.
X */
X#ifndef SBSIZE
X#define SBSIZE 64
X#endif
X#define SBMASK (SBSIZE - 1)
X#if (SBSIZE ^ SBMASK) != ((SBSIZE * 2) - 1)
X << error, SBSIZE must be a power of 2 >>
X#endif
X
Xstatic DEFBUF *symtab[SBSIZE]; /* Symbol table queue headers */
X
XDEFBUF *
Xlookid(c)
Xint c; /* First character of token */
X/*
X * Look for the next token in the symbol table. Returns token in tokenbuf.
X * If found, returns the table pointer; Else returns NULL.
X */
X{
X register int nhash;
X register DEFBUF *dp;
X register int ct;
X int temp;
X int isrecurse; /* For #define foo foo */
X
X DBUG_ENTER ("lookid");
X nhash = 0;
X if ((isrecurse = (c == DEF_MAGIC))) /* If recursive macro */
X c = get(); /* hack, skip DEF_MAGIC */
X ct = 0;
X do
X {
X if (ct == tokenbsize)
X#ifdef amiga
X /*
X * Duplicate the action of incmem, which grows the area
X * to the new size, reallocating and copying if necessary.
X * The disadvantage of this emulation is that the copy is
X * always done because we have no realloc().
X */
X {
X extern char *malloc ();
X extern char *memcpy ();
X char *new = malloc ((unsigned) (1 + (tokenbsize *= 2)));
X if (new == NULL) {
X cfatal("Out of memory", NULLST);
X } else {
X memcpy (new, tokenbuf, ct);
X free (tokenbuf);
X tokenbuf = new;
X }
X }
X#else
X tokenbuf = incmem(tokenbuf, 1 + (tokenbsize *= 2));
X#endif
X tokenbuf[ct++] = c; /* Store token byte */
X nhash += c; /* Update hash value */
X c = get();
X }
X while (type[c] == LET || type[c] == DIG);
X unget(); /* Rescan terminator */
X tokenbuf[ct] = EOS; /* Terminate token */
X if (isrecurse) /* Recursive definition */
X DBUG_RETURN (NULL); /* undefined just now */
X nhash += ct; /* Fix hash value */
X dp = symtab[nhash & SBMASK]; /* Starting bucket */
X while (dp != (DEFBUF *) NULL) { /* Search symbol table */
X if (dp->hash == nhash /* Fast precheck */
X && (temp = strcmp(dp->name, tokenbuf)) >= 0)
X break;
X dp = dp->link; /* Nope, try next one */
X }
X DBUG_RETURN ((temp == 0) ? dp : NULL);
X}
X
XDEFBUF *
Xdefendel(name, delete)
Xchar *name;
Xint delete; /* TRUE to delete a symbol */
X/*
X * Enter this name in the lookup table (delete = FALSE)
X * or delete this name (delete = TRUE).
X * Returns a pointer to the define block (delete = FALSE)
X * Returns NULL if the symbol wasn't defined (delete = TRUE).
X */
X{
X register DEFBUF *dp;
X register DEFBUF **prevp;
X register char *np;
X int nhash;
X int temp;
X int size;
X
X DBUG_ENTER ("defendel");
X for (nhash = 0, np = name; *np != EOS;)
X nhash += *np++;
X size = (np - name);
X nhash += size;
X prevp = &symtab[nhash & SBMASK];
X while ((dp = *prevp) != (DEFBUF *) NULL) {
X if (dp->hash == nhash
X && (temp = strcmp(dp->name, name)) >= 0) {
X if (temp > 0)
X dp = NULL; /* Not found */
X else {
X *prevp = dp->link; /* Found, unlink and */
X if (dp->repl != NULL) /* Free the replacement */
X free(dp->repl); /* if any, and then */
X free((char *) dp); /* Free the symbol */
X }
X break;
X }
X prevp = &dp->link;
X }
X if (!delete) {
X dp = (DEFBUF *) getmem((int) (sizeof (DEFBUF) + size));
X dp->link = *prevp;
X *prevp = dp;
X dp->hash = nhash;
X dp->repl = NULL;
X dp->nargs = 0;
X strcpy(dp->name, name);
X }
X DBUG_RETURN (dp);
X}
X
X#if DEBUG
X
Xdumpdef(why)
Xchar *why;
X{
X register DEFBUF *dp;
X register DEFBUF **syp;
X
X DBUG_ENTER ("dumpdef");
X printf("CPP symbol table dump %s\n", why);
X for (syp = symtab; syp < &symtab[SBSIZE]; syp++) {
X if ((dp = *syp) != (DEFBUF *) NULL) {
X printf("symtab[%d]\n", (syp - symtab));
X do {
X dumpadef((char *) NULL, dp);
X } while ((dp = dp->link) != (DEFBUF *) NULL);
X }
X }
X DBUG_VOID_RETURN;
X}
X
Xdumpadef(why, dp)
Xchar *why; /* Notation */
Xregister DEFBUF *dp;
X{
X register char *cp;
X register int c;
X
X DBUG_ENTER ("dumpadef");
X printf(" \"%s\" [%d]", dp->name, dp->nargs);
X if (why != NULL)
X printf(" (%s)", why);
X if (dp->repl != NULL) {
X printf(" => ");
X for (cp = dp->repl; (c = *cp++ & 0xFF) != EOS;) {
X if (c >= MAC_PARM && c <= (MAC_PARM + PAR_MAC))
X printf("<%d>", c - MAC_PARM);
X else if (isprint(c) || c == '\n' || c == '\t')
X putchar(c);
X else if (c < ' ')
X printf("<^%c>", c + '@');
X else
X printf("<\\0%o>", c);
X }
X }
X else {
X printf(", no replacement.");
X }
X putchar('\n');
X DBUG_VOID_RETURN;
X}
X#endif
X
Xoutdefines()
X{
X register DEFBUF *dp;
X register DEFBUF **syp;
X
X DBUG_ENTER ("outdefines");
X deldefines(); /* Delete built-in #defines */
X for (syp = symtab; syp < &symtab[SBSIZE]; syp++) {
X if ((dp = *syp) != (DEFBUF *) NULL) {
X do {
X outadefine(dp);
X } while ((dp = dp->link) != (DEFBUF *) NULL);
X }
X }
X DBUG_VOID_RETURN;
X}
X
Xoutadefine(dp)
Xregister DEFBUF *dp;
X{
X register char *cp;
X register int c;
X
X DBUG_ENTER ("outadefine");
X printf("#define %s", dp->name);
X if (dp->nargs > 0) {
X register int i;
X printf("(");
X for (i = 1; i < dp->nargs; i++) {
X printf("__%d,", i);
X }
X printf("__%d)", i);
X } else if (dp->nargs == 0) {
X printf("()");
X }
X if (dp->repl != NULL) {
X printf("\t");
X for (cp = dp->repl; (c = *cp++ & 0xFF) != EOS;) {
X if (c >= MAC_PARM && c < (MAC_PARM + PAR_MAC))
X printf("__%d", c - MAC_PARM + 1);
X else if (isprint(c) || c == '\t' || c == '\n')
X putchar(c);
X else switch (c) {
X case QUOTE_PARM:
X printf("#");
X break;
X case DEF_MAGIC: /* Special anti-recursion */
X case MAC_PARM + PAR_MAC: /* Special "arg" marker */
X break;
X case COM_SEP:
X#if COMMENT_INVISIBLE
X printf("/**/");
X#else
X printf(" ");
X#endif
X break;
X case TOK_SEP:
X printf("##");
X break;
X default:
X printf("\\0%o", c);
X }
X }
X }
X putchar('\n');
X DBUG_VOID_RETURN;
X}
X
X/*
X * G E T
X */
X
Xint
Xget()
X/*
X * Return the next character from a macro or the current file.
X * Handle end of file from #include files.
X */
X{
X register int c;
X register FILEINFO *file;
X register int popped; /* Recursion fixup */
X extern char *fgets ();
X
X DBUG_ENTER ("get");
X popped = 0;
Xget_from_file:
X if ((file = infile) == NULL)
X DBUG_RETURN (EOF_CHAR);
Xnewline:
X#if 0
X printf("get(%s), recursion %d, line %d, bptr = %d, buffer \"%s\"\n",
X file->filename, recursion, line,
X file->bptr - file->buffer, file->buffer);
X#endif
X /*
X * Read a character from the current input line or macro.
X * At EOS, either finish the current macro (freeing temp.
X * storage) or read another line from the current input file.
X * At EOF, exit the current file (#include) or, at EOF from
X * the cpp input file, return EOF_CHAR to finish processing.
X */
X if ((c = *file->bptr++ & 0xFF) == EOS) {
X /*
X * Nothing in current line or macro. Get next line (if
X * input from a file), or do end of file/macro processing.
X * In the latter case, jump back to restart from the top.
X */
X if (file->fp == NULL) { /* NULL if macro */
X popped++;
X recursion -= file->unrecur;
X if (recursion < 0)
X recursion = 0;
X infile = file->parent; /* Unwind file chain */
X }
X else { /* Else get from a file */
X if ((file->bptr = fgets(file->buffer, NBUFF, file->fp))
X != NULL) {
X#if DEBUG
X if (debug > 1) { /* Dump it to stdout */
X printf("\n#line %d (%s), %s",
X line, file->filename, file->buffer);
X }
X#endif
X goto newline; /* process the line */
X }
X else {
X fclose(file->fp); /* Close finished file */
X if ((infile = file->parent) != NULL) {
X /*
X * There is an "ungotten" newline in the current
X * infile buffer (set there by doinclude() in
X * cpp1.c). Thus, we know that the mainline code
X * is skipping over blank lines and will do a
X * #line at its convenience.
X */
X wrongline = TRUE; /* Need a #line now */
X }
X }
X }
X /*
X * Free up space used by the (finished) file or macro and
X * restart input from the parent file/macro, if any.
X */
X free(file->filename); /* Free name and */
X if (file->progname != NULL) /* if a #line was seen, */
X free(file->progname); /* free it, too. */
X free((char *) file); /* Free file space */
X if (infile == NULL) /* If at end of file */
X DBUG_RETURN (EOF_CHAR); /* Return end of file */
X line = infile->line; /* Reset line number */
X goto get_from_file; /* Get from the top. */
X }
X /*
X * Common processing for the new character.
X */
X if (c == DEF_MAGIC && file->fp != NULL) /* Don't allow delete */
X goto newline; /* from a file */
X if (file->parent != NULL) { /* Macro or #include */
X if (popped != 0)
X file->parent->unrecur += popped;
X else {
X recursion -= file->parent->unrecur;
X if (recursion < 0)
X recursion = 0;
X file->parent->unrecur = 0;
X }
X }
X if (c == '\n') /* Maintain current */
X ++line; /* line counter */
X if (instring) /* Strings just return */
X DBUG_RETURN (c); /* the character. */
X else if (c == '/') { /* Comment? */
X instring = TRUE; /* So get() won't loop */
X if ((c = get()) != '*') { /* Next byte '*'? */
X instring = FALSE; /* Nope, no comment */
X unget(); /* Push the char. back */
X DBUG_RETURN ('/'); /* Return the slash */
X }
X if (keepcomments) { /* If writing comments */
X putchar('/'); /* Write out the */
X putchar('*'); /* initializer */
X }
X for (;;) { /* Eat a comment */
X c = get();
Xtest: if (keepcomments && c != EOF_CHAR)
X cput(c);
X switch (c) {
X case EOF_CHAR:
X cerror("EOF in comment", NULLST);
X DBUG_RETURN (EOF_CHAR);
X
X#ifdef NOTDEF
X case '/':
X if ((c = get()) != '*') /* Don't let comments */
X goto test; /* Nest. */
X cwarn("Nested comments", NULLST);
X#endif /* NOTDEF */
X /* Fall into * stuff */
X case '*':
X if ((c = get()) != '/') /* If comment doesn't */
X goto test; /* end, look at next */
X instring = FALSE; /* End of comment, */
X if (keepcomments) { /* Put out the comment */
X cput(c); /* terminator, too */
X }
X /*
X * A comment is syntactically "whitespace" --
X * however, there are certain strange sequences
X * such as
X * #define foo(x) (something)
X * foo|* comment *|(123)
X * these are '/' ^ ^
X * where just returning space (or COM_SEP) will cause
X * problems. This can be "fixed" by overwriting the
X * '/' in the input line buffer with ' ' (or COM_SEP)
X * but that may mess up an error message.
X * So, we peek ahead -- if the next character is
X * "whitespace" we just get another character, if not,
X * we modify the buffer. All in the name of purity.
X */
X if (*file->bptr == '\n'
X || type[*file->bptr & 0xFF] == SPA)
X goto newline;
X#if COMMENT_INVISIBLE
X /*
X * Return magic (old-fashioned) syntactic space.
X */
X DBUG_RETURN ((file->bptr[-1] = COM_SEP));
X#else
X DBUG_RETURN ((file->bptr[-1] = ' '));
X#endif
X
X case '\n': /* we'll need a #line */
X if (!keepcomments)
X wrongline = TRUE; /* later... */
X default: /* Anything else is */
X break; /* Just a character */
X } /* End switch */
X } /* End comment loop */
X } /* End if in comment */
X else if (!inmacro && c == '\\') { /* If backslash, peek */
X if ((c = get()) == '\n') { /* for a <nl>. If so, */
X wrongline = TRUE;
X goto newline;
X }
X else { /* Backslash anything */
X unget(); /* Get it later */
X DBUG_RETURN ('\\'); /* Return the backslash */
X }
X }
X else if (c == '\f' || c == VT) /* Form Feed, Vertical */
X c = ' '; /* Tab are whitespace */
X DBUG_RETURN (c); /* Just return the char */
X}
X
Xunget()
X/*
X * Backup the pointer to reread the last character. Fatal error
X * (code bug) if we backup too far. unget() may be called,
X * without problems, at end of file. Only one character may
X * be ungotten. If you need to unget more, call ungetstring().
X */
X{
X register FILEINFO *file;
X
X DBUG_ENTER ("unget");
X if ((file = infile) == NULL)
X DBUG_VOID_RETURN; /* Unget after EOF */
X if (--file->bptr < file->buffer)
X cfatal("Too much pushback", NULLST);
X if (*file->bptr == '\n') /* Ungetting a newline? */
X --line; /* Unget the line number, too */
X DBUG_VOID_RETURN;
X}
X
Xungetstring(text)
Xchar *text;
X/*
X * Push a string back on the input stream. This is done by treating
X * the text as if it were a macro.
X */
X{
X register FILEINFO *file;
X extern FILEINFO *getfile();
X
X DBUG_ENTER ("ungetstring");
X file = getfile(strlen(text) + 1, "");
X strcpy(file->buffer, text);
X DBUG_VOID_RETURN;
X}
X
Xint
Xcget()
X/*
X * Get one character, absorb "funny space" after comments or
X * token concatenation
X */
X{
X register int c;
X
X DBUG_ENTER ("cget");
X do {
X c = get();
X#if COMMENT_INVISIBLE
X } while (c == TOK_SEP || c == COM_SEP);
X#else
X } while (c == TOK_SEP);
X#endif
X DBUG_RETURN (c);
X}
X
X/*
X * Error messages and other hacks. The first byte of severity
X * is 'S' for string arguments and 'I' for int arguments. This
X * is needed for portability with machines that have int's that
X * are shorter than char *'s.
X */
X
Xstatic
Xdomsg(severity, format, arg)
Xchar *severity; /* "Error", "Warning", "Fatal" */
Xchar *format; /* Format for the error message */
Xchar *arg; /* Something for the message */
X/*
X * Print filenames, macro names, and line numbers for error messages.
X */
X{
X register char *tp;
X register FILEINFO *file;
X
X DBUG_ENTER ("domsg");
X for (file = infile; file && !file->fp; file = file->parent)
X ;
X tp = file ? file->filename : 0;
X fprintf (stderr, "%s\"%s\", line %d: %s: ",
X MSG_PREFIX, tp, line, &severity[1]);
X if (*severity == 'S')
X fprintf(stderr, format, arg);
X else
X fprintf(stderr, format, (int) arg);
X putc('\n', stderr);
X
X if (file) /*OIS*0.92*/
X while ((file = file->parent) != NULL) { /* Print #includes, too */
X tp = file->parent ? "," : ".";
X if (file->fp == NULL)
X fprintf(stderr, " from macro %s%s\n", file->filename, tp);
X else {
X fprintf(stderr, " from file %s, line %d%s\n",
X (file->progname != NULL)
X ? file->progname : file->filename,
X file->line, tp);
X }
X }
X DBUG_VOID_RETURN;
X}
X
Xcerror(format, sarg)
Xchar *format;
Xchar *sarg; /* Single string argument */
X/*
X * Print a normal error message, string argument.
X */
X{
X DBUG_ENTER ("cerror");
X domsg("SError", format, sarg);
X errors++;
X DBUG_VOID_RETURN;
X}
X
Xcierror(format, narg)
Xchar *format;
Xint narg; /* Single numeric argument */
X/*
X * Print a normal error message, numeric argument.
X */
X{
X DBUG_ENTER ("cierror");
X domsg("IError", format, (char *) narg);
X errors++;
X DBUG_VOID_RETURN;
X}
X
Xcfatal(format, sarg)
Xchar *format;
Xchar *sarg; /* Single string argument */
X/*
X * A real disaster
X */
X{
X DBUG_ENTER ("cfatal");
X domsg("SFatal error", format, sarg);
X exit(IO_ERROR);
X DBUG_VOID_RETURN;
X}
X
Xcwarn(format, sarg)
Xchar *format;
Xchar *sarg; /* Single string argument */
X/*
X * A non-fatal error, string argument.
X */
X{
X DBUG_ENTER ("cwarn");
X domsg("SWarning", format, sarg);
X DBUG_VOID_RETURN;
X}
X
Xciwarn(format, narg)
Xchar *format;
Xint narg; /* Single numeric argument */
X/*
X * A non-fatal error, numeric argument.
X */
X{
X DBUG_ENTER ("ciwarn");
X domsg("IWarning", format, (char *) narg);
X DBUG_VOID_RETURN;
X}
X
X#if amiga
X
Xchar *memcpy (s1, s2, n)
Xchar *s1, *s2;
Xint n;
X{
X char *saves1 = s1;
X
X DBUG_ENTER ("memcpy");
X while (n-- > 0) {
X *s1++ = *s2++;
X }
X DBUG_RETURN (saves1);
X}
X
X#endif /* amiga */
END_OF_FILE
if test 33823 -ne `wc -c <'Cpp6.c'`; then
echo shar: \"'Cpp6.c'\" unpacked with wrong size!
fi
# end of 'Cpp6.c'
fi
echo shar: End of archive 5 \(of 5\).
cp /dev/null ark5isdone
MISSING=""
for I in 1 2 3 4 5 ; do
if test ! -f ark${I}isdone ; then
MISSING="${MISSING} ${I}"
fi
done
if test "${MISSING}" = "" ; then
echo You have unpacked all 5 archives.
rm -f ark[1-9]isdone
else
echo You still need to unpack the following archives:
echo " " ${MISSING}
fi
## End of shell archive.
exit 0
--
Submissions to comp.sources.amiga and comp.binaries.amiga should be sent to:
amiga@cs.odu.edu
or amiga@xanth.cs.odu.edu ( obsolescent mailers may need this address )
or ...!uunet!xanth!amiga ( very obsolescent mailers need this address )
Comments, questions, and suggestions s should be addressed to ``amiga-request''
(only use ``amiga'' for submissions) at the above addresses.