aboutsummaryrefslogtreecommitdiff
path: root/unix/boot/spp/xpp/xpp.l
diff options
context:
space:
mode:
Diffstat (limited to 'unix/boot/spp/xpp/xpp.l')
-rw-r--r--unix/boot/spp/xpp/xpp.l476
1 files changed, 476 insertions, 0 deletions
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);
+}
generated by cgit (git 2.34.1) at 2025-09-20 07:05:14 -0400