rsalz@uunet.uu.net (Rich Salz) (10/24/89)
Submitted-by: Edoardo Biagioni <biagioni@cs.unc.edu>
Posting-number: Volume 20, Issue 51
Archive-name: fpc/part02
# This is a shell archive.
# Remove everything above and including the cut line.
# Then run the rest of the file through sh.
-----cut here-----cut here-----cut here-----cut here-----
#!/bin/sh
# shar: Shell Archiver
# Run the following text with /bin/sh to create:
# fp.c.part1
# lex.yy.c
echo shar: extracting fp.c.part1 '(32154 characters)'
sed 's/^XX//' << \SHAR_EOF > fp.c.part1
XX#include <stdio.h>
XX#include <strings.h>
XX#include <ctype.h>
XX#include "fp.h"
XX
XXextern char * malloc ();
XXextern char * sprintf ();
XXextern exit ();
XX/* for me, this should be void exit, but the man (3) page doesn't
XX * think so. Some implementations have void exit, some don't, so
XX * either way there is no way to tell lint to shut up about it.
XX * Just ignore it if it comes up */
XX
XXstruct fp_object nilobj = {NILOBJ};
XXstruct fp_object tobj = {TRUEOBJ};
XXstruct fp_object fobj = {FALSEOBJ};
XX
XXstruct stackframe * stack = 0;
XX
XXint fpargc;
XXchar ** fpargv;
XX
XXfp_data staticstore = 0; /* a vector of all the things that
XX * are allocated statically, so we can
XX * return them at the end. */
XX
XX/*
XX#define NORETURN 1
XX */
XX/*
XX#ifdef DEBUG
XX#define TSTRET /* used to test reference counting * /
XX#define CHECKREF /* used to print reference count, pointer values * /
XX#endif
XX */
XX#ifdef NOCHECK
XX#define NCOUNTVEC
XX/* nocheck is the fast option, so if we have it we certainly don't want
XX to count vectors */
XX#endif
XX
XX#ifdef NCOUNTVEC
XX#ifdef TSTRET
XX#undef NCOUNTVEC
XX#endif
XX#endif
XX
XX#define nonvector(x) ((x->fp_type != NILOBJ) && \
XX (x->fp_type != VECTOR))
XX#define nonboolean(x) ((x->fp_type != TRUEOBJ) && \
XX (x->fp_type != FALSEOBJ))
XX
XX#ifndef NOCHECK
XXvoid checkpair (data, fname)
XXfp_data data;
XXchar * fname;
XX{
XX void parmbot ();
XX
XX if (data->fp_type != VECTOR)
XX parmbot (fname, "input is not a vector", data);
XX if ((data->fp_header.fp_next == 0) ||
XX (data->fp_header.fp_next->fp_header.fp_next != 0))
XX parmbot (fname, "input is not a 2-element vector", data);
XX}
XX#else
XX#define checkpair(data, fname) /* no-op, don't waste code and time */
XX#endif
XX
XXint depthcount = 0;
XX
XXvoid indent (n, out)
XXint n;
XXFILE * out;
XX{
XX register int icount;
XX
XX for (icount = 8; icount <= n; icount += 8)
XX (void) putc ('\t', out);
XX for (icount -= 8; icount < n; icount++)
XX (void) putc (' ', out);
XX}
XX
XXint numprsize (n)
XXlong n;
XX{
XX int res;
XX
XX for (res = 1; n > 9; res++)
XX n /= 10;
XX return (res);
XX}
XX
XXint floatprsize (n)
XXfloat n;
XX{
XX char str [100];
XX
XX (void) sprintf (str, "%f", n);
XX return (strlen (str));
XX}
XX
XXint isstring (data)
XXfp_data data;
XX{
XX if (data->fp_type != VECTOR)
XX return (0);
XX while (data != 0)
XX if (data->fp_entry->fp_type != CHARCONST)
XX return (0);
XX else
XX data = data->fp_header.fp_next;
XX return (1);
XX}
XX
XXint printlen (data)
XXfp_data data;
XX{
XX register fp_data ptr;
XX register int str;
XX register int result;
XX#ifndef NOCHECK
XX void genbottom ();
XX#endif
XX
XX switch (data->fp_type)
XX {
XX case NILOBJ:
XX return (2); /* <> */
XX case TRUEOBJ:
XX return (1); /* T */
XX case FALSEOBJ:
XX return (1); /* F */
XX case INTCONST:
XX return (numprsize (data->fp_header.fp_int));
XX case ATOMCONST:
XX return (strlen (data->fp_header.fp_atom));
XX case FLOATCONST:
XX return (floatprsize (data->fp_header.fp_float));
XX case CHARCONST:
XX return (2);
XX case VECTOR:
XX str = isstring (data);
XX if (str)
XX result = 2; /* for the "" */
XX else
XX result = 1;
XX/* 2 for the brackets, -1 since blank not placed before first item */
XX ptr = data;
XX while (ptr != 0)
XX {
XX if (str)
XX result += 2;
XX else
XX result += 2 + printlen (ptr->fp_entry);
XX /* 1 for the comma, 1 for the blank between elements */
XX ptr = ptr->fp_header.fp_next;
XX }
XX return (result);
XX#ifndef NOCHECK
XX default:
XX genbottom ("print: unknown object type", data);
XX return (0);
XX#endif
XX }
XX}
XX
XXvoid printfpdata (out, data, ind)
XXFILE * out;
XXfp_data data;
XXint ind;
XX{
XX int chars, str;
XX char c;
XX fp_data track;
XX#ifndef NOCHECK
XX void genbottom ();
XX#endif
XX
XX#ifndef NOCHECK
XX if (data == 0) /* invalid argument, abort */
XX genbottom ("print: null pointer passed to printfpdata", fp_nil);
XX#endif
XX switch (data->fp_type)
XX {
XX case NILOBJ:
XX (void) fprintf (out, "<>");
XX break;
XX case TRUEOBJ:
XX (void) putc ('T', out);
XX break;
XX case FALSEOBJ:
XX (void) putc ('F', out);
XX break;
XX case INTCONST:
XX (void) fprintf (out, "%d", data->fp_header.fp_int);
XX break;
XX case ATOMCONST:
XX (void) fprintf (out, "%s", data->fp_header.fp_atom);
XX break;
XX case CHARCONST:
XX c = data->fp_header.fp_char;
XX if ((c > '~') || (c < ' '))
XX (void) fprintf (out, "'%3o", c);
XX else
XX (void) fprintf (out, "'%c", c);
XX break;
XX case FLOATCONST:
XX (void) fprintf (out, "%f", data->fp_header.fp_float);
XX break;
XX case VECTOR:
XX str = isstring (data);
XX if (str)
XX (void) putc ('"', out);
XX else
XX {
XX chars = printlen (data);
XX (void) putc ('<', out);
XX }
XX track = data;
XX while (track != 0)
XX {
XX if (str)
XX (void) putc (track->fp_entry->fp_header.fp_char, out);
XX else
XX printfpdata (out, track->fp_entry, ind + 1);
XX track = track->fp_header.fp_next;
XX if ((! str) && (track != 0))
XX {
XX putc (',', out);
XX if (chars > (80 - ind)) /* put on separate lines, indent */
XX {
XX (void) putc ('\n', out);
XX indent (ind + 1, out);
XX }
XX else
XX (void) putc (' ', out);
XX }
XX }
XX if (str)
XX (void) putc ('"', out);
XX else
XX (void) putc ('>', out);
XX break;
XX#ifndef NOCHECK
XX default:
XX genbottom ("print: unknown object type", data);
XX#endif
XX }
XX#ifdef CHECKREF
XX (void) fprintf (out, ".%d/%d", data->fp_ref, data);
XX#endif
XX}
XX
XXlong unsigned currsize = 0; /* keep stats about allocation */
XXlong unsigned maxsize = 0; /* keep stats about allocation */
XX
XXfp_data freelist = 0; /* pointer to list of free cells */
XX
XXvoid makefree ()
XX{
XX register fp_data cells;
XX#define BLOCKSIZE 512
XX
XX cells = (fp_data) malloc ((unsigned) BLOCKSIZE * VECTSIZE);
XX#ifndef NOCHECK
XX if (cells == 0)
XX genbottom ("memory allocator: out of space", fp_nil);
XX#endif
XX for (freelist = cells; (cells - freelist) < BLOCKSIZE; cells++)
XX cells->fp_entry = cells + 1;
XX cells = freelist + BLOCKSIZE - 1;
XX cells->fp_entry = 0;
XX}
XX
XX#ifndef NCOUNTVEC
XXint nalloc = 0;
XX#endif
XX
XXfp_data newconst (type)
XXint type;
XX{
XX register fp_data new;
XX
XX#ifdef TSTRET
XX (void) fprintf (stderr, "entering newconst\n");
XX#endif
XX if (freelist == 0)
XX makefree ();
XX new = freelist;
XX freelist = new->fp_entry;
XX new->fp_type = type;
XX#ifndef NCOUNTVEC
XX currsize += CONSTSIZE;
XX if (currsize > maxsize)
XX maxsize = currsize;
XX#endif
XX#ifdef TSTRET
XX (void) fprintf (stderr, "allocated %d bytes, type is %d",
XX CONSTSIZE, new->fp_type);
XX (void) fprintf (stderr, ", max is %d, now exiting newconst\n", maxsize);
XX#endif
XX return (new);
XX}
XX
XXfp_data newcell ()
XX{
XX register fp_data new;
XX
XX#ifdef TSTRET
XX (void) fprintf (stderr, "entering newcell, size is %d\n", size);
XX#endif
XX if (freelist == 0)
XX makefree ();
XX new = freelist;
XX freelist = new->fp_entry;
XX new->fp_type = VECTOR; /* init type, ref count */
XX new->fp_ref = 1;
XX new->fp_header.fp_next = 0;
XX#ifndef NCOUNTVEC
XX nalloc++;
XX currsize += VECTSIZE;
XX if (currsize > maxsize)
XX maxsize = currsize;
XX#endif
XX#ifdef TSTRET
XX (void) fprintf (stderr, "%d vectors allocated so far\n", nalloc);
XX (void) fprintf (stderr, "allocated %d bytes, type is %d", VECTSIZE, VECTOR);
XX (void) fprintf (stderr, ", max is %d, now exiting newcell\n", maxsize);
XX#endif
XX return (new);
XX}
XX
XXfp_data newpair ()
XX{
XX register fp_data head, tail;
XX
XX#ifdef TSTRET
XX (void) fprintf (stderr, "entering newpair, size is %d\n", size);
XX#endif
XX if (freelist == 0)
XX makefree ();
XX head = freelist;
XX freelist = head->fp_entry;
XX if (freelist == 0)
XX makefree ();
XX tail = freelist;
XX freelist = tail->fp_entry;
XX head->fp_type = VECTOR; /* init type, ref count */
XX head->fp_ref = 1;
XX head->fp_header.fp_next = tail;
XX tail->fp_type = VECTOR;
XX tail->fp_ref = 1;
XX tail->fp_header.fp_next = 0;
XX#ifndef NCOUNTVEC
XX nalloc += 2;
XX currsize += (VECTSIZE + VECTSIZE);
XX if (currsize > maxsize)
XX maxsize = currsize;
XX#endif
XX#ifdef TSTRET
XX (void) fprintf (stderr, "%d vectors allocated so far\n", nalloc);
XX (void) fprintf (stderr, "allocated %d bytes, type is %d",
XX 2 * VECTSIZE, VECTOR);
XX (void) fprintf (stderr, ", max is %d, now exiting newpair\n", maxsize);
XX#endif
XX return (head);
XX}
XX
XX/* the following is less efficient than newconst, newcell or newpair,
XX so should only be used with vectors of length > 2 or of variable
XX length */
XXfp_data newvect (size)
XXlong size;
XX{
XX register fp_data new, old;
XX#ifdef TSTRET
XX register int space;
XX#endif
XX
XX#ifdef TSTRET
XX (void) fprintf (stderr, "entering newvect, size is %d\n", size);
XX space = size * VECTSIZE;
XX#endif
XX#ifndef NCOUNTVEC
XX currsize += size * VECTSIZE;
XX nalloc += size;
XX if (currsize > maxsize)
XX maxsize = currsize;
XX#endif
XX/* build the vector back-to-front */
XX old = (fp_data) 0;
XX while (size-- > 0)
XX {
XX if (freelist == 0) makefree ();
XX new = freelist;
XX freelist = freelist->fp_entry;
XX new->fp_type = VECTOR; /* init type, ref count */
XX new->fp_ref = 1;
XX new->fp_header.fp_next = old;
XX old = new;
XX }
XX#ifdef TSTRET
XX (void) fprintf (stderr, "%d vectors allocated so far\n", nalloc);
XX (void) fprintf (stderr, "allocated %d bytes, type is %d",
XX space, new->fp_type);
XX (void) fprintf (stderr, ", max is %d, now exiting newvect\n", maxsize);
XX#endif
XX return (new);
XX}
XX
XX#ifndef NCOUNTVEC
XXint dalloc = 0;
XX#endif
XX
XX/* returnvect should only be called via dec_ref, which checks for reference
XX count == 0 and type == vector */
XXvoid returnvect (data)
XXfp_data data;
XX{
XX register fp_data old;
XX
XX#ifdef TSTRET
XX (void) fprintf (stderr, "entering returnvect, input is ");
XX printfpdata (stderr, data, 0);
XX (void) fprintf (stderr, "\nref count is %d\n", data->fp_ref);
XX#endif
XX while ((data != 0) && (data->fp_ref == 0))
XX {
XX#ifdef TSTRET
XX if (data->fp_ref < 0)
XX {
XX (void) fprintf (stderr,
XX "reference counting error, negative count found\n");
XX (void) fprintf (stderr, "data is ");
XX printfpdata (stderr, data, 0);
XX (void) fprintf (stderr, "\nreference count is %d\n", data->fp_ref);
XX (void) exit (1);
XX }
XX#endif
XX#ifndef NCOUNTVEC
XX currsize -= VECTSIZE;
XX dalloc++;
XX#endif
XX dec_ref (data->fp_entry); /* return element */
XX old = data;
XX data = data->fp_header.fp_next;
XX if (data != 0) /* return tail, if it has other ref */
XX data->fp_ref--;
XX#ifndef NORETURN
XX old->fp_entry = freelist; /* return self */
XX freelist = old;
XX#endif
XX }
XX#ifdef TSTRET
XX (void) fprintf (stderr, "%d vectors deallocated\nexiting returnvect",
XX dalloc);
XX#endif
XX}
XX
XXvoid checkstorage ()
XX{
XX#ifndef NCOUNTVEC
XX if (staticstore != 0)
XX dec_ref (staticstore);
XX if (nalloc != dalloc)
XX {
XX fprintf (stderr, "WARNING: %d cells allocated, %d deallocated\n",
XX nalloc, dalloc);
XX fprintf (stderr, "(the two numbers should be the same)\n");
XX fprintf (stderr, "This is an implementation error. The above\n");
XX fprintf (stderr, "results may be incorrect.\n");
XX }
XX#endif
XX}
XX
XXvoid printstorage ()
XX{
XX checkstorage ();
XX#ifndef NCOUNTVEC
XX (void) fprintf (stdout,
XX "%d cells allocated, %d cells deallocated\n", nalloc, dalloc);
XX (void) fprintf (stdout,
XX "maximum space needed was %d bytes\n", maxsize);
XX#endif
XX}
XX
XXvoid putfpdata (data)
XXfp_data data;
XX{
XX#ifdef DEBUG
XX (void) fprintf (stderr, "entering putfpdata\n");
XX#endif
XX printfpdata (stdout, data, 0);
XX (void) putc ('\n', stdout);
XX#ifdef DEBUG
XX (void) fprintf (stderr, "exiting putfpdata\n");
XX#endif
XX}
XX
XXvoid putfpstring (data, out)
XXfp_data data;
XXFILE * out;
XX{
XX#ifndef NOCHECK
XX if ((data->fp_type != NILOBJ) && ! isstring (data))
XX genbottom ("print string: input was not a string", data);
XX#endif
XX if (data->fp_type != NILOBJ)
XX while (data != 0)
XX {
XX (void) putc (data->fp_entry->fp_header.fp_char, out);
XX data = data->fp_header.fp_next;
XX }
XX}
XX
XXvoid putfpstrings (data)
XXfp_data data;
XX/* if the argument is a string it outputs it using putfpstring;
XX * otherwise it must be a vector of pairs <filename string>, the
XX * strings become the contents of the named files
XX */
XX{
XX extern FILE * fopen ();
XX extern int fclose ();
XX static void toCstring ();
XX register FILE * out;
XX register fp_data fname;
XX register fp_data string;
XX register fp_data entry;
XX register int closeres;
XX char filename [FNAMELEN];
XX
XX if ((data->fp_type == NILOBJ) || isstring (data))
XX putfpstring (data, stdout);
XX else
XX while (data != 0)
XX {
XX entry = data->fp_entry;
XX data = data->fp_header.fp_next;
XX#ifndef NOCHECK
XX checkpair (entry, "output routine");
XX#endif
XX fname = entry->fp_entry;
XX string = entry->fp_header.fp_next->fp_entry;
XX#ifndef NOCHECK
XX if (! isstring (fname))
XX genbottom ("print: file name is not a string", entry);
XX/* string-ness of the string is checked in putfpstring */
XX#endif
XX toCstring (fname, filename);
XX out = fopen (filename, "w");
XX#ifndef NOCHECK
XX if (out == 0)
XX genbottom ("print: unable to open the output file", fname);
XX#endif
XX putfpstring (string, out);
XX closeres = fclose (out);
XX#ifndef NOCHECK
XX if (closeres == EOF)
XX genbottom ("print: unable to close the output file", fname);
XX#endif
XX }
XX}
XX
XXfp_data readfpdata (in, input_char, dryrun)
XXFILE * in;
XXchar * input_char;
XXint dryrun; /* check file (1), or actually input it (0)? */
XX /* if it's a dry run, returns fp_true if correct, */
XX /* fp_false if the file is unreadable. */
XX{
XX char string [128];
XX fp_data res, next, last, numconst;
XX unsigned int pos = 0;
XX long num;
XX float real;
XX int isneg = 0;
XX int negexp = 0;
XX void genbottom ();
XX
XX while (isspace (*input_char))
XX *input_char = getc (in);
XX if (*input_char == '<') /* opening vector */
XX {
XX *input_char = getc (in);
XX while (isspace (*input_char))
XX *input_char = getc (in);
XX last = 0;
XX if (dryrun)
XX res = fp_true;
XX else
XX res = fp_nil;
XX while (*input_char != '>')
XX {
XX if (dryrun)
XX {
XX if (readfpdata (in, input_char, 1) ->fp_type != TRUEOBJ)
XX return (fp_false);
XX }
XX else
XX {
XX next = newcell ();
XX next->fp_entry = readfpdata (in, input_char, 0);
XX if (last == 0)
XX res = next;
XX else
XX last->fp_header.fp_next = next;
XX last = next;
XX }
XX while (isspace (*input_char))
XX *input_char = getc (in);
XX if ((*input_char != ',') && (*input_char != '>'))
XX if (dryrun)
XX return (fp_false);
XX else
XX genbottom ("read: comma or > expected after vector element", res);
XX if (*input_char == ',')
XX *input_char = getc (in);
XX while (isspace (*input_char))
XX *input_char = getc (in);
XX }
XX *input_char = getc (in);
XX } /* end if vector */
XX else if (((*input_char >= '0') && (*input_char <= '9')) ||
XX (*input_char == '-') || (*input_char == '+') ||
XX (*input_char == '.')) /* number */
XX {
XX isneg = *input_char == '-';
XX if (isneg || (*input_char == '+'))
XX {
XX *input_char = getc (in);
XX while (isspace (*input_char))
XX *input_char = getc (in);
XX }
XX num = 0;
XX while ((*input_char >= '0') && (*input_char <= '9'))
XX {
XX num = (num * 10) + (*input_char - '0');
XX *input_char = getc (in);
XX }
XX if ((*input_char != '.') && (*input_char != 'e') && (*input_char != 'E'))
XX { /* means we have finished reading an integer */
XX if (dryrun)
XX return (fp_true);
XX res = newconst (INTCONST);
XX res->fp_header.fp_int = (isneg) ? (-num) : num;
XX }
XX else /* floating point number */
XX {
XX real = num;
XX if (*input_char == '.') /* reading the fractional part */
XX {
XX num = 10; /* num is now the divisor */
XX *input_char = getc (in);
XX while ((*input_char >= '0') && (*input_char <= '9'))
XX {
XX real += ((float) (*input_char - '0')) / (float) (num);
XX num *= 10;
XX *input_char = getc (in);
XX }
XX }
XX if ((*input_char == 'e') || (*input_char == 'E'))
XX { /* time to read the exponent */
XX *input_char = getc (in);
XX negexp = *input_char == '-';
XX if (negexp || (*input_char == '+'))
XX {
XX *input_char = getc (in);
XX while (isspace (*input_char))
XX *input_char = getc (in);
XX }
XX num = 0;
XX while ((*input_char >= '0') && (*input_char <= '9'))
XX {
XX num = (num * 10) + (*input_char - '0');
XX *input_char = getc (in);
XX }
XX while (num-- > 0)
XX if (negexp)
XX real /= 10;
XX else
XX real *= 10;
XX }
XX if (dryrun)
XX return (fp_true);
XX res = newconst (FLOATCONST);
XX res->fp_header.fp_float = (isneg) ? (-real) : real;
XX }
XX } /* end if number */
XX else if (*input_char == '\'') /* single char */
XX {
XX *input_char = getc (in);
XX if (*input_char == '\\')
XX *input_char = getc (in);
XX if (! dryrun)
XX {
XX res = newconst (CHARCONST);
XX res->fp_header.fp_char = *input_char;
XX }
XX *input_char = getc (in);
XX } /* end if char */
XX else if (*input_char == '"') /* string, i.e., vector of chars */
XX {
XX last = 0;
XX if (! dryrun)
XX res = fp_nil;
XX while (1)
XX {
XX *input_char = getc (in);
XX if (*input_char == '\\')
XX *input_char = getc (in);
XX else if (*input_char == '"')
XX break;
XX if (! dryrun)
XX {
XX numconst = newconst (CHARCONST);
XX numconst->fp_header.fp_char = *input_char;
XX next = newcell ();
XX next->fp_entry = numconst;
XX if (last == 0)
XX res = next;
XX else
XX last->fp_header.fp_next = next;
XX last = next;
XX }
XX }
XX *input_char = getc (in);
XX } /* end if string */
XX else if (isalpha (*input_char)) /* symbol */
XX {
XX while (isalnum (*input_char) || (*input_char == '.'))
XX {
XX string [pos++] = *input_char;
XX *input_char = getc (in);
XX }
XX string [pos] = '\0';
XX if (dryrun)
XX return (fp_true);
XX if ((pos == 1) && (string [0] == 'T'))
XX res = fp_true;
XX else if ((pos == 1) && (string [0] == 'F'))
XX res = fp_false;
XX else
XX {
XX res = newconst (ATOMCONST);
XX res->fp_header.fp_atom = malloc (pos + 1);
XX (void) strcpy (res->fp_header.fp_atom, string);
XX }
XX } /* end if symbol */
XX else if (((int) *input_char) == EOF) /* end of file */
XX {
XX if (dryrun)
XX return (fp_false);
XX else
XX genbottom ("read: end of file reached before end of FFP object\n",
XX res);
XX }
XX else if (dryrun)
XX return (fp_false);
XX else
XX {
XX sprintf (string,
XX "read: unknown token type\nchar was %c (%d decimal)\n",
XX *input_char, *input_char);
XX genbottom (string, fp_nil);
XX }
XX return (res);
XX}
XX
XXfp_data readfpstring (in)
XXFILE * in;
XX{
XX fp_data res = 0;
XX fp_data chase, cptr;
XX int input_char;
XX
XX if ((in == 0) || ((input_char = getc (in)) == EOF))
XX res = fp_nil;
XX else
XX {
XX chase = res = newcell ();
XX cptr = newconst (CHARCONST);
XX cptr->fp_header.fp_char = input_char;
XX chase->fp_entry = cptr;
XX while ((input_char = getc (in)) != EOF)
XX {
XX chase = chase->fp_header.fp_next = newcell ();
XX cptr = newconst (CHARCONST);
XX cptr->fp_header.fp_char = input_char;
XX chase->fp_entry = cptr;
XX }
XX }
XX return (res);
XX}
XX
XXfp_data getfpdata ()
XX{
XX fp_data res;
XX char input_char;
XX
XX#ifdef DEBUG
XX (void) fprintf (stderr, "entering getfpdata\n");
XX#endif
XX input_char = getc (stdin);
XX res = readfpdata (stdin, &input_char, 0);
XX#ifdef DEBUG
XX (void) fprintf (stderr, "exiting getfpdata, result is ");
XX printfpdata (stderr, res, 0);
XX (void) putc ('\n', stderr);
XX#endif
XX return (res);
XX}
XX
XXfp_data getfpchar ()
XX{
XX fp_data res;
XX
XX#ifdef DEBUG
XX (void) fprintf (stderr, "entering getfpchar\n");
XX#endif
XX res = newconst (CHARCONST);
XX res->fp_header.fp_char = getc (stdin);
XX#ifdef DEBUG
XX (void) fprintf (stderr, "exiting getfpchar, result is ");
XX printfpdata (stderr, res, 0);
XX (void) putc ('\n', stderr);
XX#endif
XX return (res);
XX}
XX
XXfp_data getfpstring ()
XX{
XX fp_data res;
XX
XX#ifdef DEBUG
XX (void) fprintf (stderr, "entering getfpstring\n");
XX#endif
XX res = readfpstring (stdin);
XX#ifdef DEBUG
XX (void) fprintf (stderr, "exiting getfpstring, result is ");
XX printfpdata (stderr, res, 0);
XX (void) putc ('\n', stderr);
XX#endif
XX return (res);
XX}
XX
XX#ifndef NOCHECK
XXint getonec (f)
XXFILE * f;
XX{
XX int ch, ch1;
XX
XX ch1 = ch = getc (f);
XX while ((ch1 != '\n') && (ch1 != EOF))
XX ch1 = getc (f);
XX return (ch);
XX}
XX
XXvoid stackdump (interfile, inter, outfile, baddata)
XXFILE * interfile;
XXint inter;
XXFILE * outfile;
XXint baddata;
XX{
XX int ch;
XX int levels = 0;
XX
XX while (stack != 0)
XX {
XX if ((! baddata) || (levels++ > 1))
XX {
XX (void) fprintf (outfile, "called by routine %s, with input\n",
XX stack->st_name);
XX printfpdata (outfile, stack->st_data, 0);
XX }
XX else
XX (void) fprintf (outfile,
XX "called by routine %s, with probably bad data\n",
XX stack->st_name);
XX stack = stack->st_prev;
XX (void) putc ('\n', outfile);
XX if (inter)
XX {
XX (void) fprintf (outfile, "continue stack dump?\n", stack->st_name);
XX ch = getonec (interfile);
XX if ((ch == 'n') || (ch == 'N'))
XX break;
XX }
XX }
XX}
XX#endif
XX
XX/* cannot be static because used by the main loop, sometimes */
XXvoid genbottom (message, data)
XXchar * message;
XXfp_data data;
XX{
XX int ch;
XX static int reentrant = 0;
XX FILE * core;
XX
XX (void) fprintf (stderr, "error: bottom produced during execution\n");
XX (void) fprintf (stderr, "%s\n", message);
XX if (reentrant)
XX (void) fprintf (stderr, "an invalid pointer was input to the primitive\n");
XX else
XX {
XX reentrant = 1; /* might be called by printfpdata */
XX printfpdata (stderr, data, 0);
XX (void) putc ('\n', stderr);
XX reentrant = 0;
XX }
XX#ifndef NOCHECK
XX (void) fprintf (stderr, "do you wish a stack dump (y/n)?\n");
XX ch = getonec (stdin);
XX if (ch == EOF)
XX {
XX (void) fprintf (stderr, "dumping the stack to file 'core'\n");
XX core = fopen ("core", "w");
XX stackdump (stdin, 0, core, reentrant);
XX reentrant = fclose (core);
XX }
XX else if ((ch != 'n') && (ch != 'N'))
XX {
XX (void) fprintf (stderr, "interactive stack dump (y/n)?\n");
XX ch = getonec (stdin);
XX (void) fprintf (stderr, "dumping the relevant portions of the stack:\n");
XX stackdump (stdin, (ch == 'y') || (ch == 'Y'), stderr, reentrant);
XX }
XX#endif
XX (void) fprintf (stderr, "aborting...\n");
XX (void) exit (1);
XX}
XX
XXfp_data checkpoint (data)
XXfp_data data;
XX/* behaves the same as id, but outputs its data */
XX{
XX static int asked = 0;
XX static int keepasking = 0;
XX struct stackframe * savestack;
XX static FILE * tty;
XX int ch;
XX
XX#ifndef NOCHECK
XX if (! asked)
XX {
XX asked = 1;
XX tty = fopen ("/dev/tty", "r");
XX if (tty != 0)
XX {
XX (void) fprintf (stderr,
XX "do you wish to interact with the checkpoints (y/n)?\n");
XX ch = getonec (tty);
XX keepasking = ((ch == 'y') || (ch == 'Y'));
XX }
XX }
XX#endif
XX (void) fprintf (stderr, "checkpoint encountered, input is\n");
XX printfpdata (stderr, data, 0);
XX (void) putc ('\n', stderr);
XX#ifndef NOCHECK
XX if (keepasking)
XX {
XX (void) fprintf (stderr,
XX"type y for stack dump, a to abort, space or new-line to continue\n");
XX ch = getonec (tty);
XX if ((ch == 'a') || (ch == 'A'))
XX {
XX (void) fprintf (stderr, "\naborting...\n");
XX (void) exit (1);
XX }
XX if ((ch == 'y') || (ch == 'Y'))
XX {
XX savestack = stack;
XX (void) fprintf (stderr, "interactive stack dump (y/n)?\n");
XX ch = getonec (tty);
XX (void) fprintf (stderr, "dumping the relevant portions of the stack:\n");
XX stackdump (tty, ((ch == 'y') || (ch == 'Y')), stderr, 0);
XX stack = savestack;
XX }
XX }
XX#endif
XX return (data);
XX}
XX
XXfp_data error (data)
XXfp_data data;
XX{
XX genbottom ("error: ", data);
XX}
XX
XXfp_data tl (data)
XXfp_data data;
XX{
XX register fp_data res;
XX
XX#ifdef DEBUG
XX (void) fprintf (stderr, "entering tl, object is ");
XX printfpdata (stderr, data, 0);
XX (void) putc ('\n', stderr);
XX#endif
XX#ifndef NOCHECK
XX if (data->fp_type != VECTOR)
XX genbottom ("tl: data is not a vector", data);
XX#endif
XX res = data->fp_header.fp_next;
XX if (res == 0)
XX res = & nilobj;
XX else
XX res->fp_ref += 1;
XX dec_ref (data);
XX#ifdef DEBUG
XX (void) fprintf (stderr, "exiting tl, result is ");
XX printfpdata (stderr, res, 0);
XX (void) putc ('\n', stderr);
XX#endif
XX return (res);
XX}
XX
XXfp_data tlr (data)
XXfp_data data;
XX{
XX register fp_data res, vector, prev, next;
XX
XX#ifdef DEBUG
XX (void) fprintf (stderr, "entering tlr, object is ");
XX printfpdata (stderr, data, 0);
XX (void) putc ('\n', stderr);
XX#endif
XX#ifndef NOCHECK
XX if (data->fp_type != VECTOR)
XX genbottom ("tlr: data is not a vector", data);
XX#endif
XX vector = data;
XX if (vector->fp_header.fp_next == 0)
XX res = fp_nil;
XX else
XX {
XX prev = res = next = newcell ();
XX next->fp_entry = vector->fp_entry;
XX inc_ref (next->fp_entry);
XX while ((vector = vector->fp_header.fp_next)->fp_header.fp_next != 0)
XX {
XX next = newcell ();
XX next->fp_entry = vector->fp_entry;
XX prev->fp_header.fp_next = next;
XX prev = next;
XX inc_ref (next->fp_entry);
XX }
XX }
XX dec_ref (data);
XX#ifdef DEBUG
XX (void) fprintf (stderr, "exiting tlr, result is ");
XX printfpdata (stderr, res, 0);
XX (void) putc ('\n', stderr);
XX#endif
XX return (res);
XX}
XX
XXfp_data rotl (data)
XXfp_data data;
XX{
XX register fp_data res, from, to;
XX register long size;
XX
XX#ifdef DEBUG
XX (void) fprintf (stderr, "entering rotl, object is ");
XX printfpdata (stderr, data, 0);
XX (void) putc ('\n', stderr);
XX#endif
XX#ifndef NOCHECK
XX if (nonvector (data))
XX genbottom ("rotl: data is not a vector or nil", data);
XX#endif
XX res = data;
XX if (data->fp_type != NILOBJ)
XX {
XX for (size = 0; res != 0; res = res->fp_header.fp_next)
XX size++;
XX res = newvect (size);
XX from = data->fp_header.fp_next;
XX to = res;
XX while (from != 0)
XX {
XX to->fp_entry = from->fp_entry;
XX inc_ref (to->fp_entry);
XX to = to->fp_header.fp_next;
XX from = from->fp_header.fp_next;
XX }
XX to->fp_entry = data->fp_entry;
XX inc_ref (to->fp_entry);
XX dec_ref (data);
XX }
XX#ifdef DEBUG
XX (void) fprintf (stderr, "exiting rotl, result is ");
XX printfpdata (stderr, res, 0);
XX (void) putc ('\n', stderr);
XX#endif
XX return (res);
XX}
XX
XXfp_data rotr (data)
XXfp_data data;
XX{
XX register fp_data res, from, to;
XX register long size;
XX
XX#ifdef DEBUG
XX (void) fprintf (stderr, "entering rotr, object is ");
XX printfpdata (stderr, data, 0);
XX (void) putc ('\n', stderr);
XX#endif
XX#ifndef NOCHECK
XX if (nonvector (data))
XX genbottom ("rotr: data is not a vector or nil", data);
XX#endif
XX res = data;
XX if (data->fp_type != NILOBJ)
XX {
XX for (size = 0; res != 0; res = res->fp_header.fp_next)
XX size++;
XX res = newvect (size);
XX from = data;
XX to = res->fp_header.fp_next;
XX while (to != 0)
XX {
XX to->fp_entry = from->fp_entry;
XX inc_ref (to->fp_entry);
XX to = to->fp_header.fp_next;
XX from = from->fp_header.fp_next;
XX }
XX res->fp_entry = from->fp_entry;
XX inc_ref (res->fp_entry);
XX dec_ref (data);
XX }
XX#ifdef DEBUG
XX (void) fprintf (stderr, "exiting rotr, result is ");
XX printfpdata (stderr, res, 0);
XX (void) putc ('\n', stderr);
XX#endif
XX return (res);
XX}
XX
XXfp_data id (data)
XXfp_data data;
XX{
XX#ifdef DEBUG
XX (void) fprintf (stderr, "entering id, object is ");
XX printfpdata (stderr, data, 0);
XX (void) putc ('\n', stderr);
XX#endif
XX#ifdef DEBUG
XX (void) fprintf (stderr, "exiting id, result is ");
XX printfpdata (stderr, data, 0);
XX (void) putc ('\n', stderr);
XX#endif
XX return (data);
XX}
XX
XXfp_data atom (data)
XXfp_data data;
XX{
XX register fp_data res;
XX
XX#ifdef DEBUG
XX (void) fprintf (stderr, "entering atom, object is ");
XX printfpdata (stderr, data, 0);
XX (void) putc ('\n', stderr);
XX#endif
XX if (data->fp_type != VECTOR)
XX res = (fp_true);
XX else
XX res = (fp_false);
XX dec_ref (data);
XX#ifdef DEBUG
XX (void) fprintf (stderr, "exiting atom, result is ");
XX printfpdata (stderr, res, 0);
XX (void) putc ('\n', stderr);
XX#endif
XX return (res);
XX}
XX
XXfp_data reverse (data)
XXfp_data data;
XX{
XX register fp_data res, saveres, vector;
XX
XX#ifdef DEBUG
XX (void) fprintf (stderr, "entering reverse, object is ");
XX printfpdata (stderr, data, 0);
XX (void) putc ('\n', stderr);
XX#endif
XX#ifndef NOCHECK
XX if (nonvector (data))
XX genbottom ("reverse: data is not a vector or nil", data);
XX#endif
XX if (data->fp_type == NILOBJ)
XX res = data;
XX else
XX {
XX vector = data;
XX res = 0;
XX while (vector != 0)
XX {
XX saveres = res;
XX res = newcell ();
XX res->fp_header.fp_next = saveres;
XX res->fp_entry = vector->fp_entry;
XX inc_ref (res->fp_entry);
XX vector = vector->fp_header.fp_next;
XX }
XX dec_ref (data);
XX }
XX#ifdef DEBUG
XX (void) fprintf (stderr, "exiting reverse, result is ");
XX printfpdata (stderr, res, 0);
XX (void) putc ('\n', stderr);
XX#endif
XX return (res);
XX}
XX
XXfp_data distl (data)
XXfp_data data;
XX{
XX register fp_data obj, vector, res, newobjs, prev, next;
XX
XX#ifdef DEBUG
XX (void) fprintf (stderr, "entering distl, object is ");
XX printfpdata (stderr, data, 0);
XX (void) putc ('\n', stderr);
XX#endif
XX#ifndef NOCHECK
XX if (data->fp_type != VECTOR)
XX genbottom ("distl: input is not a vector", data);
XX if ((data->fp_header.fp_next == 0) ||
XX (data->fp_header.fp_next->fp_header.fp_next != 0))
XX genbottom ("distl: input is not a 2-element vector", data);
XX#endif
XX obj = data->fp_entry;
XX vector = data->fp_header.fp_next->fp_entry;
XX#ifndef NOCHECK
XX if (nonvector (vector))
XX genbottom ("distl: 2nd element is not a vector or nil", data);
XX#endif
XX res = vector;
XX if (vector->fp_type != NILOBJ)
XX {
XX res = next = newcell ();
XX newobjs = newpair ();
XX newobjs->fp_entry = obj;
XX inc_ref (obj);
XX newobjs->fp_header.fp_next->fp_entry = vector->fp_entry;
XX inc_ref (vector->fp_entry);
XX next->fp_entry = newobjs;
XX while ((vector = vector->fp_header.fp_next) != 0)
XX {
XX prev = next;
XX next = newcell ();
XX newobjs = newpair ();
XX newobjs->fp_entry = obj;
XX inc_ref (obj);
XX newobjs->fp_header.fp_next->fp_entry = vector->fp_entry;
XX inc_ref (vector->fp_entry);
XX next->fp_entry = newobjs;
XX prev->fp_header.fp_next = next;
XX }
XX }
XX dec_ref (data);
XX#ifdef DEBUG
XX (void) fprintf (stderr, "exiting distl, result is ");
XX printfpdata (stderr, res, 0);
XX (void) putc ('\n', stderr);
XX#endif
XX return (res);
XX}
XX
XXfp_data distr (data)
XXfp_data data;
XX{
XX register fp_data obj, vector, res, newobjs, prev, next;
XX
XX#ifdef DEBUG
XX (void) fprintf (stderr, "entering distr, object is ");
XX printfpdata (stderr, data, 0);
XX (void) putc ('\n', stderr);
XX#endif
XX#ifndef NOCHECK
XX if (data->fp_type != VECTOR)
XX genbottom ("distr: input is not a vector", data);
XX if ((data->fp_header.fp_next == 0) ||
XX (data->fp_header.fp_next->fp_header.fp_next != 0))
XX genbottom ("distr: input is not a 2-element vector", data);
XX#endif
XX vector = data->fp_entry;
XX obj = data->fp_header.fp_next->fp_entry;
XX#ifndef NOCHECK
XX if (nonvector (vector))
XX genbottom ("distr: 1st element is not a vector or nil", data);
XX#endif
XX res = vector; /* so it's correct if vector == nil */
XX if (vector->fp_type != NILOBJ)
XX {
XX res = next = newcell ();
XX newobjs = newpair ();
XX newobjs->fp_header.fp_next->fp_entry = obj;
XX inc_ref (obj);
XX newobjs->fp_entry = vector->fp_entry;
XX inc_ref (vector->fp_entry);
XX next->fp_entry = newobjs;
XX while ((vector = vector->fp_header.fp_next) != 0)
XX {
XX prev = next;
XX next = newcell ();
XX newobjs = newpair ();
XX newobjs->fp_header.fp_next->fp_entry = obj;
XX inc_ref (obj);
XX newobjs->fp_entry = vector->fp_entry;
XX inc_ref (vector->fp_entry);
XX next->fp_entry = newobjs;
XX prev->fp_header.fp_next = next;
XX }
XX }
XX dec_ref (data);
XX#ifdef DEBUG
XX (void) fprintf (stderr, "exiting distr, result is ");
XX printfpdata (stderr, res, 0);
XX (void) putc ('\n', stderr);
XX#endif
XX return (res);
XX}
XX
XXfp_data apndl (data)
XXfp_data data;
XX{
XX register fp_data vector, el, res;
XX
XX#ifdef DEBUG
XX (void) fprintf (stderr, "entering apndl, object is ");
XX printfpdata (stderr, data, 0);
XX (void) putc ('\n', stderr);
XX#endif
XX#ifndef NOCHECK
XX if (data->fp_type != VECTOR)
XX genbottom ("apndl: input is not a vector", data);
XX if ((data->fp_header.fp_next == 0) ||
XX (data->fp_header.fp_next->fp_header.fp_next != 0))
XX genbottom ("apndl: input is not a 2-element vector", data);
XX#endif
XX el = data->fp_entry;
XX vector = data->fp_header.fp_next->fp_entry;
XX#ifndef NOCHECK
XX if (nonvector (vector))
XX genbottom ("apndl: 2nd element is not a vector or nil", data);
XX#endif
XX if (vector->fp_type != VECTOR) /* nil? */
XX vector = 0;
XX else
XX inc_ref (vector);
XX res = newcell ();
XX res->fp_entry = el;
XX inc_ref (el);
XX res->fp_header.fp_next = vector;
XX dec_ref (data);
XX#ifdef DEBUG
XX (void) fprintf (stderr, "exiting apndl, result is ");
XX printfpdata (stderr, res, 0);
XX (void) putc ('\n', stderr);
XX#endif
XX return (res);
XX}
SHAR_EOF
if test 32154 -ne "`wc -c fp.c.part1`"
then
echo shar: error transmitting fp.c.part1 '(should have been 32154 characters)'
fi
echo shar: extracting lex.yy.c '(12642 characters)'
sed 's/^XX//' << \SHAR_EOF > lex.yy.c
XX# include "stdio.h"
XX# define U(x) x
XX# define NLSTATE yyprevious=YYNEWLINE
XX# define BEGIN yybgin = yysvec + 1 +
XX# define INITIAL 0
XX# define YYLERR yysvec
XX# define YYSTATE (yyestate-yysvec-1)
XX# define YYOPTIM 1
XX# define YYLMAX 200
XX# define output(c) (void) putc(c,yyout)
XX# define input() (((yytchar=yysptr>yysbuf?U(*--yysptr):getc(yyin))==10?(yylineno++,yytchar):yytchar)==EOF?0:yytchar)
XX# define unput(c) {yytchar= (c);if(yytchar=='\n')yylineno--;*yysptr++=yytchar;}
XX# define yymore() (yymorfg=1)
XX# define ECHO (void) fprintf(yyout, "%s",yytext)
XX# define REJECT { nstr = yyreject(); goto yyfussy;}
XXint yyleng; extern char yytext[];
XXint yymorfg;
XXextern char *yysptr, yysbuf[];
XXint yytchar;
XXFILE *yyin ={stdin}, *yyout ={stdout};
XXextern int yylineno;
XXstruct yysvf {
XX struct yywork *yystoff;
XX struct yysvf *yyother;
XX int *yystops;};
XXstruct yysvf *yyestate;
XXextern struct yysvf yysvec[], *yybgin;
XX# define YYNEWLINE 10
XXyylex(){
XXint nstr; extern int yyprevious;
XXwhile((nstr = yylook()) >= 0)
XXyyfussy: switch(nstr){
XXcase 0:
XXif(yywrap()) return(0); break;
XXcase 1:
XX { return (Def); }
XXbreak;
XXcase 2:
XX { return (Then); }
XXbreak;
XXcase 3:
XX { return (Else); }
XXbreak;
XXcase 4:
XX { return (Compose); }
XXbreak;
XXcase 5:
XX { return (Alpha); }
XXbreak;
XXcase 6:
XX { return (Tree); }
XXbreak;
XXcase 7:
XX { return (Insert); }
XXbreak;
XXcase 8:
XX { return (Rinsert); }
XXbreak;
XXcase 9:
XX { return (','); }
XXbreak;
XXcase 10:
XX { return ('['); }
XXbreak;
XXcase 11:
XX { return (']'); }
XXbreak;
XXcase 12:
XX { return ('('); }
XXbreak;
XXcase 13:
XX { return (')'); }
XXbreak;
XXcase 14:
XX { return ('<'); }
XXbreak;
XXcase 15:
XX { return ('>'); }
XXbreak;
XXcase 16:
XX { return ('_'); }
XXbreak;
XXcase 17:
XX { return (Bu); }
XXbreak;
XXcase 18:
XX { return (Bur); }
XXbreak;
XXcase 19:
XX { return (While); }
XXbreak;
XXcase 20:
XX { return ('+'); }
XXbreak;
XXcase 21:
XX { return ('*'); }
XXbreak;
XXcase 22:
XX { return (Div); }
XXbreak;
XXcase 23:
XX { return ('='); }
XXbreak;
XXcase 24:
XX { return (Leq); }
XXbreak;
XXcase 25:
XX { return (Geq); }
XXbreak;
XXcase 26:
XX { return (Noteq); }
XXbreak;
XXcase 27:
XX { return (TrueConst); }
XXbreak;
XXcase 28:
XX { return (FalseConst); }
XXbreak;
XXcase 29:
XX{ return (Symbol); }
XXbreak;
XXcase 30:
XX { return (Rsel); }
XXbreak;
XXcase 31:
XX{ return (Float); }
XXbreak;
XXcase 32:
XX{ return (Float); }
XXbreak;
XXcase 33:
XX{ return (Sel); }
XXbreak;
XXcase 34:
XX { return (Sel); }
XXbreak;
XXcase 35:
XX { return ('-'); }
XXbreak;
XXcase 36:
XX{ return (String); }
XXbreak;
XXcase 37:
XX { return (CharConst); }
XXbreak;
XXcase 38:
XX { return (CharConst); }
XXbreak;
XXcase 39:
XX{ set_line (yytext); }
XXbreak;
XXcase 40:
XX { inc_line (); }
XXbreak;
XXcase 41:
XX { inc_line (); }
XXbreak;
XXcase 42:
XX ;
XXbreak;
XXcase -1:
XXbreak;
XXdefault:
XX(void) fprintf(yyout,"bad switch yylook %d",nstr);
XX} return(0); }
XX/* end of yylex */
XXint yyvstop[] ={
XX0,
XX
XX42,
XX0,
XX
XX41,
XX0,
XX
XX42,
XX0,
XX
XX42,
XX0,
XX
XX42,
XX0,
XX
XX42,
XX0,
XX
XX12,
XX42,
XX0,
XX
XX13,
XX42,
XX0,
XX
XX21,
XX42,
XX0,
XX
XX20,
XX42,
XX0,
XX
XX9,
XX42,
XX0,
XX
XX35,
XX42,
XX0,
XX
XX7,
XX42,
XX0,
XX
XX34,
XX42,
XX0,
XX
XX3,
XX42,
XX0,
XX
XX14,
XX42,
XX0,
XX
XX23,
XX42,
XX0,
XX
XX15,
XX42,
XX0,
XX
XX29,
XX42,
XX0,
XX
XX29,
XX42,
XX0,
XX
XX28,
XX29,
XX42,
XX0,
XX
XX27,
XX29,
XX42,
XX0,
XX
XX10,
XX42,
XX0,
XX
XX8,
XX42,
XX0,
XX
XX11,
XX42,
XX0,
XX
XX16,
XX42,
XX0,
XX
XX29,
XX42,
XX0,
XX
XX29,
XX42,
XX0,
XX
XX29,
XX42,
XX0,
XX
XX4,
XX29,
XX42,
XX0,
XX
XX29,
XX42,
XX0,
XX
XX42,
XX0,
XX
XX26,
XX0,
XX
XX36,
XX0,
XX
XX40,
XX0,
XX
XX38,
XX0,
XX
XX38,
XX0,
XX
XX33,
XX0,
XX
XX2,
XX0,
XX
XX32,
XX0,
XX
XX34,
XX0,
XX
XX30,
XX0,
XX
XX24,
XX0,
XX
XX25,
XX0,
XX
XX29,
XX0,
XX
XX29,
XX0,
XX
XX6,
XX0,
XX
XX5,
XX29,
XX0,
XX
XX17,
XX29,
XX0,
XX
XX29,
XX0,
XX
XX29,
XX0,
XX
XX37,
XX0,
XX
XX31,
XX0,
XX
XX1,
XX29,
XX0,
XX
XX18,
XX29,
XX0,
XX
XX22,
XX29,
XX0,
XX
XX29,
XX0,
XX
XX29,
XX0,
XX
XX19,
XX29,
XX0,
XX
XX39,
XX0,
XX0};
XX# define YYTYPE char
XXstruct yywork { YYTYPE verify, advance; } yycrank[] ={
XX0,0, 0,0, 1,3, 0,0,
XX6,36, 0,0, 7,38, 0,0,
XX0,0, 0,0, 0,0, 1,4,
XX0,0, 6,36, 0,0, 7,39,
XX0,0, 0,0, 0,0, 0,0,
XX0,0, 0,0, 0,0, 0,0,
XX0,0, 0,0, 0,0, 0,0,
XX0,0, 0,0, 0,0, 0,0,
XX0,0, 34,56, 1,5, 1,6,
XX1,7, 6,37, 63,65, 7,38,
XX1,8, 1,9, 1,10, 1,11,
XX1,12, 1,13, 1,14, 65,67,
XX1,15, 1,16, 26,51, 6,36,
XX56,63, 7,38, 63,63, 0,0,
XX0,0, 0,0, 8,40, 0,0,
XX1,17, 1,18, 1,19, 1,20,
XX5,35, 18,47, 1,21, 8,0,
XX6,36, 1,22, 7,38, 1,23,
XX14,42, 14,42, 14,42, 14,42,
XX14,42, 14,42, 14,42, 14,42,
XX14,42, 14,42, 20,48, 0,0,
XX0,0, 1,24, 14,43, 0,0,
XX0,0, 0,0, 0,0, 8,40,
XX1,25, 1,26, 1,27, 0,0,
XX1,28, 0,0, 1,29, 1,30,
XX29,52, 1,31, 22,50, 50,59,
XX64,66, 8,40, 31,54, 2,5,
XX33,55, 2,34, 55,62, 62,64,
XX1,32, 2,8, 2,9, 2,10,
XX2,11, 2,12, 2,13, 2,14,
XX1,33, 2,15, 8,40, 30,53,
XX53,60, 54,61, 0,0, 0,0,
XX0,0, 0,0, 0,0, 0,0,
XX0,0, 2,17, 2,18, 2,19,
XX2,20, 0,0, 0,0, 0,0,
XX0,0, 0,0, 2,22, 0,0,
XX2,23, 0,0, 0,0, 0,0,
XX0,0, 8,41, 0,0, 0,0,
XX0,0, 0,0, 0,0, 0,0,
XX0,0, 0,0, 2,24, 0,0,
XX0,0, 0,0, 0,0, 0,0,
XX0,0, 2,25, 2,26, 2,27,
XX0,0, 2,28, 0,0, 2,29,
XX2,30, 16,44, 2,31, 16,45,
XX16,45, 16,45, 16,45, 16,45,
XX16,45, 16,45, 16,45, 16,45,
XX16,45, 2,32, 0,0, 0,0,
XX0,0, 0,0, 0,0, 0,0,
XX0,0, 2,33, 21,49, 21,49,
XX21,49, 21,49, 21,49, 21,49,
XX21,49, 21,49, 21,49, 21,49,
XX0,0, 0,0, 0,0, 0,0,
XX0,0, 0,0, 0,0, 21,49,
XX21,49, 21,49, 21,49, 21,49,
XX21,49, 21,49, 21,49, 21,49,
XX21,49, 21,49, 21,49, 21,49,
XX21,49, 21,49, 21,49, 21,49,
XX21,49, 21,49, 21,49, 21,49,
XX21,49, 21,49, 21,49, 21,49,
XX21,49, 0,0, 0,0, 0,0,
XX0,0, 16,46, 0,0, 21,49,
XX21,49, 21,49, 21,49, 21,49,
XX21,49, 21,49, 21,49, 21,49,
XX21,49, 21,49, 21,49, 21,49,
XX21,49, 21,49, 21,49, 21,49,
XX21,49, 21,49, 21,49, 21,49,
XX21,49, 21,49, 21,49, 21,49,
XX21,49, 41,57, 0,0, 0,0,
XX0,0, 0,0, 0,0, 0,0,
XX0,0, 42,58, 41,0, 42,42,
XX42,42, 42,42, 42,42, 42,42,
XX42,42, 42,42, 42,42, 42,42,
XX42,42, 44,44, 44,44, 44,44,
XX44,44, 44,44, 44,44, 44,44,
XX44,44, 44,44, 44,44, 67,67,
XX0,0, 68,67, 41,57, 58,58,
XX58,58, 58,58, 58,58, 58,58,
XX58,58, 58,58, 58,58, 58,58,
XX58,58, 0,0, 0,0, 0,0,
XX41,57, 0,0, 0,0, 0,0,
XX0,0, 0,0, 0,0, 0,0,
XX0,0, 0,0, 0,0, 0,0,
XX0,0, 0,0, 0,0, 0,0,
XX67,68, 41,57, 68,68, 0,0,
XX0,0, 0,0, 0,0, 0,0,
XX0,0, 0,0, 0,0, 0,0,
XX0,0, 0,0, 67,67, 0,0,
XX68,67, 0,0, 0,0, 0,0,
XX0,0, 0,0, 0,0, 0,0,
XX0,0, 0,0, 0,0, 0,0,
XX0,0, 0,0, 0,0, 67,67,
XX0,0, 68,67, 0,0, 0,0,
XX0,0};
XXstruct yysvf yysvec[] ={
XX0, 0, 0,
XXyycrank+-1, 0, 0,
XXyycrank+-74, yysvec+1, 0,
XXyycrank+0, 0, yyvstop+1,
XXyycrank+0, 0, yyvstop+3,
XXyycrank+3, 0, yyvstop+5,
XXyycrank+-3, 0, yyvstop+7,
XXyycrank+-5, 0, yyvstop+9,
XXyycrank+-57, 0, yyvstop+11,
XXyycrank+0, 0, yyvstop+13,
XXyycrank+0, 0, yyvstop+16,
XXyycrank+0, 0, yyvstop+19,
XXyycrank+0, 0, yyvstop+22,
XXyycrank+0, 0, yyvstop+25,
XXyycrank+24, 0, yyvstop+28,
XXyycrank+0, 0, yyvstop+31,
XXyycrank+127, 0, yyvstop+34,
XXyycrank+0, 0, yyvstop+37,
XXyycrank+4, 0, yyvstop+40,
XXyycrank+0, 0, yyvstop+43,
XXyycrank+21, 0, yyvstop+46,
XXyycrank+146, 0, yyvstop+49,
XXyycrank+1, yysvec+21, yyvstop+52,
XXyycrank+0, yysvec+21, yyvstop+55,
XXyycrank+0, yysvec+21, yyvstop+59,
XXyycrank+0, 0, yyvstop+63,
XXyycrank+3, 0, yyvstop+66,
XXyycrank+0, 0, yyvstop+69,
XXyycrank+0, 0, yyvstop+72,
XXyycrank+3, yysvec+21, yyvstop+75,
XXyycrank+6, yysvec+21, yyvstop+78,
XXyycrank+1, yysvec+21, yyvstop+81,
XXyycrank+0, yysvec+21, yyvstop+84,
XXyycrank+4, yysvec+21, yyvstop+88,
XXyycrank+-1, yysvec+7, yyvstop+91,
XXyycrank+0, 0, yyvstop+93,
XXyycrank+0, yysvec+6, 0,
XXyycrank+0, 0, yyvstop+95,
XXyycrank+0, yysvec+7, 0,
XXyycrank+0, 0, yyvstop+97,
XXyycrank+0, 0, yyvstop+99,
XXyycrank+-268, 0, yyvstop+101,
XXyycrank+231, 0, yyvstop+103,
XXyycrank+0, 0, yyvstop+105,
XXyycrank+241, 0, yyvstop+107,
XXyycrank+0, yysvec+16, yyvstop+109,
XXyycrank+0, 0, yyvstop+111,
XXyycrank+0, 0, yyvstop+113,
XXyycrank+0, 0, yyvstop+115,
XXyycrank+0, yysvec+21, yyvstop+117,
XXyycrank+1, yysvec+21, yyvstop+119,
XXyycrank+0, 0, yyvstop+121,
XXyycrank+0, yysvec+21, yyvstop+123,
XXyycrank+10, yysvec+21, yyvstop+126,
XXyycrank+7, yysvec+21, yyvstop+129,
XXyycrank+5, yysvec+21, yyvstop+131,
XXyycrank+-4, yysvec+7, 0,
XXyycrank+0, 0, yyvstop+133,
XXyycrank+255, 0, yyvstop+135,
XXyycrank+0, yysvec+21, yyvstop+137,
XXyycrank+0, yysvec+21, yyvstop+140,
XXyycrank+0, yysvec+21, yyvstop+143,
XXyycrank+3, yysvec+21, yyvstop+146,
XXyycrank+-6, yysvec+7, 0,
XXyycrank+3, yysvec+21, yyvstop+148,
XXyycrank+-13, yysvec+7, 0,
XXyycrank+0, yysvec+21, yyvstop+150,
XXyycrank+-298, yysvec+7, 0,
XXyycrank+-300, yysvec+7, yyvstop+153,
XX0, 0, 0};
XXstruct yywork *yytop = yycrank+365;
XXstruct yysvf *yybgin = yysvec+1;
XXchar yymatch[] ={
XX00 ,01 ,01 ,01 ,01 ,01 ,01 ,01 ,
XX01 ,01 ,012 ,01 ,01 ,01 ,01 ,01 ,
XX01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 ,
XX01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 ,
XX01 ,01 ,'"' ,01 ,01 ,01 ,01 ,01 ,
XX01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 ,
XX'0' ,'0' ,'0' ,'0' ,'0' ,'0' ,'0' ,'0' ,
XX'0' ,'0' ,01 ,01 ,01 ,01 ,01 ,01 ,
XX01 ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,
XX'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,
XX'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,
XX'A' ,'A' ,'A' ,01 ,01 ,01 ,01 ,01 ,
XX01 ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,
XX'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,
XX'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,
XX'A' ,'A' ,'A' ,01 ,01 ,01 ,01 ,01 ,
XX0};
XXchar yyextra[] ={
XX0,0,0,0,0,0,0,0,
XX0,0,0,0,0,0,0,0,
XX0,0,0,0,0,0,0,0,
XX0,0,0,0,0,0,0,0,
XX0,0,0,0,0,0,0,0,
XX0,0,0,0,0,0,0,0,
XX0};
XX/* ncform 4.1 83/08/11 */
XX
XXint yylineno =1;
XX# define YYU(x) x
XX# define NLSTATE yyprevious=YYNEWLINE
XXchar yytext[YYLMAX];
XXstruct yysvf *yylstate [YYLMAX], **yylsp, **yyolsp;
XXchar yysbuf[YYLMAX];
XXchar *yysptr = yysbuf;
XXint *yyfnd;
XXextern struct yysvf *yyestate;
XXint yyprevious = YYNEWLINE;
XXyylook(){
XX register struct yysvf *yystate, **lsp;
XX register struct yywork *yyt;
XX struct yysvf *yyz;
XX int yych;
XX struct yywork *yyr;
XX# ifdef LEXDEBUG
XX int debug;
XX# endif
XX char *yylastch;
XX /* start off machines */
XX# ifdef LEXDEBUG
XX debug = 0;
XX# endif
XX if (!yymorfg)
XX yylastch = yytext;
XX else {
XX yymorfg=0;
XX yylastch = yytext+yyleng;
XX }
XX for(;;){
XX lsp = yylstate;
XX yyestate = yystate = yybgin;
XX if (yyprevious==YYNEWLINE) yystate++;
XX for (;;){
XX# ifdef LEXDEBUG
XX if(debug)(void) fprintf(yyout,"state %d\n",yystate-yysvec-1);
XX# endif
XX yyt = yystate->yystoff;
XX if(yyt == yycrank){ /* may not be any transitions */
XX yyz = yystate->yyother;
XX if(yyz == 0)break;
XX if(yyz->yystoff == yycrank)break;
XX }
XX *yylastch++ = yych = input();
XX tryagain:
XX# ifdef LEXDEBUG
XX if(debug){
XX (void) fprintf(yyout,"char ");
XX allprint(yych);
XX (void) putchar('\n');
XX }
XX# endif
XX yyr = yyt;
XX if ( (int)yyt > (int)yycrank){
XX yyt = yyr + yych;
XX if (yyt <= yytop && yyt->verify+yysvec == yystate){
XX if(yyt->advance+yysvec == YYLERR) /* error transitions */
XX {unput(*--yylastch);break;}
XX *lsp++ = yystate = yyt->advance+yysvec;
XX goto contin;
XX }
XX }
XX# ifdef YYOPTIM
XX else if((int)yyt < (int)yycrank) { /* r < yycrank */
XX yyt = yyr = yycrank+(yycrank-yyt);
XX# ifdef LEXDEBUG
XX if(debug)(void) fprintf(yyout,"compressed state\n");
XX# endif
XX yyt = yyt + yych;
XX if(yyt <= yytop && yyt->verify+yysvec == yystate){
XX if(yyt->advance+yysvec == YYLERR) /* error transitions */
XX {unput(*--yylastch);break;}
XX *lsp++ = yystate = yyt->advance+yysvec;
XX goto contin;
XX }
XX yyt = yyr + YYU(yymatch[yych]);
XX# ifdef LEXDEBUG
XX if(debug){
XX (void) fprintf(yyout,"try fall back character ");
XX allprint(YYU(yymatch[yych]));
XX (void) putchar('\n');
XX }
XX# endif
XX if(yyt <= yytop && yyt->verify+yysvec == yystate){
XX if(yyt->advance+yysvec == YYLERR) /* error transition */
XX {unput(*--yylastch);break;}
XX *lsp++ = yystate = yyt->advance+yysvec;
XX goto contin;
XX }
XX }
XX if ((yystate = yystate->yyother) && (yyt= yystate->yystoff) != yycrank){
XX# ifdef LEXDEBUG
XX if(debug)(void) fprintf(yyout,"fall back to state %d\n",yystate-yysvec-1);
XX# endif
XX goto tryagain;
XX }
XX# endif
XX else
XX {unput(*--yylastch);break;}
XX contin:
XX# ifdef LEXDEBUG
XX if(debug){
XX (void) fprintf(yyout,"state %d char ",yystate-yysvec-1);
XX allprint(yych);
XX (void) putchar('\n');
XX }
XX# endif
XX ;
XX }
XX# ifdef LEXDEBUG
XX if(debug){
XX (void) fprintf(yyout,"stopped at %d with ",*(lsp-1)-yysvec-1);
XX allprint(yych);
XX (void) putchar('\n');
XX }
XX# endif
XX while (lsp-- > yylstate){
XX *yylastch-- = 0;
XX if (*lsp != 0 && (yyfnd= (*lsp)->yystops) && *yyfnd > 0){
XX yyolsp = lsp;
XX if(yyextra[*yyfnd]){ /* must backup */
XX while(yyback((*lsp)->yystops,-*yyfnd) != 1 && lsp > yylstate){
XX lsp--;
XX unput(*yylastch--);
XX }
XX }
XX yyprevious = YYU(*yylastch);
XX yylsp = lsp;
XX yyleng = yylastch-yytext+1;
XX yytext[yyleng] = 0;
XX# ifdef LEXDEBUG
XX if(debug){
XX (void) fprintf(yyout,"\nmatch ");
XX sprint(yytext);
XX (void) fprintf(yyout," action %d\n",*yyfnd);
XX }
XX# endif
XX return(*yyfnd++);
XX }
XX unput(*yylastch);
XX }
XX if (yytext[0] == 0 /* && feof(yyin) */)
XX {
XX yysptr=yysbuf;
XX return(0);
XX }
XX yyprevious = yytext[0] = input();
XX if (yyprevious>0)
XX output(yyprevious);
XX yylastch=yytext;
XX# ifdef LEXDEBUG
XX if(debug)(void) putchar('\n');
XX# endif
XX }
XX }
XXyyback(p, m)
XX int *p;
XX{
XXif (p==0) return(0);
XXwhile (*p)
XX {
XX if (*p++ == m)
XX return(1);
XX }
XXreturn(0);
XX}
XX /* the following are only used in the lex library */
XXyyinput(){
XX return(input());
XX }
XXyyoutput(c)
XX int c; {
XX output(c);
XX }
XXyyunput(c)
XX int c; {
XX unput(c);
XX }
SHAR_EOF
if test 12642 -ne "`wc -c lex.yy.c`"
then
echo shar: error transmitting lex.yy.c '(should have been 12642 characters)'
fi
# End of shell archive
exit 0
--
Please send comp.sources.unix-related mail to rsalz@uunet.uu.net.
Use a domain-based address or give alternate paths, or you may lose out.