aboutsummaryrefslogtreecommitdiff
path: root/unix/boot/spp/xpp
diff options
context:
space:
mode:
Diffstat (limited to 'unix/boot/spp/xpp')
-rw-r--r--unix/boot/spp/xpp/README6
-rw-r--r--unix/boot/spp/xpp/decl.c565
-rw-r--r--unix/boot/spp/xpp/lex.sed9
-rw-r--r--unix/boot/spp/xpp/lexyy.c2932
-rw-r--r--unix/boot/spp/xpp/mkpkg.sh15
-rw-r--r--unix/boot/spp/xpp/xpp.h94
-rw-r--r--unix/boot/spp/xpp/xpp.l476
-rw-r--r--unix/boot/spp/xpp/xpp.l.orig188
-rw-r--r--unix/boot/spp/xpp/xppProto.h55
-rw-r--r--unix/boot/spp/xpp/xppcode.c1826
-rw-r--r--unix/boot/spp/xpp/xppcode.c.bak1705
-rw-r--r--unix/boot/spp/xpp/xppmain.c225
-rw-r--r--unix/boot/spp/xpp/zztest.x19
13 files changed, 8115 insertions, 0 deletions
diff --git a/unix/boot/spp/xpp/README b/unix/boot/spp/xpp/README
new file mode 100644
index 00000000..6f5b7b9f
--- /dev/null
+++ b/unix/boot/spp/xpp/README
@@ -0,0 +1,6 @@
+XPP -- First pass of the SPP preprocessor.
+
+ This directory contains the Lex and C sources for the first pass of the
+preprocessor for the IRAF SPP (subset preprocessor) language. XPP takes as
+input an SPP source file and produces as output a text file which is further
+processed by RPP (the second pass) to produce Fortran.
diff --git a/unix/boot/spp/xpp/decl.c b/unix/boot/spp/xpp/decl.c
new file mode 100644
index 00000000..b5c64774
--- /dev/null
+++ b/unix/boot/spp/xpp/decl.c
@@ -0,0 +1,565 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#include <stdio.h>
+#include <ctype.h>
+#include <string.h>
+#include "xpp.h"
+
+#define import_spp
+#include <iraf.h>
+
+#ifndef SZ_SBUF
+#define SZ_SBUF 4096 /* max chars in proc. decls. */
+#endif
+#define SZ_TOKEN 63 /* max chars in a token */
+#define MAX_SYMBOLS 300 /* max symbol table entries */
+#define SPMAX (&sbuf[SZ_SBUF-1])
+#define UNDECL 0
+
+/*
+ * DECL.C -- A package of routines for parsing argument lists and declarations
+ * and generating the Fortran (actually, RPP) declarations required to compile
+ * a procedure. The main functions of this package at present are to remove
+ * arbitrary limitations on the ordering of argument declarations imposed by
+ * Fortran, and to perform various compile time checks on all declarations.
+ * Specifically, we allow scalar arguments to be used to dimension array
+ * arguments before the scalar arguments are declared, and we check for
+ * multiple declarations of the same object.
+ *
+ * Package Externals:
+ *
+ * d_newproc (name, type) process procedure declaration
+ * d_declaration (typestr) process typed declaration statement
+ * d_codegen (fp) output declarations for sym table
+ * d_runtime (text) return any runtime initialization text
+ *
+ * *symbol = d_enter (symbol, dtype, flags)
+ * *symbol = d_lookup (symbol)
+ *
+ * The external procedures YY_INPUT() and YY_UNPUT() are called to get/putpack
+ * characters from the input.
+ */
+
+extern int linenum[]; /* line numbers in files */
+extern int istkptr; /* istk pointer */
+
+struct symbol {
+ char *s_name; /* symbol name */
+ char *s_dimstr; /* dimension string if array */
+ short s_dtype; /* datatype (0 until declared) */
+ short s_flags; /* type flags */
+};
+
+#define S_ARGUMENT 001 /* symbol is an argument */
+#define S_ARRAY 002 /* symbol is an array */
+#define S_FUNCTION 004 /* symbol is a function() */
+#define S_EXTERN 010 /* symbol is an external */
+
+static char sbuf[SZ_SBUF+1]; /* string buffer */
+static char *nextch = sbuf; /* next location in sbuf */
+static char procname[SZ_FNAME+1]; /* procedure name */
+static int proctype; /* procedure type if function */
+static struct symbol sym[MAX_SYMBOLS]; /* symbol table */
+static int nsym = 0; /* number of symbols */
+
+struct symbol *d_enter();
+struct symbol *d_lookup();
+
+extern void error (int errcode, char *errmsg);
+extern void xpp_warn (char *warnmsg);
+extern int yy_input (void);
+extern void yy_unput (char ch);
+
+
+void d_newproc (char *name, int dtype);
+int d_declaration (int dtype);
+void d_codegen (register FILE *fp);
+void d_runtime (char *text);
+void d_makedecl (struct symbol *sp, FILE *fp);
+struct symbol *d_enter (char *name, int dtype, int flags);
+struct symbol *d_lookup (char *name);
+void d_chksbuf (void);
+int d_gettok (char *tokstr, int maxch);
+void d_declfunc (struct symbol *sp, FILE *fp);
+
+
+
+
+/* D_NEWPROC -- Process a procedure declaration. The name of the procedure
+ * is passed as the single argument. The input stream is left positioned
+ * with the ( of the argument list as the next token (if present). INPUT is
+ * called repeatedly to read the remainder of the declaration, which may span
+ * several lines. The symbol table is cleared whenever a new procedure
+ * declaration is started.
+ */
+void
+d_newproc (name, dtype)
+char *name; /* procedure name */
+int dtype; /* procedure type (0 if subr) */
+{
+ register int token;
+ char tokstr[SZ_TOKEN+1];
+
+
+
+ /* Print procedure name to keep the user amused in case the file
+ * is large and the machine slow.
+ */
+ fprintf (stderr, " %s:\n", name);
+ fflush (stderr);
+
+ strncpy (procname, name, SZ_FNAME);
+ proctype = dtype;
+ nextch = sbuf;
+ nsym = 0;
+
+ /* Check for null argument list. */
+ if (d_gettok(tokstr,SZ_TOKEN) != '(')
+ return;
+
+ /* Process the argument list.
+ */
+ while ((token = d_gettok(tokstr,SZ_TOKEN)) != ')') {
+ if (isalpha(token)) {
+ /* Enter argument name into the symbol table.
+ */
+ if (d_lookup (tokstr) != NULL) {
+ char lbuf[200];
+ sprintf (lbuf, "%s.%s multiply declared",
+ procname, tokstr);
+ xpp_warn (lbuf);
+ } else
+ d_enter (tokstr, UNDECL, S_ARGUMENT);
+ } else if (token == '\n') {
+ linenum[istkptr]++;
+ continue;
+ } else if (token == ',') {
+ continue;
+ } else
+ error (XPP_SYNTAX, "bad syntax in procedure argument list");
+ }
+}
+
+
+/* D_DECLARATION -- Process a declaration statement. This is any statement
+ * of the form
+ *
+ * type obj1, obj2, ..., objn
+ *
+ * ignoring comments and newlines following commas. The recognized types are
+ *
+ * bool, char, short, int, long, real, double, complex, pointer, extern
+ *
+ * If "obj" is followed by "()" the function type bit is set. If followed
+ * by "[...]" the array bit is set and the dimension string is accumulated,
+ * converting [] into (), adding 1 for char arrays, etc. in the process.
+ * Each OBJ identifier is entered into the symbol table with its attributes.
+ */
+int
+d_declaration (int dtype)
+{
+ register struct symbol *sp = NULL;
+ register char ch;
+ int token, ndim;
+ char tokstr[SZ_TOKEN+1];
+
+ while ((token = d_gettok(tokstr,SZ_TOKEN)) != '\n') {
+ if (isalpha(token)) {
+
+#ifdef CYGWIN
+ { if (strncmp ("procedure", tokstr, 9) == 0) {
+/*
+ extern char *yytext;
+ pushcontext (PROCSTMT);
+ d_gettok (yytext, SZ_TOKEN-1);
+ d_newproc (yytext, dtype);
+*/
+ pushcontext (PROCSTMT);
+ d_gettok (tokstr, SZ_TOKEN-1);
+ d_newproc (tokstr, dtype);
+ return (1);
+ }
+ }
+#endif
+
+ /* Enter argument or variable name into the symbol table.
+ * If symbol is already in table it must be an argument
+ * or we have a multiple declaration.
+ */
+ if ((sp = d_lookup (tokstr)) != NULL) {
+ if (dtype == XTY_EXTERN)
+ sp->s_flags |= S_EXTERN;
+ else if (sp->s_flags & S_ARGUMENT && sp->s_dtype == UNDECL)
+ sp->s_dtype = dtype;
+ else {
+ char lbuf[200];
+ sprintf (lbuf, "%s.%s multiply declared",
+ procname, tokstr);
+ xpp_warn (lbuf);
+ }
+ } else
+ sp = d_enter (tokstr, dtype, 0);
+
+ /* Check for trailing () or [].
+ */
+ token = d_gettok (tokstr, SZ_TOKEN);
+
+ switch (token) {
+ case ',':
+ case '\n':
+ yy_unput (token);
+ continue;
+
+ case '(':
+ /* Function declaration.
+ */
+ if ((token = d_gettok(tokstr,SZ_TOKEN)) != ')') {
+ yy_unput (token);
+ error (XPP_SYNTAX,
+ "missing right paren in function declaration");
+ }
+ sp->s_flags |= S_FUNCTION;
+ continue;
+
+ case '[':
+ /* Array declaration. Turn [] into (), add space for EOS
+ * if char array, set array bit for operand in symbol table.
+ */
+ sp->s_dimstr = nextch;
+ *nextch++ = '(';
+ ndim = 1;
+
+ while ((ch = yy_input()) != ']' && ch > 0) {
+ if (ch == '\n') {
+ yy_unput (ch);
+ error (XPP_SYNTAX,
+ "missing right bracket in array declaration");
+ break;
+ } else if (ch == ',') {
+ /* Add one char for the EOS in the first axis of
+ * a multidimensional char array.
+ */
+ if (ndim == 1 && dtype == TY_CHAR)
+ *nextch++ = '+', *nextch++ = '1';
+ *nextch++ = ',';
+ ndim++;
+ } else if (ch == 'A') {
+ /* Turn [ARB] into [*] for array arguments. */
+ if ((ch = yy_input()) == 'R') {
+ if ((ch = yy_input()) == 'B') {
+ *nextch++ = '*';
+ ndim++;
+ if (!(sp->s_flags & S_ARGUMENT)) {
+ error (XPP_SYNTAX,
+ "local variable dimensioned ARB");
+ break;
+ }
+ } else {
+ *nextch++ = 'A';
+ *nextch++ = 'R';
+ yy_unput (ch);
+ }
+ } else {
+ *nextch++ = 'A';
+ yy_unput (ch);
+ }
+ } else
+ *nextch++ = ch;
+ }
+
+ if (ndim == 1 && dtype == TY_CHAR)
+ *nextch++ = '+', *nextch++ = '1';
+
+ *nextch++ = ')';
+ *nextch++ = '\0';
+ d_chksbuf();
+
+ sp->s_flags |= S_ARRAY;
+ break;
+
+ default:
+ error (XPP_SYNTAX, "declaration syntax error");
+ }
+
+ } else if (token == ',') {
+ /* Check for implied continuation on the next line.
+ */
+ do {
+ ch = yy_input();
+ } while (ch == ' ' || ch == '\t');
+
+ if (ch == '\n')
+ linenum[istkptr]++;
+ else
+ yy_unput (ch);
+
+ } else if (sp && (sp->s_flags & S_ARGUMENT)) {
+ error (XPP_SYNTAX, "bad syntax in procedure argument list");
+ } else
+ error (XPP_SYNTAX, "declaration syntax error");
+ }
+
+ yy_unput ('\n');
+
+ return (0);
+}
+
+
+/* D_CODEGEN -- Output the RPP declarations for all symbol table entries.
+ * Declare scalar arguments first, followed by array arguments, followed
+ * by nonarguments.
+ */
+void
+d_codegen (fp)
+register FILE *fp;
+{
+ register struct symbol *sp;
+ register struct symbol *top = &sym[nsym-1];
+ extern char *type_decl[];
+ int col;
+
+ /* Declare the procedure itself.
+ */
+ if (proctype) {
+ fputs (type_decl[proctype], fp);
+ fputs (" x$func ", fp);
+ } else
+ fputs ("x$subr ", fp);
+
+ fputs (procname, fp);
+ fputs (" ", fp);
+
+ /* Output the argument list. Keep track of the approximate line length
+ * and break line if it gets too long for the second pass.
+ */
+ fputs ("(", fp);
+ col = strlen(procname) + 9;
+
+ for (sp=sym; sp <= top; sp++)
+ if (sp->s_flags & S_ARGUMENT) {
+ if (sp > sym) {
+ fputs (", ", fp);
+ col += 2;
+ }
+ col += strlen (sp->s_name);
+ if (col >= 78) {
+ fputs ("\n\t", fp);
+ col = strlen (sp->s_name) + 1;
+ }
+ fputs (sp->s_name, fp);
+ }
+ fputs (")\n", fp);
+
+ /* Declare scalar arguments. */
+ for (sp=sym; sp <= top; sp++)
+ if (sp->s_flags & S_ARGUMENT)
+ if (!(sp->s_flags & S_ARRAY))
+ d_makedecl (sp, fp);
+
+ /* Declare vector arguments. */
+ for (sp=sym; sp <= top; sp++)
+ if (sp->s_flags & S_ARGUMENT)
+ if (sp->s_flags & S_ARRAY)
+ d_makedecl (sp, fp);
+
+ /* Declare local variables and externals. */
+ for (sp=sym; sp <= top; sp++)
+ if (sp->s_flags & S_ARGUMENT)
+ continue;
+ else if (sp->s_flags & S_FUNCTION)
+ d_declfunc (sp, fp);
+ else
+ d_makedecl (sp, fp);
+}
+
+
+/* D_RUNTIME -- Return any runtime procedure initialization statements,
+ * i.e., statements to be executed at runtime when a procedure is entered,
+ * in the given output buffer.
+ */
+void
+d_runtime (char *text)
+{
+ /* For certain types of functions, ensure that the function value
+ * is initialized to a legal value, in case the procedure is exited
+ * without returning a value (e.g., during error processing).
+ */
+ switch (proctype) {
+ case XTY_REAL:
+ case XTY_DOUBLE:
+ sprintf (text, "\t%s = 0\n", procname);
+ break;
+ default:
+ text[0] = EOS;
+ break;
+ }
+}
+
+
+/* D_MAKEDECL -- Output a single RPP symbol declaration. Each declaration
+ * is output on a separate line.
+ */
+void
+d_makedecl (sp, fp)
+register struct symbol *sp; /* symbol table entry */
+register FILE *fp; /* output file */
+{
+ extern char *type_decl[];
+
+ if (sp->s_dtype != UNDECL) {
+ fputs (type_decl[sp->s_dtype], fp);
+ fputs ("\t", fp);
+ fputs (sp->s_name, fp);
+ if (sp->s_flags & S_ARRAY)
+ fputs (sp->s_dimstr, fp);
+ fputs ("\n", fp);
+ }
+
+ if (sp->s_flags & S_EXTERN) {
+ fputs (type_decl[XTY_EXTERN], fp);
+ fputs ("\t", fp);
+ fputs (sp->s_name, fp);
+ fputs ("\n", fp);
+ }
+}
+
+
+/* D_ENTER -- Add a symbol to the symbol table. Return a pointer to the
+ * new symbol.
+ */
+struct symbol *
+d_enter (name, dtype, flags)
+char *name; /* symbol name */
+int dtype; /* data type code */
+int flags; /* flag bits */
+{
+ register struct symbol *sp;
+
+
+ sp = &sym[nsym];
+ nsym++;
+ if (nsym > MAX_SYMBOLS)
+ error (XPP_COMPERR, "too many declarations in procedure");
+
+ sp->s_name = strcpy (nextch, name);
+ nextch += strlen(name) + 1;
+ d_chksbuf();
+
+ sp->s_dimstr = NULL;
+ sp->s_dtype = dtype;
+ sp->s_flags = flags;
+
+ return (sp);
+}
+
+
+/* D_LOOKUP -- Lookup a symbol in the symbol table. Return a pointer to the
+ * symbol table entry.
+ */
+struct symbol *
+d_lookup (name)
+char *name; /* symbol name */
+{
+ register struct symbol *sp;
+ register struct symbol *top = &sym[nsym-1];
+
+ for (sp=sym; sp <= top; sp++)
+ if (sp->s_name[0] == name[0])
+ if (strcmp (sp->s_name, name) == 0)
+ return (sp);
+
+ return (NULL);
+}
+
+
+/* D_CHKSBUF -- Check for overflow on the string buffer.
+ */
+void
+d_chksbuf()
+{
+ if (nextch > SPMAX)
+ error (XPP_COMPERR, "decl string buffer overflow");
+}
+
+
+/* D_GETTOK -- Get the next token from the input stream. Return the integer
+ * value of the first character of the token as the function value. EOF
+ * is an error in this application, not a token.
+ */
+int
+d_gettok (tokstr, maxch)
+char *tokstr; /* receives token string */
+int maxch; /* max chars to token string */
+{
+ register char *op = tokstr;
+ register int ch, n;
+
+
+
+ /* Skip whitespace and comments to first char of next token.
+ */
+ do {
+ ch = yy_input();
+ } while (ch == ' ' || ch == '\t');
+
+ if (ch == '#') {
+ /* Skip a comment.
+ */
+ while ((ch = yy_input()) != '\n' && ch > 0)
+ ;
+ }
+
+ if (ch <= 0)
+ error (XPP_SYNTAX, "unexpected EOF");
+
+ *op++ = ch;
+ n = maxch - 1;
+
+ if (isalpha (ch)) {
+ /* Identifer.
+ */
+ while ((ch = yy_input()) > 0)
+ if (isalnum(ch) || ch == '_') {
+ *op++ = ch;
+ if (--n <= 0)
+ error (XPP_SYNTAX, "identifier too long");
+ } else {
+ yy_unput (ch);
+ break;
+ }
+
+ } else if (isdigit (ch)) {
+ /* Number.
+ */
+ while ((ch = yy_input()) > 0)
+ if (isdigit(ch)) {
+ *op++ = ch;
+ if (--n <= 0)
+ error (XPP_SYNTAX, "number too long");
+ } else {
+ yy_unput (ch);
+ break;
+ }
+
+ }
+
+ *op++ = '\0';
+ if (ch <= 0)
+ error (XPP_SYNTAX, "unexpected EOF");
+
+ return (tokstr[0]);
+}
+
+
+/* D_DECLFUNC -- Declare a function. This module is provided to allow
+ * for any special treatment required for certain types of function
+ * declarations.
+ */
+void
+d_declfunc (sp, fp)
+register struct symbol *sp;
+FILE *fp;
+{
+ d_makedecl (sp, fp);
+}
diff --git a/unix/boot/spp/xpp/lex.sed b/unix/boot/spp/xpp/lex.sed
new file mode 100644
index 00000000..b0b35fd7
--- /dev/null
+++ b/unix/boot/spp/xpp/lex.sed
@@ -0,0 +1,9 @@
+/int nstr; extern int yyprevious;/a\
+if (yyin==NULL) yyin = stdin;\
+if (yyout==NULL) yyout = stdout;
+/{stdin}/c\
+FILE *yyin, *yyout;
+s/"stdio.h"/<stdio.h>/
+s/YYLMAX 200/YYLMAX 8192/
+s/static int input/int input/g
+s/static void yyunput/void yyunput/g
diff --git a/unix/boot/spp/xpp/lexyy.c b/unix/boot/spp/xpp/lexyy.c
new file mode 100644
index 00000000..c79ba67d
--- /dev/null
+++ b/unix/boot/spp/xpp/lexyy.c
@@ -0,0 +1,2932 @@
+
+#line 3 "lex.yy.c"
+
+#define YY_INT_ALIGNED short int
+
+/* A lexical scanner generated by flex */
+
+#define FLEX_SCANNER
+#define YY_FLEX_MAJOR_VERSION 2
+#define YY_FLEX_MINOR_VERSION 5
+#define YY_FLEX_SUBMINOR_VERSION 35
+#if YY_FLEX_SUBMINOR_VERSION > 0
+#define FLEX_BETA
+#endif
+
+/* First, we deal with platform-specific or compiler-specific issues. */
+
+/* begin standard C headers. */
+#include <stdio.h>
+#include <string.h>
+#include <errno.h>
+#include <stdlib.h>
+
+/* end standard C headers. */
+
+/* flex integer type definitions */
+
+#ifndef FLEXINT_H
+#define FLEXINT_H
+
+/* C99 systems have <inttypes.h>. Non-C99 systems may or may not. */
+
+#if defined (__STDC_VERSION__) && __STDC_VERSION__ >= 199901L
+
+/* C99 says to define __STDC_LIMIT_MACROS before including stdint.h,
+ * if you want the limit (max/min) macros for int types.
+ */
+#ifndef __STDC_LIMIT_MACROS
+#define __STDC_LIMIT_MACROS 1
+#endif
+
+#include <inttypes.h>
+typedef int8_t flex_int8_t;
+typedef uint8_t flex_uint8_t;
+typedef int16_t flex_int16_t;
+typedef uint16_t flex_uint16_t;
+typedef int32_t flex_int32_t;
+typedef uint32_t flex_uint32_t;
+typedef uint64_t flex_uint64_t;
+#else
+typedef signed char flex_int8_t;
+typedef short int flex_int16_t;
+typedef int flex_int32_t;
+typedef unsigned char flex_uint8_t;
+typedef unsigned short int flex_uint16_t;
+typedef unsigned int flex_uint32_t;
+#endif /* ! C99 */
+
+/* Limits of integral types. */
+#ifndef INT8_MIN
+#define INT8_MIN (-128)
+#endif
+#ifndef INT16_MIN
+#define INT16_MIN (-32767-1)
+#endif
+#ifndef INT32_MIN
+#define INT32_MIN (-2147483647-1)
+#endif
+#ifndef INT8_MAX
+#define INT8_MAX (127)
+#endif
+#ifndef INT16_MAX
+#define INT16_MAX (32767)
+#endif
+#ifndef INT32_MAX
+#define INT32_MAX (2147483647)
+#endif
+#ifndef UINT8_MAX
+#define UINT8_MAX (255U)
+#endif
+#ifndef UINT16_MAX
+#define UINT16_MAX (65535U)
+#endif
+#ifndef UINT32_MAX
+#define UINT32_MAX (4294967295U)
+#endif
+
+#endif /* ! FLEXINT_H */
+
+#ifdef __cplusplus
+
+/* The "const" storage-class-modifier is valid. */
+#define YY_USE_CONST
+
+#else /* ! __cplusplus */
+
+/* C99 requires __STDC__ to be defined as 1. */
+#if defined (__STDC__)
+
+#define YY_USE_CONST
+
+#endif /* defined (__STDC__) */
+#endif /* ! __cplusplus */
+
+#ifdef YY_USE_CONST
+#define yyconst const
+#else
+#define yyconst
+#endif
+
+/* Returned upon end-of-file. */
+#define YY_NULL 0
+
+/* Promotes a possibly negative, possibly signed char to an unsigned
+ * integer for use as an array index. If the signed char is negative,
+ * we want to instead treat it as an 8-bit unsigned char, hence the
+ * double cast.
+ */
+#define YY_SC_TO_UI(c) ((unsigned int) (unsigned char) c)
+
+/* Enter a start condition. This macro really ought to take a parameter,
+ * but we do it the disgusting crufty way forced on us by the ()-less
+ * definition of BEGIN.
+ */
+#define BEGIN (yy_start) = 1 + 2 *
+
+/* Translate the current start state into a value that can be later handed
+ * to BEGIN to return to the state. The YYSTATE alias is for lex
+ * compatibility.
+ */
+#define YY_START (((yy_start) - 1) / 2)
+#define YYSTATE YY_START
+
+/* Action number for EOF rule of a given start state. */
+#define YY_STATE_EOF(state) (YY_END_OF_BUFFER + state + 1)
+
+/* Special action meaning "start processing a new file". */
+#define YY_NEW_FILE yyrestart(yyin )
+
+#define YY_END_OF_BUFFER_CHAR 0
+
+/* Size of default input buffer. */
+#ifndef YY_BUF_SIZE
+#define YY_BUF_SIZE 16384
+#endif
+
+/* The state buf must be large enough to hold one state per character in the main buffer.
+ */
+#define YY_STATE_BUF_SIZE ((YY_BUF_SIZE + 2) * sizeof(yy_state_type))
+
+#ifndef YY_TYPEDEF_YY_BUFFER_STATE
+#define YY_TYPEDEF_YY_BUFFER_STATE
+typedef struct yy_buffer_state *YY_BUFFER_STATE;
+#endif
+
+#ifndef YY_TYPEDEF_YY_SIZE_T
+#define YY_TYPEDEF_YY_SIZE_T
+typedef size_t yy_size_t;
+#endif
+
+extern yy_size_t yyleng;
+
+extern FILE *yyin, *yyout;
+
+#define EOB_ACT_CONTINUE_SCAN 0
+#define EOB_ACT_END_OF_FILE 1
+#define EOB_ACT_LAST_MATCH 2
+
+ /* Note: We specifically omit the test for yy_rule_can_match_eol because it requires
+ * access to the local variable yy_act. Since yyless() is a macro, it would break
+ * existing scanners that call yyless() from OUTSIDE yylex.
+ * One obvious solution it to make yy_act a global. I tried that, and saw
+ * a 5% performance hit in a non-yylineno scanner, because yy_act is
+ * normally declared as a register variable-- so it is not worth it.
+ */
+ #define YY_LESS_LINENO(n) \
+ do { \
+ yy_size_t yyl;\
+ for ( yyl = n; yyl < yyleng; ++yyl )\
+ if ( yytext[yyl] == '\n' )\
+ --yylineno;\
+ }while(0)
+
+/* Return all but the first "n" matched characters back to the input stream. */
+#define yyless(n) \
+ do \
+ { \
+ /* Undo effects of setting up yytext. */ \
+ int yyless_macro_arg = (n); \
+ YY_LESS_LINENO(yyless_macro_arg);\
+ *yy_cp = (yy_hold_char); \
+ YY_RESTORE_YY_MORE_OFFSET \
+ (yy_c_buf_p) = yy_cp = yy_bp + yyless_macro_arg - YY_MORE_ADJ; \
+ YY_DO_BEFORE_ACTION; /* set up yytext again */ \
+ } \
+ while ( 0 )
+
+#define unput(c) yyunput( c, (yytext_ptr) )
+
+#ifndef YY_STRUCT_YY_BUFFER_STATE
+#define YY_STRUCT_YY_BUFFER_STATE
+struct yy_buffer_state
+ {
+ FILE *yy_input_file;
+
+ char *yy_ch_buf; /* input buffer */
+ char *yy_buf_pos; /* current position in input buffer */
+
+ /* Size of input buffer in bytes, not including room for EOB
+ * characters.
+ */
+ yy_size_t yy_buf_size;
+
+ /* Number of characters read into yy_ch_buf, not including EOB
+ * characters.
+ */
+ yy_size_t yy_n_chars;
+
+ /* Whether we "own" the buffer - i.e., we know we created it,
+ * and can realloc() it to grow it, and should free() it to
+ * delete it.
+ */
+ int yy_is_our_buffer;
+
+ /* Whether this is an "interactive" input source; if so, and
+ * if we're using stdio for input, then we want to use getc()
+ * instead of fread(), to make sure we stop fetching input after
+ * each newline.
+ */
+ int yy_is_interactive;
+
+ /* Whether we're considered to be at the beginning of a line.
+ * If so, '^' rules will be active on the next match, otherwise
+ * not.
+ */
+ int yy_at_bol;
+
+ int yy_bs_lineno; /**< The line count. */
+ int yy_bs_column; /**< The column count. */
+
+ /* Whether to try to fill the input buffer when we reach the
+ * end of it.
+ */
+ int yy_fill_buffer;
+
+ int yy_buffer_status;
+
+#define YY_BUFFER_NEW 0
+#define YY_BUFFER_NORMAL 1
+ /* When an EOF's been seen but there's still some text to process
+ * then we mark the buffer as YY_EOF_PENDING, to indicate that we
+ * shouldn't try reading from the input source any more. We might
+ * still have a bunch of tokens to match, though, because of
+ * possible backing-up.
+ *
+ * When we actually see the EOF, we change the status to "new"
+ * (via yyrestart()), so that the user can continue scanning by
+ * just pointing yyin at a new input file.
+ */
+#define YY_BUFFER_EOF_PENDING 2
+
+ };
+#endif /* !YY_STRUCT_YY_BUFFER_STATE */
+
+/* Stack of input buffers. */
+static size_t yy_buffer_stack_top = 0; /**< index of top of stack. */
+static size_t yy_buffer_stack_max = 0; /**< capacity of stack. */
+static YY_BUFFER_STATE * yy_buffer_stack = 0; /**< Stack as an array. */
+
+/* We provide macros for accessing buffer states in case in the
+ * future we want to put the buffer states in a more general
+ * "scanner state".
+ *
+ * Returns the top of the stack, or NULL.
+ */
+#define YY_CURRENT_BUFFER ( (yy_buffer_stack) \
+ ? (yy_buffer_stack)[(yy_buffer_stack_top)] \
+ : NULL)
+
+/* Same as previous macro, but useful when we know that the buffer stack is not
+ * NULL or when we need an lvalue. For internal use only.
+ */
+#define YY_CURRENT_BUFFER_LVALUE (yy_buffer_stack)[(yy_buffer_stack_top)]
+
+/* yy_hold_char holds the character lost when yytext is formed. */
+static char yy_hold_char;
+static yy_size_t yy_n_chars; /* number of characters read into yy_ch_buf */
+yy_size_t yyleng;
+
+/* Points to current character in buffer. */
+static char *yy_c_buf_p = (char *) 0;
+static int yy_init = 0; /* whether we need to initialize */
+static int yy_start = 0; /* start state number */
+
+/* Flag which is used to allow yywrap()'s to do buffer switches
+ * instead of setting up a fresh yyin. A bit of a hack ...
+ */
+static int yy_did_buffer_switch_on_eof;
+
+void yyrestart (FILE *input_file );
+void yy_switch_to_buffer (YY_BUFFER_STATE new_buffer );
+YY_BUFFER_STATE yy_create_buffer (FILE *file,int size );
+void yy_delete_buffer (YY_BUFFER_STATE b );
+void yy_flush_buffer (YY_BUFFER_STATE b );
+void yypush_buffer_state (YY_BUFFER_STATE new_buffer );
+void yypop_buffer_state (void );
+
+static void yyensure_buffer_stack (void );
+static void yy_load_buffer_state (void );
+static void yy_init_buffer (YY_BUFFER_STATE b,FILE *file );
+
+#define YY_FLUSH_BUFFER yy_flush_buffer(YY_CURRENT_BUFFER )
+
+YY_BUFFER_STATE yy_scan_buffer (char *base,yy_size_t size );
+YY_BUFFER_STATE yy_scan_string (yyconst char *yy_str );
+YY_BUFFER_STATE yy_scan_bytes (yyconst char *bytes,yy_size_t len );
+
+void *yyalloc (yy_size_t );
+void *yyrealloc (void *,yy_size_t );
+void yyfree (void * );
+
+#define yy_new_buffer yy_create_buffer
+
+#define yy_set_interactive(is_interactive) \
+ { \
+ if ( ! YY_CURRENT_BUFFER ){ \
+ yyensure_buffer_stack (); \
+ YY_CURRENT_BUFFER_LVALUE = \
+ yy_create_buffer(yyin,YY_BUF_SIZE ); \
+ } \
+ YY_CURRENT_BUFFER_LVALUE->yy_is_interactive = is_interactive; \
+ }
+
+#define yy_set_bol(at_bol) \
+ { \
+ if ( ! YY_CURRENT_BUFFER ){\
+ yyensure_buffer_stack (); \
+ YY_CURRENT_BUFFER_LVALUE = \
+ yy_create_buffer(yyin,YY_BUF_SIZE ); \
+ } \
+ YY_CURRENT_BUFFER_LVALUE->yy_at_bol = at_bol; \
+ }
+
+#define YY_AT_BOL() (YY_CURRENT_BUFFER_LVALUE->yy_at_bol)
+
+/* Begin user sect3 */
+
+typedef unsigned char YY_CHAR;
+
+FILE *yyin = (FILE *) 0, *yyout = (FILE *) 0;
+
+typedef int yy_state_type;
+
+#define YY_FLEX_LEX_COMPAT
+extern int yylineno;
+
+int yylineno = 1;
+
+extern char yytext[];
+
+static yy_state_type yy_get_previous_state (void );
+static yy_state_type yy_try_NUL_trans (yy_state_type current_state );
+static int yy_get_next_buffer (void );
+static void yy_fatal_error (yyconst char msg[] );
+
+/* Done after the current pattern has been matched and before the
+ * corresponding action - sets up yytext.
+ */
+#define YY_DO_BEFORE_ACTION \
+ (yytext_ptr) = yy_bp; \
+ yyleng = (yy_size_t) (yy_cp - yy_bp); \
+ (yy_hold_char) = *yy_cp; \
+ *yy_cp = '\0'; \
+ if ( yyleng + (yy_more_offset) >= YYLMAX ) \
+ YY_FATAL_ERROR( "token too large, exceeds YYLMAX" ); \
+ yy_flex_strncpy( &yytext[(yy_more_offset)], (yytext_ptr), yyleng + 1 ); \
+ yyleng += (yy_more_offset); \
+ (yy_prev_more_offset) = (yy_more_offset); \
+ (yy_more_offset) = 0; \
+ (yy_c_buf_p) = yy_cp;
+
+#define YY_NUM_RULES 44
+#define YY_END_OF_BUFFER 45
+/* This struct is not used in this scanner,
+ but its presence is necessary. */
+struct yy_trans_info
+ {
+ flex_int32_t yy_verify;
+ flex_int32_t yy_nxt;
+ };
+static yyconst flex_int16_t yy_acclist[275] =
+ { 0,
+ 45, 44, 43, 44, 41, 44, 25, 44, 44, 32,
+ 44, 44, 44, 44, 44, 44, 28, 44, 28, 44,
+ 38, 44, 39, 44, 28, 44, 28, 44, 36, 44,
+ 44, 37, 44, 44, 26, 44, 44, 44, 28, 44,
+ 28, 44, 28, 44, 28, 44, 28, 44, 28, 44,
+ 28, 44, 28, 44, 28, 44, 28, 44, 28, 44,
+ 34, 33, 40, 42, 30, 31, 30, 28, 28, 28,
+ 31, 28, 28, 35, 26, 28, 28, 28, 28, 28,
+ 28, 28, 28, 28, 28, 28, 28, 28, 28, 28,
+ 28, 28, 28, 28, 28, 28, 28, 28, 28, 28,
+
+ 28, 28, 28, 28,16405, 28, 28, 28,16388, 28,
+ 28, 28, 28, 28, 28, 28, 29, 28, 28,16405,
+ 28, 28, 28, 28,16385, 28,16386, 28, 28,16407,
+ 28, 28, 8213, 8213, 28, 28, 28, 8196, 8196, 28,
+ 28,16389, 28, 28, 28,16390, 28, 28, 28,16397,
+ 29, 28, 28,16407,16397, 16, 28, 28, 28,16401,
+ 8193, 8193, 28, 8194, 8194, 28, 28, 8215, 8215, 28,
+ 28, 28, 28, 28, 8197, 8197, 28, 28, 28, 8198,
+ 8198, 28, 28,16387, 28, 8205, 8205, 28, 29, 28,
+ 28,16408,16401, 28, 28, 8209, 8209, 28, 28, 28,
+
+ 16404, 28,16391, 28,16394, 28, 28, 28, 8195, 8195,
+ 28, 28,16406, 29, 28, 8216, 8216, 28,16404,16406,
+ 16404, 14, 28, 28, 28,16392, 8212, 8212, 8212, 28,
+ 8199, 8199, 28, 8202, 8202, 28, 28, 28,16393, 28,
+ 8214, 8214, 28, 28, 14, 28, 8200, 8200, 28, 27,
+ 8201, 8201, 28, 28, 28,16396, 15, 28, 28,16395,
+ 16396, 8204, 8204, 28, 15,16395, 19, 8203, 8204, 8203,
+ 8204, 28, 8203, 18
+ } ;
+
+static yyconst flex_int16_t yy_accept[285] =
+ { 0,
+ 1, 1, 1, 2, 3, 5, 7, 9, 10, 12,
+ 13, 14, 15, 16, 17, 19, 21, 23, 25, 27,
+ 29, 31, 32, 34, 35, 37, 38, 39, 41, 43,
+ 45, 47, 49, 51, 53, 55, 57, 59, 61, 62,
+ 63, 64, 64, 65, 65, 65, 65, 65, 65, 66,
+ 67, 68, 69, 70, 72, 73, 74, 75, 75, 75,
+ 75, 75, 75, 75, 75, 75, 75, 75, 76, 76,
+ 76, 77, 78, 79, 80, 81, 82, 83, 84, 85,
+ 86, 87, 88, 89, 90, 91, 92, 93, 94, 94,
+ 94, 95, 96, 96, 96, 96, 96, 96, 96, 96,
+
+ 96, 96, 96, 96, 97, 98, 99, 100, 101, 102,
+ 103, 104, 106, 107, 108, 110, 111, 112, 113, 114,
+ 115, 116, 117, 118, 119, 120, 120, 120, 120, 120,
+ 121, 121, 121, 121, 121, 121, 121, 122, 123, 124,
+ 126, 128, 129, 131, 132, 133, 134, 136, 137, 138,
+ 139, 141, 143, 144, 145, 147, 148, 149, 151, 152,
+ 152, 153, 154, 154, 154, 154, 155, 155, 155, 155,
+ 155, 156, 156, 157, 158, 159, 161, 162, 164, 165,
+ 167, 168, 169, 171, 172, 173, 174, 175, 176, 178,
+ 179, 180, 181, 183, 185, 186, 187, 189, 190, 190,
+
+ 191, 193, 193, 193, 194, 194, 194, 194, 194, 194,
+ 195, 196, 197, 199, 200, 202, 204, 206, 207, 208,
+ 209, 210, 212, 214, 215, 216, 217, 219, 219, 219,
+ 220, 220, 220, 221, 222, 224, 225, 227, 228, 229,
+ 231, 232, 234, 235, 237, 238, 240, 241, 242, 244,
+ 245, 246, 246, 246, 246, 247, 248, 250, 250, 250,
+ 250, 251, 252, 254, 255, 257, 257, 257, 259, 259,
+ 262, 263, 265, 266, 267, 268, 268, 270, 273, 274,
+ 274, 274, 275, 275
+ } ;
+
+static yyconst flex_int32_t yy_ec[256] =
+ { 0,
+ 1, 1, 1, 1, 1, 1, 1, 1, 2, 3,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 4, 1, 5, 6, 7, 8, 9, 10, 11,
+ 12, 13, 1, 14, 1, 15, 1, 16, 16, 16,
+ 16, 16, 16, 16, 17, 18, 18, 19, 20, 21,
+ 1, 1, 1, 1, 22, 23, 24, 25, 26, 22,
+ 27, 27, 28, 27, 27, 29, 30, 31, 27, 32,
+ 27, 33, 27, 34, 27, 27, 27, 35, 27, 27,
+ 36, 1, 37, 1, 38, 1, 39, 40, 41, 42,
+
+ 43, 44, 45, 46, 47, 48, 49, 50, 51, 52,
+ 53, 54, 48, 55, 56, 57, 58, 48, 59, 60,
+ 48, 48, 61, 62, 63, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1
+ } ;
+
+static yyconst flex_int32_t yy_meta[64] =
+ { 0,
+ 1, 2, 3, 2, 1, 1, 4, 1, 1, 1,
+ 1, 1, 1, 1, 1, 5, 5, 5, 1, 1,
+ 1, 5, 5, 5, 5, 5, 5, 5, 5, 5,
+ 5, 5, 5, 5, 5, 1, 1, 5, 6, 6,
+ 6, 6, 6, 6, 6, 6, 6, 6, 6, 6,
+ 6, 6, 6, 6, 6, 6, 6, 6, 6, 6,
+ 1, 1, 1
+ } ;
+
+static yyconst flex_int16_t yy_base[295] =
+ { 0,
+ 0, 62, 390, 1555, 1555, 1555, 1555, 380, 1555, 358,
+ 364, 65, 104, 58, 149, 0, 1555, 1555, 313, 308,
+ 1555, 304, 1555, 208, 0, 53, 319, 333, 29, 30,
+ 41, 26, 311, 309, 32, 318, 33, 321, 1555, 1555,
+ 1555, 104, 1555, 356, 0, 0, 84, 115, 0, 1555,
+ 1555, 0, 250, 0, 305, 310, 1555, 0, 314, 324,
+ 311, 50, 301, 300, 296, 293, 310, 0, 305, 302,
+ 337, 298, 289, 302, 289, 282, 294, 279, 294, 278,
+ 56, 282, 286, 279, 289, 274, 271, 253, 305, 119,
+ 266, 249, 298, 259, 246, 258, 259, 259, 246, 243,
+
+ 241, 252, 245, 86, 247, 243, 237, 237, 251, 242,
+ 248, 310, 244, 236, 373, 239, 231, 241, 231, 225,
+ 232, 229, 123, 234, 230, 115, 223, 230, 216, 0,
+ 211, 219, 212, 209, 210, 202, 228, 222, 200, 436,
+ 499, 199, 562, 195, 196, 1555, 0, 190, 186, 1555,
+ 0, 625, 186, 198, 688, 183, 187, 751, 129, 137,
+ 196, 191, 210, 204, 182, 0, 181, 174, 188, 178,
+ 0, 177, 1555, 204, 193, 814, 1555, 0, 1555, 0,
+ 183, 1555, 0, 182, 181, 171, 180, 1555, 0, 178,
+ 178, 1555, 0, 877, 173, 1555, 0, 132, 138, 159,
+
+ 940, 192, 180, 0, 170, 169, 166, 162, 163, 176,
+ 178, 1555, 0, 143, 1003, 1066, 1129, 158, 145, 141,
+ 1555, 0, 1192, 183, 142, 1555, 0, 167, 168, 97,
+ 150, 134, 0, 0, 0, 158, 1255, 1555, 155, 0,
+ 1555, 0, 1555, 0, 156, 1318, 133, 1555, 0, 138,
+ 1555, 136, 174, 108, 130, 1555, 0, 166, 178, 181,
+ 1555, 1555, 0, 109, 1381, 119, 82, 0, 185, 1444,
+ 1555, 0, 1555, 0, 1555, 81, 1555, 0, 1555, 64,
+ 36, 1555, 1555, 1504, 1510, 1516, 1522, 1526, 1530, 1534,
+ 1538, 1542, 1545, 1550
+
+ } ;
+
+static yyconst flex_int16_t yy_def[295] =
+ { 0,
+ 283, 1, 283, 283, 283, 283, 283, 283, 283, 283,
+ 283, 283, 283, 13, 284, 284, 283, 283, 284, 284,
+ 283, 283, 283, 283, 285, 283, 283, 284, 284, 284,
+ 284, 284, 284, 284, 284, 284, 284, 284, 283, 283,
+ 283, 283, 283, 286, 13, 14, 283, 14, 48, 283,
+ 283, 284, 284, 284, 284, 284, 283, 24, 283, 283,
+ 283, 283, 283, 283, 283, 283, 283, 285, 283, 283,
+ 284, 284, 284, 284, 284, 284, 284, 284, 284, 284,
+ 284, 284, 284, 284, 284, 284, 284, 284, 286, 283,
+ 284, 284, 283, 283, 283, 283, 283, 283, 283, 283,
+
+ 283, 283, 283, 284, 284, 284, 284, 284, 284, 284,
+ 284, 284, 284, 284, 284, 284, 284, 284, 284, 284,
+ 284, 284, 283, 284, 284, 283, 283, 283, 283, 287,
+ 283, 283, 283, 283, 283, 283, 284, 284, 284, 284,
+ 284, 284, 284, 284, 284, 283, 284, 284, 284, 283,
+ 284, 284, 284, 284, 284, 284, 284, 284, 283, 283,
+ 284, 284, 283, 283, 283, 288, 283, 283, 283, 283,
+ 289, 283, 283, 284, 284, 284, 283, 284, 283, 284,
+ 284, 283, 284, 284, 284, 284, 284, 283, 284, 284,
+ 284, 283, 284, 284, 284, 283, 284, 283, 283, 284,
+
+ 284, 283, 283, 290, 283, 283, 283, 283, 283, 284,
+ 284, 283, 284, 284, 284, 284, 284, 284, 284, 284,
+ 283, 284, 284, 283, 284, 283, 284, 283, 283, 291,
+ 283, 283, 292, 291, 284, 284, 284, 283, 293, 284,
+ 283, 284, 283, 284, 284, 284, 284, 283, 284, 284,
+ 283, 283, 283, 283, 284, 283, 284, 293, 293, 283,
+ 283, 283, 284, 284, 284, 283, 283, 284, 283, 284,
+ 283, 284, 283, 294, 283, 283, 283, 284, 283, 283,
+ 283, 283, 0, 283, 283, 283, 283, 283, 283, 283,
+ 283, 283, 283, 283
+
+ } ;
+
+static yyconst flex_int16_t yy_nxt[1619] =
+ { 0,
+ 4, 4, 5, 4, 6, 7, 4, 4, 8, 9,
+ 10, 4, 11, 12, 4, 13, 13, 14, 4, 12,
+ 4, 15, 15, 15, 15, 15, 16, 16, 16, 16,
+ 16, 16, 16, 16, 16, 17, 18, 4, 16, 16,
+ 16, 16, 16, 16, 16, 16, 16, 16, 16, 16,
+ 16, 16, 16, 19, 16, 20, 16, 16, 16, 16,
+ 21, 22, 23, 24, 40, 24, 42, 43, 42, 25,
+ 44, 72, 26, 46, 46, 74, 27, 79, 86, 76,
+ 48, 73, 75, 77, 83, 80, 84, 90, 95, 87,
+ 282, 56, 96, 78, 69, 28, 114, 283, 239, 90,
+
+ 239, 29, 30, 31, 32, 42, 43, 42, 33, 44,
+ 137, 34, 115, 138, 281, 35, 36, 37, 38, 45,
+ 45, 46, 47, 280, 274, 48, 49, 48, 48, 48,
+ 48, 48, 48, 283, 123, 123, 123, 159, 50, 163,
+ 199, 160, 164, 51, 198, 198, 198, 198, 198, 198,
+ 273, 270, 199, 224, 224, 224, 258, 260, 258, 260,
+ 261, 268, 267, 50, 53, 53, 53, 258, 266, 258,
+ 53, 53, 53, 53, 53, 260, 261, 260, 261, 269,
+ 265, 269, 260, 54, 260, 261, 269, 264, 269, 275,
+ 255, 254, 253, 252, 261, 251, 250, 159, 247, 246,
+
+ 245, 261, 237, 236, 235, 234, 233, 232, 54, 58,
+ 231, 58, 230, 229, 276, 228, 225, 223, 59, 220,
+ 219, 218, 217, 216, 215, 214, 211, 210, 209, 208,
+ 207, 206, 205, 204, 203, 202, 201, 200, 195, 194,
+ 191, 60, 190, 187, 186, 185, 184, 61, 181, 62,
+ 63, 176, 175, 174, 64, 173, 172, 171, 170, 169,
+ 168, 65, 167, 66, 67, 53, 53, 53, 166, 165,
+ 162, 53, 53, 53, 53, 53, 161, 158, 157, 156,
+ 155, 154, 153, 152, 54, 149, 148, 145, 144, 143,
+ 142, 141, 140, 139, 136, 135, 134, 133, 132, 131,
+
+ 130, 129, 128, 127, 126, 125, 124, 43, 122, 54,
+ 146, 146, 146, 146, 146, 146, 147, 146, 146, 146,
+ 146, 146, 146, 146, 146, 121, 120, 119, 146, 146,
+ 146, 118, 117, 116, 113, 112, 111, 110, 109, 108,
+ 107, 106, 105, 104, 103, 146, 146, 102, 101, 100,
+ 99, 98, 97, 94, 93, 69, 92, 91, 43, 88,
+ 85, 82, 81, 71, 70, 57, 56, 55, 41, 40,
+ 146, 146, 146, 150, 150, 150, 150, 150, 150, 151,
+ 150, 150, 150, 150, 150, 150, 150, 150, 39, 283,
+ 283, 150, 150, 150, 283, 283, 283, 283, 283, 283,
+
+ 283, 283, 283, 283, 283, 283, 283, 283, 150, 150,
+ 283, 283, 283, 283, 283, 283, 283, 283, 283, 283,
+ 283, 283, 283, 283, 283, 283, 283, 283, 283, 283,
+ 283, 283, 283, 150, 150, 150, 177, 177, 177, 177,
+ 177, 177, 178, 177, 177, 177, 177, 177, 177, 177,
+ 177, 283, 283, 283, 177, 177, 177, 283, 283, 283,
+ 283, 283, 283, 283, 283, 283, 283, 283, 283, 283,
+ 283, 177, 177, 283, 283, 283, 283, 283, 283, 283,
+ 283, 283, 283, 283, 283, 283, 283, 283, 283, 283,
+ 283, 283, 283, 283, 283, 283, 177, 177, 177, 179,
+
+ 179, 179, 179, 179, 179, 180, 179, 179, 179, 179,
+ 179, 179, 179, 179, 283, 283, 283, 179, 179, 179,
+ 283, 283, 283, 283, 283, 283, 283, 283, 283, 283,
+ 283, 283, 283, 283, 179, 179, 283, 283, 283, 283,
+ 283, 283, 283, 283, 283, 283, 283, 283, 283, 283,
+ 283, 283, 283, 283, 283, 283, 283, 283, 283, 179,
+ 179, 179, 182, 182, 182, 182, 182, 182, 183, 182,
+ 182, 182, 182, 182, 182, 182, 182, 283, 283, 283,
+ 182, 182, 182, 283, 283, 283, 283, 283, 283, 283,
+ 283, 283, 283, 283, 283, 283, 283, 182, 182, 283,
+
+ 283, 283, 283, 283, 283, 283, 283, 283, 283, 283,
+ 283, 283, 283, 283, 283, 283, 283, 283, 283, 283,
+ 283, 283, 182, 182, 182, 188, 188, 188, 188, 188,
+ 188, 189, 188, 188, 188, 188, 188, 188, 188, 188,
+ 283, 283, 283, 188, 188, 188, 283, 283, 283, 283,
+ 283, 283, 283, 283, 283, 283, 283, 283, 283, 283,
+ 188, 188, 283, 283, 283, 283, 283, 283, 283, 283,
+ 283, 283, 283, 283, 283, 283, 283, 283, 283, 283,
+ 283, 283, 283, 283, 283, 188, 188, 188, 192, 192,
+ 192, 192, 192, 192, 193, 192, 192, 192, 192, 192,
+
+ 192, 192, 192, 283, 283, 283, 192, 192, 192, 283,
+ 283, 283, 283, 283, 283, 283, 283, 283, 283, 283,
+ 283, 283, 283, 192, 192, 283, 283, 283, 283, 283,
+ 283, 283, 283, 283, 283, 283, 283, 283, 283, 283,
+ 283, 283, 283, 283, 283, 283, 283, 283, 192, 192,
+ 192, 196, 196, 196, 196, 196, 196, 197, 196, 196,
+ 196, 196, 196, 196, 196, 196, 283, 283, 283, 196,
+ 196, 196, 283, 283, 283, 283, 283, 283, 283, 283,
+ 283, 283, 283, 283, 283, 283, 196, 196, 283, 283,
+ 283, 283, 283, 283, 283, 283, 283, 283, 283, 283,
+
+ 283, 283, 283, 283, 283, 283, 283, 283, 283, 283,
+ 283, 196, 196, 196, 212, 212, 212, 212, 212, 212,
+ 213, 212, 212, 212, 212, 212, 212, 212, 212, 283,
+ 283, 283, 212, 212, 212, 283, 283, 283, 283, 283,
+ 283, 283, 283, 283, 283, 283, 283, 283, 283, 212,
+ 212, 283, 283, 283, 283, 283, 283, 283, 283, 283,
+ 283, 283, 283, 283, 283, 283, 283, 283, 283, 283,
+ 283, 283, 283, 283, 212, 212, 212, 221, 221, 221,
+ 221, 221, 221, 222, 221, 221, 221, 221, 221, 221,
+ 221, 221, 283, 283, 283, 221, 221, 221, 283, 283,
+
+ 283, 283, 283, 283, 283, 283, 283, 283, 283, 283,
+ 283, 283, 221, 221, 283, 283, 283, 283, 283, 283,
+ 283, 283, 283, 283, 283, 283, 283, 283, 283, 283,
+ 283, 283, 283, 283, 283, 283, 283, 221, 221, 221,
+ 226, 226, 226, 226, 226, 226, 227, 226, 226, 226,
+ 226, 226, 226, 226, 226, 283, 283, 283, 226, 226,
+ 226, 283, 283, 283, 283, 283, 283, 283, 283, 283,
+ 283, 283, 283, 283, 283, 226, 226, 283, 283, 283,
+ 283, 283, 283, 283, 283, 283, 283, 283, 283, 283,
+ 283, 283, 283, 283, 283, 283, 283, 283, 283, 283,
+
+ 226, 226, 226, 238, 239, 238, 239, 238, 238, 240,
+ 238, 238, 238, 238, 238, 238, 238, 238, 283, 283,
+ 283, 238, 238, 238, 283, 283, 283, 283, 283, 283,
+ 283, 283, 283, 283, 283, 283, 283, 283, 238, 238,
+ 283, 283, 283, 283, 283, 283, 283, 283, 283, 283,
+ 283, 283, 283, 283, 283, 283, 283, 283, 283, 283,
+ 283, 283, 283, 238, 238, 238, 241, 241, 241, 241,
+ 241, 241, 242, 241, 241, 241, 241, 241, 241, 241,
+ 241, 283, 283, 283, 241, 241, 241, 283, 283, 283,
+ 283, 283, 283, 283, 283, 283, 283, 283, 283, 283,
+
+ 283, 241, 241, 283, 283, 283, 283, 283, 283, 283,
+ 283, 283, 283, 283, 283, 283, 283, 283, 283, 283,
+ 283, 283, 283, 283, 283, 283, 241, 241, 241, 243,
+ 243, 243, 243, 243, 243, 244, 243, 243, 243, 243,
+ 243, 243, 243, 243, 283, 283, 283, 243, 243, 243,
+ 283, 283, 283, 283, 283, 283, 283, 283, 283, 283,
+ 283, 283, 283, 283, 243, 243, 283, 283, 283, 283,
+ 283, 283, 283, 283, 283, 283, 283, 283, 283, 283,
+ 283, 283, 283, 283, 283, 283, 283, 283, 283, 243,
+ 243, 243, 248, 248, 248, 248, 248, 248, 249, 248,
+
+ 248, 248, 248, 248, 248, 248, 248, 283, 283, 283,
+ 248, 248, 248, 283, 283, 283, 283, 283, 283, 283,
+ 283, 283, 283, 283, 283, 283, 283, 248, 248, 283,
+ 283, 283, 283, 283, 283, 283, 283, 283, 283, 283,
+ 283, 283, 283, 283, 283, 283, 283, 283, 283, 283,
+ 283, 283, 248, 248, 248, 256, 256, 256, 256, 256,
+ 256, 257, 256, 256, 256, 256, 256, 256, 256, 256,
+ 283, 283, 283, 256, 256, 256, 283, 283, 283, 283,
+ 283, 283, 283, 283, 283, 283, 283, 283, 283, 283,
+ 256, 256, 283, 283, 283, 283, 283, 283, 283, 283,
+
+ 283, 283, 283, 283, 283, 283, 283, 283, 283, 283,
+ 283, 283, 283, 283, 283, 256, 256, 256, 262, 262,
+ 262, 262, 262, 262, 263, 262, 262, 262, 262, 262,
+ 262, 262, 262, 283, 283, 283, 262, 262, 262, 283,
+ 283, 283, 283, 283, 283, 283, 283, 283, 283, 283,
+ 283, 283, 283, 262, 262, 283, 283, 283, 283, 283,
+ 283, 283, 283, 283, 283, 283, 283, 283, 283, 283,
+ 283, 283, 283, 283, 283, 283, 283, 283, 262, 262,
+ 262, 271, 271, 271, 271, 271, 271, 272, 271, 271,
+ 271, 271, 271, 271, 271, 271, 283, 283, 283, 271,
+
+ 271, 271, 283, 283, 283, 283, 283, 283, 283, 283,
+ 283, 283, 283, 283, 283, 283, 271, 271, 283, 283,
+ 283, 283, 283, 283, 283, 283, 283, 283, 283, 283,
+ 283, 283, 283, 283, 283, 283, 283, 283, 283, 283,
+ 283, 271, 271, 271, 277, 277, 277, 277, 277, 277,
+ 278, 277, 277, 277, 277, 277, 277, 277, 277, 283,
+ 283, 283, 277, 277, 277, 283, 283, 283, 283, 283,
+ 283, 283, 283, 283, 283, 283, 283, 283, 283, 277,
+ 277, 283, 283, 283, 283, 283, 283, 283, 283, 283,
+ 283, 283, 283, 283, 283, 283, 283, 283, 283, 283,
+
+ 283, 283, 283, 283, 277, 277, 277, 52, 52, 52,
+ 68, 68, 283, 68, 68, 68, 89, 89, 89, 89,
+ 89, 89, 146, 146, 146, 146, 182, 182, 182, 182,
+ 196, 196, 196, 196, 212, 212, 212, 212, 238, 238,
+ 238, 238, 248, 248, 248, 248, 259, 283, 283, 259,
+ 279, 279, 279, 279, 3, 283, 283, 283, 283, 283,
+ 283, 283, 283, 283, 283, 283, 283, 283, 283, 283,
+ 283, 283, 283, 283, 283, 283, 283, 283, 283, 283,
+ 283, 283, 283, 283, 283, 283, 283, 283, 283, 283,
+ 283, 283, 283, 283, 283, 283, 283, 283, 283, 283,
+
+ 283, 283, 283, 283, 283, 283, 283, 283, 283, 283,
+ 283, 283, 283, 283, 283, 283, 283, 283
+ } ;
+
+static yyconst flex_int16_t yy_chk[1619] =
+ { 0,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 2, 26, 2, 12, 12, 12, 2,
+ 12, 29, 2, 14, 14, 30, 2, 32, 37, 31,
+ 14, 29, 30, 31, 35, 32, 35, 47, 62, 37,
+ 281, 37, 62, 31, 26, 2, 81, 14, 230, 47,
+
+ 230, 2, 2, 2, 2, 42, 42, 42, 2, 42,
+ 104, 2, 81, 104, 280, 2, 2, 2, 2, 13,
+ 13, 13, 13, 276, 267, 13, 13, 13, 13, 13,
+ 48, 48, 48, 48, 90, 90, 90, 123, 13, 126,
+ 160, 123, 126, 13, 159, 159, 159, 198, 198, 198,
+ 266, 264, 160, 199, 199, 199, 239, 245, 239, 245,
+ 245, 255, 254, 13, 15, 15, 15, 258, 252, 258,
+ 15, 15, 15, 15, 15, 253, 245, 253, 253, 259,
+ 250, 259, 260, 15, 260, 260, 269, 247, 269, 269,
+ 236, 232, 231, 229, 253, 228, 225, 224, 220, 219,
+
+ 218, 260, 214, 211, 210, 209, 208, 207, 15, 24,
+ 206, 24, 205, 203, 269, 202, 200, 195, 24, 191,
+ 190, 187, 186, 185, 184, 181, 175, 174, 172, 170,
+ 169, 168, 167, 165, 164, 163, 162, 161, 157, 156,
+ 154, 24, 153, 149, 148, 145, 144, 24, 142, 24,
+ 24, 139, 138, 137, 24, 136, 135, 134, 133, 132,
+ 131, 24, 129, 24, 24, 53, 53, 53, 128, 127,
+ 125, 53, 53, 53, 53, 53, 124, 122, 121, 120,
+ 119, 118, 117, 116, 53, 114, 113, 111, 110, 109,
+ 108, 107, 106, 105, 103, 102, 101, 100, 99, 98,
+
+ 97, 96, 95, 94, 93, 92, 91, 89, 88, 53,
+ 112, 112, 112, 112, 112, 112, 112, 112, 112, 112,
+ 112, 112, 112, 112, 112, 87, 86, 85, 112, 112,
+ 112, 84, 83, 82, 80, 79, 78, 77, 76, 75,
+ 74, 73, 72, 71, 70, 112, 112, 69, 67, 66,
+ 65, 64, 63, 61, 60, 59, 56, 55, 44, 38,
+ 36, 34, 33, 28, 27, 22, 20, 19, 11, 10,
+ 112, 112, 112, 115, 115, 115, 115, 115, 115, 115,
+ 115, 115, 115, 115, 115, 115, 115, 115, 8, 3,
+ 0, 115, 115, 115, 0, 0, 0, 0, 0, 0,
+
+ 0, 0, 0, 0, 0, 0, 0, 0, 115, 115,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 115, 115, 115, 140, 140, 140, 140,
+ 140, 140, 140, 140, 140, 140, 140, 140, 140, 140,
+ 140, 0, 0, 0, 140, 140, 140, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 140, 140, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 140, 140, 140, 141,
+
+ 141, 141, 141, 141, 141, 141, 141, 141, 141, 141,
+ 141, 141, 141, 141, 0, 0, 0, 141, 141, 141,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 141, 141, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 141,
+ 141, 141, 143, 143, 143, 143, 143, 143, 143, 143,
+ 143, 143, 143, 143, 143, 143, 143, 0, 0, 0,
+ 143, 143, 143, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 143, 143, 0,
+
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 143, 143, 143, 152, 152, 152, 152, 152,
+ 152, 152, 152, 152, 152, 152, 152, 152, 152, 152,
+ 0, 0, 0, 152, 152, 152, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 152, 152, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 152, 152, 152, 155, 155,
+ 155, 155, 155, 155, 155, 155, 155, 155, 155, 155,
+
+ 155, 155, 155, 0, 0, 0, 155, 155, 155, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 155, 155, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 155, 155,
+ 155, 158, 158, 158, 158, 158, 158, 158, 158, 158,
+ 158, 158, 158, 158, 158, 158, 0, 0, 0, 158,
+ 158, 158, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 158, 158, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 158, 158, 158, 176, 176, 176, 176, 176, 176,
+ 176, 176, 176, 176, 176, 176, 176, 176, 176, 0,
+ 0, 0, 176, 176, 176, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 176,
+ 176, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 176, 176, 176, 194, 194, 194,
+ 194, 194, 194, 194, 194, 194, 194, 194, 194, 194,
+ 194, 194, 0, 0, 0, 194, 194, 194, 0, 0,
+
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 194, 194, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 194, 194, 194,
+ 201, 201, 201, 201, 201, 201, 201, 201, 201, 201,
+ 201, 201, 201, 201, 201, 0, 0, 0, 201, 201,
+ 201, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 201, 201, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+
+ 201, 201, 201, 215, 215, 215, 215, 215, 215, 215,
+ 215, 215, 215, 215, 215, 215, 215, 215, 0, 0,
+ 0, 215, 215, 215, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 215, 215,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 215, 215, 215, 216, 216, 216, 216,
+ 216, 216, 216, 216, 216, 216, 216, 216, 216, 216,
+ 216, 0, 0, 0, 216, 216, 216, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+
+ 0, 216, 216, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 216, 216, 216, 217,
+ 217, 217, 217, 217, 217, 217, 217, 217, 217, 217,
+ 217, 217, 217, 217, 0, 0, 0, 217, 217, 217,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 217, 217, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 217,
+ 217, 217, 223, 223, 223, 223, 223, 223, 223, 223,
+
+ 223, 223, 223, 223, 223, 223, 223, 0, 0, 0,
+ 223, 223, 223, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 223, 223, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 223, 223, 223, 237, 237, 237, 237, 237,
+ 237, 237, 237, 237, 237, 237, 237, 237, 237, 237,
+ 0, 0, 0, 237, 237, 237, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 237, 237, 0, 0, 0, 0, 0, 0, 0, 0,
+
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 237, 237, 237, 246, 246,
+ 246, 246, 246, 246, 246, 246, 246, 246, 246, 246,
+ 246, 246, 246, 0, 0, 0, 246, 246, 246, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 246, 246, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 246, 246,
+ 246, 265, 265, 265, 265, 265, 265, 265, 265, 265,
+ 265, 265, 265, 265, 265, 265, 0, 0, 0, 265,
+
+ 265, 265, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 265, 265, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 265, 265, 265, 270, 270, 270, 270, 270, 270,
+ 270, 270, 270, 270, 270, 270, 270, 270, 270, 0,
+ 0, 0, 270, 270, 270, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 270,
+ 270, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+
+ 0, 0, 0, 0, 270, 270, 270, 284, 284, 284,
+ 285, 285, 0, 285, 285, 285, 286, 286, 286, 286,
+ 286, 286, 287, 287, 287, 287, 288, 288, 288, 288,
+ 289, 289, 289, 289, 290, 290, 290, 290, 291, 291,
+ 291, 291, 292, 292, 292, 292, 293, 0, 0, 293,
+ 294, 294, 294, 294, 283, 283, 283, 283, 283, 283,
+ 283, 283, 283, 283, 283, 283, 283, 283, 283, 283,
+ 283, 283, 283, 283, 283, 283, 283, 283, 283, 283,
+ 283, 283, 283, 283, 283, 283, 283, 283, 283, 283,
+ 283, 283, 283, 283, 283, 283, 283, 283, 283, 283,
+
+ 283, 283, 283, 283, 283, 283, 283, 283, 283, 283,
+ 283, 283, 283, 283, 283, 283, 283, 283
+ } ;
+
+/* Table of booleans, true if rule could match eol. */
+static yyconst flex_int32_t yy_rule_can_match_eol[45] =
+ { 0,
+1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 1, 0, 0,
+ 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 1, 1, 0, };
+
+extern int yy_flex_debug;
+int yy_flex_debug = 0;
+
+static yy_state_type *yy_state_buf=0, *yy_state_ptr=0;
+static char *yy_full_match;
+static int yy_lp;
+static int yy_looking_for_trail_begin = 0;
+static int yy_full_lp;
+static int *yy_full_state;
+#define YY_TRAILING_MASK 0x2000
+#define YY_TRAILING_HEAD_MASK 0x4000
+#define REJECT \
+{ \
+*yy_cp = (yy_hold_char); /* undo effects of setting up yytext */ \
+yy_cp = (yy_full_match); /* restore poss. backed-over text */ \
+(yy_lp) = (yy_full_lp); /* restore orig. accepting pos. */ \
+(yy_state_ptr) = (yy_full_state); /* restore orig. state */ \
+yy_current_state = *(yy_state_ptr); /* restore curr. state */ \
+++(yy_lp); \
+goto find_rule; \
+}
+
+static int yy_more_offset = 0;
+static int yy_prev_more_offset = 0;
+#define yymore() ((yy_more_offset) = yy_flex_strlen( yytext ))
+#define YY_NEED_STRLEN
+#define YY_MORE_ADJ 0
+#define YY_RESTORE_YY_MORE_OFFSET \
+ { \
+ (yy_more_offset) = (yy_prev_more_offset); \
+ yyleng -= (yy_more_offset); \
+ }
+#ifndef YYLMAX
+#define YYLMAX 8192
+#endif
+
+char yytext[YYLMAX];
+char *yytext_ptr;
+#line 1 "xpp.l"
+#line 2 "xpp.l"
+
+#include <stdio.h>
+#include <ctype.h>
+#include "xpp.h"
+#include "../../bootProto.h"
+#include "xppProto.h"
+
+#define import_spp
+#include <iraf.h>
+
+
+#include "xpp.h"
+
+/*
+ * Lexical definition for the first pass of the IRAF subset preprocessor.
+ * This program is a horrible kludge but will suffice until there is time
+ * to build something better.
+ */
+
+#undef output /* undefine LEX output macro -- we use proc */
+#undef ECHO /* ditto echo */
+#define ECHO outstr (yytext)
+
+#define OCTAL 8
+#define HEX 16
+#define CHARCON 1
+
+#ifdef YYLMAX
+#undef YYLMAX
+#endif
+#define YYLMAX YY_BUF_SIZE
+
+YY_BUFFER_STATE include_stack[MAX_INCLUDE];
+
+
+extern FILE *istk[];
+extern char fname[MAX_INCLUDE][SZ_PATHNAME];
+extern char *machdefs[];
+extern int hbindefs, foreigndefs;
+
+extern int linenum[]; /* line numbers in files */
+extern int istkptr; /* istk pointer */
+extern int str_idnum; /* for ST0000 string names */
+extern int nbrace; /* count of braces */
+extern int nswitch; /* number of "switch" stmts */
+extern int errflag; /* set if compiler error */
+extern int errchk; /* sef if error checking */
+extern int context; /* lexical context flags */
+extern int ntasks;
+static int dtype; /* set if typed procedure */
+
+extern char *vfn2osfn();
+extern void skipnl (void);
+
+
+void typespec (int typecode);
+void process_task_statement (void);
+
+void do_include (void);
+int yywrap (void);
+int yy_input (void);
+void yy_unput (char ch);
+
+
+#line 1053 "lex.yy.c"
+
+#define INITIAL 0
+
+#ifndef YY_NO_UNISTD_H
+/* Special case for "unistd.h", since it is non-ANSI. We include it way
+ * down here because we want the user's section 1 to have been scanned first.
+ * The user has a chance to override it with an option.
+ */
+#include <unistd.h>
+#endif
+
+#ifndef YY_EXTRA_TYPE
+#define YY_EXTRA_TYPE void *
+#endif
+
+static int yy_init_globals (void );
+
+/* Accessor methods to globals.
+ These are made visible to non-reentrant scanners for convenience. */
+
+int yylex_destroy (void );
+
+int yyget_debug (void );
+
+void yyset_debug (int debug_flag );
+
+YY_EXTRA_TYPE yyget_extra (void );
+
+void yyset_extra (YY_EXTRA_TYPE user_defined );
+
+FILE *yyget_in (void );
+
+void yyset_in (FILE * in_str );
+
+FILE *yyget_out (void );
+
+void yyset_out (FILE * out_str );
+
+yy_size_t yyget_leng (void );
+
+char *yyget_text (void );
+
+int yyget_lineno (void );
+
+void yyset_lineno (int line_number );
+
+/* Macros after this point can all be overridden by user definitions in
+ * section 1.
+ */
+
+#ifndef YY_SKIP_YYWRAP
+#ifdef __cplusplus
+extern "C" int yywrap (void );
+#else
+extern int yywrap (void );
+#endif
+#endif
+
+ void yyunput (int c,char *buf_ptr );
+
+#ifndef yytext_ptr
+static void yy_flex_strncpy (char *,yyconst char *,int );
+#endif
+
+#ifdef YY_NEED_STRLEN
+static int yy_flex_strlen (yyconst char * );
+#endif
+
+#ifndef YY_NO_INPUT
+
+#ifdef __cplusplus
+static int yyinput (void );
+#else
+int input (void );
+#endif
+
+#endif
+
+/* Amount of stuff to slurp up with each read. */
+#ifndef YY_READ_BUF_SIZE
+#define YY_READ_BUF_SIZE 8192
+#endif
+
+/* Copy whatever the last rule matched to the standard output. */
+#ifndef ECHO
+/* This used to be an fputs(), but since the string might contain NUL's,
+ * we now use fwrite().
+ */
+#define ECHO fwrite( yytext, yyleng, 1, yyout )
+#endif
+
+/* Gets input and stuffs it into "buf". number of characters read, or YY_NULL,
+ * is returned in "result".
+ */
+#ifndef YY_INPUT
+#define YY_INPUT(buf,result,max_size) \
+ if ( YY_CURRENT_BUFFER_LVALUE->yy_is_interactive ) \
+ { \
+ int c = '*'; \
+ yy_size_t n; \
+ for ( n = 0; n < max_size && \
+ (c = getc( yyin )) != EOF && c != '\n'; ++n ) \
+ buf[n] = (char) c; \
+ if ( c == '\n' ) \
+ buf[n++] = (char) c; \
+ if ( c == EOF && ferror( yyin ) ) \
+ YY_FATAL_ERROR( "input in flex scanner failed" ); \
+ result = n; \
+ } \
+ else \
+ { \
+ errno=0; \
+ while ( (result = fread(buf, 1, max_size, yyin))==0 && ferror(yyin)) \
+ { \
+ if( errno != EINTR) \
+ { \
+ YY_FATAL_ERROR( "input in flex scanner failed" ); \
+ break; \
+ } \
+ errno=0; \
+ clearerr(yyin); \
+ } \
+ }\
+\
+
+#endif
+
+/* No semi-colon after return; correct usage is to write "yyterminate();" -
+ * we don't want an extra ';' after the "return" because that will cause
+ * some compilers to complain about unreachable statements.
+ */
+#ifndef yyterminate
+#define yyterminate() return YY_NULL
+#endif
+
+/* Number of entries by which start-condition stack grows. */
+#ifndef YY_START_STACK_INCR
+#define YY_START_STACK_INCR 25
+#endif
+
+/* Report a fatal error. */
+#ifndef YY_FATAL_ERROR
+#define YY_FATAL_ERROR(msg) yy_fatal_error( msg )
+#endif
+
+/* end tables serialization structures and prototypes */
+
+/* Default declaration of generated scanner - a define so the user can
+ * easily add parameters.
+ */
+#ifndef YY_DECL
+#define YY_DECL_IS_OURS 1
+
+extern int yylex (void);
+
+#define YY_DECL int yylex (void)
+#endif /* !YY_DECL */
+
+/* Code executed at the beginning of each rule, after yytext and yyleng
+ * have been set up.
+ */
+#ifndef YY_USER_ACTION
+#define YY_USER_ACTION
+#endif
+
+/* Code executed at the end of each rule. */
+#ifndef YY_BREAK
+#define YY_BREAK break;
+#endif
+
+#define YY_RULE_SETUP \
+ if ( yyleng > 0 ) \
+ YY_CURRENT_BUFFER_LVALUE->yy_at_bol = \
+ (yytext[yyleng - 1] == '\n'); \
+ YY_USER_ACTION
+
+/** The main scanner function which does all the work.
+ */
+YY_DECL
+{
+ register yy_state_type yy_current_state;
+ register char *yy_cp, *yy_bp;
+ register int yy_act;
+
+#line 79 "xpp.l"
+
+
+#line 1241 "lex.yy.c"
+
+ if ( !(yy_init) )
+ {
+ (yy_init) = 1;
+
+#ifdef YY_USER_INIT
+ YY_USER_INIT;
+#endif
+
+ /* Create the reject buffer large enough to save one state per allowed character. */
+ if ( ! (yy_state_buf) )
+ (yy_state_buf) = (yy_state_type *)yyalloc(YY_STATE_BUF_SIZE );
+ if ( ! (yy_state_buf) )
+ YY_FATAL_ERROR( "out of dynamic memory in yylex()" );
+
+ if ( ! (yy_start) )
+ (yy_start) = 1; /* first start state */
+
+ if ( ! yyin )
+ yyin = stdin;
+
+ if ( ! yyout )
+ yyout = stdout;
+
+ if ( ! YY_CURRENT_BUFFER ) {
+ yyensure_buffer_stack ();
+ YY_CURRENT_BUFFER_LVALUE =
+ yy_create_buffer(yyin,YY_BUF_SIZE );
+ }
+
+ yy_load_buffer_state( );
+ }
+
+ while ( 1 ) /* loops until end-of-file is reached */
+ {
+ yy_cp = (yy_c_buf_p);
+
+ /* Support of yytext. */
+ *yy_cp = (yy_hold_char);
+
+ /* yy_bp points to the position in yy_ch_buf of the start of
+ * the current run.
+ */
+ yy_bp = yy_cp;
+
+ yy_current_state = (yy_start);
+ yy_current_state += YY_AT_BOL();
+
+ (yy_state_ptr) = (yy_state_buf);
+ *(yy_state_ptr)++ = yy_current_state;
+
+yy_match:
+ do
+ {
+ register YY_CHAR yy_c = yy_ec[YY_SC_TO_UI(*yy_cp)];
+ while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state )
+ {
+ yy_current_state = (int) yy_def[yy_current_state];
+ if ( yy_current_state >= 284 )
+ yy_c = yy_meta[(unsigned int) yy_c];
+ }
+ yy_current_state = yy_nxt[yy_base[yy_current_state] + (unsigned int) yy_c];
+ *(yy_state_ptr)++ = yy_current_state;
+ ++yy_cp;
+ }
+ while ( yy_base[yy_current_state] != 1555 );
+
+yy_find_action:
+ yy_current_state = *--(yy_state_ptr);
+ (yy_lp) = yy_accept[yy_current_state];
+goto find_rule; /* Shut up GCC warning -Wall */
+find_rule: /* we branch to this label when backing up */
+ for ( ; ; ) /* until we find what rule we matched */
+ {
+ if ( (yy_lp) && (yy_lp) < yy_accept[yy_current_state + 1] )
+ {
+ yy_act = yy_acclist[(yy_lp)];
+ if ( yy_act & YY_TRAILING_HEAD_MASK ||
+ (yy_looking_for_trail_begin) )
+ {
+ if ( yy_act == (yy_looking_for_trail_begin) )
+ {
+ (yy_looking_for_trail_begin) = 0;
+ yy_act &= ~YY_TRAILING_HEAD_MASK;
+ break;
+ }
+ }
+ else if ( yy_act & YY_TRAILING_MASK )
+ {
+ (yy_looking_for_trail_begin) = yy_act & ~YY_TRAILING_MASK;
+ (yy_looking_for_trail_begin) |= YY_TRAILING_HEAD_MASK;
+ (yy_full_match) = yy_cp;
+ (yy_full_state) = (yy_state_ptr);
+ (yy_full_lp) = (yy_lp);
+ }
+ else
+ {
+ (yy_full_match) = yy_cp;
+ (yy_full_state) = (yy_state_ptr);
+ (yy_full_lp) = (yy_lp);
+ break;
+ }
+ ++(yy_lp);
+ goto find_rule;
+ }
+ --yy_cp;
+ yy_current_state = *--(yy_state_ptr);
+ (yy_lp) = yy_accept[yy_current_state];
+ }
+
+ YY_DO_BEFORE_ACTION;
+
+ if ( yy_act != YY_END_OF_BUFFER && yy_rule_can_match_eol[yy_act] )
+ {
+ yy_size_t yyl;
+ for ( yyl = (yy_prev_more_offset); yyl < yyleng; ++yyl )
+ if ( yytext[yyl] == '\n' )
+
+ yylineno++;
+;
+ }
+
+do_action: /* This label is used only to access EOF actions. */
+
+ switch ( yy_act )
+ { /* beginning of action switch */
+case 1:
+/* rule 1 can match eol */
+YY_RULE_SETUP
+#line 81 "xpp.l"
+typespec (XTY_BOOL);
+ YY_BREAK
+case 2:
+/* rule 2 can match eol */
+YY_RULE_SETUP
+#line 82 "xpp.l"
+typespec (XTY_CHAR);
+ YY_BREAK
+case 3:
+/* rule 3 can match eol */
+YY_RULE_SETUP
+#line 83 "xpp.l"
+typespec (XTY_SHORT);
+ YY_BREAK
+case 4:
+/* rule 4 can match eol */
+YY_RULE_SETUP
+#line 84 "xpp.l"
+typespec (XTY_INT);
+ YY_BREAK
+case 5:
+/* rule 5 can match eol */
+YY_RULE_SETUP
+#line 85 "xpp.l"
+typespec (XTY_LONG);
+ YY_BREAK
+case 6:
+/* rule 6 can match eol */
+YY_RULE_SETUP
+#line 86 "xpp.l"
+typespec (XTY_REAL);
+ YY_BREAK
+case 7:
+/* rule 7 can match eol */
+YY_RULE_SETUP
+#line 87 "xpp.l"
+typespec (XTY_DOUBLE);
+ YY_BREAK
+case 8:
+/* rule 8 can match eol */
+YY_RULE_SETUP
+#line 88 "xpp.l"
+typespec (XTY_COMPLEX);
+ YY_BREAK
+case 9:
+/* rule 9 can match eol */
+YY_RULE_SETUP
+#line 89 "xpp.l"
+typespec (XTY_POINTER);
+ YY_BREAK
+case 10:
+/* rule 10 can match eol */
+YY_RULE_SETUP
+#line 90 "xpp.l"
+typespec (XTY_EXTERN);
+ YY_BREAK
+case 11:
+/* rule 11 can match eol */
+YY_RULE_SETUP
+#line 92 "xpp.l"
+{
+ /* Subroutine declaration. */
+ pushcontext (PROCSTMT);
+ d_gettok (yytext, YYLMAX-1);
+ d_newproc (yytext, 0);
+ }
+ YY_BREAK
+case 12:
+/* rule 12 can match eol */
+YY_RULE_SETUP
+#line 99 "xpp.l"
+{
+ /* Function declaration. */
+ pushcontext (PROCSTMT);
+ d_gettok (yytext, YYLMAX-1);
+ d_newproc (yytext, dtype);
+ setline();
+ }
+ YY_BREAK
+case 13:
+/* rule 13 can match eol */
+YY_RULE_SETUP
+#line 107 "xpp.l"
+{ if (context & BODY)
+ ECHO;
+ else {
+ process_task_statement();
+ setline();
+ }
+ }
+ YY_BREAK
+case 14:
+YY_RULE_SETUP
+#line 114 "xpp.l"
+put_dictionary();
+ YY_BREAK
+case 15:
+YY_RULE_SETUP
+#line 115 "xpp.l"
+put_interpreter();
+ YY_BREAK
+case 16:
+YY_RULE_SETUP
+#line 116 "xpp.l"
+{
+ skip_helpblock();
+ setline();
+ }
+ YY_BREAK
+case 17:
+/* rule 17 can match eol */
+YY_RULE_SETUP
+#line 120 "xpp.l"
+{
+ begin_code();
+ setline();
+ }
+ YY_BREAK
+case 18:
+YY_RULE_SETUP
+#line 124 "xpp.l"
+{
+ macro_redef();
+ setline();
+ }
+ YY_BREAK
+case 19:
+YY_RULE_SETUP
+#line 128 "xpp.l"
+{
+ str_enter();
+ }
+ YY_BREAK
+case 20:
+/* rule 20 can match eol */
+YY_RULE_SETUP
+#line 131 "xpp.l"
+{
+ pushcontext (DEFSTMT);
+ ECHO;
+ }
+ YY_BREAK
+case 21:
+/* rule 21 can match eol */
+YY_RULE_SETUP
+#line 135 "xpp.l"
+{
+ end_code();
+ setline();
+ }
+ YY_BREAK
+case 22:
+/* rule 22 can match eol */
+YY_RULE_SETUP
+#line 139 "xpp.l"
+{
+ (context & BODY) ? ECHO
+ : do_string ('"', STR_DECL);
+ }
+ YY_BREAK
+case 23:
+/* rule 23 can match eol */
+YY_RULE_SETUP
+#line 143 "xpp.l"
+{
+ if (!(context & BODY))
+ pushcontext (DATASTMT);
+ ECHO;
+ }
+ YY_BREAK
+case 24:
+/* rule 24 can match eol */
+YY_RULE_SETUP
+#line 149 "xpp.l"
+{
+ ECHO;
+ if (context & BODY)
+ nswitch++;
+ }
+ YY_BREAK
+case 25:
+YY_RULE_SETUP
+#line 155 "xpp.l"
+skipnl();
+ YY_BREAK
+case 26:
+YY_RULE_SETUP
+#line 156 "xpp.l"
+ECHO;
+ YY_BREAK
+case 27:
+YY_RULE_SETUP
+#line 158 "xpp.l"
+do_include();
+ YY_BREAK
+case 28:
+YY_RULE_SETUP
+#line 160 "xpp.l"
+mapident();
+ YY_BREAK
+case 29:
+YY_RULE_SETUP
+#line 162 "xpp.l"
+hms (yytext);
+ YY_BREAK
+case 30:
+YY_RULE_SETUP
+#line 163 "xpp.l"
+int_constant (yytext, OCTAL);
+ YY_BREAK
+case 31:
+YY_RULE_SETUP
+#line 164 "xpp.l"
+int_constant (yytext, HEX);
+ YY_BREAK
+case 32:
+YY_RULE_SETUP
+#line 165 "xpp.l"
+int_constant (yytext, CHARCON);
+ YY_BREAK
+case 33:
+YY_RULE_SETUP
+#line 167 "xpp.l"
+{
+ if (context & (BODY|PROCSTMT))
+ ECHO;
+ }
+ YY_BREAK
+case 34:
+YY_RULE_SETUP
+#line 172 "xpp.l"
+output ('&');
+ YY_BREAK
+case 35:
+YY_RULE_SETUP
+#line 173 "xpp.l"
+output ('|');
+ YY_BREAK
+case 36:
+YY_RULE_SETUP
+#line 175 "xpp.l"
+{
+ ECHO;
+ nbrace++;
+ }
+ YY_BREAK
+case 37:
+YY_RULE_SETUP
+#line 179 "xpp.l"
+{
+ ECHO;
+ nbrace--;
+ }
+ YY_BREAK
+case 38:
+YY_RULE_SETUP
+#line 183 "xpp.l"
+output ('(');
+ YY_BREAK
+case 39:
+YY_RULE_SETUP
+#line 184 "xpp.l"
+output (')');
+ YY_BREAK
+case 40:
+YY_RULE_SETUP
+#line 186 "xpp.l"
+do_hollerith();
+ YY_BREAK
+case 41:
+YY_RULE_SETUP
+#line 188 "xpp.l"
+{
+ if (context & BODY)
+ do_string ('"', STR_INLINE);
+ else
+ ECHO;
+ }
+ YY_BREAK
+case 42:
+/* rule 42 can match eol */
+YY_RULE_SETUP
+#line 195 "xpp.l"
+{
+ /* If statement is continued do not pop
+ * the context.
+ */
+ ECHO;
+ linenum[istkptr]++;
+ }
+ YY_BREAK
+case 43:
+/* rule 43 can match eol */
+YY_RULE_SETUP
+#line 203 "xpp.l"
+{
+ /* End of newline and end of statement.
+ */
+ ECHO;
+ linenum[istkptr]++;
+ popcontext();
+ }
+ YY_BREAK
+case 44:
+YY_RULE_SETUP
+#line 211 "xpp.l"
+ECHO;
+ YY_BREAK
+#line 1680 "lex.yy.c"
+ case YY_STATE_EOF(INITIAL):
+ yyterminate();
+
+ case YY_END_OF_BUFFER:
+ {
+ /* Amount of text matched not including the EOB char. */
+ int yy_amount_of_matched_text = (int) (yy_cp - (yytext_ptr)) - 1;
+
+ /* Undo the effects of YY_DO_BEFORE_ACTION. */
+ *yy_cp = (yy_hold_char);
+ YY_RESTORE_YY_MORE_OFFSET
+
+ if ( YY_CURRENT_BUFFER_LVALUE->yy_buffer_status == YY_BUFFER_NEW )
+ {
+ /* We're scanning a new file or input source. It's
+ * possible that this happened because the user
+ * just pointed yyin at a new source and called
+ * yylex(). If so, then we have to assure
+ * consistency between YY_CURRENT_BUFFER and our
+ * globals. Here is the right place to do so, because
+ * this is the first action (other than possibly a
+ * back-up) that will match for the new input source.
+ */
+ (yy_n_chars) = YY_CURRENT_BUFFER_LVALUE->yy_n_chars;
+ YY_CURRENT_BUFFER_LVALUE->yy_input_file = yyin;
+ YY_CURRENT_BUFFER_LVALUE->yy_buffer_status = YY_BUFFER_NORMAL;
+ }
+
+ /* Note that here we test for yy_c_buf_p "<=" to the position
+ * of the first EOB in the buffer, since yy_c_buf_p will
+ * already have been incremented past the NUL character
+ * (since all states make transitions on EOB to the
+ * end-of-buffer state). Contrast this with the test
+ * in input().
+ */
+ if ( (yy_c_buf_p) <= &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)] )
+ { /* This was really a NUL. */
+ yy_state_type yy_next_state;
+
+ (yy_c_buf_p) = (yytext_ptr) + yy_amount_of_matched_text;
+
+ yy_current_state = yy_get_previous_state( );
+
+ /* Okay, we're now positioned to make the NUL
+ * transition. We couldn't have
+ * yy_get_previous_state() go ahead and do it
+ * for us because it doesn't know how to deal
+ * with the possibility of jamming (and we don't
+ * want to build jamming into it because then it
+ * will run more slowly).
+ */
+
+ yy_next_state = yy_try_NUL_trans( yy_current_state );
+
+ yy_bp = (yytext_ptr) + YY_MORE_ADJ;
+
+ if ( yy_next_state )
+ {
+ /* Consume the NUL. */
+ yy_cp = ++(yy_c_buf_p);
+ yy_current_state = yy_next_state;
+ goto yy_match;
+ }
+
+ else
+ {
+ yy_cp = (yy_c_buf_p);
+ goto yy_find_action;
+ }
+ }
+
+ else switch ( yy_get_next_buffer( ) )
+ {
+ case EOB_ACT_END_OF_FILE:
+ {
+ (yy_did_buffer_switch_on_eof) = 0;
+
+ if ( yywrap( ) )
+ {
+ /* Note: because we've taken care in
+ * yy_get_next_buffer() to have set up
+ * yytext, we can now set up
+ * yy_c_buf_p so that if some total
+ * hoser (like flex itself) wants to
+ * call the scanner after we return the
+ * YY_NULL, it'll still work - another
+ * YY_NULL will get returned.
+ */
+ (yy_c_buf_p) = (yytext_ptr) + YY_MORE_ADJ;
+
+ yy_act = YY_STATE_EOF(YY_START);
+ goto do_action;
+ }
+
+ else
+ {
+ if ( ! (yy_did_buffer_switch_on_eof) )
+ YY_NEW_FILE;
+ }
+ break;
+ }
+
+ case EOB_ACT_CONTINUE_SCAN:
+ (yy_c_buf_p) =
+ (yytext_ptr) + yy_amount_of_matched_text;
+
+ yy_current_state = yy_get_previous_state( );
+
+ yy_cp = (yy_c_buf_p);
+ yy_bp = (yytext_ptr) + YY_MORE_ADJ;
+ goto yy_match;
+
+ case EOB_ACT_LAST_MATCH:
+ (yy_c_buf_p) =
+ &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)];
+
+ yy_current_state = yy_get_previous_state( );
+
+ yy_cp = (yy_c_buf_p);
+ yy_bp = (yytext_ptr) + YY_MORE_ADJ;
+ goto yy_find_action;
+ }
+ break;
+ }
+
+ default:
+ YY_FATAL_ERROR(
+ "fatal flex scanner internal error--no action found" );
+ } /* end of action switch */
+ } /* end of scanning one token */
+} /* end of yylex */
+
+/* yy_get_next_buffer - try to read in a new buffer
+ *
+ * Returns a code representing an action:
+ * EOB_ACT_LAST_MATCH -
+ * EOB_ACT_CONTINUE_SCAN - continue scanning from current position
+ * EOB_ACT_END_OF_FILE - end of file
+ */
+static int yy_get_next_buffer (void)
+{
+ register char *dest = YY_CURRENT_BUFFER_LVALUE->yy_ch_buf;
+ register char *source = (yytext_ptr);
+ register int number_to_move, i;
+ int ret_val;
+
+ if ( (yy_c_buf_p) > &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars) + 1] )
+ YY_FATAL_ERROR(
+ "fatal flex scanner internal error--end of buffer missed" );
+
+ if ( YY_CURRENT_BUFFER_LVALUE->yy_fill_buffer == 0 )
+ { /* Don't try to fill the buffer, so this is an EOF. */
+ if ( (yy_c_buf_p) - (yytext_ptr) - YY_MORE_ADJ == 1 )
+ {
+ /* We matched a single character, the EOB, so
+ * treat this as a final EOF.
+ */
+ return EOB_ACT_END_OF_FILE;
+ }
+
+ else
+ {
+ /* We matched some text prior to the EOB, first
+ * process it.
+ */
+ return EOB_ACT_LAST_MATCH;
+ }
+ }
+
+ /* Try to read more data. */
+
+ /* First move last chars to start of buffer. */
+ number_to_move = (int) ((yy_c_buf_p) - (yytext_ptr)) - 1;
+
+ for ( i = 0; i < number_to_move; ++i )
+ *(dest++) = *(source++);
+
+ if ( YY_CURRENT_BUFFER_LVALUE->yy_buffer_status == YY_BUFFER_EOF_PENDING )
+ /* don't do the read, it's not guaranteed to return an EOF,
+ * just force an EOF
+ */
+ YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars) = 0;
+
+ else
+ {
+ yy_size_t num_to_read =
+ YY_CURRENT_BUFFER_LVALUE->yy_buf_size - number_to_move - 1;
+
+ while ( num_to_read <= 0 )
+ { /* Not enough room in the buffer - grow it. */
+
+ YY_FATAL_ERROR(
+"input buffer overflow, can't enlarge buffer because scanner uses REJECT" );
+
+ }
+
+ if ( num_to_read > YY_READ_BUF_SIZE )
+ num_to_read = YY_READ_BUF_SIZE;
+
+ /* Read in more data. */
+ YY_INPUT( (&YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[number_to_move]),
+ (yy_n_chars), num_to_read );
+
+ YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars);
+ }
+
+ if ( (yy_n_chars) == 0 )
+ {
+ if ( number_to_move == YY_MORE_ADJ )
+ {
+ ret_val = EOB_ACT_END_OF_FILE;
+ yyrestart(yyin );
+ }
+
+ else
+ {
+ ret_val = EOB_ACT_LAST_MATCH;
+ YY_CURRENT_BUFFER_LVALUE->yy_buffer_status =
+ YY_BUFFER_EOF_PENDING;
+ }
+ }
+
+ else
+ ret_val = EOB_ACT_CONTINUE_SCAN;
+
+ if ((yy_size_t) ((yy_n_chars) + number_to_move) > YY_CURRENT_BUFFER_LVALUE->yy_buf_size) {
+ /* Extend the array by 50%, plus the number we really need. */
+ yy_size_t new_size = (yy_n_chars) + number_to_move + ((yy_n_chars) >> 1);
+ YY_CURRENT_BUFFER_LVALUE->yy_ch_buf = (char *) yyrealloc((void *) YY_CURRENT_BUFFER_LVALUE->yy_ch_buf,new_size );
+ if ( ! YY_CURRENT_BUFFER_LVALUE->yy_ch_buf )
+ YY_FATAL_ERROR( "out of dynamic memory in yy_get_next_buffer()" );
+ }
+
+ (yy_n_chars) += number_to_move;
+ YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)] = YY_END_OF_BUFFER_CHAR;
+ YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars) + 1] = YY_END_OF_BUFFER_CHAR;
+
+ (yytext_ptr) = &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[0];
+
+ return ret_val;
+}
+
+/* yy_get_previous_state - get the state just before the EOB char was reached */
+
+ static yy_state_type yy_get_previous_state (void)
+{
+ register yy_state_type yy_current_state;
+ register char *yy_cp;
+
+ yy_current_state = (yy_start);
+ yy_current_state += YY_AT_BOL();
+
+ (yy_state_ptr) = (yy_state_buf);
+ *(yy_state_ptr)++ = yy_current_state;
+
+ for ( yy_cp = (yytext_ptr) + YY_MORE_ADJ; yy_cp < (yy_c_buf_p); ++yy_cp )
+ {
+ register YY_CHAR yy_c = (*yy_cp ? yy_ec[YY_SC_TO_UI(*yy_cp)] : 1);
+ while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state )
+ {
+ yy_current_state = (int) yy_def[yy_current_state];
+ if ( yy_current_state >= 284 )
+ yy_c = yy_meta[(unsigned int) yy_c];
+ }
+ yy_current_state = yy_nxt[yy_base[yy_current_state] + (unsigned int) yy_c];
+ *(yy_state_ptr)++ = yy_current_state;
+ }
+
+ return yy_current_state;
+}
+
+/* yy_try_NUL_trans - try to make a transition on the NUL character
+ *
+ * synopsis
+ * next_state = yy_try_NUL_trans( current_state );
+ */
+ static yy_state_type yy_try_NUL_trans (yy_state_type yy_current_state )
+{
+ register int yy_is_jam;
+
+ register YY_CHAR yy_c = 1;
+ while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state )
+ {
+ yy_current_state = (int) yy_def[yy_current_state];
+ if ( yy_current_state >= 284 )
+ yy_c = yy_meta[(unsigned int) yy_c];
+ }
+ yy_current_state = yy_nxt[yy_base[yy_current_state] + (unsigned int) yy_c];
+ yy_is_jam = (yy_current_state == 283);
+ if ( ! yy_is_jam )
+ *(yy_state_ptr)++ = yy_current_state;
+
+ return yy_is_jam ? 0 : yy_current_state;
+}
+
+ void yyunput (int c, register char * yy_bp )
+{
+ register char *yy_cp;
+
+ yy_cp = (yy_c_buf_p);
+
+ /* undo effects of setting up yytext */
+ *yy_cp = (yy_hold_char);
+
+ if ( yy_cp < YY_CURRENT_BUFFER_LVALUE->yy_ch_buf + 2 )
+ { /* need to shift things up to make room */
+ /* +2 for EOB chars. */
+ register yy_size_t number_to_move = (yy_n_chars) + 2;
+ register char *dest = &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[
+ YY_CURRENT_BUFFER_LVALUE->yy_buf_size + 2];
+ register char *source =
+ &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[number_to_move];
+
+ while ( source > YY_CURRENT_BUFFER_LVALUE->yy_ch_buf )
+ *--dest = *--source;
+
+ yy_cp += (int) (dest - source);
+ yy_bp += (int) (dest - source);
+ YY_CURRENT_BUFFER_LVALUE->yy_n_chars =
+ (yy_n_chars) = YY_CURRENT_BUFFER_LVALUE->yy_buf_size;
+
+ if ( yy_cp < YY_CURRENT_BUFFER_LVALUE->yy_ch_buf + 2 )
+ YY_FATAL_ERROR( "flex scanner push-back overflow" );
+ }
+
+ *--yy_cp = (char) c;
+
+ if ( c == '\n' ){
+ --yylineno;
+ }
+
+ (yytext_ptr) = yy_bp;
+ (yy_hold_char) = *yy_cp;
+ (yy_c_buf_p) = yy_cp;
+}
+
+#ifndef YY_NO_INPUT
+#ifdef __cplusplus
+ static int yyinput (void)
+#else
+ int input (void)
+#endif
+
+{
+ int c;
+
+ *(yy_c_buf_p) = (yy_hold_char);
+
+ if ( *(yy_c_buf_p) == YY_END_OF_BUFFER_CHAR )
+ {
+ /* yy_c_buf_p now points to the character we want to return.
+ * If this occurs *before* the EOB characters, then it's a
+ * valid NUL; if not, then we've hit the end of the buffer.
+ */
+ if ( (yy_c_buf_p) < &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)] )
+ /* This was really a NUL. */
+ *(yy_c_buf_p) = '\0';
+
+ else
+ { /* need more input */
+ yy_size_t offset = (yy_c_buf_p) - (yytext_ptr);
+ ++(yy_c_buf_p);
+
+ switch ( yy_get_next_buffer( ) )
+ {
+ case EOB_ACT_LAST_MATCH:
+ /* This happens because yy_g_n_b()
+ * sees that we've accumulated a
+ * token and flags that we need to
+ * try matching the token before
+ * proceeding. But for input(),
+ * there's no matching to consider.
+ * So convert the EOB_ACT_LAST_MATCH
+ * to EOB_ACT_END_OF_FILE.
+ */
+
+ /* Reset buffer status. */
+ yyrestart(yyin );
+
+ /*FALLTHROUGH*/
+
+ case EOB_ACT_END_OF_FILE:
+ {
+ if ( yywrap( ) )
+ return 0;
+
+ if ( ! (yy_did_buffer_switch_on_eof) )
+ YY_NEW_FILE;
+#ifdef __cplusplus
+ return yyinput();
+#else
+ return input();
+#endif
+ }
+
+ case EOB_ACT_CONTINUE_SCAN:
+ (yy_c_buf_p) = (yytext_ptr) + offset;
+ break;
+ }
+ }
+ }
+
+ c = *(unsigned char *) (yy_c_buf_p); /* cast for 8-bit char's */
+ *(yy_c_buf_p) = '\0'; /* preserve yytext */
+ (yy_hold_char) = *++(yy_c_buf_p);
+
+ YY_CURRENT_BUFFER_LVALUE->yy_at_bol = (c == '\n');
+ if ( YY_CURRENT_BUFFER_LVALUE->yy_at_bol )
+
+ yylineno++;
+;
+
+ return c;
+}
+#endif /* ifndef YY_NO_INPUT */
+
+/** Immediately switch to a different input stream.
+ * @param input_file A readable stream.
+ *
+ * @note This function does not reset the start condition to @c INITIAL .
+ */
+ void yyrestart (FILE * input_file )
+{
+
+ if ( ! YY_CURRENT_BUFFER ){
+ yyensure_buffer_stack ();
+ YY_CURRENT_BUFFER_LVALUE =
+ yy_create_buffer(yyin,YY_BUF_SIZE );
+ }
+
+ yy_init_buffer(YY_CURRENT_BUFFER,input_file );
+ yy_load_buffer_state( );
+}
+
+/** Switch to a different input buffer.
+ * @param new_buffer The new input buffer.
+ *
+ */
+ void yy_switch_to_buffer (YY_BUFFER_STATE new_buffer )
+{
+
+ /* TODO. We should be able to replace this entire function body
+ * with
+ * yypop_buffer_state();
+ * yypush_buffer_state(new_buffer);
+ */
+ yyensure_buffer_stack ();
+ if ( YY_CURRENT_BUFFER == new_buffer )
+ return;
+
+ if ( YY_CURRENT_BUFFER )
+ {
+ /* Flush out information for old buffer. */
+ *(yy_c_buf_p) = (yy_hold_char);
+ YY_CURRENT_BUFFER_LVALUE->yy_buf_pos = (yy_c_buf_p);
+ YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars);
+ }
+
+ YY_CURRENT_BUFFER_LVALUE = new_buffer;
+ yy_load_buffer_state( );
+
+ /* We don't actually know whether we did this switch during
+ * EOF (yywrap()) processing, but the only time this flag
+ * is looked at is after yywrap() is called, so it's safe
+ * to go ahead and always set it.
+ */
+ (yy_did_buffer_switch_on_eof) = 1;
+}
+
+static void yy_load_buffer_state (void)
+{
+ (yy_n_chars) = YY_CURRENT_BUFFER_LVALUE->yy_n_chars;
+ (yytext_ptr) = (yy_c_buf_p) = YY_CURRENT_BUFFER_LVALUE->yy_buf_pos;
+ yyin = YY_CURRENT_BUFFER_LVALUE->yy_input_file;
+ (yy_hold_char) = *(yy_c_buf_p);
+}
+
+/** Allocate and initialize an input buffer state.
+ * @param file A readable stream.
+ * @param size The character buffer size in bytes. When in doubt, use @c YY_BUF_SIZE.
+ *
+ * @return the allocated buffer state.
+ */
+ YY_BUFFER_STATE yy_create_buffer (FILE * file, int size )
+{
+ YY_BUFFER_STATE b;
+
+ b = (YY_BUFFER_STATE) yyalloc(sizeof( struct yy_buffer_state ) );
+ if ( ! b )
+ YY_FATAL_ERROR( "out of dynamic memory in yy_create_buffer()" );
+
+ b->yy_buf_size = size;
+
+ /* yy_ch_buf has to be 2 characters longer than the size given because
+ * we need to put in 2 end-of-buffer characters.
+ */
+ b->yy_ch_buf = (char *) yyalloc(b->yy_buf_size + 2 );
+ if ( ! b->yy_ch_buf )
+ YY_FATAL_ERROR( "out of dynamic memory in yy_create_buffer()" );
+
+ b->yy_is_our_buffer = 1;
+
+ yy_init_buffer(b,file );
+
+ return b;
+}
+
+/** Destroy the buffer.
+ * @param b a buffer created with yy_create_buffer()
+ *
+ */
+ void yy_delete_buffer (YY_BUFFER_STATE b )
+{
+
+ if ( ! b )
+ return;
+
+ if ( b == YY_CURRENT_BUFFER ) /* Not sure if we should pop here. */
+ YY_CURRENT_BUFFER_LVALUE = (YY_BUFFER_STATE) 0;
+
+ if ( b->yy_is_our_buffer )
+ yyfree((void *) b->yy_ch_buf );
+
+ yyfree((void *) b );
+}
+
+#ifndef __cplusplus
+extern int isatty (int );
+#endif /* __cplusplus */
+
+/* Initializes or reinitializes a buffer.
+ * This function is sometimes called more than once on the same buffer,
+ * such as during a yyrestart() or at EOF.
+ */
+ static void yy_init_buffer (YY_BUFFER_STATE b, FILE * file )
+
+{
+ int oerrno = errno;
+
+ yy_flush_buffer(b );
+
+ b->yy_input_file = file;
+ b->yy_fill_buffer = 1;
+
+ /* If b is the current buffer, then yy_init_buffer was _probably_
+ * called from yyrestart() or through yy_get_next_buffer.
+ * In that case, we don't want to reset the lineno or column.
+ */
+ if (b != YY_CURRENT_BUFFER){
+ b->yy_bs_lineno = 1;
+ b->yy_bs_column = 0;
+ }
+
+ b->yy_is_interactive = file ? (isatty( fileno(file) ) > 0) : 0;
+
+ errno = oerrno;
+}
+
+/** Discard all buffered characters. On the next scan, YY_INPUT will be called.
+ * @param b the buffer state to be flushed, usually @c YY_CURRENT_BUFFER.
+ *
+ */
+ void yy_flush_buffer (YY_BUFFER_STATE b )
+{
+ if ( ! b )
+ return;
+
+ b->yy_n_chars = 0;
+
+ /* We always need two end-of-buffer characters. The first causes
+ * a transition to the end-of-buffer state. The second causes
+ * a jam in that state.
+ */
+ b->yy_ch_buf[0] = YY_END_OF_BUFFER_CHAR;
+ b->yy_ch_buf[1] = YY_END_OF_BUFFER_CHAR;
+
+ b->yy_buf_pos = &b->yy_ch_buf[0];
+
+ b->yy_at_bol = 1;
+ b->yy_buffer_status = YY_BUFFER_NEW;
+
+ if ( b == YY_CURRENT_BUFFER )
+ yy_load_buffer_state( );
+}
+
+/** Pushes the new state onto the stack. The new state becomes
+ * the current state. This function will allocate the stack
+ * if necessary.
+ * @param new_buffer The new state.
+ *
+ */
+void yypush_buffer_state (YY_BUFFER_STATE new_buffer )
+{
+ if (new_buffer == NULL)
+ return;
+
+ yyensure_buffer_stack();
+
+ /* This block is copied from yy_switch_to_buffer. */
+ if ( YY_CURRENT_BUFFER )
+ {
+ /* Flush out information for old buffer. */
+ *(yy_c_buf_p) = (yy_hold_char);
+ YY_CURRENT_BUFFER_LVALUE->yy_buf_pos = (yy_c_buf_p);
+ YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars);
+ }
+
+ /* Only push if top exists. Otherwise, replace top. */
+ if (YY_CURRENT_BUFFER)
+ (yy_buffer_stack_top)++;
+ YY_CURRENT_BUFFER_LVALUE = new_buffer;
+
+ /* copied from yy_switch_to_buffer. */
+ yy_load_buffer_state( );
+ (yy_did_buffer_switch_on_eof) = 1;
+}
+
+/** Removes and deletes the top of the stack, if present.
+ * The next element becomes the new top.
+ *
+ */
+void yypop_buffer_state (void)
+{
+ if (!YY_CURRENT_BUFFER)
+ return;
+
+ yy_delete_buffer(YY_CURRENT_BUFFER );
+ YY_CURRENT_BUFFER_LVALUE = NULL;
+ if ((yy_buffer_stack_top) > 0)
+ --(yy_buffer_stack_top);
+
+ if (YY_CURRENT_BUFFER) {
+ yy_load_buffer_state( );
+ (yy_did_buffer_switch_on_eof) = 1;
+ }
+}
+
+/* Allocates the stack if it does not exist.
+ * Guarantees space for at least one push.
+ */
+static void yyensure_buffer_stack (void)
+{
+ yy_size_t num_to_alloc;
+
+ if (!(yy_buffer_stack)) {
+
+ /* First allocation is just for 2 elements, since we don't know if this
+ * scanner will even need a stack. We use 2 instead of 1 to avoid an
+ * immediate realloc on the next call.
+ */
+ num_to_alloc = 1;
+ (yy_buffer_stack) = (struct yy_buffer_state**)yyalloc
+ (num_to_alloc * sizeof(struct yy_buffer_state*)
+ );
+ if ( ! (yy_buffer_stack) )
+ YY_FATAL_ERROR( "out of dynamic memory in yyensure_buffer_stack()" );
+
+ memset((yy_buffer_stack), 0, num_to_alloc * sizeof(struct yy_buffer_state*));
+
+ (yy_buffer_stack_max) = num_to_alloc;
+ (yy_buffer_stack_top) = 0;
+ return;
+ }
+
+ if ((yy_buffer_stack_top) >= ((yy_buffer_stack_max)) - 1){
+
+ /* Increase the buffer to prepare for a possible push. */
+ int grow_size = 8 /* arbitrary grow size */;
+
+ num_to_alloc = (yy_buffer_stack_max) + grow_size;
+ (yy_buffer_stack) = (struct yy_buffer_state**)yyrealloc
+ ((yy_buffer_stack),
+ num_to_alloc * sizeof(struct yy_buffer_state*)
+ );
+ if ( ! (yy_buffer_stack) )
+ YY_FATAL_ERROR( "out of dynamic memory in yyensure_buffer_stack()" );
+
+ /* zero only the new slots.*/
+ memset((yy_buffer_stack) + (yy_buffer_stack_max), 0, grow_size * sizeof(struct yy_buffer_state*));
+ (yy_buffer_stack_max) = num_to_alloc;
+ }
+}
+
+/** Setup the input buffer state to scan directly from a user-specified character buffer.
+ * @param base the character buffer
+ * @param size the size in bytes of the character buffer
+ *
+ * @return the newly allocated buffer state object.
+ */
+YY_BUFFER_STATE yy_scan_buffer (char * base, yy_size_t size )
+{
+ YY_BUFFER_STATE b;
+
+ if ( size < 2 ||
+ base[size-2] != YY_END_OF_BUFFER_CHAR ||
+ base[size-1] != YY_END_OF_BUFFER_CHAR )
+ /* They forgot to leave room for the EOB's. */
+ return 0;
+
+ b = (YY_BUFFER_STATE) yyalloc(sizeof( struct yy_buffer_state ) );
+ if ( ! b )
+ YY_FATAL_ERROR( "out of dynamic memory in yy_scan_buffer()" );
+
+ b->yy_buf_size = size - 2; /* "- 2" to take care of EOB's */
+ b->yy_buf_pos = b->yy_ch_buf = base;
+ b->yy_is_our_buffer = 0;
+ b->yy_input_file = 0;
+ b->yy_n_chars = b->yy_buf_size;
+ b->yy_is_interactive = 0;
+ b->yy_at_bol = 1;
+ b->yy_fill_buffer = 0;
+ b->yy_buffer_status = YY_BUFFER_NEW;
+
+ yy_switch_to_buffer(b );
+
+ return b;
+}
+
+/** Setup the input buffer state to scan a string. The next call to yylex() will
+ * scan from a @e copy of @a str.
+ * @param yystr a NUL-terminated string to scan
+ *
+ * @return the newly allocated buffer state object.
+ * @note If you want to scan bytes that may contain NUL values, then use
+ * yy_scan_bytes() instead.
+ */
+YY_BUFFER_STATE yy_scan_string (yyconst char * yystr )
+{
+
+ return yy_scan_bytes(yystr,strlen(yystr) );
+}
+
+/** Setup the input buffer state to scan the given bytes. The next call to yylex() will
+ * scan from a @e copy of @a bytes.
+ * @param bytes the byte buffer to scan
+ * @param len the number of bytes in the buffer pointed to by @a bytes.
+ *
+ * @return the newly allocated buffer state object.
+ */
+YY_BUFFER_STATE yy_scan_bytes (yyconst char * yybytes, yy_size_t _yybytes_len )
+{
+ YY_BUFFER_STATE b;
+ char *buf;
+ yy_size_t n, i;
+
+ /* Get memory for full buffer, including space for trailing EOB's. */
+ n = _yybytes_len + 2;
+ buf = (char *) yyalloc(n );
+ if ( ! buf )
+ YY_FATAL_ERROR( "out of dynamic memory in yy_scan_bytes()" );
+
+ for ( i = 0; i < _yybytes_len; ++i )
+ buf[i] = yybytes[i];
+
+ buf[_yybytes_len] = buf[_yybytes_len+1] = YY_END_OF_BUFFER_CHAR;
+
+ b = yy_scan_buffer(buf,n );
+ if ( ! b )
+ YY_FATAL_ERROR( "bad buffer in yy_scan_bytes()" );
+
+ /* It's okay to grow etc. this buffer, and we should throw it
+ * away when we're done.
+ */
+ b->yy_is_our_buffer = 1;
+
+ return b;
+}
+
+#ifndef YY_EXIT_FAILURE
+#define YY_EXIT_FAILURE 2
+#endif
+
+static void yy_fatal_error (yyconst char* msg )
+{
+ (void) fprintf( stderr, "%s\n", msg );
+ exit( YY_EXIT_FAILURE );
+}
+
+/* Redefine yyless() so it works in section 3 code. */
+
+#undef yyless
+#define yyless(n) \
+ do \
+ { \
+ /* Undo effects of setting up yytext. */ \
+ int yyless_macro_arg = (n); \
+ YY_LESS_LINENO(yyless_macro_arg);\
+ yytext[yyleng] = (yy_hold_char); \
+ (yy_c_buf_p) = yytext + yyless_macro_arg; \
+ (yy_hold_char) = *(yy_c_buf_p); \
+ *(yy_c_buf_p) = '\0'; \
+ yyleng = yyless_macro_arg; \
+ } \
+ while ( 0 )
+
+/* Accessor methods (get/set functions) to struct members. */
+
+/** Get the current line number.
+ *
+ */
+int yyget_lineno (void)
+{
+
+ return yylineno;
+}
+
+/** Get the input stream.
+ *
+ */
+FILE *yyget_in (void)
+{
+ return yyin;
+}
+
+/** Get the output stream.
+ *
+ */
+FILE *yyget_out (void)
+{
+ return yyout;
+}
+
+/** Get the length of the current token.
+ *
+ */
+yy_size_t yyget_leng (void)
+{
+ return yyleng;
+}
+
+/** Get the current token.
+ *
+ */
+
+char *yyget_text (void)
+{
+ return yytext;
+}
+
+/** Set the current line number.
+ * @param line_number
+ *
+ */
+void yyset_lineno (int line_number )
+{
+
+ yylineno = line_number;
+}
+
+/** Set the input stream. This does not discard the current
+ * input buffer.
+ * @param in_str A readable stream.
+ *
+ * @see yy_switch_to_buffer
+ */
+void yyset_in (FILE * in_str )
+{
+ yyin = in_str ;
+}
+
+void yyset_out (FILE * out_str )
+{
+ yyout = out_str ;
+}
+
+int yyget_debug (void)
+{
+ return yy_flex_debug;
+}
+
+void yyset_debug (int bdebug )
+{
+ yy_flex_debug = bdebug ;
+}
+
+static int yy_init_globals (void)
+{
+ /* Initialization is the same as for the non-reentrant scanner.
+ * This function is called from yylex_destroy(), so don't allocate here.
+ */
+
+ /* We do not touch yylineno unless the option is enabled. */
+ yylineno = 1;
+
+ (yy_buffer_stack) = 0;
+ (yy_buffer_stack_top) = 0;
+ (yy_buffer_stack_max) = 0;
+ (yy_c_buf_p) = (char *) 0;
+ (yy_init) = 0;
+ (yy_start) = 0;
+
+ (yy_state_buf) = 0;
+ (yy_state_ptr) = 0;
+ (yy_full_match) = 0;
+ (yy_lp) = 0;
+
+/* Defined in main.c */
+#ifdef YY_STDINIT
+ yyin = stdin;
+ yyout = stdout;
+#else
+ yyin = (FILE *) 0;
+ yyout = (FILE *) 0;
+#endif
+
+ /* For future reference: Set errno on error, since we are called by
+ * yylex_init()
+ */
+ return 0;
+}
+
+/* yylex_destroy is for both reentrant and non-reentrant scanners. */
+int yylex_destroy (void)
+{
+
+ /* Pop the buffer stack, destroying each element. */
+ while(YY_CURRENT_BUFFER){
+ yy_delete_buffer(YY_CURRENT_BUFFER );
+ YY_CURRENT_BUFFER_LVALUE = NULL;
+ yypop_buffer_state();
+ }
+
+ /* Destroy the stack itself. */
+ yyfree((yy_buffer_stack) );
+ (yy_buffer_stack) = NULL;
+
+ yyfree ( (yy_state_buf) );
+ (yy_state_buf) = NULL;
+
+ /* Reset the globals. This is important in a non-reentrant scanner so the next time
+ * yylex() is called, initialization will occur. */
+ yy_init_globals( );
+
+ return 0;
+}
+
+/*
+ * Internal utility routines.
+ */
+
+#ifndef yytext_ptr
+static void yy_flex_strncpy (char* s1, yyconst char * s2, int n )
+{
+ register int i;
+ for ( i = 0; i < n; ++i )
+ s1[i] = s2[i];
+}
+#endif
+
+#ifdef YY_NEED_STRLEN
+static int yy_flex_strlen (yyconst char * s )
+{
+ register int n;
+ for ( n = 0; s[n]; ++n )
+ ;
+
+ return n;
+}
+#endif
+
+void *yyalloc (yy_size_t size )
+{
+ return (void *) malloc( size );
+}
+
+void *yyrealloc (void * ptr, yy_size_t size )
+{
+ /* The cast to (char *) in the following accommodates both
+ * implementations that use char* generic pointers, and those
+ * that use void* generic pointers. It works with the latter
+ * because both ANSI C and C++ allow castless assignment from
+ * any pointer type to void*, and deal with argument conversions
+ * as though doing an assignment.
+ */
+ return (void *) realloc( (char *) ptr, size );
+}
+
+void yyfree (void * ptr )
+{
+ free( (char *) ptr ); /* see yyrealloc() for (char *) cast */
+}
+
+#define YYTABLES_NAME "yytables"
+
+#line 211 "xpp.l"
+
+
+
+
+/* TYPESPEC -- Context dependent processing of a type specifier. If in the
+ * declarations section, process a declarations statement. If in procedure
+ * body or in a define statement, map the type specifier identifer and output
+ * the mapped value (intrinsic function name). Otherwise we must be in global
+ * space, and the type spec begins a function declaration; save the datatype
+ * code for d_newproc().
+ */
+void
+typespec (typecode)
+int typecode;
+{
+ if (context & DECL)
+ d_declaration (typecode);
+ else if (context & (BODY|DEFSTMT))
+ mapident();
+ else
+ dtype = typecode;
+}
+
+
+
+/* PROCESS_TASK_STATEMENT -- Parse the TASK statement. The task statement
+ * is replaced by the "sys_runtask" procedure (sysruk), which is called by
+ * the IRAF main to run a task, or to print the dictionary (cmd "?").
+ * The source for the basic sys_runtask procedure is in "lib$sysruk.x".
+ * We process the task statement into some internal tables, then open the
+ * sysruk.x file as an include file. Special macros therein are
+ * replaced by the taskname dictionary as processing continues.
+ */
+void
+process_task_statement()
+{
+ char ch;
+
+ if (ntasks > 0) { /* only one task statement permitted */
+ error (XPP_SYNTAX, "Only one TASK statement permitted per file");
+ return;
+ }
+
+ /* Process the task statement into the TASK_LIST structure.
+ */
+ if (parse_task_statement() == ERR) {
+ error (XPP_SYNTAX, "Syntax error in TASK statement");
+ while ((ch = input()) != EOF && ch != '\n')
+ ;
+ unput ('\n');
+ return;
+ }
+
+ /* Open RUNTASK ("lib$sysruk.x") as an include file.
+ */
+ istk[istkptr] = yyin;
+ if (++istkptr >= MAX_INCLUDE) {
+ istkptr--;
+ error (XPP_COMPERR, "Maximum include nesting exceeded");
+ return;
+ }
+
+ strcpy (fname[istkptr], IRAFLIB);
+ strcat (fname[istkptr], RUNTASK);
+ if ((yyin = fopen (vfn2osfn (fname[istkptr],0), "r")) == NULL) {
+ yyin = istk[--istkptr];
+ error (XPP_SYNTAX, "Cannot read lib$sysruk.x");
+ return;
+ }
+
+ linenum[istkptr] = 1;
+
+ /* Put the newline back so that LEX "^..." matches will work on
+ * first line of the include file.
+ */
+ unput ('\n');
+
+ yypush_buffer_state(yy_create_buffer(yyin,YY_BUF_SIZE ));
+ BEGIN(INITIAL);
+}
+
+
+/* DO_INCLUDE -- Process an include statement, i.e., eat up the include
+ * statement, push the current input file on a stack, and open the new file.
+ * System include files are referenced as "<file>", other files as "file".
+ */
+void
+do_include()
+{
+ char *p, delim, *rindex();
+ char hfile[SZ_FNAME+1], *op;
+ int root_len;
+
+
+ /* Push current input file status on the input file stack istk.
+ */
+ istk[istkptr] = yyin;
+ if (++istkptr >= MAX_INCLUDE) {
+ --istkptr;
+ error (XPP_COMPERR, "Maximum include nesting exceeded");
+ return;
+ }
+
+ /* If filespec "<file>", call os_sysfile to get the pathname of the
+ * system include file.
+ */
+ if (yytext[yyleng-1] == '<') {
+
+ for (op=hfile; (*op = input()) != EOF; op++)
+ if (*op == '\n') {
+ --istkptr;
+ error (XPP_SYNTAX, "missing > delim in include statement");
+ return;
+ } else if (*op == '>')
+ break;
+
+ *op = EOS;
+
+ if (os_sysfile (hfile, fname[istkptr], SZ_PATHNAME) == ERR) {
+ --istkptr;
+ error (XPP_COMPERR, "cannot find include file");
+ return;
+ }
+
+ } else {
+ /* Prepend pathname leading to the file in which the current
+ * include statement was found. Compiler may not have been run
+ * from the directory containing the source and include file.
+ */
+ if (!hbindefs) {
+ if ((p = rindex (fname[istkptr-1], '/')) == NULL)
+ root_len = 0;
+ else
+ root_len = p - fname[istkptr-1] + 1;
+ strncpy (fname[istkptr], fname[istkptr-1], root_len);
+
+ } else {
+ if ((p = vfn2osfn (HBIN_INCLUDES, 0))) {
+ root_len = strlen (p);
+ strncpy (fname[istkptr], p, root_len);
+ } else {
+ --istkptr;
+ error (XPP_COMPERR, "cannot find hbin$ directory");
+ return;
+ }
+ }
+ fname[istkptr][root_len] = EOS;
+
+ delim = '"';
+
+ /* Advance to end of whatever is in the file name string.
+ */
+ for (p=fname[istkptr]; *p != EOS; p++)
+ ;
+ /* Concatenate name of referenced file.
+ */
+ while ((*p = input()) != delim) {
+ if (*p == '\n' || *p == EOF) {
+ --istkptr;
+ error (XPP_SYNTAX, "bad include file name");
+ return;
+ }
+ p++;
+ }
+ *p = EOS;
+ }
+
+ /* If the foreign defs option is in effect, the machine dependent defs
+ * for a foreign machine are given by a substitute "iraf.h" file named
+ * on the command line. This foreign machine header file includes
+ * not only the iraf.h for the foreign machine, but the equivalent of
+ * all the files named in the array of strings "machdefs". Ignore any
+ * attempts to include any of these files since they have already been
+ * included in the foreign definitions header file.
+ */
+ if (foreigndefs) {
+ char sysfile[SZ_PATHNAME];
+ char **files;
+
+ /*
+ for (files=machdefs; *files != NULL; files++) {
+ */
+ for (files=machdefs; **files; files++) {
+ memset (sysfile, 0, SZ_PATHNAME);
+ strcpy (sysfile, HOSTLIB);
+ strcat (sysfile, *files);
+ if (strcmp (sysfile, fname[istkptr]) == 0) {
+ --istkptr;
+ return;
+ }
+ }
+ }
+
+ if ((yyin = fopen (vfn2osfn(fname[istkptr],0), "r")) == NULL) {
+ yyin = istk[--istkptr];
+ error (XPP_SYNTAX, "Cannot open include file");
+ return;
+ }
+
+ /* Keep track of the line number within the include file. */
+ linenum[istkptr] = 1;
+
+ /* Put the newline back so that LEX "^..." matches will work on
+ * first line of include file.
+ */
+ unput ('\n');
+
+ yypush_buffer_state(yy_create_buffer(yyin,YY_BUF_SIZE ));
+ BEGIN(INITIAL);
+}
+
+
+/* YYWRAP -- Called by LEX when end of file is reached. If input stack is
+ * not empty, close off include file and continue on in old file. Return
+ * nonzero when the stack is empty, i.e., when we reach the end of the
+ * main file.
+ */
+int
+yywrap()
+{
+ /* The last line of a file is not necessarily newline terminated.
+ * Output a newline just in case.
+ */
+ fprintf (yyout, "\n");
+
+ if (istkptr <= 0) {
+ /* ALL DONE with main file.
+ */
+ return (1);
+
+ } else {
+ /* End of include file. Pop old input file and set line number
+ * for error messages.
+ */
+ fclose (yyin);
+ /* yyin = istk[--istkptr]; */
+ istkptr--;
+
+ yypop_buffer_state ();
+ if ( !YY_CURRENT_BUFFER )
+ yyterminate ();
+
+ if (istkptr == 0)
+ setline();
+ return (0);
+ }
+}
+
+
+
+/* YY_INPUT -- Get a character from the input stream.
+ */
+int
+yy_input ()
+{
+ return (input());
+}
+
+
+/* YY_UNPUT -- Put a character back into the input stream.
+ */
+void
+yy_unput (ch)
+char ch;
+{
+ unput(ch);
+}
+
diff --git a/unix/boot/spp/xpp/mkpkg.sh b/unix/boot/spp/xpp/mkpkg.sh
new file mode 100644
index 00000000..d6972000
--- /dev/null
+++ b/unix/boot/spp/xpp/mkpkg.sh
@@ -0,0 +1,15 @@
+# Make the first pass (XPP) of the SPP language compiler.
+
+find xpp.l -newer lexyy.c -exec rm lexyy.c \;
+if test -f lexyy.c; then\
+ $CC -c $HSI_CF lexyy.c;\
+else\
+ lex xpp.l;\
+ sed -f lex.sed lex.yy.c > lexyy.c; rm lex.yy.c;\
+ $CC -c $HSI_CF lexyy.c;\
+fi
+
+$CC -c $HSI_CF xppmain.c xppcode.c decl.c
+$CC $HSI_LF xppmain.o lexyy.o xppcode.o decl.o $HSI_LIBS -o xpp.e
+mv -f xpp.e ../../../hlib
+rm *.o
diff --git a/unix/boot/spp/xpp/xpp.h b/unix/boot/spp/xpp/xpp.h
new file mode 100644
index 00000000..2fde825d
--- /dev/null
+++ b/unix/boot/spp/xpp/xpp.h
@@ -0,0 +1,94 @@
+/* XPP error codes.
+ */
+#define XPP_OK OSOK /* no problems */
+#define XPP_COMPERR 101 /* compiler error */
+#define XPP_BADXFILE 102 /* cannot open .x file */
+#define XPP_SYNTAX 104 /* language error */
+
+
+
+#define F77 /* Fortran 77 target compiler? */
+
+#define IRAFLIB "iraf$lib/"
+#define HOSTLIB "host$hlib/"
+#define HBIN_INCLUDES "hbin$arch_includes/"
+
+
+/* Size limiting definitions.
+ */
+#define MAX_TASKS 100 /* max no. of tasks we can handle */
+#define SZ_OBUF 131072 /* buffers procedure body */
+#define SZ_DBUF 8192 /* for errchk, common, ect. decls */
+#define SZ_SBUF 8192 /* buffers text of strings */
+#define MAX_STRINGS 256 /* max strings in a procedure */
+#define MAX_INCLUDE 5 /* maximum nesting of includes */
+#define MIN_REALPREC 7 /* used by HMS */
+#define SZ_NUMBUF 32 /* for numeric constants */
+#define SZ_STBUF 4096 /* text of defined strings */
+#define MAX_DEFSTR 128 /* max defined strings */
+
+#define RUNTASK "sysruk.x"
+#define OCTAL 8
+#define DECIMAL 10
+#define HEX 16
+#define CHARCON 1
+#define SEXAG 2
+
+
+/* Contexts.
+ */
+#define GLOBAL 01
+#define DECL 02
+#define BODY 04
+#define DEFSTMT 010
+#define DATASTMT 020
+#define PROCSTMT 040
+
+/* String type codes.
+ */
+#define STR_INLINE 0
+#define STR_DEFINE 1
+#define STR_DECL 2
+
+/* SPP keywords. The datatype keywords bool through pointer must be assigned
+ * the lowest numbers.
+ */
+#define XTY_BOOL 1
+#define XTY_CHAR 2
+#define XTY_SHORT 3
+#define XTY_INT 4
+#define XTY_LONG 5
+#define XTY_REAL 6
+#define XTY_DOUBLE 7
+#define XTY_COMPLEX 8
+#define XTY_POINTER 9
+#define XTY_PROC 10
+#define XTY_TRUE 11
+#define XTY_FALSE 12
+#define XTY_IFERR 13
+#define XTY_IFNOERR 14
+#define XTY_EXTERN 15
+#define XTY_ERROR 16
+#define MAX_KEY 16
+
+/* RPP type keywords (must match type codes above).
+ */
+#define RPP_TYPES {\
+ "",\
+ "x$bool",\
+ "x$short", /* MACHDEP */\
+ "x$short",\
+ "x$int",\
+ "x$long",\
+ "x$real",\
+ "x$dble",\
+ "x$cplx",\
+ "x$pntr",\
+ "x$fcn",\
+ ".true.",\
+ ".false.",\
+ "iferr",\
+ "ifnoerr",\
+ "x$extn",\
+ "error"\
+}
diff --git a/unix/boot/spp/xpp/xpp.l b/unix/boot/spp/xpp/xpp.l
new file mode 100644
index 00000000..554c38dc
--- /dev/null
+++ b/unix/boot/spp/xpp/xpp.l
@@ -0,0 +1,476 @@
+%{
+
+#include <stdio.h>
+#include <ctype.h>
+#include "xpp.h"
+#include "../../bootProto.h"
+#include "xppProto.h"
+
+#define import_spp
+#include <iraf.h>
+
+
+#include "xpp.h"
+
+/*
+ * Lexical definition for the first pass of the IRAF subset preprocessor.
+ * This program is a horrible kludge but will suffice until there is time
+ * to build something better.
+ */
+
+#undef output /* undefine LEX output macro -- we use proc */
+#undef ECHO /* ditto echo */
+#define ECHO outstr (yytext)
+
+#define OCTAL 8
+#define HEX 16
+#define CHARCON 1
+
+#ifdef YYLMAX
+#undef YYLMAX
+#endif
+#define YYLMAX YY_BUF_SIZE
+
+YY_BUFFER_STATE include_stack[MAX_INCLUDE];
+
+
+extern FILE *istk[];
+extern char fname[MAX_INCLUDE][SZ_PATHNAME];
+extern char *machdefs[];
+extern int hbindefs, foreigndefs;
+
+extern int linenum[]; /* line numbers in files */
+extern int istkptr; /* istk pointer */
+extern int str_idnum; /* for ST0000 string names */
+extern int nbrace; /* count of braces */
+extern int nswitch; /* number of "switch" stmts */
+extern int errflag; /* set if compiler error */
+extern int errchk; /* sef if error checking */
+extern int context; /* lexical context flags */
+extern int ntasks;
+static int dtype; /* set if typed procedure */
+
+extern char *vfn2osfn();
+extern void skipnl (void);
+
+
+void typespec (int typecode);
+void process_task_statement (void);
+
+void do_include (void);
+int yywrap (void);
+int yy_input (void);
+void yy_unput (char ch);
+
+
+%}
+
+D [0-9]
+O [0-7]
+S [ 0-6]{D}
+X [0-9A-F]
+W [ \t]
+NI [^a-zA-Z0-9_]
+
+%a 5000
+%o 9000
+%k 500
+
+%%
+
+^"bool"/{NI} typespec (XTY_BOOL);
+^"char"/{NI} typespec (XTY_CHAR);
+^"short"/{NI} typespec (XTY_SHORT);
+^"int"/{NI} typespec (XTY_INT);
+^"long"/{NI} typespec (XTY_LONG);
+^"real"/{NI} typespec (XTY_REAL);
+^"double"/{NI} typespec (XTY_DOUBLE);
+^"complex"/{NI} typespec (XTY_COMPLEX);
+^"pointer"/{NI} typespec (XTY_POINTER);
+^"extern"/{NI} typespec (XTY_EXTERN);
+
+^{W}*"procedure"/{NI} {
+ /* Subroutine declaration. */
+ pushcontext (PROCSTMT);
+ d_gettok (yytext, YYLMAX-1);
+ d_newproc (yytext, 0);
+ }
+
+"procedure"/{NI} {
+ /* Function declaration. */
+ pushcontext (PROCSTMT);
+ d_gettok (yytext, YYLMAX-1);
+ d_newproc (yytext, dtype);
+ setline();
+ }
+
+^{W}*"task"/{NI} { if (context & BODY)
+ ECHO;
+ else {
+ process_task_statement();
+ setline();
+ }
+ }
+^{W}*"TN$DECL" put_dictionary();
+^{W}*"TN$INTERP" put_interpreter();
+^".""help" {
+ skip_helpblock();
+ setline();
+ }
+^{W}*"begin"/{NI} {
+ begin_code();
+ setline();
+ }
+^{W}*"define"{W}+[A-Z0-9_]+{W}+Memr {
+ macro_redef();
+ setline();
+ }
+^{W}*"define"{W}+[A-Z0-9_]+{W}+\" {
+ str_enter();
+ }
+^{W}*("(")?"define"/{NI} {
+ pushcontext (DEFSTMT);
+ ECHO;
+ }
+^{W}*"end"/{NI} {
+ end_code();
+ setline();
+ }
+^{W}*"string"/{NI} {
+ (context & BODY) ? ECHO
+ : do_string ('"', STR_DECL);
+ }
+^{W}*"data"/{NI} {
+ if (!(context & BODY))
+ pushcontext (DATASTMT);
+ ECHO;
+ }
+
+"switch"/{NI} {
+ ECHO;
+ if (context & BODY)
+ nswitch++;
+ }
+
+"#" skipnl();
+^"%"[^\n]* ECHO;
+
+^{W}*"include"{W}*(\"|<) do_include();
+
+[a-zA-Z][a-zA-Z0-9_$]* mapident();
+
+{D}+":"{S}(":"{S})?("."{D}*)? hms (yytext);
+{O}+("B"|"b") int_constant (yytext, OCTAL);
+{X}+("X"|"x") int_constant (yytext, HEX);
+\' int_constant (yytext, CHARCON);
+
+"()" {
+ if (context & (BODY|PROCSTMT))
+ ECHO;
+ }
+
+"&&" output ('&');
+"||" output ('|');
+
+"{" {
+ ECHO;
+ nbrace++;
+ }
+"}" {
+ ECHO;
+ nbrace--;
+ }
+"[" output ('(');
+"]" output (')');
+
+\*\" do_hollerith();
+
+\" {
+ if (context & BODY)
+ do_string ('"', STR_INLINE);
+ else
+ ECHO;
+ }
+
+(","|";"){W}*("#"[^\n]*)?"\n" {
+ /* If statement is continued do not pop
+ * the context.
+ */
+ ECHO;
+ linenum[istkptr]++;
+ }
+
+"\n" {
+ /* End of newline and end of statement.
+ */
+ ECHO;
+ linenum[istkptr]++;
+ popcontext();
+ }
+
+%%
+
+
+/* TYPESPEC -- Context dependent processing of a type specifier. If in the
+ * declarations section, process a declarations statement. If in procedure
+ * body or in a define statement, map the type specifier identifer and output
+ * the mapped value (intrinsic function name). Otherwise we must be in global
+ * space, and the type spec begins a function declaration; save the datatype
+ * code for d_newproc().
+ */
+void
+typespec (typecode)
+int typecode;
+{
+ if (context & DECL)
+ d_declaration (typecode);
+ else if (context & (BODY|DEFSTMT))
+ mapident();
+ else
+ dtype = typecode;
+}
+
+
+
+/* PROCESS_TASK_STATEMENT -- Parse the TASK statement. The task statement
+ * is replaced by the "sys_runtask" procedure (sysruk), which is called by
+ * the IRAF main to run a task, or to print the dictionary (cmd "?").
+ * The source for the basic sys_runtask procedure is in "lib$sysruk.x".
+ * We process the task statement into some internal tables, then open the
+ * sysruk.x file as an include file. Special macros therein are
+ * replaced by the taskname dictionary as processing continues.
+ */
+void
+process_task_statement()
+{
+ char ch;
+
+ if (ntasks > 0) { /* only one task statement permitted */
+ error (XPP_SYNTAX, "Only one TASK statement permitted per file");
+ return;
+ }
+
+ /* Process the task statement into the TASK_LIST structure.
+ */
+ if (parse_task_statement() == ERR) {
+ error (XPP_SYNTAX, "Syntax error in TASK statement");
+ while ((ch = input()) != EOF && ch != '\n')
+ ;
+ unput ('\n');
+ return;
+ }
+
+ /* Open RUNTASK ("lib$sysruk.x") as an include file.
+ */
+ istk[istkptr] = yyin;
+ if (++istkptr >= MAX_INCLUDE) {
+ istkptr--;
+ error (XPP_COMPERR, "Maximum include nesting exceeded");
+ return;
+ }
+
+ strcpy (fname[istkptr], IRAFLIB);
+ strcat (fname[istkptr], RUNTASK);
+ if ((yyin = fopen (vfn2osfn (fname[istkptr],0), "r")) == NULL) {
+ yyin = istk[--istkptr];
+ error (XPP_SYNTAX, "Cannot read lib$sysruk.x");
+ return;
+ }
+
+ linenum[istkptr] = 1;
+
+ /* Put the newline back so that LEX "^..." matches will work on
+ * first line of the include file.
+ */
+ unput ('\n');
+
+ yypush_buffer_state(yy_create_buffer( yyin, YY_BUF_SIZE ));
+ BEGIN(INITIAL);
+}
+
+
+/* DO_INCLUDE -- Process an include statement, i.e., eat up the include
+ * statement, push the current input file on a stack, and open the new file.
+ * System include files are referenced as "<file>", other files as "file".
+ */
+void
+do_include()
+{
+ char *p, delim, *rindex();
+ char hfile[SZ_FNAME+1], *op;
+ int root_len;
+
+
+ /* Push current input file status on the input file stack istk.
+ */
+ istk[istkptr] = yyin;
+ if (++istkptr >= MAX_INCLUDE) {
+ --istkptr;
+ error (XPP_COMPERR, "Maximum include nesting exceeded");
+ return;
+ }
+
+ /* If filespec "<file>", call os_sysfile to get the pathname of the
+ * system include file.
+ */
+ if (yytext[yyleng-1] == '<') {
+
+ for (op=hfile; (*op = input()) != EOF; op++)
+ if (*op == '\n') {
+ --istkptr;
+ error (XPP_SYNTAX, "missing > delim in include statement");
+ return;
+ } else if (*op == '>')
+ break;
+
+ *op = EOS;
+
+ if (os_sysfile (hfile, fname[istkptr], SZ_PATHNAME) == ERR) {
+ --istkptr;
+ error (XPP_COMPERR, "cannot find include file");
+ return;
+ }
+
+ } else {
+ /* Prepend pathname leading to the file in which the current
+ * include statement was found. Compiler may not have been run
+ * from the directory containing the source and include file.
+ */
+ if (!hbindefs) {
+ if ((p = rindex (fname[istkptr-1], '/')) == NULL)
+ root_len = 0;
+ else
+ root_len = p - fname[istkptr-1] + 1;
+ strncpy (fname[istkptr], fname[istkptr-1], root_len);
+
+ } else {
+ if ((p = vfn2osfn (HBIN_INCLUDES, 0))) {
+ root_len = strlen (p);
+ strncpy (fname[istkptr], p, root_len);
+ } else {
+ --istkptr;
+ error (XPP_COMPERR, "cannot find hbin$ directory");
+ return;
+ }
+ }
+ fname[istkptr][root_len] = EOS;
+
+ delim = '"';
+
+ /* Advance to end of whatever is in the file name string.
+ */
+ for (p=fname[istkptr]; *p != EOS; p++)
+ ;
+ /* Concatenate name of referenced file.
+ */
+ while ((*p = input()) != delim) {
+ if (*p == '\n' || *p == EOF) {
+ --istkptr;
+ error (XPP_SYNTAX, "bad include file name");
+ return;
+ }
+ p++;
+ }
+ *p = EOS;
+ }
+
+ /* If the foreign defs option is in effect, the machine dependent defs
+ * for a foreign machine are given by a substitute "iraf.h" file named
+ * on the command line. This foreign machine header file includes
+ * not only the iraf.h for the foreign machine, but the equivalent of
+ * all the files named in the array of strings "machdefs". Ignore any
+ * attempts to include any of these files since they have already been
+ * included in the foreign definitions header file.
+ */
+ if (foreigndefs) {
+ char sysfile[SZ_PATHNAME];
+ char **files;
+
+ /*
+ for (files=machdefs; *files != NULL; files++) {
+ */
+ for (files=machdefs; **files; files++) {
+ memset (sysfile, 0, SZ_PATHNAME);
+ strcpy (sysfile, HOSTLIB);
+ strcat (sysfile, *files);
+ if (strcmp (sysfile, fname[istkptr]) == 0) {
+ --istkptr;
+ return;
+ }
+ }
+ }
+
+ if ((yyin = fopen (vfn2osfn(fname[istkptr],0), "r")) == NULL) {
+ yyin = istk[--istkptr];
+ error (XPP_SYNTAX, "Cannot open include file");
+ return;
+ }
+
+ /* Keep track of the line number within the include file. */
+ linenum[istkptr] = 1;
+
+ /* Put the newline back so that LEX "^..." matches will work on
+ * first line of include file.
+ */
+ unput ('\n');
+
+ yypush_buffer_state(yy_create_buffer( yyin, YY_BUF_SIZE ));
+ BEGIN(INITIAL);
+}
+
+
+/* YYWRAP -- Called by LEX when end of file is reached. If input stack is
+ * not empty, close off include file and continue on in old file. Return
+ * nonzero when the stack is empty, i.e., when we reach the end of the
+ * main file.
+ */
+int
+yywrap()
+{
+ /* The last line of a file is not necessarily newline terminated.
+ * Output a newline just in case.
+ */
+ fprintf (yyout, "\n");
+
+ if (istkptr <= 0) {
+ /* ALL DONE with main file.
+ */
+ return (1);
+
+ } else {
+ /* End of include file. Pop old input file and set line number
+ * for error messages.
+ */
+ fclose (yyin);
+ /* yyin = istk[--istkptr]; */
+ istkptr--;
+
+ yypop_buffer_state ();
+ if ( !YY_CURRENT_BUFFER )
+ yyterminate ();
+
+ if (istkptr == 0)
+ setline();
+ return (0);
+ }
+}
+
+
+
+/* YY_INPUT -- Get a character from the input stream.
+ */
+int
+yy_input ()
+{
+ return (input());
+}
+
+
+/* YY_UNPUT -- Put a character back into the input stream.
+ */
+void
+yy_unput (ch)
+char ch;
+{
+ unput(ch);
+}
diff --git a/unix/boot/spp/xpp/xpp.l.orig b/unix/boot/spp/xpp/xpp.l.orig
new file mode 100644
index 00000000..f5c7a375
--- /dev/null
+++ b/unix/boot/spp/xpp/xpp.l.orig
@@ -0,0 +1,188 @@
+%{
+
+#include "xpp.h"
+
+/*
+ * Lexical definition for the first pass of the IRAF subset preprocessor.
+ * This program is a horrible kludge but will suffice until there is time
+ * to build something better.
+ */
+
+#undef output /* undefine LEX output macro -- we use proc */
+#undef ECHO /* ditto echo */
+#define ECHO outstr (yytext)
+
+#define OCTAL 8
+#define HEX 16
+#define CHARCON 1
+
+extern int linenum[]; /* line numbers in files */
+extern int istkptr; /* istk pointer */
+extern int str_idnum; /* for ST0000 string names */
+extern int nbrace; /* count of braces */
+extern int nswitch; /* number of "switch" stmts */
+extern int errflag; /* set if compiler error */
+extern int errchk; /* sef if error checking */
+extern int context; /* lexical context flags */
+static int dtype; /* set if typed procedure */
+
+%}
+
+D [0-9]
+O [0-7]
+S [ 0-6]{D}
+X [0-9A-F]
+W [ \t]
+NI [^a-zA-Z0-9_]
+
+%a 5000
+%o 9000
+%k 500
+
+%%
+
+^"bool"/{NI} typespec (XTY_BOOL);
+^"char"/{NI} typespec (XTY_CHAR);
+^"short"/{NI} typespec (XTY_SHORT);
+^"int"/{NI} typespec (XTY_INT);
+^"long"/{NI} typespec (XTY_LONG);
+^"real"/{NI} typespec (XTY_REAL);
+^"double"/{NI} typespec (XTY_DOUBLE);
+^"complex"/{NI} typespec (XTY_COMPLEX);
+^"pointer"/{NI} typespec (XTY_POINTER);
+^"extern"/{NI} typespec (XTY_EXTERN);
+
+^{W}*"procedure"/{NI} {
+ /* Subroutine declaration. */
+ pushcontext (PROCSTMT);
+ d_gettok (yytext, YYLMAX-1);
+ d_newproc (yytext, 0);
+ }
+
+"procedure"/{NI} {
+ /* Function declaration. */
+ pushcontext (PROCSTMT);
+ d_gettok (yytext, YYLMAX-1);
+ d_newproc (yytext, dtype);
+ }
+
+^{W}*"task"/{NI} { if (context & BODY)
+ ECHO;
+ else {
+ process_task_statement();
+ setline();
+ }
+ }
+^{W}*"TN$DECL" put_dictionary();
+^{W}*"TN$INTERP" put_interpreter();
+^".""help" {
+ skip_helpblock();
+ setline();
+ }
+
+^{W}*"begin"/{NI} {
+ begin_code();
+ setline();
+ }
+^{W}*"define"{W}+[A-Z0-9_]+{W}+\" {
+ str_enter();
+ }
+^{W}*("(")?"define"/{NI} {
+ pushcontext (DEFSTMT);
+ ECHO;
+ }
+^{W}*"end"/{NI} {
+ end_code();
+ }
+^{W}*"string"/{NI} {
+ (context & BODY) ? ECHO
+ : do_string ('"', STR_DECL);
+ }
+^{W}*"data"/{NI} {
+ if (!(context & BODY))
+ pushcontext (DATASTMT);
+ ECHO;
+ }
+
+"switch"/{NI} {
+ ECHO;
+ if (context & BODY)
+ nswitch++;
+ }
+
+"#" skipnl();
+^"%"[^\n]* ECHO;
+
+^{W}*"include"{W}*(\"|<) do_include();
+
+[a-zA-Z][a-zA-Z0-9_$]* mapident();
+
+{D}+":"{S}(":"{S})?("."{D}*)? hms (yytext);
+{O}+("B"|"b") int_constant (yytext, OCTAL);
+{X}+("X"|"x") int_constant (yytext, HEX);
+\' int_constant (yytext, CHARCON);
+
+"()" {
+ if (context & (BODY|PROCSTMT))
+ ECHO;
+ }
+
+"&&" output ('&');
+"||" output ('|');
+
+"{" {
+ ECHO;
+ nbrace++;
+ }
+"}" {
+ ECHO;
+ nbrace--;
+ }
+"[" output ('(');
+"]" output (')');
+
+\*\" do_hollerith();
+
+\" {
+ if (context & BODY)
+ do_string ('"', STR_INLINE);
+ else
+ ECHO;
+ }
+
+(","|";"){W}*("#"[^\n]*)?"\n" {
+ /* If statement is continued do not pop
+ * the context.
+ */
+ ECHO;
+ linenum[istkptr]++;
+ }
+
+"\n" {
+ /* End of newline and end of statement.
+ */
+ ECHO;
+ linenum[istkptr]++;
+ popcontext();
+ }
+
+%%
+
+
+/* TYPESPEC -- Context dependent processing of a type specifier. If in the
+ * declarations section, process a declarations statement. If in procedure
+ * body or in a define statement, map the type specifier identifer and output
+ * the mapped value (intrinsic function name). Otherwise we must be in global
+ * space, and the type spec begins a function declaration; save the datatype
+ * code for d_newproc().
+ */
+typespec (typecode)
+int typecode;
+{
+ if (context & DECL)
+ d_declaration (typecode);
+ else if (context & (BODY|DEFSTMT))
+ mapident();
+ else
+ dtype = typecode;
+}
diff --git a/unix/boot/spp/xpp/xppProto.h b/unix/boot/spp/xpp/xppProto.h
new file mode 100644
index 00000000..073aa585
--- /dev/null
+++ b/unix/boot/spp/xpp/xppProto.h
@@ -0,0 +1,55 @@
+
+/* decl.c */
+void d_newproc (char *name, int dtype);
+int d_declaration (int dtype);
+void d_codegen (register FILE *fp);
+void d_runtime (char *text);
+//void d_makedecl (struct symbol *sp, FILE *fp);
+struct symbol *d_enter (char *name, int dtype, int flags);
+struct symbol *d_lookup (char *name);
+void d_chksbuf (void);
+int d_gettok (char *tokstr, int maxch);
+//void d_declfunc (struct symbol *sp, FILE *fp);
+
+
+/* xppcode.c */
+void setcontext (int new_context);
+void pushcontext (int new_context);
+int popcontext (void);
+void hashtbl (void);
+int findkw (void);
+void mapident (void);
+void str_enter (void);
+char *str_fetch (register char *strname);
+void macro_redef (void);
+void setline (void);
+void output (char ch);
+
+void do_type (int type);
+void do_char (void);
+void skip_helpblock (void);
+int parse_task_statement (void);
+int get_task (char *task_name, char *proc_name, int maxch);
+int get_name (char *outstr, int maxch);
+int nextch (void);
+void put_dictionary (void);
+void put_interpreter (void);
+void outstr (char *string);
+void begin_code (void);
+void end_code (void);
+void init_strings (void);
+//void write_string_data_statement (struct string *s);
+void do_string (char delim, int strtype);
+void do_hollerith (void);
+void sbuf_check (void);
+
+char *str_uniqid (void);
+void traverse (char delim);
+void error (int errcode, char *errmsg);
+void xpp_warn (char *warnmsg);
+long accum (int base, char **strp);
+
+int charcon (char *string);
+void int_constant (char *string, int base);
+void hms (char *number);
+
diff --git a/unix/boot/spp/xpp/xppcode.c b/unix/boot/spp/xpp/xppcode.c
new file mode 100644
index 00000000..e083cb27
--- /dev/null
+++ b/unix/boot/spp/xpp/xppcode.c
@@ -0,0 +1,1826 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#include <stdio.h>
+#include <ctype.h>
+#include <string.h>
+#include <stdlib.h>
+#include <unistd.h>
+#include "xpp.h"
+#include "../../bootProto.h"
+
+#define import_spp
+#include <iraf.h>
+
+/*
+ * C code for the first pass of the IRAF subset preprocessor (SPP).
+ * The decision to initially organize the SPP compiler into two passes was
+ * made to permit maximum use of the existing raftor preprocessor, which is
+ * the basis for the second pass of the SPP. Eventually the two passes
+ * should be combined into a single program. Most of the operations performed
+ * by the first pass (XPP) should be performed AFTER macro substitution,
+ * rather than before as is the case in the current implementation, which
+ * processes macros in the second pass (RPP).
+ *
+ * Beware that this is not a very good program which was not carefully
+ * designed and which was never intended to have a long lifetime. The next
+ * step is to replace the two passes by a single program which is functionally
+ * very similar, but which is more carefully engineered and which is written
+ * in the SPP language calling IRAF file i/o. Eventually a true compiler
+ * will be written, providing many new features, i.e., structures and pointers,
+ * automatic storage class, mapped arrays, enhanced i/o support, and good
+ * compile time error checking. This compiler will also feature a table driven
+ * code generator (generating primitive Fortran statements), which will provide
+ * greater machine independence.
+ */
+
+
+extern char *vfn2osfn();
+
+/* Escape sequence characters and their binary equivalents.
+ */
+char *esc_ch = "ntfr\\\"'";
+char *esc_val = "\n\t\f\r\\\"\'";
+
+/* External and internal data stuctures. We need access to the LEX i/o
+ * buffers because we use the LEX i/o macros, which provide pushback,
+ * because we must change the streams to process includes, and so on.
+ * These definitions are VERY Lex dependent.
+ */
+extern char yytext[]; /* LEX character buffer */
+extern int yyleng; /* length of string in yytext */
+extern FILE *yyin, *yyout; /* LEX input, output files */
+
+extern char yytchar, *yysptr, yysbuf[];
+extern int yylineno;
+
+#define U(x) x
+/*
+#define input() (((yytchar=yysptr>yysbuf?U(*--yysptr):getc(yyin))==10\
+?(yylineno++,yytchar):yytchar)==EOF?0:yytchar)
+#define unput(c) {yytchar= (c);if(yytchar=='\n')yylineno--;*yysptr++=yytchar;}
+*/
+
+extern int input();
+extern void yyunput();
+extern void d_codegen (register FILE *fp);
+extern void d_runtime (char *text);
+
+extern char *yytext_ptr;
+#define unput(c) yyunput( c, (yytext_ptr) )
+
+
+
+int context = GLOBAL; /* lexical context variable */
+extern int hbindefs, foreigndefs;
+char *machdefs[] = { "mach.h", "config.h", "" };
+
+/* The task structure is used for TASK declarations. Since this is a
+ * throwaway program we do not bother with dynamic storage allocation,
+ * which would remove the limit on the number of tasks in a task statment.
+ */
+struct task {
+ char *task_name; /* logical task name */
+ char *proc_name; /* name of procedure */
+ short name_offset; /* offset of name in dictionary */
+};
+
+/* The string structure is used for STRING declarations and for inline
+ * strings. Strings are stored in a fixed size, statically allocated
+ * string buffer.
+ */
+struct string {
+ char *str_name; /* name of string */
+ char *str_text; /* ptr to text of string */
+ short str_length; /* length of string */
+};
+
+struct task task_list[MAX_TASKS];
+struct string string_list[MAX_STRINGS];
+
+FILE *istk[MAX_INCLUDE]; /* stack for input file descriptors */
+int linenum[MAX_INCLUDE]; /* line numbers in files */
+char fname[MAX_INCLUDE][SZ_PATHNAME];/* file names */
+int istkptr = 0; /* istk pointer */
+
+char obuf[SZ_OBUF]; /* buffer for body of procedure */
+char dbuf[SZ_DBUF]; /* buffer for misc proc. decls. */
+char sbuf[SZ_SBUF]; /* string buffer */
+char *sp = sbuf; /* string buffer pointer */
+char *op = obuf; /* pointer in output buffer */
+char *dp = dbuf; /* pointer in decls buffer */
+int nstrings = 0; /* number of strings so far */
+int strloopdecl; /* data dummy do index declared? */
+
+int ntasks = 0; /* number of tasks in interpreter */
+int str_idnum = 0; /* for generating unique string names */
+int nbrace = 0; /* must be zero when "end" is reached */
+int nswitch = 0; /* number switch stmts in procedure */
+int errflag;
+int errhand = NO; /* set if proc employs error handler */
+int errchk = NO; /* set if proc employs error checking */
+
+
+void skipnl (void);
+void setcontext (int new_context);
+void pushcontext (int new_context);
+int popcontext (void);
+void hashtbl (void);
+int findkw (void);
+void mapident (void);
+void str_enter (void);
+char *str_fetch (register char *strname);
+void macro_redef (void);
+void setline (void);
+void output (char ch);
+
+void do_type (int type);
+void do_char (void);
+void skip_helpblock (void);
+int parse_task_statement (void);
+int get_task (char *task_name, char *proc_name, int maxch);
+int get_name (char *outstr, int maxch);
+int nextch (void);
+void put_dictionary (void);
+void put_interpreter (void);
+void outstr (char *string);
+void begin_code (void);
+void end_code (void);
+void init_strings (void);
+void write_string_data_statement (struct string *s);
+void do_string (char delim, int strtype);
+void do_hollerith (void);
+void sbuf_check (void);
+
+char *str_uniqid (void);
+void traverse (char delim);
+void error (int errcode, char *errmsg);
+void xpp_warn (char *warnmsg);
+long accum (int base, char **strp);
+
+int charcon (char *string);
+void int_constant (char *string, int base);
+void hms (char *number);
+
+
+
+/* SKIPNL -- Skip to newline, e.g., when a comment is encountered.
+ */
+void
+skipnl (void)
+{
+ int c;
+ while ((c=input()) != '\n')
+ ;
+ unput ('\n');
+}
+
+
+/*
+ * CONTEXT -- Package for setting, saving, and restoring the lexical context.
+ * The action of the preprocessor in some cases depends upon the context, i.e.,
+ * what type of statement we are processing, whether we are in global space,
+ * within a procedure, etc.
+ */
+
+#define MAX_CONTEXT 5 /* max nesting of context */
+
+int cntxstk[MAX_CONTEXT]; /* for saving context */
+int cntxsp = 0; /* save stack pointer */
+
+
+/* SETCONTEXT -- Set the context. Clears any saved context.
+ */
+void
+setcontext (int new_context)
+{
+ context = new_context;
+ cntxsp = 0;
+}
+
+
+/* PUSHCONTEXT -- Push a temporary context.
+ */
+void
+pushcontext (int new_context)
+{
+ cntxstk[cntxsp++] = context;
+ context = new_context;
+
+ if (cntxsp > MAX_CONTEXT)
+ error (XPP_COMPERR, "save context stack overflow");
+}
+
+
+/* POPCONTEXT -- Pop the former context. If the current context is PROCSTMT
+ * (just finished compiling a procedure statement) then set the context to DECL
+ * to indicate that we are entering the declarations section of a procedure.
+ */
+int
+popcontext (void)
+{
+ if (context & PROCSTMT) {
+ context = DECL;
+ if (cntxsp > 0)
+ --cntxsp;
+ } else if (cntxsp > 0)
+ context = cntxstk[--cntxsp];
+
+ return (context);
+}
+
+
+/* Keyword table. The simple hashing scheme requires that the keywords appear
+ * in the table in sorted order.
+ */
+#define LEN_KWTBL 18
+
+struct {
+ char *keyw; /* keyword name string */
+ short opcode; /* opcode from above definitions */
+ short nelem; /* number of table elements to skip if
+ * to get to next character class.
+ */
+} kwtbl[] = {
+ { "FALSE", XTY_FALSE, 0 },
+ { "TRUE", XTY_TRUE, 0 },
+ { "bool", XTY_BOOL, 0 },
+ { "char", XTY_CHAR, 1 },
+ { "complex", XTY_COMPLEX, 0 },
+ { "double", XTY_DOUBLE, 0 },
+ { "error", XTY_ERROR, 1 },
+ { "extern", XTY_EXTERN, 0 },
+ { "false", XTY_FALSE, 0 },
+ { "iferr", XTY_IFERR, 2 },
+ { "ifnoerr", XTY_IFNOERR, 1 },
+ { "int", XTY_INT, 0 },
+ { "long", XTY_LONG, 0 },
+ { "pointer", XTY_POINTER, 1 },
+ { "procedure", XTY_PROC, 0 },
+ { "real", XTY_REAL, 0 },
+ { "short", XTY_SHORT, 0 },
+ { "true", XTY_TRUE, 0 },
+};
+
+/* short kwindex[30]; simple alphabetic hash index */
+/* #define CINDEX(ch) (isupper(ch)?ch-'A':ch-'a') */
+
+#define MAXCH 128
+short kwindex[MAXCH]; /* simple alphabetic hash index */
+#define CINDEX(ch) (ch)
+
+
+/* HASHTBL -- Hash the keyword table. Initializes the "kwindex" hash table.
+ * For each character in the alphabet, the index gives the index into the
+ * sorted keyword table. If there is no keyword name beginning with the index
+ * character, the index entry is set to -1.
+ */
+void
+hashtbl (void)
+{
+ int i, j;
+
+ for (i=j=0; i <= MAXCH; i++) {
+ if (i == CINDEX (kwtbl[j].keyw[0])) {
+ kwindex[i] = j;
+ j = min (LEN_KWTBL-1, j + kwtbl[j].nelem + 1);
+ } else
+ kwindex[i] = -1;
+ }
+}
+
+
+/* FINDKW -- Lookup an indentifier in the keyword table. Return the opcode
+ * of the keyword, or ERR if no match.
+ */
+int
+findkw (void)
+{
+ register char ch, *p, *q;
+ int i, ilimit;
+
+ if (kwindex[0] == 0)
+ hashtbl();
+
+ i = CINDEX (yytext[0]);
+ if (i < 0 || i >= MAXCH || (i = kwindex[i]) < 0)
+ return (ERR);
+ ilimit = i + kwtbl[i].nelem;
+
+ for (; i <= ilimit; i++) {
+ p = kwtbl[i].keyw + 1;
+ q = yytext + 1;
+
+ for (; *p != EOS; q++, p++) {
+ ch = *q;
+ /* 5DEC95 - Don't case convert keywords.
+ if (isupper (ch))
+ ch = tolower (ch);
+ */
+ if (*p != ch)
+ break;
+ }
+ if (*p == EOS && *q == EOS)
+ return (kwtbl[i].opcode);
+ }
+ return (ERR);
+}
+
+
+/* MAPIDENT -- Lookup an identifier in the keyword table. If the identifier is
+ * not a keyword, output it as is. If a datatype keyword, the action depends
+ * on whether we are in a procedure body or not (i.e., whether the keyword
+ * begins a declaration or is a type coercion function). Most of the other
+ * keywords are mapped into special x$.. identifiers for further processing
+ * by the second pass.
+ */
+void
+mapident (void)
+{
+ int i, findkw();
+ char *str_fetch();
+ register char *ip, *op;
+
+ /* If not keyword and not defined string, output as is. The first
+ * char must be upper case for the name to be recognized as that of
+ * a defined string. If we are processing a "define" macro expansion
+ * is disabled.
+ */
+ if ((i = findkw()) == ERR) {
+ if (!isupper(yytext[0]) || (context & DEFSTMT) ||
+ (ip = str_fetch (yytext)) == NULL) {
+
+ outstr (yytext);
+ return;
+
+ } else {
+ yyleng = 0;
+ for (op=yytext; (*op++ = *ip++) != EOS; )
+ yyleng++;
+ do_string ('"', STR_DEFINE);
+ return;
+ }
+ }
+
+ /* If datatype keyword, call do_type. */
+ if (i <= XTY_POINTER) {
+ do_type (i);
+ return;
+ }
+
+ switch (i) {
+ case XTY_TRUE:
+ outstr (".true.");
+ break;
+ case XTY_FALSE:
+ outstr (".false.");
+ break;
+ case XTY_IFERR:
+ case XTY_IFNOERR:
+ outstr (yytext);
+ errhand = YES;
+ errchk = YES;
+ break;
+ case XTY_ERROR:
+ outstr (yytext);
+ errchk = YES;
+ break;
+
+ case XTY_EXTERN:
+ /* UNREACHABLE (due to decl.c additions).
+ */
+ outstr ("x$extn");
+ break;
+
+ default:
+ error (XPP_COMPERR, "Keyword lookup error");
+ }
+}
+
+
+char st_buf[SZ_STBUF];
+char *st_next = st_buf;
+
+struct st_def {
+ char *st_name;
+ char *st_value;
+} st_list[MAX_DEFSTR];
+
+int st_nstr = 0;
+
+/* STR_ENTER -- Enter a defined string into the string table. The string
+ * table is a kludge to provide the capability to define strings in SPP.
+ * The problem is that XPP handles strings but RPP handles macros, hence
+ * strings cannot be defined. We get around this by recognizing defines
+ * of the form 'define NAME "..."'. If a macro with a quoted value is
+ * encounted we are called to enter the name and the string into the
+ * table. LOOKUP, above, subsequently searches the table for defined
+ * strings. The name must be upper case or the table will not be searched.
+ *
+ * N.B.: we are called by the lexical analyser with 'define name "' in
+ * yytext. The next input() will return the first char of the string.
+ */
+void
+str_enter (void)
+{
+ register char *ip, *op, ch;
+ register struct st_def *s;
+ register int n;
+ char name[SZ_FNAME+1];
+
+
+ /* Skip to the first char of the name string.
+ */
+ ip = yytext;
+ while (isspace (*ip))
+ ip++;
+ while (!isspace (*ip))
+ ip++;
+ while (isspace (*ip))
+ ip++;
+
+ /* Do not accept statement unless the name is upper case.
+ */
+ if (!isupper (*ip)) {
+ outstr (yytext);
+ return;
+ }
+
+ /* Extract macro name. */
+ for (op=name; (isalnum(*ip) || *ip == '_'); )
+ *op++ = *ip++;
+ *op = EOS;
+
+ /* Check for a redefinition. */
+ for (n=st_nstr, s=st_list, ch=name[0]; --n >= 0; s++) {
+ if (*(s->st_name) == ch)
+ if (strcmp (s->st_name, name) == 0)
+ break;
+ }
+
+ /* Make a new entry?. */
+ if (n < 0) {
+ s = &st_list[st_nstr++];
+ if (st_nstr >= MAX_DEFSTR)
+ error (XPP_COMPERR, "Too many defined strings");
+
+ /* Put defined NAME in string buffer. */
+ for (s->st_name = st_next, (ip=name); (*st_next++ = *ip++); )
+ ;
+ }
+
+ /* Put value in string buffer.
+ */
+ s->st_value = st_next;
+ traverse ('"');
+ for (ip=yytext; (*st_next++ = *ip++) != EOS; )
+ ;
+ *st_next++ = EOS;
+
+ if (st_next - st_buf >= SZ_STBUF)
+ error (XPP_COMPERR, "Too many defined strings");
+}
+
+
+/* STR_FETCH -- Search the defined string table for the named string
+ * parameter and return a pointer to the string if found, NULL otherwise.
+ */
+char *
+str_fetch (register char *strname)
+{
+ register struct st_def *s = st_list;
+ register int n = st_nstr;
+ register char ch = strname[0];
+
+ while (--n >= 0) {
+ if (*(s->st_name) == ch)
+ if (strcmp (s->st_name, strname) == 0)
+ return (s->st_value);
+ s++;
+ }
+
+ return (NULL);
+}
+
+
+/* MACRO_REDEF -- Redefine the macro to automatically add a P2<T> macro
+ * to struct definitions.
+ */
+void
+macro_redef (void)
+{
+ register int nb=0;
+ register char *ip, *op, ch;
+ char name[SZ_FNAME];
+ char value[SZ_LINE];
+
+
+ outstr ("define\t");
+ memset (name, 0, SZ_FNAME);
+ memset (value, 0, SZ_LINE);
+
+ /* Skip to the first char of the name string.
+ */
+ ip = yytext;
+ while (isspace (*ip))
+ ip++;
+ while (!isspace (*ip))
+ ip++;
+ while (isspace (*ip))
+ ip++;
+
+ /* Extract macro name. */
+ for (op=name; (isalnum(*ip) || *ip == '_'); )
+ *op++ = *ip++;
+ *op = EOS;
+ outstr (name);
+ outstr ("\t");
+
+
+ /* Modify value.
+ */
+ op = value;
+ while ( (ch = input()) != EOF ) {
+ if (ch == '\n') {
+ break;
+ } else if (ch == '#') { /* eat a comment */
+ while ((ch = input()) != '\n')
+ ;
+ break;
+
+
+ } else {
+ if (ch == '[') {
+ nb++;
+ if (nb > 1) *op++ = '(';
+ } else if (ch == ']') {
+ nb--;
+ if (nb <= 0)
+ break;
+ else
+ *op++ = ')';
+ } else if (nb >= 1)
+ *op++ = ch;
+ }
+ }
+
+ outstr ("Memr(");
+ if (strcmp (value, "$1") == 0) {
+#if defined(MACH64) && defined(AUTO_P2R)
+ char *emsg[SZ_LINE];
+ int strict = 0;
+#endif
+
+ /* A macro such as "Memr[$1]" which is typically used as a
+ * shorthand for an array allocated as TY_REAL and not a part
+ * of a struct, however it might also be the first element of
+ * a struct. In this case, print a warning so it can be checked
+ * manually and just pass it through.
+ */
+#if defined(MACH64) && defined(AUTO_P2R)
+ memset (emsg, 0, SZ_LINE);
+ sprintf (emsg,
+ "Error in %s: line %d: ambiguous Memr for '%s' needs P2R/P2P",
+ fname[istkptr], linenum[istkptr], name);
+ if (strict)
+ error (XPP_COMPERR, emsg);
+ else
+ fprintf (stderr, "%s\n", emsg);
+#endif
+ outstr (value);
+
+ } else if (strncmp ("Mem", value, 3) == 0 || isupper (value[0])) {
+ /* In this case we assume a complex macro using some other
+ * Mem element or an upper-case macro. These are again used
+ * typically as a shorthand and use pointers directly, so pass
+ * it through unchanged.
+ */
+ outstr (value);
+
+ } else {
+ /* Assume it's part of a struct, e.g. "Memr[$1+N]".
+ *
+ * FIXME -- We should really be more careful to check the syntax.
+ fprintf (stderr, "INFO %s line %d: ",
+ fname[istkptr], linenum[istkptr]);
+ fprintf (stderr, "adding P2R macro for '%s'\n", name);
+ */
+#if defined(MACH64) && defined(AUTO_P2R)
+ if (value[0] == '$') {
+ outstr ("P2R(");
+ outstr (value);
+ outstr (")");
+ } else
+ outstr (value);
+#else
+ outstr (value);
+#endif
+ }
+ outstr (")\n");
+
+ linenum[istkptr]++;
+}
+
+
+/* SETLINE -- Set the file line number. Used by the first pass to set
+ * line number after processing an include file and in various other
+ * places. Necessary to get correct line numbers in error messages from
+ * the second pass.
+ */
+void
+setline (void)
+{
+ char msg[20];
+
+ if (istkptr == 0) { /* not in include file */
+ sprintf (msg, "#!# %d\n", linenum[istkptr] - 1);
+ outstr (msg);
+ }
+}
+
+
+/* OUTPUT -- Output a character. If we are processing the body of a procedure
+ * or a data statement, put the character into the output buffer. Otherwise
+ * put the character to the output file.
+ *
+ * NOTE -- the redirection logic shown below is duplicated in OUTSTR.
+ */
+void
+output (char ch)
+{
+ if (context & (BODY|DATASTMT)) {
+ /* In body of procedure or in a data statement (which is output
+ * just preceding the body).
+ */
+ *op++ = ch;
+ if (op >= &obuf[SZ_OBUF]) {
+ error (XPP_COMPERR, "Output buffer overflow");
+ _exit (1);
+ }
+ } else if (context & DECL) {
+ /* Output of a miscellaneous declaration in the declarations
+ * section.
+ */
+ *dp++ = ch;
+ if (dp >= &dbuf[SZ_DBUF]) {
+ error (XPP_COMPERR, "Declarations buffer overflow");
+ _exit (1);
+ }
+ } else {
+ /* Outside of a procedure.
+ */
+ putc (ch, yyout);
+ }
+}
+
+
+/* Datatype keywords for declarations. The special x$.. keywords are
+ * for communication with the second pass. Note that this table is machine
+ * dependent, since it maps char into type short.
+ */
+char *type_decl[] = RPP_TYPES;
+
+
+/* Intrinsic functions used for type coercion. These mappings are machine
+ * dependent (MACHDEP). If your machine has INTEGER*2 and INTEGER*4, and
+ * integer cannot be passed as an argument when a short or long is expected,
+ * and your compiler has INT2 and INT4 type coercion intrinsic functions,
+ * you should use those here instead of INT (which happens to work for a VAX).
+ * If you cannot pass an int when a short is expected (i.e., IBM), and you
+ * do not have an INT2 intrinsic function, you should provide an external
+ * INTEGER*2 function called "int2" and use that for type coercion. Note
+ * that it will then be necessary to have the preprocessor automatically
+ * generate a declaration for the function. This nonsense will all go away
+ * when we set up a proper table driven code generator!!
+ */
+char *intrinsic_function[] = {
+ "", /* table is one-indexed */
+ "(0 != ", /* bool(expr) */
+ "int", /* char(expr) */
+ "int", /* short(expr) */
+ "int", /* int(expr) */
+ "int", /* long(expr) */
+ "real", /* real(expr) */
+ "dble", /* double(expr) */
+ "cmplx", /* complex(expr) */
+ "int" /* pointer(expr) */
+};
+
+
+/* DO_TYPE -- Process a datatype keyword. The type of processing depends
+ * on whether we are called when processing a declaration or an expression.
+ * In expressions, the datatype keyword is the type coercion intrinsic
+ * function. DEFINE statements are a special case; we treat them as
+ * expressions, since macros containing datatype keywords are used in
+ * expressions more than in declarations. This is a kludge until the problem
+ * is properly resolved by processing macros BEFORE code generation.
+ * In the current implementation, macros are handled by the second pass (RPP).
+ */
+void
+do_type (int type)
+{
+ char ch;
+
+ if (context & (BODY|DEFSTMT)) {
+ switch (type) {
+ case XTY_BOOL:
+ for (ch=input(); ch == ' ' || ch == '\t'; ch=input())
+ ;
+ if (ch != '(')
+ error (XPP_SYNTAX, "Illegal boolean expr");
+ outstr (intrinsic_function[type]);
+ return;
+
+ case XTY_CHAR:
+ case XTY_SHORT:
+ case XTY_INT:
+ case XTY_LONG:
+ case XTY_REAL:
+ case XTY_DOUBLE:
+ case XTY_COMPLEX:
+ case XTY_POINTER:
+ outstr (intrinsic_function[type]);
+ return;
+
+ default:
+ error (XPP_SYNTAX, "Illegal type coercion");
+ }
+
+ } else {
+ /* UNREACHABLE when in declarations section of a procedure.
+ */
+ fprintf (yyout, "%s", type_decl[type]);
+ }
+}
+
+
+/* DO_CHAR -- Process a char array declaration. Add "+1" to the first
+ * dimension to allow space for the EOS. Called after LEX has recognized
+ * "char name[". If we reach the closing ']', convert it into a right paren
+ * for the second pass.
+ */
+void
+do_char (void)
+{
+ char ch;
+
+ for (ch=input(); ch != ',' && ch != ']'; ch=input())
+ if (ch == '\n' || ch == EOS) {
+ error (XPP_SYNTAX, "Missing comma or ']' in char declaration");
+ unput ('\n');
+ return;
+ } else
+ output (ch);
+
+ outstr ("+1");
+ if (ch == ']')
+ output (')');
+ else
+ output (ch);
+}
+
+
+/* SKIP_HELPBLOCK -- Skip over a help block (documentation section).
+ */
+void
+skip_helpblock (void)
+{
+ char ch;
+
+
+ /* fgets() no longer works with FLEX
+ while (fgets (yytext, SZ_LINE, yyin) != NULL) {
+ if (istkptr == 0)
+ linenum[istkptr]++;
+
+ if (yytext[0] == '.' && (yytext[1] == 'e' || yytext[1] == 'E')) {
+ yytext[8] = EOS;
+ if (strcmp (&yytext[1], "endhelp") == 0 ||
+ strcmp (&yytext[1], "ENDHELP") == 0)
+ break;
+ }
+ }
+ */
+
+ while ( (ch = input()) != EOF ) {
+ if (ch == '.') { /* check for ".endhelp" */
+ ch = input ();
+ if (ch == 'e' || ch == 'E') {
+ for (ch = input() ; ch != '\n' && ch != EOS; ch=input())
+ ;
+ break;
+ } else
+ for (ch = input() ; ch != '\n' && ch != EOS; ch=input())
+ ;
+
+ } else if (ch == '\n') { /* skip line */
+ ;
+ } else {
+ for (ch=input(); ch != '\n' && ch != EOS; ch=input())
+ ;
+ }
+ if (istkptr == 0)
+ linenum[istkptr]++;
+ }
+}
+
+
+/* PARSE_TASK_STATEMENT -- Parse the task statement, building up a list
+ * of task_name/procedure_name structures in the "task_list" array.
+ *
+ * task task1, task2, task3=proc3, task4, ...
+ *
+ * Task names are placed in the string buffer as one big string, with EOS
+ * delimiters between the names. This "dictionary" string is converted
+ * into a data statement at "end_code" time, along with any other strings
+ * in the runtask procedure. The procedure names, which may differ from
+ * the task names, are saved in the upper half of the output buffer. We can
+ * do this because we know that the runtask procedure is small and will not
+ * come close to filling up the output buffer, which buffers only the body
+ * of the procedure currently being processed.
+ * N.B.: Upon entry, the input is left positioned to just past the "task"
+ * keyword.
+ */
+int
+parse_task_statement (void)
+{
+ register struct task *tp;
+ register char ch, *ip;
+ char task_name[SZ_FNAME], proc_name[SZ_FNAME];
+ int name_offset;
+
+ /* Set global pointers to where we put task and proc name strings.
+ */
+ sp = sbuf;
+ op = &obuf[SZ_OBUF/2];
+ name_offset = 1;
+
+ for (ntasks=0; ntasks < MAX_TASKS; ntasks++) {
+ /* Process "taskname" or "taskname=procname". There must be
+ * at least one task name in the declaration.
+ */
+ if (get_task (task_name, proc_name, SZ_FNAME) == ERR)
+ return (ERR);
+
+ /* Set up the task declaration structure, and copy name strings
+ * into the string buffers.
+ */
+ tp = &task_list[ntasks];
+ tp->task_name = sp;
+ tp->proc_name = op;
+ tp->name_offset = name_offset;
+ name_offset += strlen (task_name) + 1;
+
+ for (ip=task_name; (*sp++ = *ip++) != EOS; )
+ if (sp >= &sbuf[SZ_SBUF])
+ goto err;
+ for (ip=proc_name; (*op++ = *ip++) != EOS; )
+ if (op >= &obuf[SZ_OBUF])
+ goto err;
+
+ /* If the next character is a comma, skip it and a newline if
+ * one follows and continue processing. If the next character is
+ * a newline, we are done. Any other character is an error.
+ * Note that nextch skips whitespace and comments.
+ */
+ ch = nextch();
+ if (ch == ',') {
+ if ((ch = nextch()) != '\n')
+ unput (ch);
+ } else if (ch == '\n') {
+ linenum[istkptr]++;
+ ntasks++; /* end of task statement */
+ break;
+ } else
+ return (ERR);
+ }
+
+ if (ntasks >= MAX_TASKS) {
+err: error (XPP_COMPERR, "too many tasks in task statement");
+ return (ERR);
+ }
+
+ /* Set up the task name dictionary string so that it gets output
+ * as a data statement when the runtask procedure is output.
+ */
+ string_list[0].str_name = "dict";
+ string_list[0].str_text = sbuf;
+ string_list[0].str_length = (sp - sbuf);
+ nstrings = 1;
+
+ /* Leave the output buffer pointer pointing to the first half of
+ * the buffer.
+ */
+ op = obuf;
+ return (OK);
+}
+
+
+/* GET_TASK -- Process a single task declaration of the form "taskname" or
+ * "taskname = procname".
+ */
+int
+get_task (char *task_name, char *proc_name, int maxch)
+{
+ register char ch;
+
+ /* Get task name.
+ */
+ if (get_name (task_name, maxch) == ERR)
+ return (ERR);
+
+ /* Get proc name if given, otherwise the procedure name is assumed
+ * to be the same as the task name.
+ */
+ if ((ch = nextch()) == '=') {
+ if (get_name (proc_name, maxch) == ERR)
+ return (ERR);
+ } else {
+ unput (ch);
+ strncpy (proc_name, task_name, maxch);
+ }
+
+ return (XOK);
+}
+
+
+/* GET_NAME -- Extract identifier from input, placing in the output string.
+ * ERR is returned if the output string overflows, or if the token is not
+ * a legal identifier.
+ */
+int
+get_name (char *outstr, int maxch)
+{
+ register char ch, *op;
+ register int nchars;
+
+ unput ((ch = nextch())); /* skip leading whitespace */
+
+ for (nchars=0, op=outstr; nchars < maxch; nchars++) {
+ ch = input();
+ if (isalpha(ch)) {
+ if (isupper(ch))
+ *op++ = tolower(ch);
+ else
+ *op++ = ch;
+ } else if ((isdigit(ch) && nchars > 0) || ch == '_' || ch == '$') {
+ *op++ = ch;
+ } else {
+ *op++ = EOS;
+ unput (ch);
+ return (nchars > 0 ? XOK : ERR);
+ }
+ }
+
+ return (ERR);
+}
+
+
+/* NEXTCH -- Get next nonwhite character from the input stream. Ignore
+ * comments. Newline is not considered whitespace.
+ */
+int
+nextch (void)
+{
+ register char ch;
+
+ while ((ch = input()) != EOF) {
+ if (ch == '#') { /* discard comment */
+ while ((ch = input()) != '\n')
+ ;
+ return (ch);
+ } else if (ch != ' ' && ch != '\t')
+ return (ch);
+ }
+ return (EOF);
+}
+
+
+/* PUT_DICTIONARY -- We are called when the keyword TN$DECL is encountered,
+ * i.e., while processing "sysruk.x". This should only happen after the
+ * task statement has been successfully processed. Our function is to replace
+ * the TN$DECL macro by the declarations for the DP and DICT structures.
+ * DP is an integer array giving the offsets of the task name strings in DICT,
+ * the dictionary string buffer.
+ */
+#define NDP_PERLINE 8 /* num DP data elements per line */
+
+void
+put_dictionary (void)
+{
+ register struct task *tp;
+ char buf[SZ_LINE];
+ int i, j, offset;
+
+ /* Discard anything found on line after the TN$DECL, which is only
+ * recognized as the first token on the line.
+ */
+ while (input() != '\n')
+ ;
+ unput ('\n');
+
+ /* Output the data statements required to initialize the DP array.
+ * These statements are spooled into the output buffer and not output
+ * until all declarations have been processed, since the Fortran std
+ * requires that data statements follow declarations.
+ */
+ pushcontext (DATASTMT);
+ tp = task_list;
+
+ for (j=0; j <= ntasks; j += NDP_PERLINE) {
+ if (!strloopdecl++) {
+ pushcontext (DECL);
+ sprintf (buf, "%s\tiyy\n", type_decl[TY_INT]);
+ outstr (buf);
+ popcontext();
+ }
+
+ sprintf (buf, "data\t(dp(iyy),iyy=%2d,%2d)\t/",
+ j+1, min (j+NDP_PERLINE, ntasks+1));
+ outstr (buf);
+
+ for (i=j; i < j+NDP_PERLINE && i <= ntasks; i++) {
+ offset = (tp++)->name_offset;
+ if (i >= ntasks)
+ sprintf (buf, "%2d/\n", XEOS);
+ else if (i == j + NDP_PERLINE - 1)
+ sprintf (buf, "%4d/\n", offset==EOS ? XEOS: offset);
+ else
+ sprintf (buf, "%4d,", offset==EOS ? XEOS: offset);
+ outstr (buf);
+ }
+ }
+
+ popcontext();
+
+ /* Output type declarations for the DP and DICT arrays. The string
+ * descriptor for string 0 (dict) was prepared when the TASK statement
+ * was processed.
+ */
+ sprintf (buf, "%s\tdp(%d)\n", type_decl[XTY_INT], ntasks + 1);
+ outstr (buf);
+ sprintf (buf, "%s\tdict(%d)\n", type_decl[XTY_CHAR],
+ string_list[0].str_length);
+ outstr (buf);
+}
+
+
+/* PUT_INTERPRETER -- Output the statements necessary to scan the dictionary
+ * for a task and call the associated procedure. We are called when the
+ * keyword TN$INTERP is encountered in the input stream.
+ */
+void
+put_interpreter (void)
+{
+ char lbuf[SZ_LINE];
+ int i;
+
+ while (input() != '\n') /* discard rest of line */
+ ;
+ unput ('\n');
+
+ for (i=0; i < ntasks; i++) {
+ sprintf (lbuf, "\tif (streq (task, dict(dp(%d)))) {\n", i+1);
+ outstr (lbuf);
+ sprintf (lbuf, "\t call %s\n", task_list[i].proc_name);
+ outstr (lbuf);
+ sprintf (lbuf, "\t return (OK)\n");
+ outstr (lbuf);
+ sprintf (lbuf, "\t}\n");
+ outstr (lbuf);
+ }
+}
+
+
+/* OUTSTR -- Output a string. Depending on the context, the string will
+ * either go direct to the output file, or will be buffered in the output
+ * buffer.
+ */
+void
+outstr (char *string)
+{
+ register char *ip;
+
+
+ if (context & (BODY|DATASTMT)) {
+ /* In body of procedure or in a data statement (which is output
+ * just preceding the body).
+ */
+ for (ip=string; (*op++ = *ip++) != EOS; )
+ ;
+ if (--op >= &obuf[SZ_OBUF]) {
+ error (XPP_COMPERR, "Output buffer overflow");
+ _exit (1);
+ }
+ } else if (context & DECL) {
+ /* Output of a miscellaneous declaration in the declarations
+ * section.
+ */
+ for (ip=string; (*dp++ = *ip++) != EOS; )
+ ;
+ if (--dp >= &dbuf[SZ_DBUF]) {
+ error (XPP_COMPERR, "Declarations buffer overflow");
+ _exit (1);
+ }
+ } else {
+ /* Outside of a procedure.
+ */
+ fputs (string, yyout);
+ }
+}
+
+
+/* BEGIN_CODE -- Code that gets executed when the keyword BEGIN is encountered,
+ * i.e., when we begin processing the executable part of a procedure
+ * declaration.
+ */
+void
+begin_code (void)
+{
+ char text[1024];
+
+ /* If we are already processing the body of a procedure, we probably
+ * have a missing END.
+ */
+ if (context & BODY)
+ xpp_warn ("Unmatched BEGIN statement");
+
+ /* Set context flag noting that we are processing the body of a
+ * procedure. Output the BEGIN statement, for the benefit of the
+ * second pass (RPP), which needs to know where the procedure body
+ * begins.
+ */
+ setcontext (BODY);
+ d_runtime (text); outstr (text);
+ outstr ("begin\n");
+ linenum[istkptr]++;
+
+ /* Initialization. */
+ nbrace = 0;
+ nswitch = 0;
+ str_idnum = 1;
+ errhand = NO;
+ errchk = NO;
+}
+
+
+/* END_CODE -- Code that gets executed when the keyword END is encountered
+ * in the input. If error checking is used in the procedure, we must declare
+ * the boolean function XERPOP. If any switches are employed, we must declare
+ * the switch variables. Next we format and output data statements for any
+ * strings encountered while processing the procedure body. If the procedure
+ * being processed is sys_runtask, the task name dictionary string is also
+ * output. Finally, we output the spooled procedure body, followed by and END
+ * statement for the benefit of the second pass.
+ */
+void
+end_code (void)
+{
+ int i;
+
+ /* If the END keyword is encountered outside of the body of a
+ * procedure, we leave it alone.
+ */
+ if (!(context & BODY)) {
+ outstr (yytext);
+ return;
+ }
+
+ /* Output argument and local variable declarations (see decl.c).
+ * Note d_enter may have been called during processing of the body
+ * of a procedure to make entries in the symbol table for intrinsic
+ * functions, switch variables, etc. (this is not currently done).
+ */
+ d_codegen (yyout);
+
+ setcontext (GLOBAL);
+
+ /* Output declarations for error checking and switches. All variables
+ * and functions must be declared.
+ */
+ if (errhand)
+ fprintf (yyout, "x$bool xerpop\n");
+ if (errchk)
+ fprintf (yyout, "errchk error, erract\n");
+ errhand = NO;
+ errchk = NO;
+
+ if (nswitch) { /* declare switch variables */
+ fprintf (yyout, "%s\t", type_decl[XTY_INT]);
+ for (i=1; i < nswitch; i++)
+ fprintf (yyout, "SW%04d,", i);
+ fprintf (yyout, "SW%04d\n", i);
+ }
+
+ /* Output any miscellaneous declarations. These include ERRCHK and
+ * COMMON declarations - anything not a std type declaration or a
+ * data statement declaration.
+ */
+ *dp++ = EOS;
+ fputs (dbuf, yyout); fflush (yyout);
+{ int i; for (i=0; i < SZ_DBUF; ) dbuf[i++] = '\0'; }
+ dp = dbuf;
+
+ /* Output the SAVE statement, which must come after all declarations
+ * and before any DATA statements.
+ */
+ fputs ("save\n", yyout);
+
+ /* Output data statements to initialize character strings, followed
+ * by any runtime procedure entry initialization statments, followed
+ * by the spooled text in the output buffer, followed by the END.
+ * Clear the string and output buffers. Any user data statements
+ * will already have been moved into the output buffer, and they
+ * will come out at the end of the declarations section regardless
+ * of where they were given in the declarations section. Data stmts
+ * are not permitted in the procedure body.
+ */
+ init_strings();
+ *op++ = EOS;
+ fputs (obuf, yyout); fflush (yyout);
+{ int i; for (i=0; i < SZ_OBUF; ) obuf[i++] = '\0'; }
+ fputs ("end\n", yyout); fflush (yyout);
+
+ op = obuf;
+ *op = EOS;
+ sp = sbuf;
+
+ if (nbrace != 0) {
+ error (XPP_SYNTAX, "Unmatched brace");
+ nbrace = 0;
+ }
+}
+
+
+#define BIG_STRING 9
+#define NPERLINE 8
+
+/* INIT_STRINGS -- Output data statements to initialize all strings in a
+ * procedure ("string" declarations, inline strings, and the runtask
+ * dictionary). Strings are implemented as integer arrays, using the
+ * smallest integer datatype provided by the host Fortran compiler, usually
+ * INTEGER*2 (XTY_CHAR).
+ */
+void
+init_strings (void)
+{
+ register int str;
+
+ if (nstrings)
+ for (str=0; str < nstrings && !strloopdecl; str++)
+ if (string_list[str].str_length >= BIG_STRING) {
+ fprintf (yyout, "%s\tiyy\n", type_decl[XTY_INT]);
+ strloopdecl++;
+ }
+
+ for (str=0; str < nstrings; str++)
+ write_string_data_statement (&string_list[str]);
+
+ sp = sbuf; /* clear string buffer */
+ nstrings = 0;
+ strloopdecl = 0;
+}
+
+
+/* WRITE_STRING_DATA_STATEMENT -- Output data statement to initialize a single
+ * string. If short string, output a simple whole-array data statement
+ * that fits all on one line. Large strings are initialized with multiple
+ * data statements, each of which initializes a section of the string
+ * using a dummy subscript. This is thought to be more portable than
+ * a single large data statement with continuation, because the number of
+ * continuation cards permitted in a data statement depends on the compiler.
+ * The loop variable in an implied do loop in a data statement must be declared
+ * on some compilers (crazy but true). Determine if we will be generating any
+ * implied dos and declare the variable if so.
+ */
+void
+write_string_data_statement (struct string *s)
+{
+ register int i, len;
+ register char *ip;
+ char ch, *name;
+ int j;
+
+ name = s->str_name;
+ ip = s->str_text;
+ len = s->str_length;
+
+ if (len < BIG_STRING) {
+ fprintf (yyout, "data\t%s\t/", name);
+ for (i=0; i < len-1; i++) {
+ if ((ch = *ip++) == EOS)
+ fprintf (yyout, "%3d,", XEOS);
+ else
+ fprintf (yyout, "%3d,", ch);
+ }
+ fprintf (yyout, "%2d/\n", XEOS);
+
+ } else {
+ for (j = 0; j < len; j += NPERLINE) {
+ fprintf (yyout, "data\t(%s(iyy),iyy=%2d,%2d)\t/",
+ name, j+1, min(j+NPERLINE, len));
+ for (i=j; i < j+NPERLINE; i++) {
+ if (i >= len-1) {
+ fprintf (yyout, "%2d/\n", XEOS);
+ return;
+ } else if (i == j+NPERLINE-1) {
+ fprintf (yyout, "%3d/\n", ip[i]==EOS ? XEOS: ip[i]);
+ } else
+ fprintf (yyout, "%3d,", ip[i]==EOS ? XEOS: ip[i]);
+ }
+ }
+ }
+}
+
+
+/* DO_STRING -- Process a STRING declaration or inline string. Add a new
+ * string descriptor to the string list, copy text of string into sbuf,
+ * save name of string array in sbuf. If inline string, manufacture the
+ * name of the string array.
+ */
+void
+do_string (
+ char delim, /* char which delimits string */
+ int strtype /* string type */
+)
+{
+ register char ch, *ip;
+ register struct string *s;
+ int readstr = 1;
+ char *str_uniqid();
+
+ /* If we run out of space for string storage, print error message,
+ * dump string decls out early, clear buffer and continue processing.
+ */
+ if (nstrings >= MAX_STRINGS) {
+ error (XPP_COMPERR, "Too many strings in procedure");
+ init_strings();
+ }
+
+ s = &string_list[nstrings];
+
+ switch (strtype) {
+
+ case STR_INLINE:
+ case STR_DEFINE:
+ /* Inline strings are implemented as Fortran arrays; generate a
+ * dummy name for the array and set up the descriptor.
+ * Defined strings are inline strings, but the name of the text of
+ * the string is already in yytext when we are called.
+ */
+ s->str_name = sp;
+ for (ip = str_uniqid(); (*sp++ = *ip++) != EOS; )
+ ;
+ sbuf_check();
+ break;
+
+ case STR_DECL:
+ /* String declaration. Read in name of string, used as name of
+ * Fortran array.
+ */
+ ch = nextch(); /* skip whitespace */
+ if (!isalpha (ch))
+ goto sterr;
+ s->str_name = sp;
+ *sp++ = ch;
+
+ /* Get rest of string name identifier. */
+ while ((ch = input()) != EOF) {
+ if (isalnum(ch) || ch == '_') {
+ *sp++ = ch;
+ sbuf_check();
+ } else if (ch == '\n') {
+sterr: error (XPP_SYNTAX, "String declaration syntax");
+ while (input() != '\n')
+ ;
+ unput ('\n');
+ return;
+ } else {
+ *sp++ = EOS;
+ break;
+ }
+ }
+
+ /* Advance to the ' or " string delimiter, in preparation for
+ * processing the string itself. If syntax error occurs, skip
+ * to newline to avoid spurious error messages. If the string
+ * is not quoted the string value field is taken to be the name
+ * of a string DEFINE.
+ */
+ delim = nextch();
+
+ if (!(delim == '"' || delim == '\'')) {
+ register char *ip, *op;
+ int ch;
+ char *str_fetch();
+
+ /* Fetch name of defined macro into yytext.
+ */
+ op = yytext;
+ *op++ = delim;
+ while ((ch = input()) != EOF)
+ if (isalnum(ch) || ch == '_')
+ *op++ = ch;
+ else
+ break;
+ unput (ch);
+ *op = EOS;
+
+ /* Fetch body of string into yytext.
+ */
+ if ((ip = str_fetch (yytext)) != NULL) {
+ yyleng = 0;
+ for (op=yytext; (*op++ = *ip++) != EOS; )
+ yyleng++;
+ readstr = 0;
+ } else {
+ error (XPP_SYNTAX,
+ "Undefined macro referenced in string declaration");
+ }
+ }
+
+ break;
+ }
+
+ /* Get the text of the string. Process escape sequences. String may
+ * not span multiple lines. In the case of a defined string, the text
+ * of the string will already be in yytext.
+ */
+ s->str_text = sp;
+ if (readstr && strtype != STR_DEFINE)
+ traverse (delim); /* process string into yytext */
+ strcpy (sp, yytext);
+ sp += yyleng + 1;
+ s->str_length = yyleng + 1;
+ sbuf_check();
+
+ /* Output array declaration for string. We want the declaration to
+ * go into the miscellaneous declarations buffer, so toggle the
+ * the context to DECL before calling OUTSTR.
+ */
+ {
+ char lbuf[SZ_LINE];
+
+ pushcontext (DECL);
+ sprintf (lbuf, "%s\t%s(%d)\n", type_decl[XTY_CHAR], s->str_name,
+ s->str_length);
+ outstr (lbuf);
+ popcontext();
+ }
+
+ /* If inline string, replace the quoted string by the name of the
+ * string variable. This text goes into the output buffer, rather
+ * than directly to the output file as is the case with the declaration
+ * above.
+ */
+ if (strtype == STR_INLINE || strtype == STR_DEFINE)
+ outstr (s->str_name);
+
+ if (++nstrings >= MAX_STRINGS)
+ error (XPP_COMPERR, "Too many strings in procedure");
+}
+
+
+/* DO_HOLLERITH -- Process and output a Fortran string. If the output
+ * compiler is Fortran 77, we output a quoted string; otherwise we output
+ * a hollerith string. Fortran (packed) strings appear in the SPP source
+ * as in the statement 'call_f77_sub (arg, *"any string", arg)'. Escape
+ * sequences are not recognized.
+ */
+void
+do_hollerith (void)
+{
+ register char *op;
+ char strbuf[SZ_LINE], outbuf[SZ_LINE];
+ int len;
+
+ /* Read the string into strbuf. */
+ for (op=strbuf, len=0; (*op = input()) != '"'; op++, len++)
+ if (*op == '\n' || *op == EOF)
+ break;
+ if (*op == '\n')
+ error (XPP_COMPERR, "Packed string not delimited");
+ else
+ *op = EOS; /* delete delimiter */
+
+#ifdef F77
+ sprintf (outbuf, "\'%s\'", strbuf);
+#else
+ sprintf (outbuf, "%dH%s", i, strbuf);
+#endif
+
+ outstr (outbuf);
+}
+
+
+/* SBUF_CHECK -- Check to see that the string buffer has not overflowed.
+ * It is a fatal error if it does.
+ */
+void
+sbuf_check (void)
+{
+ if (sp >= &sbuf[SZ_SBUF]) {
+ error (XPP_COMPERR, "String buffer overflow");
+ _exit (1);
+ }
+}
+
+
+/* STR_UNIQID -- Generate a unit identifier name for an inline string.
+ */
+char *
+str_uniqid (void)
+{
+ static char id[] = "ST0000";
+
+ sprintf (&id[2], "%04d", str_idnum++);
+ return (id);
+}
+
+
+/* TRAVERSE -- Called by the lexical analyzer when a quoted string has
+ * been recognized. Characters are input and deposited in yytext (the
+ * lexical analyzer token buffer) until the trailing quote is seen.
+ * Strings may not span lines unless the newline is delimited. The
+ * recognized escape sequences are converted upon input; all others are
+ * left alone, presumably to later be converted by other code.
+ * Quotes may be included in the string by escaping them, or by means of
+ * the double quote convention.
+ */
+void
+traverse (char delim)
+{
+ register char *op, *cp, ch;
+ char *index();
+
+
+ for (op=yytext; (*op = input()) != EOF; op++) {
+ if (*op == delim) {
+ if ((*op = input()) == EOF)
+ break;
+ if (*op == delim)
+ continue; /* double quote convention; keep one */
+ else {
+ unput (*op);
+ break; /* normal exit */
+ }
+
+ } else if (*op == '\n') { /* error recovery exit */
+ unput ('\n');
+ xpp_warn ("Newline while processing string");
+ break;
+
+ } else if (*op == '\\') {
+ if ((*op = input()) == EOF) {
+ break;
+ } else if (*op == '\n') {
+ --op; /* explicit continuation */
+ continue;
+ } else if ((cp = index (esc_ch, *op)) != NULL) {
+ *op = esc_val[cp-esc_ch];
+ } else if (isdigit (*op)) { /* '\0DD' octal constant */
+ *op -= '0';
+ while (isdigit (ch = input()))
+ *op = (*op * 8) + (ch - '0');
+ unput (ch);
+ } else {
+ ch = *op; /* unknown escape sequence, */
+ *op++ = '\\'; /* leave it alone. */
+ *op = ch;
+ }
+ }
+ }
+
+ *op = EOS;
+ yyleng = (op - yytext);
+}
+
+
+/* ERROR -- Output an error message and set exit flag so that no linking occurs.
+ * Do not abort compiler, however, because it is better to keep going and
+ * find all the errors in a single compilation.
+ */
+void
+error (int errcode, char *errmsg)
+{
+ fprintf (stderr, "Error on line %d of %s: %s\n", linenum[istkptr],
+ fname[istkptr], errmsg);
+ fflush (stderr);
+ errflag |= errcode;
+}
+
+
+/* WARN -- Output a warning message. Do not set exit flag since this is only
+ * a warning message; linking should occur if there are not any more serious
+ * errors.
+ */
+void
+xpp_warn (char *warnmsg)
+{
+ fprintf (stderr, "Warning on line %d of %s: %s\n", linenum[istkptr],
+ fname[istkptr], warnmsg);
+ fflush (stderr);
+}
+
+
+/* ACCUM -- Code for conversion of numeric constants to decimal. Convert a
+ * character string to a binary integer constant, doing the conversion in the
+ * indicated base.
+ */
+long
+accum (int base, char **strp)
+{
+ register char *ip;
+ long sum;
+ char digit;
+
+ sum = 0;
+ ip = *strp;
+
+ switch (base) {
+ case OCTAL:
+ case DECIMAL:
+ for (digit = *ip++; isdigit (digit); digit = *ip++)
+ sum = sum * base + (digit - '0');
+ *strp = ip - 1;
+ break;
+ case HEX:
+ while ((digit = *ip++) != EOF) {
+ if (isdigit (digit))
+ sum = sum * base + (digit - '0');
+ else if (digit >= 'a' && digit <= 'f')
+ sum = sum * base + (digit - 'a' + 10);
+ else if (digit >= 'A' && digit <= 'F')
+ sum = sum * base + (digit - 'A' + 10);
+ else {
+ *strp = ip;
+ break;
+ }
+ }
+ break;
+ default:
+ error (XPP_COMPERR, "Accum: unknown numeric base");
+ return (ERR);
+ }
+
+ return (sum);
+}
+
+
+/* CHARCON -- Convert a character constant to a binary integer value.
+ * The regular escape sequences are recognized; numeric values are assumed
+ * to be octal.
+ */
+int
+charcon (char *string)
+{
+ register char *ip, ch;
+ char *cc, *index();
+ char *nump;
+
+ ip = string + 1; /* skip leading apostrophe */
+ ch = *ip++;
+
+ /* Handle '\c' and '\0dd' notations.
+ */
+ if (ch == '\\') {
+ if ((cc = index (esc_ch, *ip)) != NULL) {
+ return (esc_val[cc-esc_ch]);
+ } else if (isdigit (*ip)) {
+ nump = ip;
+ return (accum (OCTAL, &nump));
+ } else
+ return (ch);
+ } else {
+ /* Regular characters, i.e., 'c'; just return ASCII value of char.
+ */
+ return (ch);
+ }
+}
+
+
+/* INT_CONSTANT -- Called to decode an integer constant, i.e., a decimal, hex,
+ * octal, or sexagesimal number, or a character constant. The numeric string
+ * is converted in the indicated base and replaced by its decimal value.
+ */
+void
+int_constant (char *string, int base)
+{
+ char decimal_constant[SZ_NUMBUF], *p;
+ long accum(), value;
+ int i;
+
+ p = string;
+ i = strlen (string);
+
+ switch (base) {
+ case DECIMAL:
+ value = accum (10, &p);
+ break;
+ case SEXAG:
+ value = accum (10, &p);
+ break;
+ case OCTAL:
+ value = accum (8, &p);
+ break;
+ case HEX:
+ value = accum (16, &p);
+ break;
+
+ case CHARCON:
+ while ((p[i] = input()) != EOF) {
+ if (p[i] == '\n') {
+ error (XPP_SYNTAX, "Undelimited character constant");
+ return;
+ } else if (p[i] == '\\') {
+ p[++i] = input();
+ i++;
+ continue;
+ } else if (p[i] == '\'')
+ break;
+ i += 1;
+ }
+ value = charcon (p);
+ break;
+
+ default:
+ error (XPP_COMPERR, "Unknown numeric base for integer conversion");
+ value = ERR;
+ }
+
+ /* Output the decimal value of the integer constant. We are simply
+ * replacing the SPP constant by a decimal constant.
+ */
+ sprintf (decimal_constant, "%ld", value);
+ outstr (decimal_constant);
+}
+
+
+/* HMS -- Convert number in HMS format into a decimal constant, and output
+ * in that form. Successive : separated fields are scaled to 1/60 th of
+ * the preceeding field. Thus "12:30" is equivalent to "12.5". Some care
+ * is taken to preserve the precision of the number.
+ */
+void
+hms (char *number)
+{
+ char cvalue[SZ_NUMBUF], *ip;
+ int bvalue, ndigits;
+ long scale = 10000000;
+ long units = 1;
+ long value = 0;
+
+ for (ndigits=0, ip=number; *ip; ip++)
+ if (isdigit (*ip))
+ ndigits++;
+
+ /* Get the unscaled base value part of the number. */
+ ip = number;
+ bvalue = accum (DECIMAL, &ip);
+
+ /* Convert any sexagesimal encoded fields. */
+ while (*ip == ':') {
+ ip++;
+ units *= 60;
+ value += (accum (DECIMAL, &ip) * scale / units);
+ }
+
+ /* Convert the fractional part of the number, if any.
+ */
+ if (*ip++ == '.')
+ while (isdigit (*ip)) {
+ units *= 10;
+ value += (*ip++ - '0') * scale / units;
+ }
+
+ /* Format the output number. */
+ if (ndigits > MIN_REALPREC)
+ sprintf (cvalue, "%d.%ldD0", bvalue, value);
+ else
+ sprintf (cvalue, "%d.%ld", bvalue, value);
+ cvalue[ndigits+1] = '\0';
+
+ /* Print the translated number. */
+ outstr (cvalue);
+}
+
+
+/*
+ * Revision history (when i remembered) --
+ *
+ * 14-Dec-82: Changed hms conversion, to produce degrees or hours,
+ * rather than seconds (lex pattern, add hms, delete ':'
+ * action from accum).
+ *
+ * 10-Mar-83 Broke C code and Lex code into separate files.
+ * Added support for error handling.
+ * Added additional type coercion functions.
+ *
+ * 20-Mar-83 Modified processing of TASK stmt to use file inclusion
+ * to read the RUNTASK file, making it possible to maintain
+ * the IRAF main as a .x file, rather than as a .r file.
+ *
+ * Dec-83 Fixed bug in processing of TASK stmt which prevented
+ * compilation of processes with many tasks. Added many
+ * comments and cleaned up the code a bit.
+ */
diff --git a/unix/boot/spp/xpp/xppcode.c.bak b/unix/boot/spp/xpp/xppcode.c.bak
new file mode 100644
index 00000000..6db614bb
--- /dev/null
+++ b/unix/boot/spp/xpp/xppcode.c.bak
@@ -0,0 +1,1705 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#include <stdio.h>
+#include <ctype.h>
+#include "xpp.h"
+
+#define import_spp
+#include <iraf.h>
+
+/*
+ * C code for the first pass of the IRAF subset preprocessor (SPP).
+ * The decision to initially organize the SPP compiler into two passes was
+ * made to permit maximum use of the existing raftor preprocessor, which is
+ * the basis for the second pass of the SPP. Eventually the two passes
+ * should be combined into a single program. Most of the operations performed
+ * by the first pass (XPP) should be performed AFTER macro substitution,
+ * rather than before as is the case in the current implementation, which
+ * processes macros in the second pass (RPP).
+ *
+ * Beware that this is not a very good program which was not carefully
+ * designed and which was never intended to have a long lifetime. The next
+ * step is to replace the two passes by a single program which is functionally
+ * very similar, but which is more carefully engineered and which is written
+ * in the SPP language calling IRAF file i/o. Eventually a true compiler
+ * will be written, providing many new features, i.e., structures and pointers,
+ * automatic storage class, mapped arrays, enhanced i/o support, and good
+ * compile time error checking. This compiler will also feature a table driven
+ * code generator (generating primitive Fortran statements), which will provide
+ * greater machine independence.
+ */
+
+
+extern char *vfn2osfn();
+
+/* Escape sequence characters and their binary equivalents.
+ */
+char *esc_ch = "ntfr\\\"'";
+char *esc_val = "\n\t\f\r\\\"\'";
+
+/* External and internal data stuctures. We need access to the LEX i/o
+ * buffers because we use the LEX i/o macros, which provide pushback,
+ * because we must change the streams to process includes, and so on.
+ * These definitions are VERY Lex dependent.
+ */
+extern char yytext[]; /* LEX character buffer */
+extern int yyleng; /* length of string in yytext */
+extern FILE *yyin, *yyout; /* LEX input, output files */
+
+extern char yytchar, *yysptr, yysbuf[];
+extern int yylineno;
+
+#define U(x) x
+/*
+#define input() (((yytchar=yysptr>yysbuf?U(*--yysptr):getc(yyin))==10\
+?(yylineno++,yytchar):yytchar)==EOF?0:yytchar)
+#define unput(c) {yytchar= (c);if(yytchar=='\n')yylineno--;*yysptr++=yytchar;}
+*/
+
+extern int input();
+extern void yyunput();
+extern char *yytext_ptr;
+#define unput(c) yyunput( c, (yytext_ptr) )
+
+
+
+int context = GLOBAL; /* lexical context variable */
+extern int hbindefs, foreigndefs;
+char *machdefs[] = { "mach.h", "config.h", "" };
+
+/* The task structure is used for TASK declarations. Since this is a
+ * throwaway program we do not bother with dynamic storage allocation,
+ * which would remove the limit on the number of tasks in a task statment.
+ */
+struct task {
+ char *task_name; /* logical task name */
+ char *proc_name; /* name of procedure */
+ short name_offset; /* offset of name in dictionary */
+};
+
+/* The string structure is used for STRING declarations and for inline
+ * strings. Strings are stored in a fixed size, statically allocated
+ * string buffer.
+ */
+struct string {
+ char *str_name; /* name of string */
+ char *str_text; /* ptr to text of string */
+ short str_length; /* length of string */
+};
+
+struct task task_list[MAX_TASKS];
+struct string string_list[MAX_STRINGS];
+
+FILE *istk[MAX_INCLUDE]; /* stack for input file descriptors */
+int linenum[MAX_INCLUDE]; /* line numbers in files */
+char fname[MAX_INCLUDE][SZ_PATHNAME];/* file names */
+int istkptr = 0; /* istk pointer */
+
+char obuf[SZ_OBUF]; /* buffer for body of procedure */
+char dbuf[SZ_DBUF]; /* buffer for misc proc. decls. */
+char sbuf[SZ_SBUF]; /* string buffer */
+char *sp = sbuf; /* string buffer pointer */
+char *op = obuf; /* pointer in output buffer */
+char *dp = dbuf; /* pointer in decls buffer */
+int nstrings = 0; /* number of strings so far */
+int strloopdecl; /* data dummy do index declared? */
+
+int ntasks = 0; /* number of tasks in interpreter */
+int str_idnum = 0; /* for generating unique string names */
+int nbrace = 0; /* must be zero when "end" is reached */
+int nswitch = 0; /* number switch stmts in procedure */
+int errflag;
+int errhand = NO; /* set if proc employs error handler */
+int errchk = NO; /* set if proc employs error checking */
+
+
+/* SKIPNL -- Skip to newline, e.g., when a comment is encountered.
+ */
+skipnl()
+{
+ int c;
+ while ((c=input()) != '\n')
+ ;
+ unput ('\n');
+}
+
+
+/*
+ * CONTEXT -- Package for setting, saving, and restoring the lexical context.
+ * The action of the preprocessor in some cases depends upon the context, i.e.,
+ * what type of statement we are processing, whether we are in global space,
+ * within a procedure, etc.
+ */
+
+#define MAX_CONTEXT 5 /* max nesting of context */
+
+int cntxstk[MAX_CONTEXT]; /* for saving context */
+int cntxsp = 0; /* save stack pointer */
+
+
+/* SETCONTEXT -- Set the context. Clears any saved context.
+ */
+setcontext (new_context)
+int new_context;
+{
+ context = new_context;
+ cntxsp = 0;
+}
+
+
+/* PUSHCONTEXT -- Push a temporary context.
+ */
+pushcontext (new_context)
+int new_context;
+{
+ cntxstk[cntxsp++] = context;
+ context = new_context;
+
+ if (cntxsp > MAX_CONTEXT)
+ error (XPP_COMPERR, "save context stack overflow");
+}
+
+
+/* POPCONTEXT -- Pop the former context. If the current context is PROCSTMT
+ * (just finished compiling a procedure statement) then set the context to DECL
+ * to indicate that we are entering the declarations section of a procedure.
+ */
+popcontext()
+{
+ if (context & PROCSTMT) {
+ context = DECL;
+ if (cntxsp > 0)
+ --cntxsp;
+ } else if (cntxsp > 0)
+ context = cntxstk[--cntxsp];
+
+ return (context);
+}
+
+
+/* Keyword table. The simple hashing scheme requires that the keywords appear
+ * in the table in sorted order.
+ */
+#define LEN_KWTBL 18
+
+struct {
+ char *keyw; /* keyword name string */
+ short opcode; /* opcode from above definitions */
+ short nelem; /* number of table elements to skip if
+ * to get to next character class.
+ */
+} kwtbl[] = {
+ "FALSE", XTY_FALSE, 0,
+ "TRUE", XTY_TRUE, 0,
+ "bool", XTY_BOOL, 0,
+ "char", XTY_CHAR, 1,
+ "complex", XTY_COMPLEX, 0,
+ "double", XTY_DOUBLE, 0,
+ "error", XTY_ERROR, 1,
+ "extern", XTY_EXTERN, 0,
+ "false", XTY_FALSE, 0,
+ "iferr", XTY_IFERR, 2,
+ "ifnoerr", XTY_IFNOERR, 1,
+ "int", XTY_INT, 0,
+ "long", XTY_LONG, 0,
+ "pointer", XTY_POINTER, 1,
+ "procedure", XTY_PROC, 0,
+ "real", XTY_REAL, 0,
+ "short", XTY_SHORT, 0,
+ "true", XTY_TRUE, 0,
+ };
+
+/* short kwindex[30]; simple alphabetic hash index */
+/* #define CINDEX(ch) (isupper(ch)?ch-'A':ch-'a') */
+
+#define MAXCH 128
+short kwindex[MAXCH]; /* simple alphabetic hash index */
+#define CINDEX(ch) (ch)
+
+
+/* HASHTBL -- Hash the keyword table. Initializes the "kwindex" hash table.
+ * For each character in the alphabet, the index gives the index into the
+ * sorted keyword table. If there is no keyword name beginning with the index
+ * character, the index entry is set to -1.
+ */
+hashtbl()
+{
+ int i, j;
+
+ for (i=j=0; i <= MAXCH; i++) {
+ if (i == CINDEX (kwtbl[j].keyw[0])) {
+ kwindex[i] = j;
+ j = min (LEN_KWTBL-1, j + kwtbl[j].nelem + 1);
+ } else
+ kwindex[i] = -1;
+ }
+}
+
+
+/* FINDKW -- Lookup an indentifier in the keyword table. Return the opcode
+ * of the keyword, or ERR if no match.
+ */
+findkw()
+{
+ register char ch, *p, *q;
+ int i, ilimit;
+
+ if (kwindex[0] == 0)
+ hashtbl();
+
+ i = CINDEX (yytext[0]);
+ if (i < 0 || i >= MAXCH || (i = kwindex[i]) < 0)
+ return (ERR);
+ ilimit = i + kwtbl[i].nelem;
+
+ for (; i <= ilimit; i++) {
+ p = kwtbl[i].keyw + 1;
+ q = yytext + 1;
+
+ for (; *p != EOS; q++, p++) {
+ ch = *q;
+ /* 5DEC95 - Don't case convert keywords.
+ if (isupper (ch))
+ ch = tolower (ch);
+ */
+ if (*p != ch)
+ break;
+ }
+ if (*p == EOS && *q == EOS)
+ return (kwtbl[i].opcode);
+ }
+ return (ERR);
+}
+
+
+/* MAPIDENT -- Lookup an identifier in the keyword table. If the identifier is
+ * not a keyword, output it as is. If a datatype keyword, the action depends
+ * on whether we are in a procedure body or not (i.e., whether the keyword
+ * begins a declaration or is a type coercion function). Most of the other
+ * keywords are mapped into special x$.. identifiers for further processing
+ * by the second pass.
+ */
+mapident()
+{
+ int i, findkw();
+ char *str_fetch();
+ register char *ip, *op;
+
+ /* If not keyword and not defined string, output as is. The first
+ * char must be upper case for the name to be recognized as that of
+ * a defined string. If we are processing a "define" macro expansion
+ * is disabled.
+ */
+ if ((i = findkw()) == ERR) {
+ if (!isupper(yytext[0]) || (context & DEFSTMT) ||
+ (ip = str_fetch (yytext)) == NULL) {
+
+ outstr (yytext);
+ return;
+
+ } else {
+ yyleng = 0;
+ for (op=yytext; (*op++ = *ip++) != EOS; )
+ yyleng++;
+ do_string ('"', STR_DEFINE);
+ return;
+ }
+ }
+
+ /* If datatype keyword, call do_type. */
+ if (i <= XTY_POINTER) {
+ do_type (i);
+ return;
+ }
+
+ switch (i) {
+ case XTY_TRUE:
+ outstr (".true.");
+ break;
+ case XTY_FALSE:
+ outstr (".false.");
+ break;
+ case XTY_IFERR:
+ case XTY_IFNOERR:
+ outstr (yytext);
+ errhand = YES;
+ errchk = YES;
+ break;
+ case XTY_ERROR:
+ outstr (yytext);
+ errchk = YES;
+ break;
+
+ case XTY_EXTERN:
+ /* UNREACHABLE (due to decl.c additions).
+ */
+ outstr ("x$extn");
+ break;
+
+ default:
+ error (XPP_COMPERR, "Keyword lookup error");
+ }
+}
+
+
+char st_buf[SZ_STBUF];
+char *st_next = st_buf;
+
+struct st_def {
+ char *st_name;
+ char *st_value;
+} st_list[MAX_DEFSTR];
+
+int st_nstr = 0;
+
+/* STR_ENTER -- Enter a defined string into the string table. The string
+ * table is a kludge to provide the capability to define strings in SPP.
+ * The problem is that XPP handles strings but RPP handles macros, hence
+ * strings cannot be defined. We get around this by recognizing defines
+ * of the form 'define NAME "..."'. If a macro with a quoted value is
+ * encounted we are called to enter the name and the string into the
+ * table. LOOKUP, above, subsequently searches the table for defined
+ * strings. The name must be upper case or the table will not be searched.
+ *
+ * N.B.: we are called by the lexical analyser with 'define name "' in
+ * yytext. The next input() will return the first char of the string.
+ */
+str_enter()
+{
+ register char *ip, *op, ch;
+ register struct st_def *s;
+ register int n;
+ char name[SZ_FNAME+1];
+
+
+ /* Skip to the first char of the name string.
+ */
+ ip = yytext;
+ while (isspace (*ip))
+ ip++;
+ while (!isspace (*ip))
+ ip++;
+ while (isspace (*ip))
+ ip++;
+
+ /* Do not accept statement unless the name is upper case.
+ */
+ if (!isupper (*ip)) {
+ outstr (yytext);
+ return;
+ }
+
+ /* Extract macro name. */
+ for (op=name; (isalnum(*ip) || *ip == '_'); )
+ *op++ = *ip++;
+ *op = EOS;
+
+ /* Check for a redefinition. */
+ for (n=st_nstr, s=st_list, ch=name[0]; --n >= 0; s++) {
+ if (*(s->st_name) == ch)
+ if (strcmp (s->st_name, name) == 0)
+ break;
+ }
+
+ /* Make a new entry?. */
+ if (n < 0) {
+ s = &st_list[st_nstr++];
+ if (st_nstr >= MAX_DEFSTR)
+ error (XPP_COMPERR, "Too many defined strings");
+
+ /* Put defined NAME in string buffer. */
+ for (s->st_name = st_next, ip=name; *st_next++ = *ip++; )
+ ;
+ }
+
+ /* Put value in string buffer.
+ */
+ s->st_value = st_next;
+ traverse ('"');
+ for (ip=yytext; (*st_next++ = *ip++) != EOS; )
+ ;
+ *st_next++ = EOS;
+
+ if (st_next - st_buf >= SZ_STBUF)
+ error (XPP_COMPERR, "Too many defined strings");
+}
+
+
+/* STR_FETCH -- Search the defined string table for the named string
+ * parameter and return a pointer to the string if found, NULL otherwise.
+ */
+char *
+str_fetch (strname)
+register char *strname;
+{
+ register struct st_def *s = st_list;
+ register int n = st_nstr;
+ register char ch = strname[0];
+
+ while (--n >= 0) {
+ if (*(s->st_name) == ch)
+ if (strcmp (s->st_name, strname) == 0)
+ return (s->st_value);
+ s++;
+ }
+
+ return (NULL);
+}
+
+
+/* MACRO_REDEF -- Redefine the macro to automatically add a P2<T> macro
+ * to struct definitions.
+ */
+macro_redef ()
+{
+ register int n;
+ register char *ip, *op, ch;
+ char name[SZ_FNAME];
+ char value[SZ_LINE];
+
+
+ outstr ("define\t");
+ memset (name, 0, SZ_FNAME);
+ memset (value, 0, SZ_LINE);
+
+ /* Skip to the first char of the name string.
+ */
+ ip = yytext;
+ while (isspace (*ip))
+ ip++;
+ while (!isspace (*ip))
+ ip++;
+ while (isspace (*ip))
+ ip++;
+
+ /* Extract macro name. */
+ for (op=name; (isalnum(*ip) || *ip == '_'); )
+ *op++ = *ip++;
+ *op++ = '\t';
+ *op = EOS;
+ outstr (name);
+
+
+ /* Modify value.
+ */
+ outstr ("Memr(P2R");
+ while ( (ch = input()) != EOF ) {
+ if (ch == '\n') {
+ break;
+ } else if (ch == '#') { /* eat a comment */
+ while ((ch = input()) != '\n')
+ ;
+ break;
+ } else if (ch == '[') {
+ outstr ("(");
+ } else if (ch == ']') {
+ outstr (")");
+ } else {
+ char chr[2];
+ chr[0] = ch; chr[1] = '\0';
+ outstr (chr);
+ }
+ }
+
+ outstr (")\n");
+ linenum[istkptr]++;
+}
+
+
+/* SETLINE -- Set the file line number. Used by the first pass to set
+ * line number after processing an include file and in various other
+ * places. Necessary to get correct line numbers in error messages from
+ * the second pass.
+ */
+setline()
+{
+ char msg[20];
+
+ if (istkptr == 0) { /* not in include file */
+ sprintf (msg, "#!# %d\n", linenum[istkptr] - 1);
+ outstr (msg);
+ }
+}
+
+
+/* OUTPUT -- Output a character. If we are processing the body of a procedure
+ * or a data statement, put the character into the output buffer. Otherwise
+ * put the character to the output file.
+ *
+ * NOTE -- the redirection logic shown below is duplicated in OUTSTR.
+ */
+output (ch)
+char ch;
+{
+ if (context & (BODY|DATASTMT)) {
+ /* In body of procedure or in a data statement (which is output
+ * just preceding the body).
+ */
+ *op++ = ch;
+ if (op >= &obuf[SZ_OBUF]) {
+ error (XPP_COMPERR, "Output buffer overflow");
+ _exit (1);
+ }
+ } else if (context & DECL) {
+ /* Output of a miscellaneous declaration in the declarations
+ * section.
+ */
+ *dp++ = ch;
+ if (dp >= &dbuf[SZ_DBUF]) {
+ error (XPP_COMPERR, "Declarations buffer overflow");
+ _exit (1);
+ }
+ } else {
+ /* Outside of a procedure.
+ */
+ putc (ch, yyout);
+ }
+}
+
+
+/* Datatype keywords for declarations. The special x$.. keywords are
+ * for communication with the second pass. Note that this table is machine
+ * dependent, since it maps char into type short.
+ */
+char *type_decl[] = RPP_TYPES;
+
+
+/* Intrinsic functions used for type coercion. These mappings are machine
+ * dependent (MACHDEP). If your machine has INTEGER*2 and INTEGER*4, and
+ * integer cannot be passed as an argument when a short or long is expected,
+ * and your compiler has INT2 and INT4 type coercion intrinsic functions,
+ * you should use those here instead of INT (which happens to work for a VAX).
+ * If you cannot pass an int when a short is expected (i.e., IBM), and you
+ * do not have an INT2 intrinsic function, you should provide an external
+ * INTEGER*2 function called "int2" and use that for type coercion. Note
+ * that it will then be necessary to have the preprocessor automatically
+ * generate a declaration for the function. This nonsense will all go away
+ * when we set up a proper table driven code generator!!
+ */
+char *intrinsic_function[] = {
+ "", /* table is one-indexed */
+ "(0 != ", /* bool(expr) */
+ "int", /* char(expr) */
+ "int", /* short(expr) */
+ "int", /* int(expr) */
+ "int", /* long(expr) */
+ "real", /* real(expr) */
+ "dble", /* double(expr) */
+ "cmplx", /* complex(expr) */
+ "int" /* pointer(expr) */
+};
+
+
+/* DO_TYPE -- Process a datatype keyword. The type of processing depends
+ * on whether we are called when processing a declaration or an expression.
+ * In expressions, the datatype keyword is the type coercion intrinsic
+ * function. DEFINE statements are a special case; we treat them as
+ * expressions, since macros containing datatype keywords are used in
+ * expressions more than in declarations. This is a kludge until the problem
+ * is properly resolved by processing macros BEFORE code generation.
+ * In the current implementation, macros are handled by the second pass (RPP).
+ */
+do_type (type)
+int type;
+{
+ char ch;
+
+ if (context & (BODY|DEFSTMT)) {
+ switch (type) {
+ case XTY_BOOL:
+ for (ch=input(); ch == ' ' || ch == '\t'; ch=input())
+ ;
+ if (ch != '(')
+ error (XPP_SYNTAX, "Illegal boolean expr");
+ outstr (intrinsic_function[type]);
+ return;
+
+ case XTY_CHAR:
+ case XTY_SHORT:
+ case XTY_INT:
+ case XTY_LONG:
+ case XTY_REAL:
+ case XTY_DOUBLE:
+ case XTY_COMPLEX:
+ case XTY_POINTER:
+ outstr (intrinsic_function[type]);
+ return;
+
+ default:
+ error (XPP_SYNTAX, "Illegal type coercion");
+ }
+
+ } else {
+ /* UNREACHABLE when in declarations section of a procedure.
+ */
+ fprintf (yyout, type_decl[type]);
+ }
+}
+
+
+/* DO_CHAR -- Process a char array declaration. Add "+1" to the first
+ * dimension to allow space for the EOS. Called after LEX has recognized
+ * "char name[". If we reach the closing ']', convert it into a right paren
+ * for the second pass.
+ */
+do_char()
+{
+ char ch;
+
+ for (ch=input(); ch != ',' && ch != ']'; ch=input())
+ if (ch == '\n' || ch == EOS) {
+ error (XPP_SYNTAX, "Missing comma or ']' in char declaration");
+ unput ('\n');
+ return;
+ } else
+ output (ch);
+
+ outstr ("+1");
+ if (ch == ']')
+ output (')');
+ else
+ output (ch);
+}
+
+
+/* SKIP_HELPBLOCK -- Skip over a help block (documentation section).
+ */
+skip_helpblock()
+{
+ char ch;
+
+
+ /* fgets() no longer works with FLEX
+ while (fgets (yytext, SZ_LINE, yyin) != NULL) {
+ if (istkptr == 0)
+ linenum[istkptr]++;
+
+ if (yytext[0] == '.' && (yytext[1] == 'e' || yytext[1] == 'E')) {
+ yytext[8] = EOS;
+ if (strcmp (&yytext[1], "endhelp") == 0 ||
+ strcmp (&yytext[1], "ENDHELP") == 0)
+ break;
+ }
+ }
+ */
+
+ while ( (ch = input()) != EOF ) {
+ if (ch == '.') { /* check for ".endhelp" */
+ ch = input ();
+ if (ch == 'e' || ch == 'E') {
+ for (ch = input() ; ch != '\n' && ch != EOS; ch=input())
+ ;
+ break;
+ } else
+ for (ch = input() ; ch != '\n' && ch != EOS; ch=input())
+ ;
+
+ } else if (ch == '\n') { /* skip line */
+ ;
+ } else {
+ for (ch=input(); ch != '\n' && ch != EOS; ch=input())
+ ;
+ }
+ if (istkptr == 0)
+ linenum[istkptr]++;
+ }
+}
+
+
+/* PARSE_TASK_STATEMENT -- Parse the task statement, building up a list
+ * of task_name/procedure_name structures in the "task_list" array.
+ *
+ * task task1, task2, task3=proc3, task4, ...
+ *
+ * Task names are placed in the string buffer as one big string, with EOS
+ * delimiters between the names. This "dictionary" string is converted
+ * into a data statement at "end_code" time, along with any other strings
+ * in the runtask procedure. The procedure names, which may differ from
+ * the task names, are saved in the upper half of the output buffer. We can
+ * do this because we know that the runtask procedure is small and will not
+ * come close to filling up the output buffer, which buffers only the body
+ * of the procedure currently being processed.
+ * N.B.: Upon entry, the input is left positioned to just past the "task"
+ * keyword.
+ */
+parse_task_statement()
+{
+ register struct task *tp;
+ register char ch, *ip;
+ char task_name[SZ_FNAME], proc_name[SZ_FNAME];
+ int name_offset;
+
+ /* Set global pointers to where we put task and proc name strings.
+ */
+ sp = sbuf;
+ op = &obuf[SZ_OBUF/2];
+ name_offset = 1;
+
+ for (ntasks=0; ntasks < MAX_TASKS; ntasks++) {
+ /* Process "taskname" or "taskname=procname". There must be
+ * at least one task name in the declaration.
+ */
+ if (get_task (task_name, proc_name, SZ_FNAME) == ERR)
+ return (ERR);
+
+ /* Set up the task declaration structure, and copy name strings
+ * into the string buffers.
+ */
+ tp = &task_list[ntasks];
+ tp->task_name = sp;
+ tp->proc_name = op;
+ tp->name_offset = name_offset;
+ name_offset += strlen (task_name) + 1;
+
+ for (ip=task_name; (*sp++ = *ip++) != EOS; )
+ if (sp >= &sbuf[SZ_SBUF])
+ goto err;
+ for (ip=proc_name; (*op++ = *ip++) != EOS; )
+ if (op >= &obuf[SZ_OBUF])
+ goto err;
+
+ /* If the next character is a comma, skip it and a newline if
+ * one follows and continue processing. If the next character is
+ * a newline, we are done. Any other character is an error.
+ * Note that nextch skips whitespace and comments.
+ */
+ ch = nextch();
+ if (ch == ',') {
+ if ((ch = nextch()) != '\n')
+ unput (ch);
+ } else if (ch == '\n') {
+ linenum[istkptr]++;
+ ntasks++; /* end of task statement */
+ break;
+ } else
+ return (ERR);
+ }
+
+ if (ntasks >= MAX_TASKS) {
+err: error (XPP_COMPERR, "too many tasks in task statement");
+ return (ERR);
+ }
+
+ /* Set up the task name dictionary string so that it gets output
+ * as a data statement when the runtask procedure is output.
+ */
+ string_list[0].str_name = "dict";
+ string_list[0].str_text = sbuf;
+ string_list[0].str_length = (sp - sbuf);
+ nstrings = 1;
+
+ /* Leave the output buffer pointer pointing to the first half of
+ * the buffer.
+ */
+ op = obuf;
+ return (OK);
+}
+
+
+/* GET_TASK -- Process a single task declaration of the form "taskname" or
+ * "taskname = procname".
+ */
+get_task (task_name, proc_name, maxch)
+char *task_name;
+char *proc_name;
+int maxch;
+{
+ register char ch;
+
+ /* Get task name.
+ */
+ if (get_name (task_name, maxch) == ERR)
+ return (ERR);
+
+ /* Get proc name if given, otherwise the procedure name is assumed
+ * to be the same as the task name.
+ */
+ if ((ch = nextch()) == '=') {
+ if (get_name (proc_name, maxch) == ERR)
+ return (ERR);
+ } else {
+ unput (ch);
+ strncpy (proc_name, task_name, maxch);
+ }
+
+ return (XOK);
+}
+
+
+/* GET_NAME -- Extract identifier from input, placing in the output string.
+ * ERR is returned if the output string overflows, or if the token is not
+ * a legal identifier.
+ */
+get_name (outstr, maxch)
+char *outstr;
+int maxch;
+{
+ register char ch, *op;
+ register int nchars;
+
+ unput ((ch = nextch())); /* skip leading whitespace */
+
+ for (nchars=0, op=outstr; nchars < maxch; nchars++) {
+ ch = input();
+ if (isalpha(ch)) {
+ if (isupper(ch))
+ *op++ = tolower(ch);
+ else
+ *op++ = ch;
+ } else if ((isdigit(ch) && nchars > 0) || ch == '_' || ch == '$') {
+ *op++ = ch;
+ } else {
+ *op++ = EOS;
+ unput (ch);
+ return (nchars > 0 ? XOK : ERR);
+ }
+ }
+
+ return (ERR);
+}
+
+
+/* NEXTCH -- Get next nonwhite character from the input stream. Ignore
+ * comments. Newline is not considered whitespace.
+ */
+nextch()
+{
+ register char ch;
+
+ while ((ch = input()) != EOF) {
+ if (ch == '#') { /* discard comment */
+ while ((ch = input()) != '\n')
+ ;
+ return (ch);
+ } else if (ch != ' ' && ch != '\t')
+ return (ch);
+ }
+ return (EOF);
+}
+
+
+/* PUT_DICTIONARY -- We are called when the keyword TN$DECL is encountered,
+ * i.e., while processing "sysruk.x". This should only happen after the
+ * task statement has been successfully processed. Our function is to replace
+ * the TN$DECL macro by the declarations for the DP and DICT structures.
+ * DP is an integer array giving the offsets of the task name strings in DICT,
+ * the dictionary string buffer.
+ */
+#define NDP_PERLINE 8 /* num DP data elements per line */
+
+put_dictionary()
+{
+ register struct task *tp;
+ char buf[SZ_LINE];
+ int i, j, offset;
+
+ /* Discard anything found on line after the TN$DECL, which is only
+ * recognized as the first token on the line.
+ */
+ while (input() != '\n')
+ ;
+ unput ('\n');
+
+ /* Output the data statements required to initialize the DP array.
+ * These statements are spooled into the output buffer and not output
+ * until all declarations have been processed, since the Fortran std
+ * requires that data statements follow declarations.
+ */
+ pushcontext (DATASTMT);
+ tp = task_list;
+
+ for (j=0; j <= ntasks; j += NDP_PERLINE) {
+ if (!strloopdecl++) {
+ pushcontext (DECL);
+ sprintf (buf, "%s\tiyy\n", type_decl[TY_INT]);
+ outstr (buf);
+ popcontext();
+ }
+
+ sprintf (buf, "data\t(dp(iyy),iyy=%2d,%2d)\t/",
+ j+1, min (j+NDP_PERLINE, ntasks+1));
+ outstr (buf);
+
+ for (i=j; i < j+NDP_PERLINE && i <= ntasks; i++) {
+ offset = (tp++)->name_offset;
+ if (i >= ntasks)
+ sprintf (buf, "%2d/\n", XEOS);
+ else if (i == j + NDP_PERLINE - 1)
+ sprintf (buf, "%4d/\n", offset==EOS ? XEOS: offset);
+ else
+ sprintf (buf, "%4d,", offset==EOS ? XEOS: offset);
+ outstr (buf);
+ }
+ }
+
+ popcontext();
+
+ /* Output type declarations for the DP and DICT arrays. The string
+ * descriptor for string 0 (dict) was prepared when the TASK statement
+ * was processed.
+ */
+ sprintf (buf, "%s\tdp(%d)\n", type_decl[XTY_INT], ntasks + 1);
+ outstr (buf);
+ sprintf (buf, "%s\tdict(%d)\n", type_decl[XTY_CHAR],
+ string_list[0].str_length);
+ outstr (buf);
+}
+
+
+/* PUT_INTERPRETER -- Output the statements necessary to scan the dictionary
+ * for a task and call the associated procedure. We are called when the
+ * keyword TN$INTERP is encountered in the input stream.
+ */
+put_interpreter()
+{
+ char lbuf[SZ_LINE];
+ int i;
+
+ while (input() != '\n') /* discard rest of line */
+ ;
+ unput ('\n');
+
+ for (i=0; i < ntasks; i++) {
+ sprintf (lbuf, "\tif (streq (task, dict(dp(%d)))) {\n", i+1);
+ outstr (lbuf);
+ sprintf (lbuf, "\t call %s\n", task_list[i].proc_name);
+ outstr (lbuf);
+ sprintf (lbuf, "\t return (OK)\n");
+ outstr (lbuf);
+ sprintf (lbuf, "\t}\n");
+ outstr (lbuf);
+ }
+}
+
+
+/* OUTSTR -- Output a string. Depending on the context, the string will
+ * either go direct to the output file, or will be buffered in the output
+ * buffer.
+ */
+outstr (string)
+char *string;
+{
+ register char *ip;
+
+
+ if (context & (BODY|DATASTMT)) {
+ /* In body of procedure or in a data statement (which is output
+ * just preceding the body).
+ */
+ for (ip=string; (*op++ = *ip++) != EOS; )
+ ;
+ if (--op >= &obuf[SZ_OBUF]) {
+ error (XPP_COMPERR, "Output buffer overflow");
+ _exit (1);
+ }
+ } else if (context & DECL) {
+ /* Output of a miscellaneous declaration in the declarations
+ * section.
+ */
+ for (ip=string; (*dp++ = *ip++) != EOS; )
+ ;
+ if (--dp >= &dbuf[SZ_DBUF]) {
+ error (XPP_COMPERR, "Declarations buffer overflow");
+ _exit (1);
+ }
+ } else {
+ /* Outside of a procedure.
+ */
+ fputs (string, yyout);
+ }
+}
+
+
+/* BEGIN_CODE -- Code that gets executed when the keyword BEGIN is encountered,
+ * i.e., when we begin processing the executable part of a procedure
+ * declaration.
+ */
+begin_code()
+{
+ char text[1024];
+
+ /* If we are already processing the body of a procedure, we probably
+ * have a missing END.
+ */
+ if (context & BODY)
+ xpp_warn ("Unmatched BEGIN statement");
+
+ /* Set context flag noting that we are processing the body of a
+ * procedure. Output the BEGIN statement, for the benefit of the
+ * second pass (RPP), which needs to know where the procedure body
+ * begins.
+ */
+ setcontext (BODY);
+ d_runtime (text); outstr (text);
+ outstr ("begin\n");
+ linenum[istkptr]++;
+
+ /* Initialization. */
+ nbrace = 0;
+ nswitch = 0;
+ str_idnum = 1;
+ errhand = NO;
+ errchk = NO;
+}
+
+
+/* END_CODE -- Code that gets executed when the keyword END is encountered
+ * in the input. If error checking is used in the procedure, we must declare
+ * the boolean function XERPOP. If any switches are employed, we must declare
+ * the switch variables. Next we format and output data statements for any
+ * strings encountered while processing the procedure body. If the procedure
+ * being processed is sys_runtask, the task name dictionary string is also
+ * output. Finally, we output the spooled procedure body, followed by and END
+ * statement for the benefit of the second pass.
+ */
+end_code()
+{
+ int i;
+
+ /* If the END keyword is encountered outside of the body of a
+ * procedure, we leave it alone.
+ */
+ if (!(context & BODY)) {
+ outstr (yytext);
+ return;
+ }
+
+ /* Output argument and local variable declarations (see decl.c).
+ * Note d_enter may have been called during processing of the body
+ * of a procedure to make entries in the symbol table for intrinsic
+ * functions, switch variables, etc. (this is not currently done).
+ */
+ d_codegen (yyout);
+
+ setcontext (GLOBAL);
+
+ /* Output declarations for error checking and switches. All variables
+ * and functions must be declared.
+ */
+ if (errhand)
+ fprintf (yyout, "x$bool xerpop\n");
+ if (errchk)
+ fprintf (yyout, "errchk error, erract\n");
+ errhand = NO;
+ errchk = NO;
+
+ if (nswitch) { /* declare switch variables */
+ fprintf (yyout, "%s\t", type_decl[XTY_INT]);
+ for (i=1; i < nswitch; i++)
+ fprintf (yyout, "SW%04d,", i);
+ fprintf (yyout, "SW%04d\n", i);
+ }
+
+ /* Output any miscellaneous declarations. These include ERRCHK and
+ * COMMON declarations - anything not a std type declaration or a
+ * data statement declaration.
+ */
+ *dp++ = EOS;
+ fputs (dbuf, yyout); fflush (yyout);
+{ int i; for (i=0; i < SZ_DBUF; ) dbuf[i++] = '\0'; }
+ dp = dbuf;
+
+ /* Output the SAVE statement, which must come after all declarations
+ * and before any DATA statements.
+ */
+ fputs ("save\n", yyout);
+
+ /* Output data statements to initialize character strings, followed
+ * by any runtime procedure entry initialization statments, followed
+ * by the spooled text in the output buffer, followed by the END.
+ * Clear the string and output buffers. Any user data statements
+ * will already have been moved into the output buffer, and they
+ * will come out at the end of the declarations section regardless
+ * of where they were given in the declarations section. Data stmts
+ * are not permitted in the procedure body.
+ */
+ init_strings();
+ *op++ = EOS;
+ fputs (obuf, yyout); fflush (yyout);
+{ int i; for (i=0; i < SZ_OBUF; ) obuf[i++] = '\0'; }
+ fputs ("end\n", yyout); fflush (yyout);
+
+ op = obuf;
+ *op = EOS;
+ sp = sbuf;
+
+ if (nbrace != 0) {
+ error (XPP_SYNTAX, "Unmatched brace");
+ nbrace = 0;
+ }
+}
+
+
+#define BIG_STRING 9
+#define NPERLINE 8
+
+/* INIT_STRINGS -- Output data statements to initialize all strings in a
+ * procedure ("string" declarations, inline strings, and the runtask
+ * dictionary). Strings are implemented as integer arrays, using the
+ * smallest integer datatype provided by the host Fortran compiler, usually
+ * INTEGER*2 (XTY_CHAR).
+ */
+init_strings()
+{
+ register int str;
+
+ if (nstrings)
+ for (str=0; str < nstrings && !strloopdecl; str++)
+ if (string_list[str].str_length >= BIG_STRING) {
+ fprintf (yyout, "%s\tiyy\n", type_decl[XTY_INT]);
+ strloopdecl++;
+ }
+
+ for (str=0; str < nstrings; str++)
+ write_string_data_statement (&string_list[str]);
+
+ sp = sbuf; /* clear string buffer */
+ nstrings = 0;
+ strloopdecl = 0;
+}
+
+
+/* WRITE_STRING_DATA_STATEMENT -- Output data statement to initialize a single
+ * string. If short string, output a simple whole-array data statement
+ * that fits all on one line. Large strings are initialized with multiple
+ * data statements, each of which initializes a section of the string
+ * using a dummy subscript. This is thought to be more portable than
+ * a single large data statement with continuation, because the number of
+ * continuation cards permitted in a data statement depends on the compiler.
+ * The loop variable in an implied do loop in a data statement must be declared
+ * on some compilers (crazy but true). Determine if we will be generating any
+ * implied dos and declare the variable if so.
+ */
+write_string_data_statement (s)
+struct string *s;
+{
+ register int i, len;
+ register char *ip;
+ char ch, *name;
+ int j;
+
+ name = s->str_name;
+ ip = s->str_text;
+ len = s->str_length;
+
+ if (len < BIG_STRING) {
+ fprintf (yyout, "data\t%s\t/", name);
+ for (i=0; i < len-1; i++) {
+ if ((ch = *ip++) == EOS)
+ fprintf (yyout, "%3d,", XEOS);
+ else
+ fprintf (yyout, "%3d,", ch);
+ }
+ fprintf (yyout, "%2d/\n", XEOS);
+
+ } else {
+ for (j = 0; j < len; j += NPERLINE) {
+ fprintf (yyout, "data\t(%s(iyy),iyy=%2d,%2d)\t/",
+ name, j+1, min(j+NPERLINE, len));
+ for (i=j; i < j+NPERLINE; i++) {
+ if (i >= len-1) {
+ fprintf (yyout, "%2d/\n", XEOS);
+ return;
+ } else if (i == j+NPERLINE-1) {
+ fprintf (yyout, "%3d/\n", ip[i]==EOS ? XEOS: ip[i]);
+ } else
+ fprintf (yyout, "%3d,", ip[i]==EOS ? XEOS: ip[i]);
+ }
+ }
+ }
+}
+
+
+/* DO_STRING -- Process a STRING declaration or inline string. Add a new
+ * string descriptor to the string list, copy text of string into sbuf,
+ * save name of string array in sbuf. If inline string, manufacture the
+ * name of the string array.
+ */
+do_string (delim, strtype)
+char delim; /* char which delimits string */
+int strtype; /* string type */
+{
+ register char ch, *ip;
+ register struct string *s;
+ int readstr = 1;
+ char *str_uniqid();
+
+ /* If we run out of space for string storage, print error message,
+ * dump string decls out early, clear buffer and continue processing.
+ */
+ if (nstrings >= MAX_STRINGS) {
+ error (XPP_COMPERR, "Too many strings in procedure");
+ init_strings();
+ }
+
+ s = &string_list[nstrings];
+
+ switch (strtype) {
+
+ case STR_INLINE:
+ case STR_DEFINE:
+ /* Inline strings are implemented as Fortran arrays; generate a
+ * dummy name for the array and set up the descriptor.
+ * Defined strings are inline strings, but the name of the text of
+ * the string is already in yytext when we are called.
+ */
+ s->str_name = sp;
+ for (ip = str_uniqid(); (*sp++ = *ip++) != EOS; )
+ ;
+ sbuf_check();
+ break;
+
+ case STR_DECL:
+ /* String declaration. Read in name of string, used as name of
+ * Fortran array.
+ */
+ ch = nextch(); /* skip whitespace */
+ if (!isalpha (ch))
+ goto sterr;
+ s->str_name = sp;
+ *sp++ = ch;
+
+ /* Get rest of string name identifier. */
+ while ((ch = input()) != EOF) {
+ if (isalnum(ch) || ch == '_') {
+ *sp++ = ch;
+ sbuf_check();
+ } else if (ch == '\n') {
+sterr: error (XPP_SYNTAX, "String declaration syntax");
+ while (input() != '\n')
+ ;
+ unput ('\n');
+ return;
+ } else {
+ *sp++ = EOS;
+ break;
+ }
+ }
+
+ /* Advance to the ' or " string delimiter, in preparation for
+ * processing the string itself. If syntax error occurs, skip
+ * to newline to avoid spurious error messages. If the string
+ * is not quoted the string value field is taken to be the name
+ * of a string DEFINE.
+ */
+ delim = nextch();
+
+ if (!(delim == '"' || delim == '\'')) {
+ register char *ip, *op;
+ int ch;
+ char *str_fetch();
+
+ /* Fetch name of defined macro into yytext.
+ */
+ op = yytext;
+ *op++ = delim;
+ while ((ch = input()) != EOF)
+ if (isalnum(ch) || ch == '_')
+ *op++ = ch;
+ else
+ break;
+ unput (ch);
+ *op = EOS;
+
+ /* Fetch body of string into yytext.
+ */
+ if ((ip = str_fetch (yytext)) != NULL) {
+ yyleng = 0;
+ for (op=yytext; (*op++ = *ip++) != EOS; )
+ yyleng++;
+ readstr = 0;
+ } else {
+ error (XPP_SYNTAX,
+ "Undefined macro referenced in string declaration");
+ }
+ }
+
+ break;
+ }
+
+ /* Get the text of the string. Process escape sequences. String may
+ * not span multiple lines. In the case of a defined string, the text
+ * of the string will already be in yytext.
+ */
+ s->str_text = sp;
+ if (readstr && strtype != STR_DEFINE)
+ traverse (delim); /* process string into yytext */
+ strcpy (sp, yytext);
+ sp += yyleng + 1;
+ s->str_length = yyleng + 1;
+ sbuf_check();
+
+ /* Output array declaration for string. We want the declaration to
+ * go into the miscellaneous declarations buffer, so toggle the
+ * the context to DECL before calling OUTSTR.
+ */
+ {
+ char lbuf[SZ_LINE];
+
+ pushcontext (DECL);
+ sprintf (lbuf, "%s\t%s(%d)\n", type_decl[XTY_CHAR], s->str_name,
+ s->str_length);
+ outstr (lbuf);
+ popcontext();
+ }
+
+ /* If inline string, replace the quoted string by the name of the
+ * string variable. This text goes into the output buffer, rather
+ * than directly to the output file as is the case with the declaration
+ * above.
+ */
+ if (strtype == STR_INLINE || strtype == STR_DEFINE)
+ outstr (s->str_name);
+
+ if (++nstrings >= MAX_STRINGS)
+ error (XPP_COMPERR, "Too many strings in procedure");
+}
+
+
+/* DO_HOLLERITH -- Process and output a Fortran string. If the output
+ * compiler is Fortran 77, we output a quoted string; otherwise we output
+ * a hollerith string. Fortran (packed) strings appear in the SPP source
+ * as in the statement 'call_f77_sub (arg, *"any string", arg)'. Escape
+ * sequences are not recognized.
+ */
+do_hollerith()
+{
+ register char *op;
+ char strbuf[SZ_LINE], outbuf[SZ_LINE];
+ int len;
+
+ /* Read the string into strbuf. */
+ for (op=strbuf, len=0; (*op = input()) != '"'; op++, len++)
+ if (*op == '\n' || *op == EOF)
+ break;
+ if (*op == '\n')
+ error (XPP_COMPERR, "Packed string not delimited");
+ else
+ *op = EOS; /* delete delimiter */
+
+#ifdef F77
+ sprintf (outbuf, "\'%s\'", strbuf);
+#else
+ sprintf (outbuf, "%dH%s", i, strbuf);
+#endif
+
+ outstr (outbuf);
+}
+
+
+/* SBUF_CHECK -- Check to see that the string buffer has not overflowed.
+ * It is a fatal error if it does.
+ */
+sbuf_check()
+{
+ if (sp >= &sbuf[SZ_SBUF]) {
+ error (XPP_COMPERR, "String buffer overflow");
+ _exit (1);
+ }
+}
+
+
+/* STR_UNIQID -- Generate a unit identifier name for an inline string.
+ */
+char *
+str_uniqid()
+{
+ static char id[] = "ST0000";
+
+ sprintf (&id[2], "%04d", str_idnum++);
+ return (id);
+}
+
+
+/* TRAVERSE -- Called by the lexical analyzer when a quoted string has
+ * been recognized. Characters are input and deposited in yytext (the
+ * lexical analyzer token buffer) until the trailing quote is seen.
+ * Strings may not span lines unless the newline is delimited. The
+ * recognized escape sequences are converted upon input; all others are
+ * left alone, presumably to later be converted by other code.
+ * Quotes may be included in the string by escaping them, or by means of
+ * the double quote convention.
+ */
+traverse (delim)
+char delim;
+{
+ register char *op, *cp, ch;
+ char *index();
+
+
+ for (op=yytext; (*op = input()) != EOF; op++) {
+ if (*op == delim) {
+ if ((*op = input()) == EOF)
+ break;
+ if (*op == delim)
+ continue; /* double quote convention; keep one */
+ else {
+ unput (*op);
+ break; /* normal exit */
+ }
+
+ } else if (*op == '\n') { /* error recovery exit */
+ unput ('\n');
+ xpp_warn ("Newline while processing string");
+ break;
+
+ } else if (*op == '\\') {
+ if ((*op = input()) == EOF) {
+ break;
+ } else if (*op == '\n') {
+ --op; /* explicit continuation */
+ continue;
+ } else if ((cp = index (esc_ch, *op)) != NULL) {
+ *op = esc_val[cp-esc_ch];
+ } else if (isdigit (*op)) { /* '\0DD' octal constant */
+ *op -= '0';
+ while (isdigit (ch = input()))
+ *op = (*op * 8) + (ch - '0');
+ unput (ch);
+ } else {
+ ch = *op; /* unknown escape sequence, */
+ *op++ = '\\'; /* leave it alone. */
+ *op = ch;
+ }
+ }
+ }
+
+ *op = EOS;
+ yyleng = (op - yytext);
+}
+
+
+/* ERROR -- Output an error message and set exit flag so that no linking occurs.
+ * Do not abort compiler, however, because it is better to keep going and
+ * find all the errors in a single compilation.
+ */
+error (errcode, errmsg)
+int errcode;
+char *errmsg;
+{
+ fprintf (stderr, "Error on line %d of %s: %s\n", linenum[istkptr],
+ fname[istkptr], errmsg);
+ fflush (stderr);
+ errflag |= errcode;
+}
+
+
+/* WARN -- Output a warning message. Do not set exit flag since this is only
+ * a warning message; linking should occur if there are not any more serious
+ * errors.
+ */
+xpp_warn (warnmsg)
+char *warnmsg;
+{
+ fprintf (stderr, "Warning on line %d of %s: %s\n", linenum[istkptr],
+ fname[istkptr], warnmsg);
+ fflush (stderr);
+}
+
+
+/* ACCUM -- Code for conversion of numeric constants to decimal. Convert a
+ * character string to a binary integer constant, doing the conversion in the
+ * indicated base.
+ */
+long
+accum (base, strp)
+int base;
+char **strp;
+{
+ register char *ip;
+ long sum;
+ char digit;
+
+ sum = 0;
+ ip = *strp;
+
+ switch (base) {
+ case OCTAL:
+ case DECIMAL:
+ for (digit = *ip++; isdigit (digit); digit = *ip++)
+ sum = sum * base + (digit - '0');
+ *strp = ip - 1;
+ break;
+ case HEX:
+ while ((digit = *ip++) != EOF) {
+ if (isdigit (digit))
+ sum = sum * base + (digit - '0');
+ else if (digit >= 'a' && digit <= 'f')
+ sum = sum * base + (digit - 'a' + 10);
+ else if (digit >= 'A' && digit <= 'F')
+ sum = sum * base + (digit - 'A' + 10);
+ else {
+ *strp = ip;
+ break;
+ }
+ }
+ break;
+ default:
+ error (XPP_COMPERR, "Accum: unknown numeric base");
+ return (ERR);
+ }
+
+ return (sum);
+}
+
+
+/* CHARCON -- Convert a character constant to a binary integer value.
+ * The regular escape sequences are recognized; numeric values are assumed
+ * to be octal.
+ */
+charcon (string)
+char *string;
+{
+ register char *ip, ch;
+ char *cc, *index();
+ char *nump;
+
+ ip = string + 1; /* skip leading apostrophe */
+ ch = *ip++;
+
+ /* Handle '\c' and '\0dd' notations.
+ */
+ if (ch == '\\') {
+ if ((cc = index (esc_ch, *ip)) != NULL) {
+ return (esc_val[cc-esc_ch]);
+ } else if (isdigit (*ip)) {
+ nump = ip;
+ return (accum (OCTAL, &nump));
+ } else
+ return (ch);
+ } else {
+ /* Regular characters, i.e., 'c'; just return ASCII value of char.
+ */
+ return (ch);
+ }
+}
+
+
+/* INT_CONSTANT -- Called to decode an integer constant, i.e., a decimal, hex,
+ * octal, or sexagesimal number, or a character constant. The numeric string
+ * is converted in the indicated base and replaced by its decimal value.
+ */
+int_constant (string, base)
+char *string;
+int base;
+{
+ char decimal_constant[SZ_NUMBUF], *p;
+ long accum(), value;
+ int i;
+
+ p = string;
+ i = strlen (string);
+
+ switch (base) {
+ case DECIMAL:
+ value = accum (10, &p);
+ break;
+ case SEXAG:
+ value = accum (10, &p);
+ break;
+ case OCTAL:
+ value = accum (8, &p);
+ break;
+ case HEX:
+ value = accum (16, &p);
+ break;
+
+ case CHARCON:
+ while ((p[i] = input()) != EOF) {
+ if (p[i] == '\n') {
+ error (XPP_SYNTAX, "Undelimited character constant");
+ return;
+ } else if (p[i] == '\\') {
+ p[++i] = input();
+ i++;
+ continue;
+ } else if (p[i] == '\'')
+ break;
+ i += 1;
+ }
+ value = charcon (p);
+ break;
+
+ default:
+ error (XPP_COMPERR, "Unknown numeric base for integer conversion");
+ value = ERR;
+ }
+
+ /* Output the decimal value of the integer constant. We are simply
+ * replacing the SPP constant by a decimal constant.
+ */
+ sprintf (decimal_constant, "%ld", value);
+ outstr (decimal_constant);
+}
+
+
+/* HMS -- Convert number in HMS format into a decimal constant, and output
+ * in that form. Successive : separated fields are scaled to 1/60 th of
+ * the preceeding field. Thus "12:30" is equivalent to "12.5". Some care
+ * is taken to preserve the precision of the number.
+ */
+char *
+hms (number)
+char *number;
+{
+ char cvalue[SZ_NUMBUF], *ip;
+ int bvalue, ndigits;
+ long scale = 10000000;
+ long units = 1;
+ long value = 0;
+
+ for (ndigits=0, ip=number; *ip; ip++)
+ if (isdigit (*ip))
+ ndigits++;
+
+ /* Get the unscaled base value part of the number. */
+ ip = number;
+ bvalue = accum (DECIMAL, &ip);
+
+ /* Convert any sexagesimal encoded fields. */
+ while (*ip == ':') {
+ ip++;
+ units *= 60;
+ value += (accum (DECIMAL, &ip) * scale / units);
+ }
+
+ /* Convert the fractional part of the number, if any.
+ */
+ if (*ip++ == '.')
+ while (isdigit (*ip)) {
+ units *= 10;
+ value += (*ip++ - '0') * scale / units;
+ }
+
+ /* Format the output number. */
+ if (ndigits > MIN_REALPREC)
+ sprintf (cvalue, "%d.%dD0", bvalue, value);
+ else
+ sprintf (cvalue, "%d.%d", bvalue, value);
+ cvalue[ndigits+1] = '\0';
+
+ /* Print the translated number. */
+ outstr (cvalue);
+}
+
+
+/*
+ * Revision history (when i remembered) --
+ *
+ * 14-Dec-82: Changed hms conversion, to produce degrees or hours,
+ * rather than seconds (lex pattern, add hms, delete ':'
+ * action from accum).
+ *
+ * 10-Mar-83 Broke C code and Lex code into separate files.
+ * Added support for error handling.
+ * Added additional type coercion functions.
+ *
+ * 20-Mar-83 Modified processing of TASK stmt to use file inclusion
+ * to read the RUNTASK file, making it possible to maintain
+ * the IRAF main as a .x file, rather than as a .r file.
+ *
+ * Dec-83 Fixed bug in processing of TASK stmt which prevented
+ * compilation of processes with many tasks. Added many
+ * comments and cleaned up the code a bit.
+ */
diff --git a/unix/boot/spp/xpp/xppmain.c b/unix/boot/spp/xpp/xppmain.c
new file mode 100644
index 00000000..766aa41d
--- /dev/null
+++ b/unix/boot/spp/xpp/xppmain.c
@@ -0,0 +1,225 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#include <stdio.h>
+#include <ctype.h>
+#include <string.h>
+#include <stdlib.h>
+#include "xpp.h"
+#include "../../bootProto.h"
+
+#define import_spp
+#define import_knames
+#include <iraf.h>
+
+/*
+ * Main routine for the XPP preprocessor (first pass of the SPP compiler).
+ */
+
+#define IRAFDEFS "host$hlib/iraf.h"
+
+int errflag;
+int foreigndefs;
+int hbindefs = 0;
+char irafdefs[SZ_PATHNAME];
+char *pkgenv = NULL;
+char v_pkgenv[SZ_FNAME];
+
+extern FILE *yyin;
+extern FILE *yyout;
+extern char fname[][SZ_PATHNAME];
+extern int linenum[];
+extern char *vfn2osfn();
+extern char *os_getenv();
+char *dottor();
+
+extern void ZZSTRT (void);
+extern void ZZSTOP (void);
+extern int yylex (void);
+
+static int isxfile (char *fname);
+
+
+int main (int argc, char *argv[])
+{
+ int i, rfflag, nfiles;
+ FILE *fp_defs, *source;
+ char *p;
+
+ ZZSTRT();
+
+ errflag = XPP_OK;
+ linenum[0] = 1;
+ rfflag = NO;
+ nfiles = 0;
+
+ /* Process flags and count the number of files.
+ */
+ for (i=1; argv[i] != NULL; i++) {
+ if (argv[i][0] == '-') {
+ switch (argv[i][1]) {
+ case 'R':
+ /* Write .r file. */
+ rfflag = YES;
+ break;
+ case 'r':
+ /* Not used anymore */
+ if ((p = argv[++i]) == NULL)
+ --i;
+ break;
+ case 'h':
+ /* Use custom irafdefs file. */
+ if ((p = argv[++i]) == NULL)
+ --i;
+ else {
+ foreigndefs++;
+ strcpy (irafdefs, p);
+ }
+ break;
+ case 'A':
+ /* Use architecture-specific include file. */
+ hbindefs++;
+ break;
+ case 'p':
+ /* Load the environment for the named package. */
+ if ((pkgenv = argv[++i]) == NULL)
+ --i;
+ else
+ loadpkgenv (pkgenv);
+ break;
+ default:
+ fprintf (stderr, "unknown option '%s'\n", argv[i]);
+ fflush (stderr);
+ }
+ } else if (isxfile (argv[i]))
+ nfiles++;
+ }
+
+ /* If no package environment was specified on the command line,
+ * check if the user has a default package set in their environment.
+ */
+ if (!pkgenv) {
+ if ((pkgenv = os_getenv("PKGENV"))) {
+ strcpy (v_pkgenv, pkgenv);
+ loadpkgenv (pkgenv = v_pkgenv);
+ }
+ }
+
+ /* Generate pathname of <iraf.h>.
+ */
+ if (!foreigndefs)
+ strcpy (irafdefs, vfn2osfn (IRAFDEFS,0));
+
+ /* Process either the standard input or a list of files.
+ */
+ if (nfiles == 0) {
+ yyin = stdin;
+ yyout = stdout;
+ strcpy (fname[0], "STDIN");
+ yylex();
+
+ } else {
+ /* Preprocess each file.
+ */
+ for (i=1; argv[i] != NULL; i++)
+ if (isxfile (argv[i])) {
+ if (nfiles > 1) {
+ fprintf (stderr, "%s:\n", argv[i]);
+ fflush (stderr);
+ }
+
+ /* Open source file.
+ */
+ if ((source = fopen (vfn2osfn(argv[i],0), "r")) == NULL) {
+ fprintf (stderr, "cannot read file %s\n", argv[i]);
+ fflush (stderr);
+ errflag |= XPP_BADXFILE;
+ } else {
+ /* Open output file.
+ */
+ if (rfflag) {
+ char *osfn;
+ osfn = vfn2osfn (dottor (argv[i]), 0);
+ if ((yyout = fopen (osfn, "w")) == NULL) {
+ fprintf (stderr,
+ "cannot write output file %s\n", osfn);
+ fflush (stderr);
+ errflag |= XPP_BADXFILE;
+ fclose (yyin);
+ continue;
+ }
+ } else
+ yyout = stdout;
+
+ /* Open and process hlib$iraf.h.
+ */
+ if ((fp_defs = fopen (irafdefs, "r")) == NULL) {
+ fprintf (stderr, "cannot open %s\n", irafdefs);
+ ZZSTOP();
+ exit (XPP_COMPERR);
+ }
+ yyin = fp_defs;
+ yylex();
+ linenum[0] = 1;
+ fclose (fp_defs);
+
+ /* Process the source file.
+ */
+ strcpy (fname[0], argv[i]);
+ yyin = source;
+ yylex();
+ fclose (source);
+
+ if (rfflag)
+ fclose (yyout);
+ }
+ }
+ }
+
+ ZZSTOP();
+ exit (errflag);
+
+ return (0);
+}
+
+
+/* ISXFILE -- Does the named file have a ".x" extension.
+ */
+static int
+isxfile (char *fname)
+{
+ char *p;
+
+ if (fname[0] != '-') {
+ for (p=fname; *p++ != EOS; )
+ ;
+ while (*--p != '.' && p >= fname)
+ ;
+ if (*p == '.' && *(p+1) == 'x')
+ return (YES);
+ }
+ return (NO);
+}
+
+
+/* DOTTOR -- Change the extension of the named file to ".r".
+ */
+char *
+dottor (fname)
+char *fname;
+{
+ static char rfname[SZ_PATHNAME+1];
+ char *ip, *op, *lastdot;
+
+ lastdot = NULL;
+ for (ip=fname, op=rfname; (*op = *ip++); op++)
+ if (*op == '.')
+ lastdot = op;
+
+ if (lastdot) {
+ *(lastdot+1) = 'r';
+ *(lastdot+2) = EOS;
+ }
+
+ return (rfname);
+}
diff --git a/unix/boot/spp/xpp/zztest.x b/unix/boot/spp/xpp/zztest.x
new file mode 100644
index 00000000..9cf695b0
--- /dev/null
+++ b/unix/boot/spp/xpp/zztest.x
@@ -0,0 +1,19 @@
+include <gio.h>
+
+define FOO Memr[Memi[$1+12]] # test comment
+
+define BAR Memr[$1]
+define BAR1 Memr[$1+1]
+define BAR2 Memr[TEST($1)]
+
+define FOOBAR Memr[$1]
+
+procedure hello()
+
+pointer xs, xe
+define XS Memr[xs+($1)-1]
+define XE Memr[xe+($1)-1]
+
+begin
+ call printf ("hello, world: %d\n", FOO(1))
+end
generated by cgit (git 2.34.1) at 2025-09-20 07:03:50 -0400