Initial commit

490 files changed, 52657 insertions, 0 deletions

diff --git a/unix/boot/README b/unix/boot/README
new file mode 100644
index 00000000..cbba59ef
--- /dev/null
+++ b/unix/boot/README
@@ -0,0 +1,19 @@
+BOOT -- Bootstrap utilities for building and maintaining IRAF.  The utilities
+in this package are implemented at the host system level, sometimes with
+assistance from the iraf kernel or other libraries.  All utilites are host
+system callable, regardless of how they are implemented.
+
+Major directories:
+
+	mkpkg		- package/library maintenance utility
+	spp		- compiler for the SPP language
+	rmbin		- seek out and destroy all binaries in a directory tree
+	rtar		- tar file reader
+	wtar		- tar file writer
+	bootlib		- system interface for the bootstrap utilities
+
+Others:
+
+	xyacc		- SPP/Yacc
+	generic		- generic preprocessor
+	vfn		- old boot-boot version of vfn2osfn (not currently used)
diff --git a/unix/boot/bootProto.h b/unix/boot/bootProto.h
new file mode 100644
index 00000000..388c2fd5
--- /dev/null
+++ b/unix/boot/bootProto.h
@@ -0,0 +1,53 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define import_spp
+#define import_knames
+#include <iraf.h>
+
+
+void 	BYTMOV (XCHAR *a, XINT *aoff, XCHAR *b, XINT *boff, XINT *nbytes);
+
+void 	loadpkgenv (char *pkg);
+void 	_envinit (void);
+void 	loadenv (char *osfn);
+
+#ifdef NO_OS_INDEX
+char   *index (char *str, int ch);
+char   *rindex (char *str, int ch);
+#endif
+
+int 	os_access (char *fname, int mode, int type);
+void 	os_amovb (char *a, char *b, int nbytes);
+int 	os_chdir (char *dir);
+void 	os_close (int fd);
+int 	os_cmd (char *cmd);
+int 	os_createdir (char *dirname, int mode);
+int 	os_createfile (char *fname, int mode, int type);
+int 	os_delete (char *fname);
+int 	os_diropen (char *dirname);
+int 	os_dirclose (int chan);
+int 	os_gfdir (int chan, char *fname, int maxch);
+int 	os_fcopy (char *oldfile, char *newfile);
+long 	os_fdate (char *fname);
+int 	os_filetype (char *fname);
+char   *osfn2vfn (char *osfn);
+int 	os_fpathname (char *vfn, char *osfn, int maxch);
+char   *os_getenv (char *envvar);
+void 	os_getowner (char *fname, int *uid, int *gid);
+int 	os_open (char *vfn, int mode, int type);
+void 	os_putenv (char *name, char *value);
+int 	os_read (int fd, char *buf, int nbytes);
+int 	os_setfmode (char *fname, int mode);
+int 	os_setowner (char *fname, int uid, int gid);
+int 	os_setmtime (char *fname, long mtime);
+char   *os_strpak (XCHAR *sppstr, char *cstr, int maxch);
+XCHAR  *os_strupk (char *str, XCHAR *outstr, int maxch);
+char   *os_subdir (char *dir, char *subdir);
+int 	os_symlink (char *fname, char *valbuf, int maxch);
+int 	os_sysfile (char *sysfile, char *fname, int maxch);
+char   *os_irafpath (char *sysfile);
+long 	os_utime (long iraf_time);
+long 	os_itime (long unix_time);
+int 	os_write (int fd, char *buf, int nbytes);
+char   *vfn2osfn (char *vfn, int new);
diff --git a/unix/boot/bootlib/README b/unix/boot/bootlib/README
new file mode 100644
index 00000000..b934f681
--- /dev/null
+++ b/unix/boot/bootlib/README
@@ -0,0 +1,53 @@
+BOOTLIB -- C callable file primitives used by the bootstrap utilities.
+
+This is a somewhat adhoc interface consisting of a collection of low level
+functions required by the bootstrap utilities.  As far as possible these
+use the iraf kernel, but occasionally non-kernel facilities are required or
+desirable.  The purpose of this interface is to isolate the machine dependence
+of the bootstrap utilities from the bulk of the code, making it easier to
+maintain IRAF on different hosts, as well as to make it easier to port IRAF
+to a new host.  No attempt has been made to specify this interface carefully;
+it is not necessary since only a limited number of programs use the routines.
+
+Partial list of functions (grows sporadically):
+
+	char *	     vfn2osfn (vfn, mode)		# Map filenames
+	char *	     osfn2vfn (osfn)
+
+	      fd = os_diropen (dir)			# Read directories
+		  os_dirclose (fd)
+		     os_gfdir (fd, fname, maxch)
+
+	bool	    os_access (fname, mode, type)	# General file
+		     os_chdir (dir)
+		     os_close (fd)
+		       os_cmd (cmd)
+		     os_close (fd
+		 os_createdir (dirname, mode)
+		os_createfile (fname, mode, type)
+		    os_delete (fname)
+		     os_fcopy (oldfile, newfile)
+		 os_fpathname (vfn, pathname, maxch)
+	long	     os_fdate (file)
+	char *      os_getenv (ennvar)
+		 fd = os_open (fname, mode, type)
+		  os_setfmode (fname, mode)
+		  os_setowner (fname, uid, gid)
+		  os_setmtime (fname, mtime)
+		   os_sysfile (fname, outstr, maxch)
+		      os_read (fd, buf, nbytes)
+		     os_write (fd, buf, nbytes)
+
+	       fd = tape_open (fname, mode)		# Tape or disk file
+		   tape_close (fd)
+		    tape_read (fd, buf, nbytes)
+		   tape_write (fd, buf, nbytes)
+
+
+Tasks which use this library must also use the kernel library (libos.a).
+Tasks which use full filename mapping will also need libsys.a and libvops.a,
+however the system can be bootstrapped with simpler filename mapping and
+then the utilities relinked with full filename mapping, once the system
+libraries have been generated.  Note that no VOS level i/o is used (only
+kernel level i/o functions are used), hence an IRAF main is not required
+to initialize the VOS i/o system.
diff --git a/unix/boot/bootlib/_bytmov.c b/unix/boot/bootlib/_bytmov.c
new file mode 100644
index 00000000..849d8e52
--- /dev/null
+++ b/unix/boot/bootlib/_bytmov.c
@@ -0,0 +1,41 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define	import_spp
+#define import_knames
+#include <iraf.h>
+
+/* BYTMOV -- Byte move from array "a" to array "b".  The move must be
+ * nondestructive, allowing a byte array to be shifted left or right a
+ * few bytes, hence comparison of the addresses of the arrays is necessary
+ * to determine if they overlap.
+ */
+void
+BYTMOV (
+  XCHAR	*a,			/* input byte array			*/
+  XINT	*aoff,			/* first byte in A to be moved		*/
+  XCHAR	*b,			/* output byte array			*/
+  XINT	*boff,			/* first byte in B to be written	*/
+  XINT	*nbytes 		/* number of bytes to move		*/
+)
+{
+	register char	*ip, *op;
+	register int	n = *nbytes;
+	char	*ap, *bp;
+
+	ap = (char *)a + (*aoff - 1);
+	bp = (char *)b + (*boff - 1);
+
+	/* If the two arrays are the same return immediately.  If the move is
+	 * to the left then copy left to right, else copy right to left.
+	 */
+	if (ap == bp) {
+	    return;
+	} else if (bp < ap) {
+	    for (ip=ap, op=bp;  --n >= 0;  )
+		*op++ = *ip++;
+	} else {
+	    for (ip = &ap[n], op = &bp[n];  --n >=  0;  )
+		*--op = *--ip;
+	}
+}
diff --git a/unix/boot/bootlib/bootlib.h b/unix/boot/bootlib/bootlib.h
new file mode 100644
index 00000000..b1bbbc7a
--- /dev/null
+++ b/unix/boot/bootlib/bootlib.h
@@ -0,0 +1,36 @@
+#include <stdio.h>
+#include <ctype.h>
+#define	import_spp
+#define	NOKNET
+#define	import_knames
+#include <iraf.h>
+
+#define	SZ_FBUF		512		/* File i/o buffer size		*/
+
+#ifdef VMS
+#define	rindex	strrchr 
+struct	timeval {
+	long	tv_sec;
+	long	tv_usec;
+};
+#else
+#include <sys/time.h>
+#endif
+
+
+# ifdef FINIT
+int	bdebug = 0;			/* print debug stuff		*/
+int	osfiletype;			/* type of single output file	*/
+XCHAR	text[SZ_FBUF];			/* output text line if textfile	*/
+XCHAR	*txop;				/* next char in output buf	*/
+# else
+extern	int bdebug;
+extern	int osfiletype;
+extern	XCHAR text[];
+extern	XCHAR *txop;
+# endif
+
+char	*vfn2osfn();
+char	*osfn2vfn();
+char	*os_strpak();
+XCHAR	*os_strupk();
diff --git a/unix/boot/bootlib/envinit.c b/unix/boot/bootlib/envinit.c
new file mode 100644
index 00000000..e70a8d86
--- /dev/null
+++ b/unix/boot/bootlib/envinit.c
@@ -0,0 +1,269 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#include <stdio.h>
+#include <string.h>
+#define	import_spp
+#define	import_xnames
+#include <iraf.h>
+
+#define	isspace(c)	((c)==' '||(c)=='\t'||(c)=='\n')
+#define	SETENV		"zzsetenv.def"
+#define	SZ_VALUE	SZ_COMMAND
+#define	MAXLEV		8
+#define	PKGLIBS		"pkglibs"
+#define	IRAFARCH	"IRAFARCH"
+#define	ARCH		"arch"
+
+extern	char  *_os_getenv (char *envvar, char *outstr, int maxch);
+extern	char  *os_getenv (char *envvar);
+extern	char  *os_strpak (XCHAR *sppstr, char *cstr, int maxch);
+extern	char  *vfn2osfn (char *vfn, int new);
+extern  XCHAR *os_strupk (char *str, XCHAR *outstr, int maxch);
+extern	void   os_putenv (char *name, char *value);
+extern	int bdebug;
+
+void 	_envinit (void);
+void 	loadenv (char *osfn);
+
+
+
+/* LOADPKGENV -- Load the environment definitions for the named package.
+ * [e.g., loadpkgenv ("noao")].  This assumes that the root directory of
+ * the named package is already defined, and that this directory contains
+ * a subdirectory lib containing the file zzsetenv.def.  If none of these
+ * assumptions are true, call loadenv(osfn) with the host filename of the
+ * file to be loaded.
+ */
+void
+loadpkgenv (char *pkg)
+{
+	char	vfn[SZ_PATHNAME+1];
+	char	pkglibs[SZ_COMMAND+1];
+	char	newlibs[SZ_COMMAND+1];
+
+	/* Initialize the default IRAF environment. */
+	_envinit();
+
+	/* If no package name is given or the IRAF environment is being
+	 * loaded we are done.
+	 */
+	if (!pkg || strcmp(pkg,"iraf")==0)
+	    return;
+
+	strcpy (vfn, pkg);
+	strcat (vfn, "$lib/");
+	strcat (vfn, SETENV);
+
+	/* Load the package environment.  The new values are added to the
+	 * environment in the conventional way except for the value of
+	 * "pkglibs".  As each package environment is loaded we want to
+	 * add the newly defined package libraries to the current list
+	 * of package libraries, otherwise the most recent package environment
+	 * overrides the earlier ones.  It is still possible that user
+	 * defined environment variables will be redefined but there is
+	 * little we can do about that; "pkglibs" is special though since
+	 * it is a part of the loadpkgenv facility.
+	 */
+	_os_getenv (PKGLIBS, pkglibs, SZ_COMMAND);
+	loadenv (vfn2osfn (vfn, 0));
+	_os_getenv (PKGLIBS, newlibs, SZ_COMMAND);
+
+	if (strlen(newlibs) > 0 && strcmp (newlibs, pkglibs)) {
+	    char    *ip, *op;
+	    char    *otop;
+
+	    /* Find the end of the current pkglibs file list. */
+	    for (ip=op=pkglibs;  *ip;  ip++)
+		if (!isspace(*ip))
+		    op = ip + 1;
+
+	    /* Concatenate the new files list segment. */
+	    if (op > pkglibs)
+		*op++ = ',';
+	    for (ip=newlibs, otop=pkglibs+SZ_COMMAND;  *ip && op < otop;  ip++)
+		if (!isspace(*ip))
+		    *op++ = *ip;
+
+	    /* Blank fill to the next SZ_LINE increment to optimize resets. */
+	    while (op < otop && ((op-pkglibs) % SZ_LINE))
+		*op++ = ' ';
+	    *op++ = EOS;
+		
+	    /* Reset the stored value in the environment. */
+	    os_putenv (PKGLIBS, pkglibs);
+	}
+}
+
+
+#ifdef NOVOS
+void _envinit (void) {}
+void loadenv (char *osfn) { printf ("HSI is compiled NOVOS\n"); }
+#else
+
+/* ENVINIT -- Initialize the VOS environment list by scanning the file
+ * hlib$zzsetenv.def.  HLIB is defined in terms of HOST which is sufficiently
+ * well known to have a value before the environment list is loaded.
+ */
+void
+_envinit (void)
+{
+	static	int initialized = 0;
+	char	osfn[SZ_PATHNAME+1], *hlib;
+	char	irafarch[SZ_PATHNAME+1];
+
+	extern  void ENVINIT(), ENVRESET();
+
+
+	if (initialized++)
+	    return;
+
+	if ( (hlib = os_getenv ("hlib")) ) {
+	    strcpy (osfn, hlib);
+	    strcat (osfn, SETENV);
+	} else {
+	    fprintf (stderr, "cannot translate logical name `hlib'");
+	    fflush (stderr);
+	}
+
+	ENVINIT();
+	loadenv (osfn);
+
+	/* If the variable "IRAFARCH" is defined and "arch" is not, add
+	 * a definition for the latter.  "arch" is used to construct
+	 * pathnames but the HSI architecture support requires only that
+	 * IRAFARCH be predefined.
+	 */
+	if (_os_getenv (IRAFARCH, irafarch, SZ_PATHNAME))
+	    if (!_os_getenv (ARCH, osfn, SZ_PATHNAME)) {
+		XCHAR   x_name[SZ_PATHNAME+1];
+		XCHAR   x_value[SZ_PATHNAME+1];
+
+		sprintf (osfn, ".%s", irafarch);
+		os_strupk (ARCH, x_name, SZ_PATHNAME);
+		os_strupk (osfn, x_value, SZ_PATHNAME);
+		ENVRESET (x_name, x_value);
+	    }
+}
+
+
+/* LOADENV -- Load environment definitions from the named host file.
+ */
+void
+loadenv (char *osfn)
+{
+	register char	*ip;
+	register XCHAR	*op;
+
+	char	lbuf[SZ_LINE+1];
+	char	pkname[SZ_FNAME+1], old_value[SZ_VALUE+1];
+	XCHAR	name[SZ_FNAME+1], value[SZ_VALUE+1];
+	FILE	*fp, *sv_fp[MAXLEV];
+	int	lev=0;
+
+	extern  void ENVRESET();
+
+
+	if ((fp = fopen (osfn, "r")) == NULL) {
+	    printf ("envinit: cannot open `%s'\n", osfn);
+	    fflush (stdout);
+	    return;
+	}
+
+	for (;;) {
+	    /* Get next line from input file. */
+	    if (fgets (lbuf, SZ_LINE, fp) == NULL) {
+		/* End of file. */
+		if (lev > 0) {
+		    fclose (fp);
+		    fp = sv_fp[--lev];
+		    continue;
+		} else
+		    break;
+
+	    } else {
+		/* Skip comments and blank lines. */
+		for (ip=lbuf;  isspace(*ip);  ip++)
+		    ;
+		if (strncmp (lbuf, "set", 3) != 0) {
+		    if (strncmp (lbuf, "reset", 5) != 0)
+			continue;
+		    else
+			ip += 5;
+		} else
+		    ip += 3;
+
+		/* Check for @file inclusion. */
+		while (isspace(*ip))
+		    ip++;
+
+		if (*ip == '@') {
+		    sv_fp[lev++] = fp;
+		    if (lev >= MAXLEV) {
+			printf ("envinit: nesting too deep\n");
+			fflush (stdout);
+			break;
+
+		    } else {
+			char *fname;
+			fname = ++ip;
+
+			while (*ip)
+			    if (isspace(*ip)) {
+				*ip = '\0';
+				break;
+			    } else
+				ip++;
+
+			if ((fp = fopen (vfn2osfn(fname,0), "r")) == NULL) {
+			    printf ("envinit: cannot open `%s'\n", fname);
+			    fflush (stdout);
+			    break;
+			}
+		    }
+		    continue;
+		}
+
+		/* fall through */
+	    }
+
+	    /* Extract name field. */
+	    for (op=name;  *ip && *ip != '=' && !isspace(*ip);  op++)
+		*op = *ip++;
+	    *op = XEOS;
+
+	    /* Extract value field; may be quoted.  Newline may be escaped
+	     * to break a long value string over several lines of the input
+	     * file.
+	     */
+	    for (; *ip && (*ip == '=' || *ip == '"' || isspace (*ip));  ip++)
+		;
+	    for (op=value;  *ip && *ip != '"' && *ip != '\n';  op++)
+		if (*ip == '\\' && *(ip+1) == '\n') {
+again:		    if (fgets (lbuf, SZ_LINE, fp) == NULL)
+			break;
+		    for (ip=lbuf;  isspace(*ip);  ip++)
+			;
+		    if (*ip == '#')
+			goto again;
+		} else
+		    *op = *ip++;
+	    *op = XEOS;
+
+	    /* Allow the user to override the values of environment variables
+	     * by defining them in their host environment.  Once again,
+	     * "pkglibs" requires special treatment as we want to permit
+	     * redefinitions to allow concatenation in loadpkgenv().
+	     */
+	    os_strpak (name, pkname, SZ_FNAME);
+	    if (strcmp (pkname, PKGLIBS) &&
+		_os_getenv (pkname, old_value, SZ_VALUE)) {
+		if (bdebug)
+		    printf ("%s = %s\n", pkname, old_value);
+	    } else
+		ENVRESET (name, value);
+	}
+
+	fclose (fp);
+}
+#endif
diff --git a/unix/boot/bootlib/index.c b/unix/boot/bootlib/index.c
new file mode 100644
index 00000000..e3387060
--- /dev/null
+++ b/unix/boot/bootlib/index.c
@@ -0,0 +1,39 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#include <stdio.h>
+
+#ifdef LINUX
+#define NOINDEX
+#endif
+#ifdef MACOSX
+/* The following effectively disables the local version. */
+#define index strindex
+#endif
+
+/* index and rindex are provided by most systems and are redundantly defined
+ * here only in case they are missing (we probably should be using the more
+ * modern strchr etc. but that is another thing).  Linux (slackware at least)
+ * defines these in the same libc.a object module as strchr etc. (this is a
+ * bug), which causes a library conflict.  Hence on Linux systems we omit
+ * these functions.
+ */
+#ifndef NOINDEX
+
+/* INDEX -- Return pointer to the first occurrence of a character in a string,
+ * or null if the char is not found.
+ */
+char *
+index ( char *str, int ch)
+{
+	register char	*ip;
+	register int	cch;
+
+	for (ip=str;  (cch = *ip);  ip++)
+	    if (cch == ch)
+		return (ip);
+
+	return (NULL);
+}
+
+#endif
diff --git a/unix/boot/bootlib/kproto32.h b/unix/boot/bootlib/kproto32.h
new file mode 100644
index 00000000..e407cff5
--- /dev/null
+++ b/unix/boot/bootlib/kproto32.h
@@ -0,0 +1,80 @@
+/* _bytmov.c */
+extern void bytmov_(short *a, int *aoff, short *b, int *boff, int *nbytes);
+/* envinit.c */
+extern void loadpkgenv(char *pkg);
+extern void _envinit(void);
+extern void loadenv(char *osfn);
+/* index.c */
+/* osaccess.c */
+extern int os_access(char *fname, int mode, int type);
+/* osamovb.c */
+extern void os_amovb(char *a, char *b, int nbytes);
+/* oschdir.c */
+extern int os_chdir(char *dir);
+/* osclose.c */
+extern void os_close(int fd);
+/* oscmd.c */
+extern int os_cmd(char *cmd);
+/* oscreatedir.c */
+extern int os_createdir(char *dirname, int mode);
+/* oscrfile.c */
+extern int os_createfile(char *fname, int mode, int type);
+/* osdelete.c */
+extern int os_delete(char *fname);
+/* osdir.c */
+extern int os_diropen(char *dirname);
+extern int os_dirclose(int chan);
+extern int os_gfdir(int chan, char *fname, int maxch);
+/* osfcopy.c */
+extern int os_fcopy(char *oldfile, char *newfile);
+/* osfdate.c */
+extern long os_fdate(char *fname);
+/* osfiletype.c */
+extern int os_filetype(char *fname);
+/* osfn2vfn.c */
+extern char *osfn2vfn(char *osfn);
+/* osfpathname.c */
+extern int os_fpathname(char *vfn, char *osfn, int maxch);
+/* osgetenv.c */
+extern char *os_getenv(char *envvar);
+extern char *_os_getenv(char *envvar, char *outstr, int maxch);
+/* osgetowner.c */
+extern void os_getowner(char *fname, int *uid, int *gid);
+/* osopen.c */
+extern int os_open(char *vfn, int mode, int type);
+/* osputenv.c */
+extern void os_putenv(char *name, char *value);
+/* osread.c */
+extern int os_read(int fd, char *buf, int nbytes);
+/* ossetfmode.c */
+extern int os_setfmode(char *fname, int mode);
+/* ossetowner.c */
+extern int os_setowner(char *fname, int uid, int gid);
+/* ossettime.c */
+extern int os_setmtime(char *fname, long mtime);
+/* osstrpak.c */
+extern char *os_strpak(short *sppstr, char *cstr, int maxch);
+/* osstrupk.c */
+extern short *os_strupk(char *str, short *outstr, int maxch);
+/* ossubdir.c */
+extern char *os_subdir(char *dir, char *subdir);
+/* ossymlink.c */
+extern int os_symlink(char *fname, char *valbuf, int maxch);
+/* ossysfile.c */
+extern int os_sysfile(char *sysfile, char *fname, int maxch);
+/* ostime.c */
+extern long os_utime(long iraf_time);
+extern long os_itime(long unix_time);
+/* oswrite.c */
+extern int os_write(int fd, char *buf, int nbytes);
+/* rindex.c */
+/* tape.c */
+extern int tape_open(char *fname, int mode);
+extern int tape_close(int fd);
+extern int tape_read(int fd, char *buf, int maxbytes);
+extern int tape_write(int fd, char *buf, int nbytes);
+/* vfn2osfn.c */
+extern char *vfn2osfn(char *vfn, int new);
+extern int kigets_(void);
+extern void kisend_(void);
+extern void kirece_(void);
diff --git a/unix/boot/bootlib/kproto64.h b/unix/boot/bootlib/kproto64.h
new file mode 100644
index 00000000..5335919c
--- /dev/null
+++ b/unix/boot/bootlib/kproto64.h
@@ -0,0 +1,80 @@
+/* _bytmov.c */
+extern void bytmov_(short *a, long *aoff, short *b, long *boff, long *nbytes);
+/* envinit.c */
+extern void loadpkgenv(char *pkg);
+extern void _envinit(void);
+extern void loadenv(char *osfn);
+/* index.c */
+/* osaccess.c */
+extern int os_access(char *fname, int mode, int type);
+/* osamovb.c */
+extern void os_amovb(char *a, char *b, int nbytes);
+/* oschdir.c */
+extern int os_chdir(char *dir);
+/* osclose.c */
+extern void os_close(int fd);
+/* oscmd.c */
+extern int os_cmd(char *cmd);
+/* oscreatedir.c */
+extern int os_createdir(char *dirname, int mode);
+/* oscrfile.c */
+extern int os_createfile(char *fname, int mode, int type);
+/* osdelete.c */
+extern int os_delete(char *fname);
+/* osdir.c */
+extern int os_diropen(char *dirname);
+extern int os_dirclose(int chan);
+extern int os_gfdir(int chan, char *fname, int maxch);
+/* osfcopy.c */
+extern int os_fcopy(char *oldfile, char *newfile);
+/* osfdate.c */
+extern long os_fdate(char *fname);
+/* osfiletype.c */
+extern int os_filetype(char *fname);
+/* osfn2vfn.c */
+extern char *osfn2vfn(char *osfn);
+/* osfpathname.c */
+extern int os_fpathname(char *vfn, char *osfn, int maxch);
+/* osgetenv.c */
+extern char *os_getenv(char *envvar);
+extern char *_os_getenv(char *envvar, char *outstr, int maxch);
+/* osgetowner.c */
+extern void os_getowner(char *fname, int *uid, int *gid);
+/* osopen.c */
+extern int os_open(char *vfn, int mode, int type);
+/* osputenv.c */
+extern void os_putenv(char *name, char *value);
+/* osread.c */
+extern int os_read(int fd, char *buf, int nbytes);
+/* ossetfmode.c */
+extern int os_setfmode(char *fname, int mode);
+/* ossetowner.c */
+extern int os_setowner(char *fname, int uid, int gid);
+/* ossettime.c */
+extern int os_setmtime(char *fname, long mtime);
+/* osstrpak.c */
+extern char *os_strpak(short *sppstr, char *cstr, int maxch);
+/* osstrupk.c */
+extern short *os_strupk(char *str, short *outstr, int maxch);
+/* ossubdir.c */
+extern char *os_subdir(char *dir, char *subdir);
+/* ossymlink.c */
+extern int os_symlink(char *fname, char *valbuf, int maxch);
+/* ossysfile.c */
+extern int os_sysfile(char *sysfile, char *fname, int maxch);
+/* ostime.c */
+extern long os_utime(long iraf_time);
+extern long os_itime(long unix_time);
+/* oswrite.c */
+extern int os_write(int fd, char *buf, int nbytes);
+/* rindex.c */
+/* tape.c */
+extern int tape_open(char *fname, int mode);
+extern int tape_close(int fd);
+extern int tape_read(int fd, char *buf, int maxbytes);
+extern int tape_write(int fd, char *buf, int nbytes);
+/* vfn2osfn.c */
+extern char *vfn2osfn(char *vfn, int new);
+extern int kigets_(void);
+extern void kisend_(void);
+extern void kirece_(void);
diff --git a/unix/boot/bootlib/mkpkg b/unix/boot/bootlib/mkpkg
new file mode 100644
index 00000000..5b4f9ba1
--- /dev/null
+++ b/unix/boot/bootlib/mkpkg
@@ -0,0 +1,49 @@
+# Update the BOOTLIB library.  The Makefile is used to bootstrap the library,
+# but once MKPKG is up it is easier to maintain the library with MKPKG.
+
+$checkout libboot.a hlib$
+$update   libboot.a
+$checkin  libboot.a hlib$
+$exit
+
+libboot.a:
+	$set XFLAGS = "-c $(HSI_XF)"
+	$iffile (as$bytmov.s)  as$bytmov.s  $else  _bytmov.c  $endif
+	osamovb.c
+
+	index.c
+	rindex.c
+	envinit.c
+
+	osaccess.c	bootlib.h
+	oschdir.c	bootlib.h
+	osclose.c	bootlib.h
+	oscmd.c		bootlib.h
+	oscreatedir.c	bootlib.h
+	oscrfile.c	bootlib.h
+	osdelete.c	bootlib.h
+	osdir.c		bootlib.h
+	osfcopy.c	bootlib.h
+	osfdate.c	bootlib.h
+	osfiletype.c
+	osfpathname.c	bootlib.h
+	osgetenv.c	bootlib.h
+	osgetowner.c	bootlib.h
+	osopen.c
+	osputenv.c	bootlib.h
+	osread.c
+	ossetfmode.c	bootlib.h
+	ossetowner.c	bootlib.h
+	ossettime.c	bootlib.h
+	osstrpak.c
+	osstrupk.c
+	ossymlink.c
+	ossubdir.c	bootlib.h
+	ossysfile.c	bootlib.h
+	ostime.c
+	oswrite.c	bootlib.h
+
+	vfn2osfn.c	bootlib.h
+	osfn2vfn.c	bootlib.h
+	tape.c
+	;
diff --git a/unix/boot/bootlib/mkpkg.sh b/unix/boot/bootlib/mkpkg.sh
new file mode 100644
index 00000000..6f37c67e
--- /dev/null
+++ b/unix/boot/bootlib/mkpkg.sh
@@ -0,0 +1,16 @@
+# Make the bootstrap utilities library (bootlib).
+
+if test -f ../../as/bytmov.s; then\
+    $CC -c $HSI_CF ../../as/bytmov.s -o bytmov.o;\
+else\
+    $CC -c $HSI_CF _bytmov.c;\
+fi
+
+# $CC -c $HSI_CF [a-z]*.c
+for i in [a-z]*.c ;\
+do	$CC -c $HSI_CF $i ;\
+done
+
+ar rv		libboot.a *.o; rm *.o
+$RANLIB		libboot.a
+mv -f		libboot.a ../../bin
diff --git a/unix/boot/bootlib/osaccess.c b/unix/boot/bootlib/osaccess.c
new file mode 100644
index 00000000..0c6861e7
--- /dev/null
+++ b/unix/boot/bootlib/osaccess.c
@@ -0,0 +1,27 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#include <string.h>
+#include "bootlib.h"
+
+/* OS_ACCESS -- Determine if file is accessible with the given access mode
+ * and type.  Returns YES (1) or NO (0).
+ */
+int
+os_access (
+  char	*fname,
+  int	mode,
+  int	type
+)
+{
+	PKCHAR	osfn[SZ_PATHNAME+1];
+	XINT	status, xmode=mode, xtype=type;
+
+	extern  int ZFACSS();
+
+
+	strcpy ((char *)osfn, vfn2osfn(fname,0));
+	ZFACSS (osfn, &xmode, &xtype, &status);
+
+	return (status);
+}
diff --git a/unix/boot/bootlib/osamovb.c b/unix/boot/bootlib/osamovb.c
new file mode 100644
index 00000000..71b1d2d0
--- /dev/null
+++ b/unix/boot/bootlib/osamovb.c
@@ -0,0 +1,34 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define import_spp
+#define import_knames
+#include <iraf.h>
+
+
+/* OS_AMOVB -- Memory to memory copy using BYTMOV.
+ */
+void
+os_amovb (
+  char	*a,
+  char	*b,
+  int	nbytes
+)
+{
+	XCHAR	*a_wp, *b_wp;
+	XINT	a_off, b_off;
+
+	extern void BYTMOV();
+
+
+	a_wp = (XCHAR *)a;
+	b_wp = (XCHAR *)b;
+
+	/* The following offsets can be something other than one if the
+	 * buffers are not word aligned.
+	 */
+	a_off = a - (char *)a_wp + 1;
+	b_off = b - (char *)b_wp + 1;
+	
+	BYTMOV (a_wp, &a_off, b_wp, &b_off, &nbytes);
+}
diff --git a/unix/boot/bootlib/oschdir.c b/unix/boot/bootlib/oschdir.c
new file mode 100644
index 00000000..497f1576
--- /dev/null
+++ b/unix/boot/bootlib/oschdir.c
@@ -0,0 +1,43 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#include "bootlib.h"
+
+
+extern int  os_fpathname (char *vfn, char *osfn, int maxch);
+
+
+
+/* OS_CHDIR -- Change the current default directory.  Note that the kernel
+ * procedure ZFCHDR should only be called with the full pathname of a 
+ * directory.
+ */
+int
+os_chdir (char *dir)
+{
+	XCHAR	dpath[SZ_PATHNAME+1];
+	XCHAR	osdir[SZ_PATHNAME+1];
+	XINT	sz_dpath, sz_osdir, status, x_maxch=SZ_PATHNAME;
+
+	extern  int ZFXDIR(), ZFGCWD(), ZFSUBD(), ZFCHDR();
+
+
+	sz_dpath = os_fpathname (dir, (char *)dpath, SZ_PATHNAME);
+	os_strupk ((char *)dpath, osdir, SZ_PATHNAME);
+	ZFXDIR (osdir, osdir, &x_maxch, &sz_osdir);
+
+	if (sz_osdir <= 0) {
+	    /* Dir is a subdirectory, not a full pathname.  Note that this
+	     * only works for an immediate subdirectory, and does not work
+	     * for paths relative to the cwd.
+	     */
+	    ZFGCWD (osdir, &x_maxch, &sz_osdir);
+	    os_strupk ((char *)osdir, osdir, SZ_PATHNAME);
+	    os_strupk (dir, dpath, SZ_PATHNAME);
+	    ZFSUBD (osdir, &x_maxch, dpath, &sz_osdir);
+	    os_strpak (osdir, (char *)dpath, SZ_PATHNAME);
+	}
+
+	ZFCHDR (dpath, &status);
+	return (status);
+}
diff --git a/unix/boot/bootlib/osclose.c b/unix/boot/bootlib/osclose.c
new file mode 100644
index 00000000..f9be512c
--- /dev/null
+++ b/unix/boot/bootlib/osclose.c
@@ -0,0 +1,29 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#include <unistd.h>		/* for close()	*/
+#include "bootlib.h"
+
+
+/* OS_CLOSE -- Close a file created (opened) by OSCREATE.  If writing to a
+ * text file flush any incomplete (non newline terminated) output line.
+ */
+void
+os_close (int fd)
+{
+	XINT	junk, xfd=fd;
+	XINT	nchars;
+
+	extern  int ZPUTTX(), ZCLSTX();
+
+
+	if (osfiletype == BINARY_FILE)
+	    close (fd);
+	else {
+	    if (txop > text) {
+		nchars = txop - text;
+		ZPUTTX (&xfd, text, &nchars, &junk);
+	    }
+	    ZCLSTX (&xfd, &junk);
+	}
+}
diff --git a/unix/boot/bootlib/oscmd.c b/unix/boot/bootlib/oscmd.c
new file mode 100644
index 00000000..0f9c9755
--- /dev/null
+++ b/unix/boot/bootlib/oscmd.c
@@ -0,0 +1,27 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#include <string.h>
+#include "bootlib.h"
+
+#define	SZ_CMD		2048
+
+/* OS_CMD -- Send a command to the host system.
+ */
+int
+os_cmd (char *cmd)
+{
+	PKCHAR	x_cmd[SZ_CMD+1];
+	PKCHAR	nullstr[1];
+	XINT	status;
+	extern  int ZOSCMD();
+
+
+	strncpy ((char *)x_cmd, cmd, SZ_CMD);
+	nullstr[0] = 0;
+
+	/* Terminate the parent process if the OS command is interrupted.
+	 */
+	ZOSCMD (x_cmd, nullstr, nullstr, nullstr, &status);
+	return (status);
+}
diff --git a/unix/boot/bootlib/oscreatedir.c b/unix/boot/bootlib/oscreatedir.c
new file mode 100644
index 00000000..517d0eed
--- /dev/null
+++ b/unix/boot/bootlib/oscreatedir.c
@@ -0,0 +1,18 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#include <sys/stat.h>		/* for mkdir()	*/
+#include "bootlib.h"
+
+/* OS_CREATEDIR -- Create a new subdirectory.
+ */
+int
+os_createdir (
+  char	*dirname,
+  int	mode
+)
+{
+	if (bdebug)
+	    fprintf (stderr, "createdir '%s'\n", dirname);
+	return (mkdir (vfn2osfn(dirname,1), mode));
+}
diff --git a/unix/boot/bootlib/oscrfile.c b/unix/boot/bootlib/oscrfile.c
new file mode 100644
index 00000000..28eec304
--- /dev/null
+++ b/unix/boot/bootlib/oscrfile.c
@@ -0,0 +1,36 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#include <fcntl.h>
+#include "bootlib.h"
+
+
+/* OS_CREATEFILE -- Open a new file for writing.  Create the file with the
+ * given mode bits.
+ */
+int
+os_createfile (
+  char	*fname,
+  int	mode,
+  int	type
+)
+{
+	static	XINT xmode = NEW_FILE;
+	PKCHAR	*osfn = (PKCHAR *) vfn2osfn (fname, 1);
+	XINT	chan;
+	extern  int ZOPNTX();
+
+
+	if (bdebug)
+	    fprintf (stderr, "create %s file `%s' -> `%s'\n",
+		type == TEXT_FILE ? "text" : "binary", fname, (char *)osfn);
+	osfiletype = type;
+
+	if (type == BINARY_FILE)
+	    return (creat ((char *)osfn, mode));
+	else {
+	    ZOPNTX (osfn, &xmode, &chan);
+	    txop = text;
+	    return (chan == XERR ? ERR : chan);
+	}
+}
diff --git a/unix/boot/bootlib/osdelete.c b/unix/boot/bootlib/osdelete.c
new file mode 100644
index 00000000..a56a72e6
--- /dev/null
+++ b/unix/boot/bootlib/osdelete.c
@@ -0,0 +1,19 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#include "bootlib.h"
+
+
+/* OS_DELETE -- Delete a file.
+ */
+int
+os_delete (char *fname)
+{
+	XINT	status;
+
+	extern  int ZFDELE();
+
+
+	ZFDELE ((PKCHAR *)vfn2osfn (fname, 0), &status);
+	return (status);
+}
diff --git a/unix/boot/bootlib/osdir.c b/unix/boot/bootlib/osdir.c
new file mode 100644
index 00000000..d3807302
--- /dev/null
+++ b/unix/boot/bootlib/osdir.c
@@ -0,0 +1,93 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#include <string.h>
+#include "bootlib.h"
+
+
+/*
+ * OS_DIR -- A package for accessing a directory as a list of files.
+ */
+
+#ifndef NOVOS
+
+/* OS_DIROPEN -- Open the directory.
+ */
+int
+os_diropen (char *dirname)
+{
+	PKCHAR	osfn[SZ_PATHNAME+1];
+	XINT	chan;
+
+	extern  int ZOPDIR();
+
+
+	strcpy ((char *)osfn, dirname);
+	ZOPDIR (osfn, &chan);
+
+	return (chan);
+}
+
+
+/* OS_DIRCLOSE -- Close the directory.
+ */
+int
+os_dirclose (int chan)
+{
+	XINT	x_chan=chan, status;
+
+	extern  int ZCLDIR();
+
+
+	ZCLDIR (&x_chan, &status);
+	return (status);
+}
+
+
+/* OS_GFDIR -- Get the next filename from the directory.
+ */
+int
+os_gfdir (
+  int	chan,
+  char	*fname,
+  int	maxch
+)
+{
+	PKCHAR	osfn[SZ_PATHNAME+1];
+	XINT	x_chan=chan, x_maxch=maxch, status;
+
+	extern  int ZGFDIR();
+
+	for (;;) {
+	    ZGFDIR (&x_chan, osfn, &x_maxch, &status);
+	    if (status > 0) {
+		/* Omit the self referential directory files "." and ".."
+		 * or recursion may result.
+		 */
+		if (strcmp ((char *)osfn, ".") == 0)
+		    continue;
+		if (strcmp ((char *)osfn, "..") == 0)
+		    continue;
+
+		strncpy (fname, osfn2vfn ((char *)osfn), maxch);
+		return (status);
+
+	    } else {
+		/* End of directory.
+		 */
+		*fname = EOS;
+		return (0);
+	    }
+	}
+}
+
+#else
+/* NOVOS bootsrap.  Just stub these out until we re-boostrap using the
+ * VOS libs, which provide zopdir.
+ */
+
+int os_dirclose (int chan) { return (-1); }
+int os_diropen (char *dirname) { return (-1); }
+int os_gfdir (int chan, char *fname, int maxch) { return (0); }
+
+#endif
diff --git a/unix/boot/bootlib/osfcopy.c b/unix/boot/bootlib/osfcopy.c
new file mode 100644
index 00000000..037d6eff
--- /dev/null
+++ b/unix/boot/bootlib/osfcopy.c
@@ -0,0 +1,84 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#include <sys/stat.h>
+#include <sys/types.h>
+#include <fcntl.h>
+#include <unistd.h>
+#include "bootlib.h"
+
+extern	int  os_access (char *fname, int mode, int type);
+
+
+/* OS_FCOPY -- Copy a file.  Used by RTAR to resolve links.
+ */
+int
+os_fcopy (
+  char	*oldfile,
+  char	*newfile
+)
+{
+	XCHAR	buf[SZ_FBUF];
+	XINT	status,	junk, maxch = SZ_FBUF, mode = 0, in, out, n, nw;
+
+	extern  int ZOPNTX(), ZGETTX(), ZCLSTX(), ZPUTTX();
+
+
+	if (os_access (oldfile,0,0) == NO)
+	    return (ERR);
+
+	if (os_access (oldfile, 0, TEXT_FILE) == YES) {
+	    if (bdebug)
+		fprintf (stderr, "copy text file '%s' -> '%s'\n",
+		    oldfile, newfile);
+
+	    mode = READ_ONLY;
+	    ZOPNTX ((PKCHAR *)vfn2osfn(oldfile,0), &mode, &in);
+	    if (in == XERR)
+		return (ERR);
+
+	    mode = NEW_FILE;
+	    ZOPNTX ((PKCHAR *)vfn2osfn(newfile,1), &mode, &out);
+	    if (out == XERR) {
+		ZCLSTX (&in, &status);
+		return (ERR);
+	    }
+
+	    while (ZGETTX (&in, buf, &maxch, &n), n != XEOF) {
+		if (n != XERR)
+		    ZPUTTX (&out, buf, &n, &status);
+		if (n == XERR || status == XERR) {
+		    ZCLSTX (&in, &junk);
+		    ZCLSTX (&out, &junk);
+		    return (ERR);
+		}
+	    }
+
+	    ZCLSTX (&in, &status);
+	    ZCLSTX (&out, &status);
+
+	    return (status);
+
+	} else {
+	    if (bdebug)
+		fprintf (stderr, "copy binary file `%s' -> `%s'\n",
+		    oldfile, newfile);
+
+	    if ((in = open (vfn2osfn(oldfile,0), 0)) == ERR)
+		return (ERR);
+	    if ((out = creat (vfn2osfn(newfile,1), 0644)) == ERR) {
+		close (in);
+		return (ERR);
+	    }
+
+	    while ((n = read (in, (char *)buf, SZ_FBUF)) > 0)
+		nw = write (out, (char *)buf, n);
+
+	    close (in);
+	    close (out);
+	    if (n < 0)
+		return (ERR);
+	}
+
+	return (ERR);
+}
diff --git a/unix/boot/bootlib/osfdate.c b/unix/boot/bootlib/osfdate.c
new file mode 100644
index 00000000..900b2a9d
--- /dev/null
+++ b/unix/boot/bootlib/osfdate.c
@@ -0,0 +1,20 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#include <sys/types.h>
+#include <sys/stat.h>
+#include "bootlib.h"
+
+
+/* FDATE -- Get the date of last modification of a file.  [MACHDEP]
+ */
+long
+os_fdate (char *fname)
+{
+	struct	stat buf;
+
+	if (stat (vfn2osfn(fname,0), &buf) == ERR)
+	    return (0);
+	else
+	    return (buf.st_mtime);
+}
diff --git a/unix/boot/bootlib/osfiletype.c b/unix/boot/bootlib/osfiletype.c
new file mode 100644
index 00000000..d211cc99
--- /dev/null
+++ b/unix/boot/bootlib/osfiletype.c
@@ -0,0 +1,116 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#include <stdio.h>
+#include <strings.h>
+#define import_spp
+#include <iraf.h>
+
+/*
+ * OS_FILETYPE -- Determine whether the named file is a text file, a binary
+ * file, or a directory.  The filename extensions used to speed up the test
+ * are portable provided osfn2vfn() is called to map the OSFN before we are
+ * called.
+ */
+
+char *binextn[] = {		/* Known binary file extensions */
+	".o",
+	".e",
+	".a",
+	".so",
+	".pyc",
+	NULL
+};
+
+char *srcextn[] = {		/* Known source file extensions */
+	".x",
+	".h",
+	".f",
+	".f77",
+	".f90",
+	".s",
+	".c",
+	".cpp",
+	".hlp",
+	".mip",
+	".imh",
+	".pix",
+	".gki",
+	".vdm",
+	".fits",
+	".fit",
+	".ftz",
+	".pl",
+	".gif",
+	".jpeg",
+	".jpg",
+	".tiff",
+	".tif",
+	".png",
+	".gz",
+	".tar",
+	".jar",
+	".java",
+	".py",
+	".pdf",
+	".ps",
+	".hqx",
+	".std",
+	NULL
+};
+
+extern 	int  os_access (char *fname, int mode, int type);
+
+
+
+/* OS_FILETYPE -- Determine the type of a file.  If the file has one of the
+ * known source file extensions we assume it is a text file; if it has a well
+ * known binary file extension we assume it is a binary file; otherwise we call
+ * os_access to determine the file type.
+ */
+int
+os_filetype (
+  char	*fname			/* name of file to be examined	*/
+)
+{
+	register char	*ip, *ep;
+	register int	ch, i;
+	char	*extn;
+
+
+	/* Get filename extension.
+	 */
+	extn = NULL;
+	for (ip=fname;  (ch = *ip);  ip++)
+	    if (ch == '.')
+		extn = ip;
+
+	/* If the filename has a extension, check the list of known text and 
+	 * binary file extensions to see if we can make a quick determination
+	 * of the file type.
+	 */
+	if (extn) {
+	    ch = *(extn + 1);
+
+	    /* Known source file extension? */
+	    for (i=0;  (ep = srcextn[i]);  i++)
+		if (*(ep+1) == ch)
+		    if (strcasecmp (ep, extn) == 0)
+			return (TEXT_FILE);
+
+	    /* Known binary file extension? */
+	    for (i=0;  (ep = binextn[i]);  i++)
+		if (*(ep+1) == ch)
+		    if (strcasecmp (ep, extn) == 0)
+			return (BINARY_FILE);
+	}
+
+	/* Call ACCESS to determine the file type.
+	 */
+	if (os_access (fname, READ_ONLY, DIRECTORY_FILE) == YES)
+	    return (DIRECTORY_FILE);
+	else if (os_access (fname, 0, TEXT_FILE) == YES)
+	    return (TEXT_FILE);
+	else
+	    return (BINARY_FILE);
+}
diff --git a/unix/boot/bootlib/osfn2vfn.c b/unix/boot/bootlib/osfn2vfn.c
new file mode 100644
index 00000000..c16ccf03
--- /dev/null
+++ b/unix/boot/bootlib/osfn2vfn.c
@@ -0,0 +1,81 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#include <stdio.h>
+#include <string.h>
+#define	NOLIBCNAMES
+#define	import_spp
+#define	import_libc
+#define	import_xnames
+#define	import_knames
+#include <iraf.h>
+#include "bootlib.h"
+
+
+static	char	vfn[SZ_PATHNAME+1];
+
+#ifdef NOVOS
+
+/* OSFN2VFN -- Convert a local-directory OS filename into a virtual filename.
+ * On UNIX this is a no-op since escape sequence encoding is not needed and
+ * the IRAF file extensions are the same as UNIX.
+ */
+char *
+osfn2vfn (
+  char	*osfn 			/* input OS filename	*/
+)
+{
+	strcpy (vfn, osfn);		/* [MACHDEP */
+	return (vfn);
+}
+
+#else
+
+/* OSFN2VFN -- Convert a local-directory OS filename into a virtual filename.
+ * Undo the escape sequence encoding and map the OS filename extension into
+ * the IRAF one.  No attempt is made to map OS directory names into IRAF
+ * logical directory names; this is a local directory operation only.
+ */
+char *osfn2vfn (osfn)
+char	*osfn;			/* input OS filename	*/
+{
+	XCHAR	x_osfn[SZ_PATHNAME+1];
+	XCHAR	x_vfn[SZ_PATHNAME+1];
+	XINT	x_maxch = SZ_PATHNAME;
+	XINT	x_mode, vp, nchars;
+
+	extern  void _envinit();
+
+
+	_envinit();
+	
+	os_strupk ("./", x_vfn, SZ_PATHNAME);
+	x_mode = VFN_UNMAP;
+	iferr (vp = VFNOPEN (x_vfn, (integer *)&x_mode)) {
+	    vp = 0;
+	    goto err_;
+	}
+
+	strcpy ((char *)x_osfn, osfn);
+	iferr (nchars = VFNUNMAP ((integer *)&vp, x_osfn, x_vfn, 
+	    (integer *)&x_maxch))
+	        goto err_;
+	if (nchars < 0)
+	    goto err_;
+
+	x_mode = VFN_NOUPDATE;
+	VFNCLOSE ((integer *)&vp, (integer *)&x_mode);
+
+	os_strpak (x_vfn, vfn, SZ_PATHNAME);
+	return (vfn);
+
+err_:
+	fprintf (stderr, "cannot unmap filename `%s'\n", osfn);
+	if (vp > 0)
+	    VFNCLOSE ((integer *)&vp, (integer *)&x_mode);
+
+	strcpy (vfn, osfn);
+	return (vfn);
+}
+
+#endif
diff --git a/unix/boot/bootlib/osfpathname.c b/unix/boot/bootlib/osfpathname.c
new file mode 100644
index 00000000..17fdba61
--- /dev/null
+++ b/unix/boot/bootlib/osfpathname.c
@@ -0,0 +1,41 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#include "bootlib.h"
+
+
+/* OS_FPATHNAME -- Map a VFN (virtual filename) into a pathname (filename
+ * specification which is independent of the current directory).
+ */
+int
+os_fpathname (
+  char	*vfn,			/* virtual filename		*/
+  char	*osfn,			/* OS filename			*/
+  int	maxch 
+)
+{
+	XCHAR	x_vfn[SZ_PATHNAME+1];
+	XCHAR	x_osfn[SZ_PATHNAME+1];
+	XINT	x_maxch = SZ_PATHNAME, x_nchars;
+
+	extern  int ZFGCWD(), ZFSUBD(), ZFPATH();
+
+
+	if (vfn[0])
+	    os_strupk (vfn2osfn(vfn,0), x_vfn, x_maxch);
+	else
+	    x_vfn[0] = 0;
+
+	if (vfn[0] == '.' && (vfn[1] == EOS || vfn[2] == EOS)) {
+	    ZFGCWD (x_osfn, &x_maxch, &x_nchars);
+	    os_strupk ((char *)x_osfn, x_osfn, x_maxch);
+	    if (vfn[1] == '.') {
+		os_strupk (vfn, x_vfn, x_maxch);
+		ZFSUBD (x_osfn, &x_maxch, x_vfn, &x_nchars);
+	    }
+	} else
+	    ZFPATH (x_vfn, x_osfn, &x_maxch, &x_nchars);
+
+	os_strpak (x_osfn, osfn, maxch);
+	return (x_nchars);
+}
diff --git a/unix/boot/bootlib/osgetenv.c b/unix/boot/bootlib/osgetenv.c
new file mode 100644
index 00000000..3ccfb403
--- /dev/null
+++ b/unix/boot/bootlib/osgetenv.c
@@ -0,0 +1,127 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#include <string.h>
+#define	import_xnames
+#include "bootlib.h"
+
+
+char *_os_getenv();
+
+
+/* OS_GETENV -- Return the value of the named environment variable.  Null is
+ * returned if the named variable is not found.
+ */
+char *
+os_getenv (char *envvar)
+{
+	static	char	irafdir[SZ_PATHNAME+1] = "";
+	static	char	hostdir[SZ_PATHNAME+1] = "";
+	static	char	valstr[SZ_COMMAND+1];
+	static	char	errmsg[] = "environment variable `%s' not found\n";
+	extern	char	*os_subdir();
+	char	*vp;
+
+
+	/* Try the standard environment first. */
+	memset (valstr, 0, SZ_COMMAND+1);
+	if ( (vp = _os_getenv (envvar, valstr, SZ_COMMAND)) )
+	    return (vp);
+
+	/* The following maps certain well-known IRAF logical directories
+	 * even if there is no regular (VOS) environment facility.
+	 */
+	if (irafdir[0] == EOS)
+	    if (_os_getenv ("iraf", irafdir, SZ_PATHNAME) == NULL) {
+		fprintf (stderr, errmsg, "iraf");
+		return (NULL);
+	    }
+	if (hostdir[0] == EOS)
+	    if (_os_getenv ("host", hostdir, SZ_PATHNAME) == NULL) {
+		fprintf (stderr, errmsg, "host");
+		return (NULL);
+	    }
+
+	/* Map the names of the well known IRAF logical directories which
+	 * are defined portably in terms of iraf$ or host$.
+	 */
+	if (       strcmp (envvar, "lib") == 0) 		/* iraf/. */
+	    strcpy (valstr, os_subdir (irafdir, "lib"));
+	else if (strcmp (envvar, "bin") == 0)
+	    strcpy (valstr, os_subdir (irafdir, "bin"));
+	else if (strcmp (envvar, "dev") == 0)
+	    strcpy (valstr, os_subdir (irafdir, "dev"));
+	else if (strcmp (envvar, "pkg") == 0)
+	    strcpy (valstr, os_subdir (irafdir, "pkg"));
+	else if (strcmp (envvar, "sys") == 0)
+	    strcpy (valstr, os_subdir (irafdir, "sys"));
+	else if (strcmp (envvar, "math") == 0)
+	    strcpy (valstr, os_subdir (irafdir, "math"));
+	else if (strcmp (envvar, "hlib") == 0)			/* host/. */
+	    strcpy (valstr, os_subdir (hostdir, "hlib"));
+	else if (strcmp (envvar, "as") == 0)
+	    strcpy (valstr, os_subdir (hostdir, "as"));
+	else
+	    return (NULL);
+
+	return (valstr);
+}
+
+
+#ifdef NOVOS
+/* _OS_GETENV -- Fetch the value of the named environment variable from the
+ * host environment.
+ */
+char *
+_os_getenv (
+  char	*envvar,		/* name of environment variable	*/
+  char	*outstr,		/* receives value		*/
+  int	maxch 
+)
+{
+	PKCHAR	symbol[SZ_FNAME+1];
+	PKCHAR	value[SZ_COMMAND+1];
+	XINT	x_maxch = SZ_COMMAND, status=1;
+
+	strcpy ((char *)symbol, envvar);
+	ZGTENV (symbol, value, &x_maxch, &status);
+
+	if (status < 0) {
+	    outstr[0] = EOS;
+	    return (NULL);
+	} else {
+	    strncpy (outstr, (char *)value, maxch);
+	    outstr[maxch] = EOS;
+	    return (outstr);
+	}
+}
+
+#else
+/* _OS_GETENV -- Fetch the value of the named environment variable from the
+ * host environment.
+ */
+char *
+_os_getenv (
+  char	*envvar,		/* name of environment variable	*/
+  char	*outstr,		/* receives value		*/
+  int	maxch 
+)
+{
+	XCHAR	x_symbol[SZ_FNAME+1];
+	XCHAR	x_value[SZ_COMMAND+1];
+	XINT	x_maxch = SZ_COMMAND, status=1;
+	extern  XINT ENVFIND();
+
+
+	os_strupk (envvar, x_symbol, SZ_FNAME);
+	status = ENVFIND (x_symbol, x_value, &x_maxch);
+
+	if (status <= 0) {
+	    outstr[0] = EOS;
+	    return (NULL);
+	} else {
+	    os_strpak (x_value, outstr, maxch);
+	    return (outstr);
+	}
+}
+#endif
diff --git a/unix/boot/bootlib/osgetowner.c b/unix/boot/bootlib/osgetowner.c
new file mode 100644
index 00000000..489997c1
--- /dev/null
+++ b/unix/boot/bootlib/osgetowner.c
@@ -0,0 +1,28 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#include <sys/types.h>
+#include <sys/stat.h>
+#include "bootlib.h"
+
+
+/* OS_GETOWNER -- Get the user and group identifications for a file.  This is
+ * not a required function and is expected to rarely work when transporting
+ * files to a host at a different site.  Nonetheless it is useful when moving
+ * files between compatible hosts at a single site, so we make use of it in
+ * case it works.  It is sufficient to merely set uid and gid to 0 and return.
+ */
+void
+os_getowner (
+  char	*fname,
+  int	*uid, 
+  int	*gid 
+)
+{
+	struct	stat fi;
+
+	if (stat (vfn2osfn(fname,0), &fi) != -1) {
+	    *uid = fi.st_uid;
+	    *gid = fi.st_gid;
+	}
+}
diff --git a/unix/boot/bootlib/osopen.c b/unix/boot/bootlib/osopen.c
new file mode 100644
index 00000000..42b3cdeb
--- /dev/null
+++ b/unix/boot/bootlib/osopen.c
@@ -0,0 +1,29 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#include <fcntl.h>
+#include "bootlib.h"
+
+extern 	int  os_createfile (char *fname, int mode, int type);
+
+
+/* OS_OPEN -- Open or create a host system file for reading or writing (text
+ * and binary disk files only).
+ */
+int
+os_open (
+  char	*vfn,			/* file to be opened		*/
+  int	mode,			/* access mode 0=R, 1=W, 2=RW	*/
+  int	type 			/* file type			*/
+)
+{
+	extern	char *vfn2osfn();
+
+	if (mode == 0) {
+	    osfiletype = BINARY_FILE;
+	    return (open (vfn2osfn (vfn, 0), 0));
+	} else if (mode == 1) {
+	    return (os_createfile (vfn, mode, type));
+	} else
+	    return (-1);
+}
diff --git a/unix/boot/bootlib/osproto.h b/unix/boot/bootlib/osproto.h
new file mode 100644
index 00000000..0be822d7
--- /dev/null
+++ b/unix/boot/bootlib/osproto.h
@@ -0,0 +1,136 @@
+extern int zdvall_(short *aliases, int *allflg, int *status);
+extern int zdvown_(short *device, short *owner, int *maxch, int *status);
+extern int zawset_(int *best_size, int *new_size, int *old_size, int *max_size);
+extern int zcall0_(int *proc);
+extern int zcall1_(int *proc, void *arg1);
+extern int zcall2_(int *proc, void *arg1, void *arg2);
+extern int zcall3_(int *proc, void *arg1, void *arg2, void *arg3);
+extern int zcall4_(int *proc, void *arg1, void *arg2, void *arg3, void *arg4);
+extern int zcall5_(int *proc, void *arg1, void *arg2, void *arg3, void *arg4, void *arg5);
+extern int zcall6_(int *proc, void *arg1, void *arg2, void *arg3, void *arg4, void *arg5, void *arg6);
+extern int zcall7_(int *proc, void *arg1, void *arg2, void *arg3, void *arg4, void *arg5, void *arg6, void *arg7);
+extern int zcall8_(int *proc, void *arg1, void *arg2, void *arg3, void *arg4, void *arg5, void *arg6, void *arg7, void *arg8);
+extern int zcall9_(int *proc, void *arg1, void *arg2, void *arg3, void *arg4, void *arg5, void *arg6, void *arg7, void *arg8, void *arg9);
+extern int zcalla_(int *proc, void *arg1, void *arg2, void *arg3, void *arg4, void *arg5, void *arg6, void *arg7, void *arg8, void *arg9, void *arg10);
+extern void zdojmp_(int *jmpbuf, int *status);
+extern int zfacss_(short *fname, int *mode, int *type, int *status);
+extern int zfaloc_(short *fname, int *nbytes, int *status);
+extern int zfchdr_(short *newdir, int *status);
+extern int zfdele_(short *fname, int *status);
+extern int zfgcwd_(short *outstr, int *maxch, int *status);
+extern int zfinfo_(short *fname, int *finfo_struct, int *status);
+extern int zopnbf_(short *osfn, int *mode, int *chan);
+extern int zclsbf_(int *fd, int *status);
+extern int zardbf_(int *chan, short *buf, int *maxbytes, int *offset);
+extern int zawrbf_(int *chan, short *buf, int *nbytes, int *offset);
+extern int zawtbf_(int *fd, int *status);
+extern int zsttbf_(int *fd, int *param, int *lvalue);
+extern int zopnks_(short *x_server, int *mode, int *chan);
+extern int zclsks_(int *chan, int *status);
+extern int zardks_(int *chan, short *buf, int *totbytes, int *loffset);
+extern int zawrks_(int *chan, short *buf, int *totbytes, int *loffset);
+extern int zawtks_(int *chan, int *status);
+extern int zsttks_(int *chan, int *param, int *lvalue);
+extern int zopnlp_(short *printer, int *mode, int *chan);
+extern int zclslp_(int *chan, int *status);
+extern int zardlp_(int *chan, short *buf, int *maxbytes, int *offset);
+extern int zawrlp_(int *chan, short *buf, int *nbytes, int *offset);
+extern int zawtlp_(int *chan, int *status);
+extern int zsttlp_(int *chan, int *param, int *lvalue);
+extern int zzopmt_(short *device, int *acmode, short *devcap, int *devpos, int *newfile, int *chan);
+extern int zzclmt_(int *chan, int *devpos, int *o_status);
+extern int zzrdmt_(int *chan, short *buf, int *maxbytes, int *offset);
+extern int zzwrmt_(int *chan, short *buf, int *nbytes, int *offset);
+extern int zzwtmt_(int *chan, int *devpos, int *o_status);
+extern int zzstmt_(int *chan, int *param, int *lvalue);
+extern int zzrwmt_(short *device, short *devcap, int *o_status);
+extern int zopnnd_(short *pk_osfn, int *mode, int *chan);
+extern int zclsnd_(int *fd, int *status);
+extern int zardnd_(int *chan, short *buf, int *maxbytes, int *offset);
+extern int zawrnd_(int *chan, short *buf, int *nbytes, int *offset);
+extern int zawtnd_(int *fd, int *status);
+extern int zsttnd_(int *fd, int *param, int *lvalue);
+extern int zopnpl_(short *plotter, int *mode, int *chan);
+extern int zclspl_(int *chan, int *status);
+extern int zardpl_(int *chan, short *buf, int *maxbytes, int *offset);
+extern int zawrpl_(int *chan, short *buf, int *nbytes, int *offset);
+extern int zawtpl_(int *chan, int *status);
+extern int zsttpl_(int *chan, int *param, int *lvalue);
+extern int zopcpr_(short *osfn, int *inchan, int *outchan, int *pid);
+extern int zclcpr_(int *pid, int *exit_status);
+extern int zardpr_(int *chan, short *buf, int *maxbytes, int *loffset);
+extern int zawrpr_(int *chan, short *buf, int *nbytes, int *loffset);
+extern int zawtpr_(int *chan, int *status);
+extern int zsttpr_(int *chan, int *param, int *lvalue);
+extern int zopnsf_(short *osfn, int *mode, int *chan);
+extern int zclssf_(int *fd, int *status);
+extern int zardsf_(int *chan, short *buf, int *maxbytes, int *offset);
+extern int zawrsf_(int *chan, short *buf, int *nbytes, int *offset);
+extern int zawtsf_(int *fd, int *status);
+extern int zsttsf_(int *fd, int *param, int *lvalue);
+extern int zopntx_(short *osfn, int *mode, int *chan);
+extern int zclstx_(int *fd, int *status);
+extern int zflstx_(int *fd, int *status);
+extern int zgettx_(int *fd, short *buf, int *maxchars, int *status);
+extern int znottx_(int *fd, int *offset);
+extern int zputtx_(int *fd, short *buf, int *nchars, int *status);
+extern int zsektx_(int *fd, int *znottx_offset, int *status);
+extern int zstttx_(int *fd, int *param, int *value);
+extern int zopnty_(short *osfn, int *mode, int *chan);
+extern int zclsty_(int *fd, int *status);
+extern int zflsty_(int *fd, int *status);
+extern int zgetty_(int *fd, short *buf, int *maxchars, int *status);
+extern int znotty_(int *fd, int *offset);
+extern int zputty_(int *fd, short *buf, int *nchars, int *status);
+extern int zsekty_(int *fd, int *znotty_offset, int *status);
+extern int zsttty_(int *fd, int *param, int *value);
+extern int zfmkcp_(short *osfn, short *new_osfn, int *status);
+extern int zfmkdr_(short *newdir, int *status);
+extern int zfnbrk_(short *vfn, int *uroot_offset, int *uextn_offset);
+extern int zfpath_(short *osfn, short *pathname, int *maxch, int *nchars);
+extern int zfpoll_(int *pfds, int *nfds, int *timeout, int *npoll, int *status);
+extern int zfprot_(short *fname, int *action, int *status);
+extern int zfrnam_(short *oldname, short *newname, int *status);
+extern int zfrmdr_(short *dir, int *status);
+extern int zfsubd_(short *osdir, int *maxch, short *subdir, int *nchars);
+extern int zfunc0_(int *proc);
+extern int zfunc1_(int *proc, void *arg1);
+extern int zfunc2_(int *proc, void *arg1, void *arg2);
+extern int zfunc3_(int *proc, void *arg1, void *arg2, void *arg3);
+extern int zfunc4_(int *proc, void *arg1, void *arg2, void *arg3, void *arg4);
+extern int zfunc5_(int *proc, void *arg1, void *arg2, void *arg3, void *arg4, void *arg5);
+extern int zfunc6_(int *proc, void *arg1, void *arg2, void *arg3, void *arg4, void *arg5, void *arg6);
+extern int zfunc7_(int *proc, void *arg1, void *arg2, void *arg3, void *arg4, void *arg5, void *arg6, void *arg7);
+extern int zfunc8_(int *proc, void *arg1, void *arg2, void *arg3, void *arg4, void *arg5, void *arg6, void *arg7, void *arg8);
+extern int zfunc9_(int *proc, void *arg1, void *arg2, void *arg3, void *arg4, void *arg5, void *arg6, void *arg7, void *arg8, void *arg9);
+extern int zfunca_(int *proc, void *arg1, void *arg2, void *arg3, void *arg4, void *arg5, void *arg6, void *arg7, void *arg8, void *arg9, void *arg10);
+extern int zfutim_(short *fname, int *atime, int *mtime, int *status);
+extern int zfxdir_(short *osfn, short *osdir, int *maxch, int *nchars);
+extern int zgcmdl_(short *cmd, int *maxch, int *status);
+extern int zghost_(short *outstr, int *maxch);
+extern int zgmtco_(int *gmtcor);
+extern int zgtenv_(short *envvar, short *outstr, int *maxch, int *status);
+extern int zgtime_(int *clock_time, int *cpu_time);
+extern int zgtpid_(int *pid);
+extern int zintpr_(int *pid, int *exception, int *status);
+extern int zlocpr_(PFI proc, int *o_epa);
+extern int zlocva_(short *variable, int *location);
+extern int zmaloc_(int *buf, int *nbytes, int *status);
+extern int zmfree_(int *buf, int *status);
+extern int zopdir_(short *fname, int *chan);
+extern int zcldir_(int *chan, int *status);
+extern int zgfdir_(int *chan, short *outstr, int *maxch, int *status);
+extern int zopdpr_(short *osfn, short *bkgfile, short *queue, int *jobcode);
+extern int zcldpr_(int *jobcode, int *killflag, int *exit_status);
+extern int zoscmd_(short *oscmd, short *stdin_file, short *stdout_file, short *stderr_file, int *status);
+extern int zpanic_(int *errcode, short *errmsg);
+extern int zraloc_(int *buf, int *nbytes, int *status);
+extern int zwmsec_(int *msec);
+extern int zxwhen_(int *sig_code, int *epa, int *old_epa);
+extern int zxgmes_(int *os_exception, short *errmsg, int *maxch);
+extern int zzepro_(void);
+extern int zzpstr_(short *s1, short *s2);
+extern int zzlstr_(short *s1, short *s2);
+extern int zzsetk_(char *ospn, char *osbfn, int prtype, int isatty, int in, int out);
+extern int zzstrt_(void);
+extern int zzstop_(void);
diff --git a/unix/boot/bootlib/osputenv.c b/unix/boot/bootlib/osputenv.c
new file mode 100644
index 00000000..40599a85
--- /dev/null
+++ b/unix/boot/bootlib/osputenv.c
@@ -0,0 +1,72 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#include <stdlib.h>
+#include <string.h>
+#define	import_xnames
+#include "bootlib.h"
+
+#define	SZ_VALUE	SZ_COMMAND
+
+#ifdef NOVOS
+/* OS_PUTENV -- Set the value of the named environment variable.
+ */
+void
+os_putenv (
+  char	*name,
+  char	*value
+)
+{
+	char	buf[SZ_VALUE], *env;
+
+	sprintf (buf, "%s=%s", name, value);
+	if ( (env = (char *) malloc (strlen(buf) + 1)) ) {
+	    strcpy (env, buf);
+#ifdef ultrix
+	    putenv (env);			/* must keep env around. */
+#else
+#ifdef vax
+	    setenv (name, value, 1);
+#else
+	    putenv (env);			/* must keep env around. */
+#endif
+#endif
+	}
+}
+
+#else
+/* OS_PUTENV -- Set the value of the named environment variable.
+ */
+void
+os_putenv (
+  char	*name,
+  char	*value
+)
+{
+	XCHAR	x_name[SZ_FNAME+1];
+	XCHAR	x_value[SZ_VALUE+1];
+	char	buf[SZ_VALUE], *env;
+	extern  void ENVRESET();
+
+
+	/* Set the VOS environment. */
+	os_strupk (name, x_name, SZ_FNAME);
+	os_strupk (value, x_value, SZ_VALUE);
+	ENVRESET (x_name, x_value);
+
+	/* Set the HOST environment. */
+	sprintf (buf, "%s=%s", name, value);
+	if ( (env = (char *) malloc (strlen(buf) + 1)) ) {
+	    strcpy (env, buf);
+#ifdef ultrix
+	    putenv (env);
+#else
+#ifdef vax
+	    setenv (name, value, 1);
+#else
+	    putenv (env);			/* must keep env around. */
+#endif
+#endif
+	}
+}
+#endif
diff --git a/unix/boot/bootlib/osread.c b/unix/boot/bootlib/osread.c
new file mode 100644
index 00000000..b7d731d2
--- /dev/null
+++ b/unix/boot/bootlib/osread.c
@@ -0,0 +1,18 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#include <unistd.h>
+
+
+/* OS_READ -- Read from a disk file.  We can use the UNIX procedures for
+ * reading both binary and text files.
+ */
+int
+os_read (
+  int	fd,			/* input file		*/
+  char	*buf,			/* output buffer	*/
+  int	nbytes 			/* max bytes to read	*/
+)
+{
+	return (read (fd, buf, nbytes));
+}
diff --git a/unix/boot/bootlib/ossetfmode.c b/unix/boot/bootlib/ossetfmode.c
new file mode 100644
index 00000000..be2f7c5f
--- /dev/null
+++ b/unix/boot/bootlib/ossetfmode.c
@@ -0,0 +1,18 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#include <sys/stat.h>
+#include "bootlib.h"
+
+
+/* OS_SETFMODE -- Set the file mode bits.  This is an important function on
+ * any system and should be implemented.
+ */
+int
+os_setfmode (
+  char	*fname,
+  int	mode
+)
+{
+	return (chmod (vfn2osfn(fname,0), mode));
+}
diff --git a/unix/boot/bootlib/ossetowner.c b/unix/boot/bootlib/ossetowner.c
new file mode 100644
index 00000000..e6d78261
--- /dev/null
+++ b/unix/boot/bootlib/ossetowner.c
@@ -0,0 +1,21 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#include <unistd.h>
+#include "bootlib.h"
+
+/* OS_SETOWNER -- Set the user and group identifications for the file.  This is
+ * not a required function and is expected to rarely work when transporting
+ * files to a host at a different site.  Nonetheless it is useful when moving
+ * files between compatible hosts at a single site, so we make use of it in
+ * case it works.
+ */
+int
+os_setowner (
+  char	*fname,
+  int	uid, 
+  int	gid
+)
+{
+	return (chown (vfn2osfn(fname,0), uid, gid));
+}
diff --git a/unix/boot/bootlib/ossettime.c b/unix/boot/bootlib/ossettime.c
new file mode 100644
index 00000000..4c7d8694
--- /dev/null
+++ b/unix/boot/bootlib/ossettime.c
@@ -0,0 +1,24 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#include <unistd.h>
+#include "bootlib.h"
+
+
+/* OS_SETMTIME -- Set the modification (update) time of a file.  Should only
+ * be called when the named file is closed.  This is a desirable but
+ * nonessential function to implement.
+ */
+int
+os_setmtime (
+  char	*fname,
+  long	mtime 
+)
+{
+	struct	timeval tvp[2];
+
+	tvp[0].tv_sec  = tvp[1].tv_sec  = mtime;
+	tvp[0].tv_usec = tvp[1].tv_usec = 0L;
+
+	return (utimes (vfn2osfn(fname,0), tvp));
+}
diff --git a/unix/boot/bootlib/osstrpak.c b/unix/boot/bootlib/osstrpak.c
new file mode 100644
index 00000000..01b6cf1a
--- /dev/null
+++ b/unix/boot/bootlib/osstrpak.c
@@ -0,0 +1,34 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define import_spp
+#include <iraf.h>
+
+
+/* OS_STRPAK -- Pack an SPP string (type XCHAR) into a C string in a user
+ * supplied buffer.  Return a pointer to the output buffer.
+ *
+ * N.B.: This routine should be used in preference to STRPAK in C code
+ * since the output string is of type char*, rather than XCHAR*.
+ */
+char *
+os_strpak (
+  XCHAR	*sppstr,		/* SPP string			*/
+  char	*cstr,			/* C string			*/
+  int	maxch 			/* max chars out, excl EOS	*/
+)
+{
+	register XCHAR	*ip = sppstr;
+	register char	*op = cstr;
+	register int	n = maxch;
+
+
+	while ( (*op++ = *ip++) ) {
+	    if (--n <= 0) {
+		*op = EOS;
+		break;
+	    }
+	}
+
+	return (cstr);
+}
diff --git a/unix/boot/bootlib/osstrupk.c b/unix/boot/bootlib/osstrupk.c
new file mode 100644
index 00000000..e0617089
--- /dev/null
+++ b/unix/boot/bootlib/osstrupk.c
@@ -0,0 +1,44 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#include <stdio.h>
+
+#include <string.h>
+#define	import_spp
+#include <iraf.h>
+
+/* OS_STRUPK -- Unpack a C string into an SPP string.  This procedure should
+ * be called from C in preference to the SPP procedure STRUPK because the
+ * input string is declared to be of type char, rather than as an XCHAR
+ * array containing packed chars as in STRUPK.  The output string is however
+ * of type XCHAR since it is expected to be passed to an SPP procedure.  A
+ * pointer to the output string is returned as the function value for use
+ * in argument lists.
+ */
+XCHAR *
+os_strupk (
+  char	*str,			/* C string			*/
+  XCHAR	*outstr,		/* SPP string			*/
+  int	maxch 			/* max chars out, excl EOS	*/
+)
+{
+	register char	*ip = str;
+	register XCHAR	*op = outstr;
+	register int	  n = maxch;
+
+
+	/* Is is necessary to determine the length of the string in order to
+	 * be able to unpack the string in place, i.e., from right to left.
+	 */
+	if (maxch) {
+	    if (sizeof(char) != sizeof(XCHAR) || str != (char *)outstr) {
+		n = min (n, strlen(ip));
+		op[n] = XEOS;
+
+		while (--n >= 0)
+		    op[n] = ip[n];
+	    }
+	}
+
+	return (outstr);
+}
diff --git a/unix/boot/bootlib/ossubdir.c b/unix/boot/bootlib/ossubdir.c
new file mode 100644
index 00000000..4330aaad
--- /dev/null
+++ b/unix/boot/bootlib/ossubdir.c
@@ -0,0 +1,31 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#include "bootlib.h"
+
+
+/* OS_SUBDIR -- Fold a subdirectory name into a directory pathname and return
+ * a pointer to the pathname of the subdirectory.
+ */
+char *
+os_subdir (
+  char	*dir,			/* OS pathname of directory	*/
+  char	*subdir 		/* name of subdirectory		*/
+)
+{
+	static	XCHAR x_path[SZ_PATHNAME+1];
+	XCHAR	x_subdir[SZ_FNAME+1];
+	XINT	x_maxch = SZ_PATHNAME, x_nchars;
+	extern  int ZFSUBD();
+
+
+	os_strupk (dir,    x_path,   SZ_PATHNAME);
+	os_strupk (subdir, x_subdir, SZ_FNAME);
+
+	ZFSUBD (x_path, &x_maxch, x_subdir, &x_nchars);
+
+	if (x_nchars > 0)
+	    return (os_strpak (x_path, (char *)x_path, SZ_PATHNAME));
+	else
+	    return (NULL);
+}
diff --git a/unix/boot/bootlib/ossymlink.c b/unix/boot/bootlib/ossymlink.c
new file mode 100644
index 00000000..991b8359
--- /dev/null
+++ b/unix/boot/bootlib/ossymlink.c
@@ -0,0 +1,35 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#include <unistd.h>
+#include <iraf.h>
+
+#ifndef VMS
+#include <sys/types.h>
+#include <sys/stat.h>
+#endif
+
+/* OS_SYMLINK -- Determine if a file is a symbolic link.
+ */
+int
+os_symlink (
+  char	*fname,			/* file to be tested */
+  char	*valbuf,		/* buffer to receive link path, else NULL */
+  int	maxch 
+)
+{
+#ifndef VMS
+	struct	stat fi;
+	int	n;
+
+	if (lstat (fname, &fi) == 0)
+	    if ((fi.st_mode & S_IFMT) == S_IFLNK) {
+		if (valbuf && maxch)
+		    if ((n = readlink (fname, valbuf, maxch)) > 0)
+			valbuf[n] = '\0';
+		return (1);
+	    }
+#endif
+
+	return (0);
+}
diff --git a/unix/boot/bootlib/ossysfile.c b/unix/boot/bootlib/ossysfile.c
new file mode 100644
index 00000000..2d4f23be
--- /dev/null
+++ b/unix/boot/bootlib/ossysfile.c
@@ -0,0 +1,113 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#include <string.h>
+#include "bootlib.h"
+
+/* Uncomment the following if the kernel for this machine does not need
+ * or provide its own custom irafpath function, used if it can not be easily
+ * determine in advance what directories need to be searched.
+ */
+/* #define STANDALONE */
+
+#ifdef STANDALONE
+#define	irafpath os_irafpath
+#endif
+
+char	*irafpath();
+char	*os_getenv();
+extern  int  os_access (char *fname, int mode, int type);
+
+
+/* OS_SYSFILE -- Return the pathname of a system library file.  The library
+ * search order is
+ *
+ *	IRAFULIB libraries, if any
+ *	HSI system libraries (lib, hlib, hbin, etc.)
+ *	pkglibs applications libraries, if any
+ *
+ * Hence, the IRAFULIB mechanism may be used to make use of custom copies
+ * of system files (libraries or global include files), whereas the `pkglibs'
+ * mechanism is provided to extend the system library search path to include
+ * applications specified libraries.  These are intended to be the global
+ * libraries of installed layered packages, rather than private user libraries
+ * (the IRAFULIB mechanism is better for the latter).
+ */
+int
+os_sysfile (
+  char	*sysfile,		/* filename from include statement	*/
+  char	*fname,			/* receives filename			*/
+  int	maxch 
+)
+{
+	register char *ip, *op;
+	char	*files, *ip_save;
+
+
+	/* Search the standard system libraries and exit if the named
+	 * file is found.
+	 */
+	strncpy (fname, irafpath(sysfile), maxch);
+	fname[maxch-1] = EOS;
+	if (strcmp (fname, sysfile) != 0)
+	    return (strlen (fname));
+
+	/* Search the designated package libraries, if any.
+	 */
+	if ( (files = os_getenv ("pkglibs")) ) {
+	    for (ip=files;  *ip;  ) {
+		/* Get the next library name from the list. */
+		while (isspace(*ip) || *ip == ',')
+		    ip++;
+		for (op=fname;  *ip && !isspace(*ip) && *ip != ',';  op++)
+		    *op = *ip++;
+		*op = EOS;
+
+		/* Append the target filename. */
+		for (ip_save=ip, (ip=sysfile);  (*op++ = *ip++);  )
+		    ;
+		ip = ip_save;
+
+		/* Exit if the file exists. */
+		if (os_access (fname, 0, 0))
+		    return (strlen (fname));
+	    }
+	}
+
+	return (ERR);
+}
+
+
+#ifdef STANDALONE
+static	char *libs[] = { "iraf$lib/", "host$hlib/", "" };
+
+/* OS_IRAFPATH -- Portable version of the kernel irafpath() function, used
+ * if only the standard directories LIB and HLIB need to be searched.
+ */
+char *
+os_irafpath (sysfile)
+char	*sysfile;		/* filename from include statement	*/
+{
+	register char	*ip, *op;
+	register int	n;
+	static	char outfname[SZ_PATHNAME+1];
+	char	fname[SZ_PATHNAME+1];
+	int	i;
+
+	strcpy (outfname, sysfile);
+
+	for (i=0;  libs[i][0] != EOS;  i++) {
+	    strcpy (fname, libs[i]);
+	    strcat (fname, sysfile);
+	    if (os_access (fname, 0,0) == YES) {
+		n = SZ_PATHNAME;
+		for (ip=fname, op=outfname;  --n >= 0 && (*op = *ip++);  op++)
+		    ;
+		*op = EOS;
+		break;
+	    }
+	}
+
+	return (outfname);
+}
+#endif
diff --git a/unix/boot/bootlib/ostime.c b/unix/boot/bootlib/ostime.c
new file mode 100644
index 00000000..8ae97df7
--- /dev/null
+++ b/unix/boot/bootlib/ostime.c
@@ -0,0 +1,113 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#include <sys/types.h>
+#ifdef SYSV
+#include <time.h>
+#else
+#include <sys/time.h>
+#include <sys/timeb.h>
+#endif
+
+#ifdef MACOSX
+#include <time.h>
+#endif
+
+#define	SECONDS_1970_TO_1980	315532800L
+static	long os_timezone();
+
+
+/* OS_UTIME -- Convert IRAF time (local standard, epoch 1980) to UNIX time
+ * (greenwich mean time, epoch 1970).	[MACHDEP]
+ *
+ * NOTE: If this is difficult to implement on your system, you can probably
+ * forget about the correction to Greenwich (e.g., 7 hours) and that for
+ * daylight savings time (1 hour), and file times will come out a bit off
+ * but it probably won't matter.
+ */
+long
+os_utime (long iraf_time)
+{
+	struct	tm *localtime();
+	time_t	time_var, lst;
+#ifdef AUX
+	long	lstl;
+#endif
+
+	lst = (time_t)iraf_time;
+	
+	/* Add minutes westward from GMT */
+	time_var = lst + os_timezone();
+
+	/* Correct for daylight savings time, if in effect */
+#ifdef AUX
+	lstl = (long)lst;
+	if (localtime(&lstl)->tm_isdst)
+#else
+	if (localtime(&lst)->tm_isdst)
+#endif
+	    time_var += 60L * 60L;
+
+	return ((long)time_var + SECONDS_1970_TO_1980);
+}
+
+
+/* OS_ITIME -- Convert UNIX time (gmt, epoch 1970) to IRAF time (lst, epoch
+ * 1980).	[MACHDEP]
+ */
+long
+os_itime (long unix_time)
+{
+	struct	tm *localtime();
+	time_t	time_var, gmt;
+#ifdef AUX
+	long	gmtl;
+#endif
+
+	gmt = (time_t)unix_time;
+	
+	/* Subtract minutes westward from GMT */
+	time_var = gmt - os_timezone();
+
+	/* Correct for daylight savings time, if in effect */
+#ifdef AUX
+	gmtl = (long)gmt;
+	if (localtime(&gmtl)->tm_isdst)
+#else
+	if (localtime(&gmt)->tm_isdst)
+#endif
+	    time_var -= 60L * 60L;
+
+	return ((long)time_var - SECONDS_1970_TO_1980);
+}
+
+
+/* OS_GTIMEZONE -- Get the local timezone, measured in seconds westward
+ * from Greenwich, ignoring daylight savings time if in effect.
+ */
+static long
+os_timezone()
+{
+#ifdef CYGWIN
+	extern	long _timezone;
+	return (_timezone);
+#else
+#if defined(SOLARIS) && defined(X86)
+	extern	long timezone;
+	return (timezone);
+
+#else
+#if defined(SYSV) || defined(MACOSX)
+	struct tm *tm;
+	time_t clock;
+	clock = time(NULL);
+	tm = gmtime (&clock);
+	return (-(tm->tm_gmtoff));
+#else
+	struct	timeb time_info;
+	ftime (&time_info);
+	return (time_info.timezone * 60);
+#endif
+#endif
+#endif
+}
diff --git a/unix/boot/bootlib/oswrite.c b/unix/boot/bootlib/oswrite.c
new file mode 100644
index 00000000..3c59f8cd
--- /dev/null
+++ b/unix/boot/bootlib/oswrite.c
@@ -0,0 +1,49 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#include <unistd.h>
+#include "bootlib.h"
+
+/* OS_WRITE -- Write to the output file.  If the output file is a text file
+ * we must convert the binary input (text) stream to the record structured
+ * stream required by the host.
+ */
+int
+os_write (
+  int	fd,			/* output file			*/
+  char	*buf,			/* data to be written		*/
+  int	nbytes 			/* num bytes to be written	*/
+)
+{
+	register char	*ip;
+	register XCHAR	*op, *otop;
+	register int	ch, n;
+	XINT	nchars, status, xfd=fd;
+	extern  int ZPUTTX();
+
+
+	if (osfiletype == BINARY_FILE)
+	    return (write (fd, buf, nbytes));
+
+	n    = nbytes;
+	ip   = buf;
+	op   = txop;
+	otop = &text[SZ_FBUF];
+
+	/* Accumulate an output line of text and pass it on to the system when
+	 * newline is seen or when the output buffer fills (unlikely).
+	 */
+	while (--n >= 0) {
+	    *op++ = ch = *ip++;
+	    if (ch == '\n' || op >= otop) {
+		nchars = op - text;
+		ZPUTTX (&xfd, text, &nchars, &status);
+		op = txop = text;
+		if (status == XERR)
+		    return (ERR);
+	    }
+	}
+
+	txop = op;
+	return (nbytes);
+}
diff --git a/unix/boot/bootlib/rindex.c b/unix/boot/bootlib/rindex.c
new file mode 100644
index 00000000..9a2a99f2
--- /dev/null
+++ b/unix/boot/bootlib/rindex.c
@@ -0,0 +1,33 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#ifdef LINUX
+#define NOINDEX
+#endif
+#ifdef MACOSX 
+/* The following effectively disables the local version. */
+#define rindex strrindex
+#endif
+
+#ifndef NOINDEX
+
+/* RINDEX -- Return pointer to the last occurrence of a character in a string,
+ * or null if the char is not found.
+ */
+char *
+rindex (str, ch)
+char	*str;
+register int ch;
+{
+	register char	*ip;
+	register int	cch;
+	char	*last;
+
+	for (ip=str, last=0;  (cch = *ip);  ip++)
+	    if (cch == ch)
+		last = ip;
+
+	return (last);
+}
+
+#endif
diff --git a/unix/boot/bootlib/tape.c b/unix/boot/bootlib/tape.c
new file mode 100644
index 00000000..6d949f72
--- /dev/null
+++ b/unix/boot/bootlib/tape.c
@@ -0,0 +1,271 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#include <stdio.h>
+#include <string.h>
+#include <unistd.h>
+#include <ctype.h>
+
+#define	NOKNET
+#define import_spp
+#define import_finfo
+#define import_knames
+#include <iraf.h>
+
+/*
+ * TAPE.C -- Generalized binary file i/o to a tape drive or other devices.
+ *
+ *	fd = tape_open (fname, mode)
+ *	    tape_close (fd)
+ *	nb = tape_read (fd, buf, maxbytes)
+ *     nb = tape_write (fd, buf, nbytes)
+ *
+ * Only one "tape" file can be open at a time (unless all open files are of
+ * the same type).  Since we call ZZRDMT and ZZWRMT directly, only blocked
+ * output is permitted (there is no internal buffering).  Only sequential
+ * output is permitted to disk (there is no seek entry point).
+ *
+ * NOTE - For the IRAF V2.10 version of this utility, only host device names
+ * are permitted.  The IRAF device names "mta", "mtb", etc are not supported
+ * as the tapefile file is not read.
+ */
+
+#define	TF_STDIN	0
+#define	TF_STDOUT	1
+#define	TF_BINARY	2
+#define	TF_TAPE		3
+
+#define	R	0
+#define	W	1
+#define	RW	2
+
+/* Tape position structure (V2.10). */
+struct mtpos {
+        int     filno;                  /* current file (1=first) */
+        int     recno;                  /* current record (1=first) */
+        int     nfiles;                 /* number of files on tape */
+        int     tapeused;               /* total tape used (Kb) */
+        int     pflags;                 /* i/o status bitflags (output) */
+};
+
+/* MTPOS bitflags. */
+#define MF_ERR  0001    /* i/o error occurred in last operation */
+#define MF_EOF  0002    /* a tape mark was seen in the last operation */
+#define MF_EOT  0004    /* end of tape seen in the last operation */
+#define MF_EOR  0010    /* a record advance occurred in the last operation */
+
+static	int ftype;
+static	XINT acmode;
+static	int ateof;
+static	XLONG offset = 0;
+
+static  int os_mtname (char *fname, char *osdev);
+
+extern  int ZZOPMT(), ZOPNBF(), ZCLSBF(), ZZCLMT();
+extern  int ZARDBF(), ZAWTBF(), ZZRDMT(), ZZWTMT(), ZAWRBF(), ZZWRMT();
+
+
+
+/* TAPE_OPEN -- Open the named file, which need not actually be a tape device.
+ */
+int
+tape_open (
+  char	*fname,		/* file or device to be opened	*/
+  int	mode 		/* access mode			*/
+)
+{
+	PKCHAR	osfn[SZ_PATHNAME+1];
+	XINT	chan;
+	extern  char *vfn2osfn();
+
+
+	if (strcmp (fname, "stdin") == 0) {
+	    ftype = TF_STDIN;
+	    if (mode != R)
+		chan = ERR;
+	    else
+		chan = 1;	/* arbitrary */
+
+	} else if (strcmp (fname, "stdout") == 0) {
+	    ftype = TF_STDOUT;
+	    if (mode != W)
+		chan = ERR;
+	    else
+		chan = 1;	/* arbitrary */
+
+	} else if (os_mtname (fname, (char *)osfn)) {
+	    /* Open a magtape device.  Only host device names are permitted.
+	     * Try to open without moving the tape (newfile=0).
+	     */
+	    register int *op;
+	    struct  mtpos devpos;
+	    int     nwords = sizeof(devpos) / sizeof(int);
+	    XINT    newfile = 0;
+	    char    *tapecap = ":np";
+
+	    for (op = (int *)&devpos;  --nwords >= 0;  )
+		*op++ = 0;
+	    ftype = TF_TAPE;
+	    if (mode == R)
+		acmode = READ_ONLY;
+	    else
+		acmode = WRITE_ONLY;
+
+	    ZZOPMT (osfn, &acmode, (PKCHAR *)tapecap, (XINT *)&devpos, 
+		&newfile, &chan);
+
+	} else {
+	    /* Open a binary disk file.
+	     */
+	    ftype = TF_BINARY;
+	    offset = 1;
+
+	    strcpy ((char *)osfn, vfn2osfn (fname, 0));
+	    if (mode == R)
+		acmode = READ_ONLY;
+	    else if (mode == W)
+		acmode = NEW_FILE;
+	    else
+		acmode = READ_WRITE;
+
+	    ZOPNBF (osfn, &acmode, &chan);
+	}
+
+	ateof = 0;
+
+	return (chan == XERR ? ERR : chan);
+}
+
+
+/* TAPE_CLOSE -- Close a file opened with tape_open.
+ */
+int
+tape_close (int fd)
+{
+	struct	mtpos devpos;
+	XINT	x_fd=fd, status;
+
+	if (ftype == TF_BINARY)
+	    ZCLSBF (&x_fd, &status);
+	else if (ftype == TF_TAPE)
+	    ZZCLMT (&x_fd, (XINT *)&devpos, &status);
+	else
+	    status = XOK;
+
+	return (status == XERR ? ERR : OK);
+}
+
+
+/* TAPE_READ -- Read from a file opened with tape_open.
+ */
+int
+tape_read (
+  int	fd,			/* input file		*/
+  char	*buf,			/* output buffer	*/
+  int	maxbytes 		/* max bytes to read	*/
+)
+{
+	struct	mtpos devpos;
+	XINT	x_fd=fd, x_maxbytes=maxbytes, status;
+
+	if (ateof)
+	    return (0);
+
+	if (ftype == TF_STDIN) {
+	    status = read (0, buf, maxbytes);
+	} else if (ftype == TF_BINARY) {
+	    ZARDBF (&x_fd, (XCHAR *)buf, &x_maxbytes, &offset);
+	    ZAWTBF (&x_fd, &status);
+	    if (status > 0)
+		offset += status;
+	} else if (ftype == TF_TAPE){
+	    ZZRDMT (&x_fd, (XCHAR *)buf, &x_maxbytes, &offset);
+	    ZZWTMT (&x_fd, (XINT *)&devpos, &status);
+	    if (devpos.pflags & MF_EOF)
+		ateof++;
+	} else
+	    status = XERR;
+
+	return (status == XERR ? ERR : status);
+}
+
+
+/* TAPE_WRITE -- Write to a file opened with tape_open.
+ */
+int
+tape_write (
+  int	fd,			/* output file		*/
+  char	*buf,			/* input bufferr	*/
+  int	nbytes 			/* nbytes to write	*/
+)
+{
+	struct	mtpos devpos;
+	XINT	x_fd=fd, x_nbytes=nbytes, status;
+
+	if (ftype == TF_STDOUT) {
+	    status = write (1, buf, nbytes);
+	} else if (ftype == TF_BINARY) {
+	    ZAWRBF (&x_fd, (XCHAR *)buf, &x_nbytes, &offset);
+	    ZAWTBF (&x_fd, &status);
+	    if (status > 0)
+		offset += status;
+	} else if (ftype == TF_TAPE) {
+	    ZZWRMT (&x_fd, (XCHAR *)buf, &x_nbytes, &offset);
+	    ZZWTMT (&x_fd, (XINT *)&devpos, &status);
+	} else
+	    status = XERR;
+
+	return (status == XERR ? ERR : status);
+}
+
+
+/* OS_MTNAME -- Parse a filename to determine if the file is a magtape
+ * device or something else.  A nonzero return indicates that the device
+ * is a tape.
+ */
+static int
+os_mtname (
+  char	*fname,		/* filename e.g., "foo.tar" or "mua0:". */
+  char	*osdev 		/* receives host system drive name */
+)
+{
+#ifdef VMS
+	register char	*ip;
+	char	drive[SZ_FNAME+1];
+#endif
+
+	/* Ignore any "mt." prefix.  This is for backwards compatibility,
+	 * to permit old-style names like "mt.MUA0:".
+	 */
+	if (!strncmp (fname, "mt.", 3) || !strncmp (fname, "MT.", 3))
+	    fname += 3;
+
+#ifdef VMS
+	/* Resolve a possible logical device name. */
+	if (strchr (fname, '['))
+	    strcpy (drive, fname);
+	else
+	    _tranlog (fname, drive);
+
+	/* If the resolved name ends with a colon it is a device name,
+	 * which we assume to be a tape device.
+	 */
+	for (ip=drive;  *ip;  ip++)
+	    ;
+	if (*(ip-1) == ':') {
+	    strcpy (osdev, drive);
+	    return (1);
+	}
+#else
+	/* For unix systems we assume anything beginning with /dev is a
+	 * tape device.
+	 */
+	if (strncmp (fname, "/dev/", 5) == 0) {
+	    strcpy (osdev, fname);
+	    return (1);
+	}
+#endif
+
+	strcpy (osdev, fname);
+	return (0);
+}
diff --git a/unix/boot/bootlib/vfn2osfn.c b/unix/boot/bootlib/vfn2osfn.c
new file mode 100644
index 00000000..c93d2090
--- /dev/null
+++ b/unix/boot/bootlib/vfn2osfn.c
@@ -0,0 +1,147 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#include <stdio.h>
+#include <string.h>
+#define	NOLIBCNAMES
+#define	import_spp
+#define	import_libc
+#define	import_xnames
+#define	import_knames
+#include <iraf.h>
+
+#define	FINIT
+#include "bootlib.h"
+
+static	PKCHAR	pk_osfn[SZ_PATHNAME+1];
+static	char	*osfn = (char *)pk_osfn;
+extern	char	*os_getenv();
+
+
+#ifdef NOVOS
+
+/* VFN2OSFN -- Map an IRAF virtual filename into an OS filename.  This is
+ * a simplified version for UNIX which does not use the VOS.  This version
+ * should also be almost sufficient to compile the system libraries when
+ * starting from scratch on a new machine, since the filenames in the system
+ * directories are simple and the full generality of the FIO filename mapping
+ * code is not required (extension mapping is about all that is required).
+ * Only the well-known system logical directories are recognized in this
+ * version, however ZGTENV is called to replace logical directories, and
+ * this in turn references the host system environment, so one can bootstrap
+ * things by using the host environment facilities.
+ */
+char *
+vfn2osfn (
+  char	*vfn,			/* input IRAF virtual filename	*/
+  int	new 			/* new file			*/
+)
+{
+	register char	*ip, *op;
+	char	fname[SZ_PATHNAME+1], *ldir;
+
+	/* Recursively expand logical directories, but don't do anything
+	 * about subdirectories, extensions, etc.  This is all that is
+	 * needed for UNIX.
+	 */
+	for (ip=vfn, op=fname;  (*op = *ip++);  op++)
+	    if (*op == '$') {
+		*op = EOS;
+		if ( (ldir = os_getenv (fname)) )
+		    strcpy (fname, ldir);
+		strcat (fname, ip);
+		return (vfn2osfn (fname, 0));
+	    }
+
+	/* Copy filename to the output string.  Fix up the "//" sequences
+	 * that occur because IRAF likes the / at the end of logical directory
+	 * names.
+	 */
+	for (ip=fname, op=osfn;  (*op = *ip++);  op++)
+	    if (*op == '/' && op > osfn && *(op-1) == '/')
+		--op;
+
+	return (osfn);
+}
+
+
+#else
+
+/* VFN2OSFN -- Map an IRAF virtual filename into an OS filename.  This is
+ * the portable version using the VOS (libsys.a+libvops.a+libos.a) to do the
+ * mapping.  The system libraries must have been built before we can do this,
+ * of course.
+ */
+char *
+vfn2osfn (
+  char	*vfn,			/* input IRAF virtual filename	*/
+  int	new 			/* new file			*/
+)
+{
+	register char	*ip;
+	register XCHAR	*op;
+	register int	n = SZ_PATHNAME;
+	XINT	vp, mode, maxch = SZ_PATHNAME;
+	PKCHAR	upkvfn[SZ_PATHNAME+1];
+	int	err;
+
+        extern  void  _envinit();
+
+
+
+	/* Copy the input filename into local storage before calling envinit,
+	 * below, to avoid any chance of overwriting the input string in a
+	 * recursive call to vfn2osfn by envinit.
+	 */
+	for (ip=vfn, op=upkvfn;  --n >= 0 && (*op++ = *ip++) != (XCHAR)EOS;  )
+	    ;
+	*(op-1) = XEOS;
+	mode = new ? VFN_WRITE : VFN_READ;
+
+	/* Nasty beast that can call vsn2osfn recursively. */
+	_envinit();
+
+	err = 0;
+	iferr (vp = VFNOPEN (upkvfn, (integer *)&mode)) {
+	    fprintf (stderr, "Warning: cannot open vfn `%s' for %s\n",
+		vfn, mode == VFN_WRITE ? "writing" : "reading");
+	    err++;
+	}
+
+	if (new) {
+	    if (!err)
+		iferr (VFNADD ((integer *)&vp, pk_osfn, (integer *)&maxch))
+		    fprintf (stderr, "Warning: cannot add filename `%s'\n",vfn);
+	} else {
+	    if (!err)
+		iferr (VFNMAP ((integer *)&vp, pk_osfn, (integer *)&maxch))
+		    fprintf (stderr, "Warning: cannot map filename `%s'\n",vfn);
+	}
+
+	mode = (mode == VFN_WRITE) ? VFN_UPDATE : VFN_NOUPDATE;
+	if (!err) {
+	    iferr (VFNCLOSE ((integer *)&vp, (integer *)&mode))
+		fprintf (stderr, "Warning: error closing mapping file\n");
+	} else
+	    *osfn = EOS;
+
+	return (osfn);
+}
+
+
+/*
+ * KISTUB -- Stub out selected KI (kernel network interface) routines.  This
+ * is done when VOS filename mapping is in use to avoid linking in a lot of
+ * objects that will never be used, since the HSI does not use networking.
+ */
+int  KI_GETHOSTS() { return (0); }
+void KI_SEND(){}
+void KI_RECEIVE(){}
+#endif
+
+#ifdef SUNOS
+/* Stub out the following too, since there is no floating point in the HSI. */
+ieee_flags(){}
+ieee_handler(){}
+abrupt_underflow_(){}
+#endif
diff --git a/unix/boot/generic.new/README b/unix/boot/generic.new/README
new file mode 100644
index 00000000..98a1d23a
--- /dev/null
+++ b/unix/boot/generic.new/README
@@ -0,0 +1,3 @@
+GENERIC -- The generic preprocessor is a simple task used to process generic
+	   code into type specific code.  A different copy of the code is output
+	   for each datatype.
diff --git a/unix/boot/generic.new/chario.c b/unix/boot/generic.new/chario.c
new file mode 100644
index 00000000..09b46e40
--- /dev/null
+++ b/unix/boot/generic.new/chario.c
@@ -0,0 +1,188 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+
+/*
+ * OS Character I/O.  This set of routines are provided as a workaround in
+ * the event that the host system cannot execute FTELL/FSEEK reliably (VMS/C
+ * could not).  The idea here is to keep track of the character offset from
+ * the beginning of the file.  K_FTELL returns the character offset.  K_FSEEK
+ * rewinds the file and reads characters forward to the indicated offset.
+ * K_GETC keeps a count of the file position.  (the k_ stands for kludge).
+ */
+
+extern	int debug;
+
+struct context {
+	FILE	*fp;			/* file descriptor	*/
+	long	fpos;			/* saved file pointer	*/
+	char	fname[512];		/* file being scanned	*/
+};
+
+FILE *
+k_fopen (fname, mode)
+char	*fname;
+char	*mode;
+{
+	register struct context *cx;
+	register FILE	*fp;
+
+	if ((fp = fopen (fname, mode)) == NULL)
+	    return (NULL);
+
+	cx = (struct context *) malloc (sizeof(struct context));
+	strcpy (cx->fname, fname);
+	cx->fpos = 0;
+	cx->fp = fp;
+
+	return ((FILE *)cx);
+}
+
+
+int
+k_fclose (cx_i)
+FILE	*cx_i;
+{
+	register struct context *cx = (struct context *)cx_i;
+	int	status;
+
+	status = fclose (cx->fp);
+	free (cx);
+
+	return (status);
+}
+
+#ifdef vms
+
+int
+k_getc (cx_i)
+FILE	*cx_i;
+{
+	register struct context *cx = (struct context *)cx_i;
+	register int	ch;
+
+	cx->fpos++;
+	if (debug > 3) {
+	    if ((ch = getc (cx->fp)) > 0)
+		printf ("%5d %03o %c\n", cx->fpos, ch, ch > 040 ? ch : 040);
+	    return (ch);
+	} else
+	    return (getc (cx->fp));
+}
+
+char *
+k_fgets (obuf, maxch, cx_i)
+char	*obuf;
+int	maxch;
+FILE	*cx_i;
+{
+	register struct context *cx = (struct context *)cx_i;
+	register int	ch, n;
+	register char	*op;
+
+	for (op=obuf, n=maxch;  --n >= 0;  )
+	    if ((ch = k_getc(cx)) < 0)
+		return (NULL);
+	    else {
+		*op++ = ch;
+		if (ch == '\n')
+		    break;
+	    }
+
+	return (obuf);
+}
+
+seek
+k_fseek (cx_i, offset, type)
+FILE	*cx_i;
+long	offset;
+int	type;
+{
+	register struct context *cx = (struct context *)cx_i;
+	register FILE	*fp = cx->fp;
+	register int	ch;
+
+	if (debug > 1)
+	    printf ("seek (%s, %ld, %d)\n", cx->fname, offset, type);
+	    
+	if (type == 0) {
+	    fseek (fp, 0L, 0);
+	    cx->fpos = 0;
+
+	    while (cx->fpos < offset && (ch = getc(fp)) != EOF) {
+		if (debug > 1)
+		    fputc (ch, stdout);
+		cx->fpos++;
+	    }
+
+	    if (debug > 1)
+		printf ("[]\n");
+
+	    return (0);
+	}
+
+	if (fseek (fp, offset, type) == -1)
+	    return (-1);
+	else {
+	    cx->fpos = ftell (fp);
+	    return (0);
+	}
+}
+
+long
+k_ftell (cx_i)
+FILE	*cx_i;
+{
+	register struct context *cx = (struct context *)cx_i;
+
+	if (debug > 1) {
+	    printf ("ftell returns %d\n", cx->fpos);
+	    fflush (stdout);
+	}
+
+	return (cx->fpos);
+}
+
+#else
+
+int
+k_getc (cx_i)
+FILE	*cx_i;
+{
+	register struct context *cx = (struct context *)cx_i;
+	return (getc (cx->fp));
+}
+
+char *
+k_fgets (op, maxch, cx_i)
+char	*op;
+int	maxch;
+FILE	*cx_i;
+{
+	register struct context *cx = (struct context *)cx_i;
+	return (fgets (op, maxch, cx->fp));
+}
+
+int
+k_fseek (cx_i, offset, type)
+FILE	*cx_i;
+long	offset;
+int	type;
+{
+	register struct context *cx = (struct context *)cx_i;
+	return (fseek (cx->fp, offset, type));
+}
+
+int
+k_ftell (cx_i)
+FILE	*cx_i;
+{
+	register struct context *cx = (struct context *)cx_i;
+	return (ftell (cx->fp));
+}
+
+#endif
diff --git a/unix/boot/generic.new/chario.o b/unix/boot/generic.new/chario.o
new file mode 100644
index 00000000..33fd2d1d
--- /dev/null
+++ b/unix/boot/generic.new/chario.o
diff --git a/unix/boot/generic.new/generic.c b/unix/boot/generic.new/generic.c
new file mode 100644
index 00000000..07d19885
--- /dev/null
+++ b/unix/boot/generic.new/generic.c
@@ -0,0 +1,892 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#include <stdio.h>
+#include <ctype.h>
+#include <stdlib.h>
+#include <string.h>
+#include <unistd.h>
+#define	import_spp
+#include <iraf.h>
+
+/*
+ * GENERIC -- This filter takes a file containing a generic operator as input
+ * and generates as output either a set of files, one for each of the data
+ * types in the generic family, or a single file wherein the generic section
+ * has been duplicated for each case.
+ */
+
+#define	input		lex_input
+#define	unput		lex_unput
+extern	char yytext[];
+extern	int  yyleng;
+extern	FILE *yyin;
+extern	FILE *yyout;
+
+#define	MAXFILES	512
+#define	MAXNEST		50
+#define	OK		0
+#define	SZ_FORSTK	20
+
+/* $FOR contstruct descriptor.
+ */
+struct _for {
+	char	f_prevtype;		/* type before $for	*/
+	char	f_types[20];		/* "csilrdx"		*/
+	char	*f_curtype;		/* pointer into f_types	*/
+	long	f_fpos;			/* seek offset of $FOR	*/
+};
+
+struct	_for forstk[SZ_FORSTK];
+int	forlev;
+char	*type_string;
+char	xtype_string[SZ_FNAME+1];
+char	type_char;
+int	pass_output = 1;
+int	clobber = NO;
+
+extern long  k_ftell (FILE *cx_i);
+extern FILE *k_fopen (char *fname, char *mode);
+extern int   k_fseek (FILE *cx_i, long offset, int type);
+extern int   k_fclose (FILE *cx_i);
+
+extern int   yylex (void);
+extern int   lex_input (void);
+extern void  lex_unput (int ch);
+
+
+char *make_typed_filename (char *template, char type_char);
+void  set_type_string (char ch);
+void  copy_line (void);
+void  copy_string (void);
+void  copy_comment (void);
+void  make_float (char type_ch);
+void  output_indef (char ch);
+void  output_upper (char *s);
+void  pass_through (void);
+void  do_for (void);
+void  do_endfor (void);
+void  do_if (void);
+void  do_else (void);
+void  do_endif (void);
+
+int   evaluate_expr (void);
+int   parse_relational (int *size1, int *size2, int *op);
+
+int   relop (void);
+int   gsize (char ch);
+char  nextch (void);
+char  gch (void);
+void  uch (char ch);
+
+void  output (char ch);
+void  outstr (char *s);
+
+
+
+
+/**
+ *  GENERIC: e.g., generic [-k] [-t csilrdx] file
+ */
+int main (int argc, char *argv[])
+{
+	char	*files[MAXFILES], *s, **p, *ip;
+	char	fname[SZ_FNAME], *extension;
+	char	*types = "i", *t;
+	char	*prefix = "";
+	char	genfname[SZ_FNAME+1];
+	char	template[SZ_FNAME+1];
+	char	input_file[SZ_FNAME+1];
+	char	*index(), *rindex();
+	int	n, nfiles;
+	FILE	*fp;
+
+	genfname[0] = EOS;
+	nfiles = 0;
+
+	for (p = &argv[1];  *p != NULL;  p++) {
+	    s = *p;
+	    if (s[0] == '-') {
+		switch (s[1]) {
+		case 'k':
+		    clobber = YES;
+		    break;
+		case 't':
+		    if (*(p+1) != NULL)
+			types = *++p;
+		    break;
+		case 'o':
+		    if (*(p+1) != NULL)
+			strcpy (genfname, *++p);
+		    break;
+		case 'p':
+		    if (*(p+1) != NULL)
+			prefix = *++p;
+		    break;
+		}
+	    } else {
+		files[nfiles++] = s;
+		if (genfname[0] != EOS && nfiles > 1) {
+		    fprintf (stderr,
+			"Cannot process multiple files with '-o' flag\n");
+		    exit (OSOK+1);
+		}
+	    }
+	}
+ 
+	for (n=0;  n < nfiles;  n++) {
+	    strcpy (input_file, files[n]);
+	    yyin = k_fopen (input_file, "r");
+	    if (yyin == NULL) {
+		fprintf (stderr, "Cannot open input file '%s'\n", input_file);
+		continue;
+	    }
+
+	    /* Set pointer to the filename extension string.  If the file name
+	     * has an extension, lop it off by overwriting the '.' with EOS.
+	     * The first character of the extension of a generic file is
+	     * normally a 'g', e.g., ".gx" or ".gc", but we want to generate
+	     * a ".x" or ".c" file, so lop off any leading g in the extension.
+	     */
+	    if ((extension = rindex (input_file, '.')) != NULL) {
+		*extension++ = EOS;
+		if (*extension == 'g')
+		    extension++;
+	    } else
+		extension = "";
+
+	    for (t=types;  *t != EOS;  t++) {
+		/* Make output file name */
+		strcpy (fname, prefix);
+
+		/* Expand a template of the form "chars$tchars" into the root
+		 * name of the new file, replacing the $t by the type char.
+		 * If using input filename as the root, add "$t"; otherwise,
+		 * check whether or not the generic filename string has a
+		 * "$t" in it, and add one at end if it does not.
+		 */
+		if (genfname[0] == EOS) {
+		    strcpy (template, input_file);
+		    strcat (template, "$t");
+
+		} else {
+		    strcpy (template, genfname);
+
+		    for (ip=index(genfname,'$');  ip != NULL;
+			ip = index(ip,'$')) {
+
+			if (*(ip+1) == '$')
+			    ip += 2;
+			else if (*(ip+1) == 't')
+			    break;
+		    }
+
+		    if (ip == NULL && strlen(types) > 1)
+			strcat (ip, "$t");
+		}
+
+		if (genfname[0] == EOS || strlen (types) > 1)
+		    strcat (fname, make_typed_filename (template, *t));
+		else
+		    strcat (fname, template);
+
+		/* If the user supplied the output filename template, we
+		 * assume that it already contains an extension.
+		 */
+		if (genfname[0] == EOS) {
+		    strcat (fname, ".");
+		    strcat (fname, extension);
+		}
+
+		if (access(fname,0) == 0) {
+		    if (clobber == NO) {
+			fprintf (stderr, "File `%s' already exists\n", fname);
+			continue;
+		    } else
+			unlink (fname);
+		}
+		if ((fp = fopen (fname, "w")) == NULL) {
+		    fprintf (stderr, "Cannot open file `%s'\n", fname);
+		    continue;
+		}
+
+		yyout = fp;
+		set_type_string (*t);
+		type_char = *t;
+		forlev = -1;
+
+		yylex();	/* do it */
+
+		fclose (fp);
+		k_fseek (yyin,0L,0);
+	    }
+
+	    k_fclose (yyin);
+	}
+
+	exit (OSOK);
+}
+
+
+/* MAKE_TYPED_FILENAME -- Make a copy of a filename string, substituting
+ * the given type suffix character for the every sequence "$t" found in the
+ * input string.  The output string is retained in an internal static buffer.
+ * Any sequence "$$" is converted into a single "$".
+ */
+char *
+make_typed_filename (char *template, char type_char)
+{
+	register char *ip, *op;
+	char	ch;
+	static	char fname[SZ_FNAME+1];
+
+	if (isupper (type_char))
+	    ch = tolower (type_char);
+	else
+	    ch = type_char;
+
+	for (ip=template, op=fname;  *ip != EOS;  )
+	    if (*ip == '$' && *(ip+1) == '$') {
+		*op++ = '$';
+		ip += 2;
+	    } else if (*ip == '$' && *(ip+1) == 't') {
+		*op++ = ch;
+		ip += 2;
+	    } else
+		*op++ = *ip++;
+	    
+	return (fname);
+}
+
+
+/* SET_TYPE_STRING -- Given the type suffix character, set the external
+ * array "type_string" to the name of the corresponding SPP datatype.
+ */
+void
+set_type_string (char ch)
+{
+	char	*ip, *op;
+
+	switch (ch) {
+	case 'B':
+	    type_string = "ubyte";		/* unsigned byte	*/
+	    break;
+	case 'U':
+	    type_string = "ushort";
+	    break;
+	case 'b':
+	    type_string = "bool";
+	    break;
+	case 'c':
+	    type_string = "char";
+	    break;
+	case 's':
+	    type_string = "short";
+	    break;
+	case 'i':
+	    type_string = "int";
+	    break;
+	case 'l':
+	    type_string = "long";
+	    break;
+	case 'r':
+	    type_string = "real";
+	    break;
+	case 'd':
+	    type_string = "double";
+	    break;
+	case 'x':
+	    type_string = "complex";
+	    break;
+	case 'p':
+	    type_string = "pointer";
+	    break;
+	default:
+	    fprintf (stderr, "Unknown type suffix char `%c'\n", ch);
+	}
+
+	op = xtype_string;
+	*op++ = 'X';
+	for (ip=type_string;  *ip != EOS;  ip++)
+	    *op++ = toupper (*ip);
+	*op++ = EOS;
+}
+
+
+/* COPY_LINE -- Output whatever is in the yylex token buffer, followed by the
+ * remainder of the line from which the token was extracted.
+ */
+void
+copy_line (void)
+{
+	char	ch;
+
+	outstr(yytext);
+	while ((ch = input()) != '\n')
+	    output(ch);
+	unput(ch);
+}
+
+
+/* COPY_STRING -- Called when the opening quote of a string is seen in the
+ * input.  Copy the opening quote followed by all input characters until the
+ * end of string is seen.
+ */
+void
+copy_string (void)
+{
+	char	ch;
+
+	outstr(yytext);
+	for (;;) {
+	    switch (ch = input()) {
+	    case '"':
+		output(ch);
+		return;
+	    case '\\':
+		output(ch);
+		if ((ch = input()) != '\n')
+		    output(ch);
+		else
+		    unput(ch);
+		break;
+	    case '\n':
+		unput(ch);
+		return;
+	    default:
+		output(ch);
+	    }
+	}
+}
+
+
+/* COPY_COMMENT -- Copy a C style comment to the output file.
+ */
+void
+copy_comment (void)
+{
+	char	ch;
+	int	flag = 0;
+
+	outstr (yytext);
+
+	while ((ch = input()) != EOF) {
+	    output (ch);
+	    switch (ch) {
+	    case '*':
+		flag = 1;
+		break;
+	    case '/':
+		if (flag == 1)
+		    return;
+		else
+		    flag = 0;
+		break;
+	    default:
+		flag = 0;
+		break;
+	    }
+	}
+}
+
+
+/* MAKE_FLOAT -- Called when a n$f is seen in the input to convert a numeric
+ * constant to the form appropriate for the indicated datatype, e.g., "0",
+ * "0.", "0.0D0", etc.
+ */
+void
+make_float (char type_ch)
+{
+	char	*p;
+
+	for (p=yytext;  *p != '$';  p++)
+	    ;
+	*p = EOS;
+
+	if (type_ch == 'x') {
+	    output ('(');
+	    outstr (yytext);
+	    outstr (".0,");
+	    outstr (yytext);
+	    outstr (".0)");
+	} else {
+	    outstr (yytext);
+	    switch (type_ch) {
+	    case 'r':
+		outstr (".0");
+		break;
+	    case 'd':
+		outstr (".0D0");
+		break;
+	    }
+	}
+}
+
+
+/* OUTPUT_INDEF -- Output the INDEF string for the indicated datatype.
+ */
+void
+output_indef (char ch)	/* output INDEF, INDEFS, INDEFL, etc. */
+{
+	outstr(yytext);
+
+	switch (ch) {
+	case 's':
+	    output ('S');
+	    break;
+	case 'i':
+	    output ('I');
+	    break;
+	case 'l':
+	    output ('L');
+	    break;
+	case 'r':
+	    output ('R');
+	    break;
+	case 'd':
+	    output ('D');
+	    break;
+	case 'x':
+	    output ('X');
+	    break;
+	}
+}
+
+
+/* OUTPUT_UPPER -- Output the name of the current datatype (INT, REAL, etc.)
+ * in upper case.
+ */
+void
+output_upper (char *s)
+{
+	char	ch, *p;
+
+	outstr(s);
+	for (p=type_string;  (ch = *p) != EOS;  p++)
+	    output(toupper(ch));
+}
+
+
+/* PASS_THROUGH -- Used to pass text on to the output without modification.
+ * The text is delimited as "$/ (text) /" in the input file.  The delimited
+ * section may enclose newlines.
+ */
+void
+pass_through (void)
+{
+	char	ch;
+
+	while ((ch = input()) != '/')
+	    output(ch);
+}
+
+
+/* DO_FOR -- Process a "$FOR (types)" statement.  The sequence of statements
+ * bracketed by $for ... $endfor will be processed and output (to a single
+ * output stream) for each datatype named in the for predicate.
+ */
+void
+do_for (void)
+{
+	register char	*op;
+	register int	ch;
+	register struct _for *fp;
+	char	types[20];
+
+	if (++forlev + 1 >= SZ_FORSTK) {
+	    fprintf (stderr, "$for statements nested too deeply\n");
+	    exit (OSOK+1);
+	}
+
+	/* Extract list of types.
+	 */
+	while ((ch = input()) != '(')
+	    if (ch == EOF || ch == '\n') {
+		fprintf (stderr, "$for must have () delimited list of types\n");
+		strcpy (types, "i");
+		goto init_;
+	    }
+
+	for (op=types;  (ch = input()) != ')';  op++)
+	    if (ch == EOF || ch == '\n') {
+		fprintf (stderr, "missing right paren in $for statement\n");
+		break;
+	    } else
+		*op = ch;
+
+	*op = EOS;
+	if (op == types) {
+	    fprintf (stderr, "null typelist in $for statement\n");
+	    strcpy (types, "i");
+	}
+
+init_:
+	fp = &forstk[forlev];
+	fp->f_prevtype = type_char;
+	strcpy (fp->f_types, types);
+	fp->f_curtype = fp->f_types;
+	fp->f_fpos = k_ftell (yyin);
+
+	type_char = *(fp->f_curtype)++;
+	set_type_string (type_char);
+}
+
+
+/* DO_ENDFOR -- Called to process a $ENDFOR.  Set the next datatype and seek
+ * back to the line following the matching $FOR statement.  When the type list
+ * is exhausted pop the $for stack and continue normal processing.
+ */
+void
+do_endfor (void)
+{
+	register struct _for *fp;
+
+	if (forlev < 0) {
+	    fprintf (stderr, "$endfor with no matching $for\n");
+	    return;
+	}
+
+	fp = &forstk[forlev];
+	if ((type_char = *(fp->f_curtype)++) != EOS) {
+	    set_type_string (type_char);
+	    k_fseek (yyin, fp->f_fpos, 0);
+	} else {
+	    type_char = fp->f_prevtype;
+	    set_type_string (type_char);
+	    --forlev;
+	}
+}
+
+
+/*
+ * Conditional Compilation
+ * -------------------------
+ */
+
+#define	TRUE	1
+#define	FALSE	0
+#define	EQ	0
+#define	NE	1
+#define	LE	2
+#define	LT	3
+#define	GE	4
+#define	GT	5
+
+char	expr_buf[80], *expr;
+int	level = 0;
+
+struct	if_stack {
+	int	oldstate;
+	int	active;
+} stk[MAXNEST];
+
+
+/* DO_IF -- Process a $IF statement.  Evaluate the predicate and push a
+ * pass or stop output flag on the if stack.
+ */
+void
+do_if (void)
+{
+	char	ch;
+	int	expr_value;
+	struct	if_stack *p;
+
+	level += 1;
+	p = &stk[level];
+	p->oldstate = pass_output;
+	p->active = (pass_output == TRUE);
+
+	if ((expr_value = evaluate_expr()) == ERR)
+	    expr_value = FALSE;
+
+	if ((ch = input()) != '\n')
+	    unput(ch);
+
+	if (p->active == FALSE)
+	    return;
+	else if (expr_value == FALSE)
+	    pass_output = FALSE;
+}
+	
+
+/* DO_ELSE -- Process a $ELSE statement.  Toggle the pass/stop output flag
+ * on top of the if stack.
+ */
+void
+do_else (void)
+{
+	char	ch;
+
+	if (level == 0)
+	    fprintf (stderr, "Unmatched $else statement\n");
+	else if (stk[level].active)		/* toggle pass_output */
+	    pass_output = (pass_output == FALSE);
+
+	if ((ch = input()) != '\n')
+	    unput(ch);
+}
+
+
+/* DO_ENDIF -- Process a $ENDIF statement.  Pop the if stack.
+ */
+void
+do_endif (void)		/* $endif statement */
+{
+	char	ch;
+
+	if (level == 0)
+	    fprintf (stderr, "Too many $endif statements\n");
+	else
+	    pass_output = stk[level--].oldstate;
+
+	if ((ch = input()) != '\n')
+	    unput(ch);
+}
+
+
+/* EVALUATE_EXPR -- Kludge to evaluate boolean expressions in $if statements.
+ * Two kinds of expressions are permitted: (datatype relop chars), or
+ * (sizeof(char) relop sizeof(char)), where relop = (==, !=, <= etc.).
+ *
+ * Examples:		$if (datatype != dx)
+ *			    (code to be compiled if type not d or x)
+ *
+ *			$if (sizeof(i) <= sizeof(r))
+ *			    (code to be compiled if size int <= real)
+ */
+int
+evaluate_expr (void)
+{
+	char	ch=0, *p, *index(); 
+	int	lpar, size1, size2, op;
+
+
+	/* Advance to start of expression (discard '(') */
+	if (nextch() != '(')
+	    goto err;
+	else
+	    input();
+
+	/* Extract expression string into buffer */
+	expr = expr_buf;
+	nextch();
+
+	for (p=expr_buf, lpar=1;  lpar > 0 && (*p = input()) != EOF;  p++)
+	    switch (ch = *p) {
+	    case '(':
+		lpar++;
+		break;
+	    case ')':
+		if (--lpar == 0)
+		    *p = EOS;
+		break;
+	    case '\n':
+		goto err;
+	    }
+		
+	/* Is current type in set or not in set */
+	if (strncmp (expr,"datatype",8) == 0) {
+	    expr += 8;
+	    switch (relop()) {
+	    case EQ:
+		return (index(expr,type_char) != NULL);
+	    case NE:
+		return (index(expr,type_char) == NULL);
+	    default:
+		goto err;
+	    }
+
+	/* Compare sizes of two data types */
+	} else if (strncmp(expr,"sizeof",6) == 0) {
+	    if (parse_relational (&size1, &size2, &op) == ERR) {
+		ch = 0;
+		goto err;
+	    }
+	    switch (op) {
+	    case EQ:
+		return (size1 == size2);
+	    case NE:
+		return (size1 != size2);
+	    case LE:
+		return (size1 <= size2);
+	    case LT:
+		return (size1 <  size2);
+	    case GE:
+		return (size1 >= size2);
+	    case GT:
+		return (size1 >  size2);
+	    }
+
+	/* only "type" and "sizeof" are implemented */
+	} else {
+err:	    fprintf (stderr, "Syntax error in $if statement\n");
+	    if (ch != '\n') {
+		/* skip rest of line */
+		while ((ch = input()) != '\n')
+		    ;
+		unput(ch);
+	    }
+	}
+
+	return (ERR);
+}
+
+
+/* PARSE_RELATIONAL -- Parse "sizeof(t1) relop sizeof(t2)"  (via brute force...) */
+int
+parse_relational (int *size1, int *size2, int *op)
+{
+	expr += 6;				/* ... (t1) */
+
+	if (gch() != '(')
+	    return (ERR);
+	if ((*size1 = gsize(gch())) == ERR)
+	    return (ERR);
+	if (gch() != ')')
+	    return (ERR);			/* relop */
+	if ((*op = relop()) == ERR)
+	    return (ERR);
+
+	uch (gch());				/* skip whitespace */
+
+	if (strncmp(expr,"sizeof",6) != 0)	/* sizeof(t2) */
+	    return (ERR);
+
+	expr += 6;
+
+	if (gch() != '(')
+	    return (ERR);
+	if ((*size2 = gsize(gch())) == ERR)
+	    return (ERR);
+	if (gch() != ')')
+	    return (ERR);
+
+	return (OK);
+}
+
+
+/* RELOP -- Return a code for the next relational operator token in the input
+ * stream.
+ */
+int
+relop (void)
+{
+	char	ch;
+
+
+	switch (gch()) {
+	case '!':
+	    if (gch() == '=')
+		return (NE);
+	    return (ERR);
+	case '=':
+	    if (gch() == '=')
+		return (EQ);
+	    return (ERR);
+	case '<':
+	    if ((ch = gch()) == '=')
+		return (LE);
+	    uch(ch);
+	    return (LT);
+	case '>':
+	    if ((ch = gch()) == '=')
+		return (GE);
+	    uch(ch);
+	    return (GT);
+	default:
+	    return (ERR);
+	}
+}
+		    
+
+/* GSIZE -- Return the size of a datatype given its character code.
+ */
+int
+gsize (char ch)
+{
+	switch (ch) {
+	case 'B':
+	    return (sizeof(XUBYTE));
+	case 'U':
+	    return (sizeof(XUSHORT));
+	case 't':
+	    return (gsize(type_char));
+	case 'c':
+	    return (sizeof(XCHAR));
+	case 's':
+	    return (sizeof(XSHORT));
+	case 'i':
+	    return (sizeof(XINT));
+	case 'l':
+	    return (sizeof(XLONG));
+	case 'r':
+	    return (sizeof(XREAL));
+	case 'd':
+	    return (sizeof(XDOUBLE));
+	case 'x':
+	    return (sizeof(XCOMPLEX));
+	case 'p':
+	    return (sizeof(XPOINTER));
+	default:
+	    return (ERR);
+	}
+}
+
+
+/* NEXTCH -- Advance to next non-whitespace character.
+ */
+char 
+nextch (void)
+{
+	char	ch;
+
+	for (ch=input();  ch == ' ' || ch == '\t';  ch=input())
+	    ;
+	unput (ch);
+	return (ch);
+}
+
+
+/* GCH -- Get next nonwhite char from expression buffer.
+ */
+char
+gch (void)
+{
+	while (*expr == ' ' || *expr == '\t')
+	    expr++;
+
+	if (*expr != EOS)
+	    return (*expr++);
+	else
+	    return (EOS);
+}
+
+
+/* UCH -- Put char back into expression buffer.
+ */
+void
+uch (char ch)
+{
+	*--expr = ch;
+}
+
+
+/* OUTPUT -- Write a single character to the output file, if output is
+ * currently enabled (else throw it away).
+ */
+void
+output (char ch)
+{
+	if (pass_output)
+	    putc (ch, yyout);
+}
+
+
+/* OUTSTR -- Output a string.
+ */
+void
+outstr (char *s)
+{
+	if (pass_output)
+	    fputs (s, yyout);
+}
diff --git a/unix/boot/generic.new/generic.e b/unix/boot/generic.new/generic.e
new file mode 100755
index 00000000..dfab2707
--- /dev/null
+++ b/unix/boot/generic.new/generic.e
diff --git a/unix/boot/generic.new/generic.hlp b/unix/boot/generic.new/generic.hlp
new file mode 100644
index 00000000..eda8ceb2
--- /dev/null
+++ b/unix/boot/generic.new/generic.hlp
@@ -0,0 +1,245 @@
+.help generic Feb86 softools
+.ih
+NAME
+generic -- generic preprocessor
+.ih
+USAGE
+generic [-k] [-o ofile] [-p prefix] [-t types] files
+.ih
+PARAMETERS
+.ls 4 -k
+Allow the output files generated by \fIgeneric\fR to clobber any existing
+files.
+.le
+.ls 4 -o ofile
+The name of the output file.  If this option is selected, only a single
+file can be processed.
+.le
+.ls 4 -p prefix
+A prefix to be prepended to the output filenames.  This is useful when
+the output files are to be placed in a different directory.
+.le
+.ls 4 -t types
+The datatypes for which output is desired.  One output file will be generated
+for each type specified, with \fIgeneric\fR automatically generating the
+output filename by appending the type character to the root filename of
+the input file.  The \fItype\fR string is some subset of [ubscilrdx],
+where the type characters are as follows.
+.ls
+.nf
+u	- C unsigned short
+b	- C byte (char)
+c	- SPP character
+s	- SPP short
+i	- SPP int
+l	- SPP long
+r	- SPP real
+d	- SPP double
+x	- SPP complex
+.fi
+.le
+
+This option cannot be used in combination with the -o option, and should
+not be used when generic code is expanded inline, rather than written into
+multiple output files.
+.le
+.ls 4 files
+The input file or files to be processed.  Generic input files should have
+the extension ".gx" or ".gc", although this is not required.  Only a single
+input file can be given if the -o option is specified.
+.le
+.ih
+DESCRIPTION
+The generic preprocessor is used to translate generic source code (code
+written to work for any datatype) into type dependent source code,
+suitable for compilation and insertion into a library.  The generic source
+is translated for each datatype, producing a type dependent copy of the
+source code for each datatype.  There are two primary modes of operation:
+
+.ls
+.ls [1]
+The generic source is embedded in a normal file, bracketed by \fI$for\fR and
+\fI$endfor\fR directives.  There is one input file and one somewhat larger
+output file, with the generic code in the input file being replaced in the
+output file by several copies of the enclosed source, one for each datatype.
+This mode is most commonly used for modules to be linked in their entirety 
+into an applications package.  The "-o" parameter is used to specify
+the output filename.
+.le
+.ls [2]
+The entire input file is generic.  There may be multiple input files, and
+for each input file N output files are generated, one for each datatype
+specified with the "-t" parameter.  The output filenames are automatically
+generated by appending the type character to the root filename of the
+input file.  This mode is most commonly used for object libraries.
+.le
+.le
+
+
+The generic preprocessor operates by token replacement (currently using a
+UNIX \fILex\fR lexical analyzer).  The input stream is broken up into a
+stream of tokens.  Each token is examined to see if it is in the following
+list, and the indicated action is taken if the token is matched.  The generic
+preprocessor directives have the form "$NAME", where $ marks a \fIgeneric\fR
+directive, and where NAME is the name of the directive.
+.ls 10 PIXEL
+Replaced by the current type name, e.g., "int", "real", etc.
+.le
+.ls 10 XPIXEL
+Replaced by the current type name in upper case, preceded by an X,
+e.g., "XINT", "XREAL", etc.  This is used for generic C procedures meant
+to be called from SPP or Fortran.
+.le
+.ls 10 INDEF
+Replaced by the numeric constant denoting indefinite for the current
+datatype.
+.le
+.ls 10 INDEF[SILRDX]
+These strings are \fInot\fR replaced, since the "INDEF" in this case is
+not generic.
+.le
+.ls 10 SZ_PIXEL
+Replaced by "SZ_INT", "SZ_REAL", etc.
+.le
+.ls 10 TY_PIXEL
+Replaced by "TY_INT", "TY_REAL", etc.
+.le
+.ls 10 $PIXEL
+Replaced by the string "PIXEL".  This is used in doubly generic sources,
+where the first pass translates $PIXEL to PIXEL, and the second to the
+actual type string.
+.le
+.ls 10 $INDEF
+Replaced by the string "INDEF".
+.le
+.ls 10 $t
+Replaced by one of the characters [ubcsilrdx].
+.le
+.ls 10 $T
+Replaced by one of the characters [UBCSILRDX].
+.le
+.ls 10 $/.../
+Replaced by the string "...", i.e., whatever is within the // delimiters.
+Used to disable generic preprocessing of arbitrary text.
+.le
+.ls 10 [0-9]+("$f"|"$F")
+Replaced by the corresponding real or double constant.  For example,
+"1$f" translates as "1.0" for type real, but as "1.0D0" for type double.
+.le
+
+.ls 10 $if (expression)
+The conditional preprocessing facility.  If the $IF tests false the code
+which follows is skipped over, and is not copied to the output file.
+Control transfers to the matching $ELSE or $ENDIF.  The following may be
+used in the boolean expression:
+
+.nf
+"datatype"	denotes the current type
+ubcsilrdx	any subset of these characters denotes
+		    the corresponding datatype
+sizeof()	the size of the specified type,
+		    e.g., for comparisons
+
+!= ==		the relational operators
+ >  <  >= <=
+
+
+Examples:
+
+	$if (datatype != dx)
+	    (code to be compiled if type not d or x)
+
+	$if (sizeof(i) <= sizeof(r))
+	    (code to be compiled if size int <= real)
+.fi
+
+$IF constructs may be nested.  The directive may appear anywhere on
+a line.
+.le
+
+.ls 10 $else
+Marks the else clause of a $IF.
+.le
+.ls 10 $endif
+Marks the end of a $IF.  One is required for every $IF.
+.le
+.ls 10 $for (types)
+For each of the listed types, output a translated copy of the code between
+the $FOR and the matching $ENDFOR.  Nesting is permitted.
+
+.nf
+Example:
+	$for (silrd)
+	(any amount of generic code)
+	$endfor
+.fi
+.le
+.ls 10 $endfor
+Marks the end of a $FOR statement.
+.le
+.ls 10 $$
+Replaced by a single $.
+.le
+.ls 10 /*...*/
+C comments are not preprocessed.
+.le
+.ls 10 "..."
+Quoted strings are not preprocessed.
+.le
+.ls 10 #...(EOL)
+SPP comments are not preprocessed.
+.le
+.ls 10 %...(EOL)
+SPP Fortran escapes are not preprocessed.
+.le
+.ih
+EXAMPLES
+1. Translate the generic source "aadd.gx" to produce the six output files
+"aadds.x", "aaddi.x", etc., in the subdirectory "ak", clobbering any
+existing files therein.  The \fIgeneric\fR task is a bootstrap utility
+written in C and is implemented as a CL foreign task, hence the UNIX
+command syntax.
+
+	cl> generic -k -p ak/ -t silrdx aadd.gx
+
+2. Perform an inline transformation ($FOR directive) of the source file
+"imsum.gx", producing the single file "imsum.x" as output.
+
+	cl> generic -k -o imsum.x imsum.gx
+    
+3. The following is a simple example of a typical generic source file.
+For additional examples, see the ".gx" sources in the VOPS, IMIO, IMAGES
+and other directories.
+
+.nf
+# ALIM -- Compute the limits (minimum and maximum values) of a vector.
+# (this is a copy of the file vops$alim.gx).
+
+procedure alim$t (a, npix, minval, maxval)
+
+PIXEL	a[ARB], minval, maxval, value
+int	npix, i
+
+begin
+	minval = a[1]
+	maxval = a[1]
+
+	do i = 1, npix {
+	    value = a[i]
+	    $if (datatype == x)
+		if (abs(value) < abs(minval))
+		    minval = value
+		else if (abs(value) > abs(maxval))
+		    maxval = value
+	    $else
+		if (value < minval)
+		    minval = value
+		else if (value > maxval)
+		    maxval = value
+	    $endif
+	}
+end
+.fi
+.ih
+SEE ALSO
+xc, xyacc
diff --git a/unix/boot/generic.new/generic.o b/unix/boot/generic.new/generic.o
new file mode 100644
index 00000000..6ea439d3
--- /dev/null
+++ b/unix/boot/generic.new/generic.o
diff --git a/unix/boot/generic.new/lex.sed b/unix/boot/generic.new/lex.sed
new file mode 100644
index 00000000..56df4751
--- /dev/null
+++ b/unix/boot/generic.new/lex.sed
@@ -0,0 +1,7 @@
+/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/getc/k_getc/
diff --git a/unix/boot/generic.new/lexyy.c b/unix/boot/generic.new/lexyy.c
new file mode 100644
index 00000000..4540bd3c
--- /dev/null
+++ b/unix/boot/generic.new/lexyy.c
@@ -0,0 +1,2045 @@
+
+#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
+
+    #define YY_LESS_LINENO(n)
+    
+/* 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 k_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;
+
+extern int yylineno;
+
+int yylineno = 1;
+
+extern char *yytext;
+#define yytext_ptr 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'; \
+	(yy_c_buf_p) = yy_cp;
+
+#define YY_NUM_RULES 33
+#define YY_END_OF_BUFFER 34
+/* 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_accept[122] =
+    {   0,
+        0,    0,   34,   33,   33,   26,   31,   33,   33,   33,
+       33,   33,   33,   33,   33,   33,   31,   32,    0,    0,
+       24,   12,    0,    0,    0,    0,   11,    0,    0,    0,
+       10,   25,    0,    0,    0,    0,    0,    0,    0,    0,
+        0,    0,    0,    0,    0,    0,    0,   19,    0,    0,
+        0,    0,    0,   14,   13,    0,    0,    0,    0,    0,
+        0,    0,    0,   27,    0,    0,    0,   22,    0,    0,
+        0,    0,   17,    0,    0,    0,    0,    0,    0,    0,
+        0,    0,   20,    0,    0,    0,    0,   15,    0,    0,
+        0,    3,    1,    0,    0,    0,   28,    0,    0,    0,
+
+       21,    8,    7,    0,   16,    9,    4,    0,    0,    2,
+       29,    0,   23,   18,    0,    0,    0,    5,    6,   30,
+        0
+    } ;
+
+static yyconst flex_int32_t yy_ec[256] =
+    {   0,
+        1,    1,    1,    1,    1,    1,    1,    1,    2,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    2,    1,    3,    4,    5,    6,    1,    1,    1,
+        1,    7,    1,    1,    1,    1,    8,    9,    9,    9,
+        9,    9,    9,    9,    9,    9,    9,    1,    1,    1,
+        1,    1,    1,    1,   10,   10,   10,   11,   12,   13,
+       10,   10,   14,   10,   10,   15,   10,   16,   17,   18,
+       10,   19,   20,   21,   10,   10,   10,   22,   23,   24,
+        1,    1,    1,    1,   25,    1,    1,    1,   26,   27,
+
+       28,   29,    1,    1,   30,    1,    1,   31,    1,   32,
+       33,    1,    1,   34,   35,   36,   37,    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,    1,    1,    1,
+        1,    1,    1,    1,    1
+    } ;
+
+static yyconst flex_int32_t yy_meta[38] =
+    {   0,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    2,
+        2,    2,    2,    2,    2,    2,    2,    2,    2,    2,
+        2,    2,    2,    2,    2,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1
+    } ;
+
+static yyconst flex_int16_t yy_base[123] =
+    {   0,
+        0,   34,  194,  195,   37,  195,  195,   38,  186,   36,
+      174,   31,   30,   36,   35,  173,   27,  195,   59,   63,
+      195,  195,   47,  173,   56,  175,  195,   39,  155,  158,
+      195,  195,   52,   73,  168,   65,   62,   66,   69,   71,
+       72,   66,   70,  172,  164,  172,  163,  195,  170,  158,
+      144,  151,  143,  195,  195,   82,   83,   91,  158,  157,
+       88,  139,  146,  195,  146,  159,   94,  195,  158,  157,
+      140,   82,  195,  101,  102,   99,  104,  107,  111,  139,
+      136,  134,  195,  147,  150,  149,  146,  195,  127,  130,
+      109,  119,  140,  110,  113,  125,  195,  128,  119,  136,
+
+      195,  195,  195,  120,  195,  135,  134,  124,  132,  133,
+      195,  120,  195,  195,  130,  131,   98,   98,   87,  195,
+      195,   83
+    } ;
+
+static yyconst flex_int16_t yy_def[123] =
+    {   0,
+      121,    1,  121,  121,  121,  121,  121,  121,  121,  121,
+      122,  122,  122,  122,  122,  122,  121,  121,  121,  121,
+      121,  121,  121,  121,  121,  121,  121,  121,  121,  121,
+      121,  121,  121,  121,  122,  122,  122,  122,  122,  122,
+      122,  121,  121,  121,  121,  121,  121,  121,  121,  121,
+      121,  121,  121,  121,  121,  122,  122,  122,  122,  122,
+      122,  121,  121,  121,  121,  121,  121,  121,  121,  121,
+      121,  121,  121,  122,  122,  122,  122,  122,  122,  121,
+      121,  121,  121,  121,  121,  121,  121,  121,  121,  121,
+      122,  122,  122,  122,  122,  122,  121,  121,  121,  121,
+
+      121,  121,  121,  121,  121,  122,  122,  122,  122,  122,
+      121,  121,  121,  121,  122,  122,  121,  122,  122,  121,
+        0,  121
+    } ;
+
+static yyconst flex_int16_t yy_nxt[233] =
+    {   0,
+        4,    5,    6,    7,    8,    4,    4,    9,   10,   11,
+       11,   11,   11,   12,   11,   11,   11,   13,   11,   14,
+       15,   16,   11,   11,    4,    4,    4,    4,    4,    4,
+        4,    4,    4,    4,    4,    4,    4,   17,   19,   18,
+       33,   20,   21,   38,   34,   22,   37,   36,   36,   23,
+       24,   25,   36,   36,   42,   26,   43,   40,   27,   39,
+       19,   45,   46,   20,   55,   28,   29,   30,   48,   51,
+       52,   49,   57,   31,   23,   24,   44,   33,   56,   36,
+       55,   34,   36,   36,   35,   61,   36,   58,   36,   36,
+       28,   29,   30,   59,   75,   60,   62,   63,   64,   36,
+
+       36,   65,   76,   74,   36,   36,   84,   85,   36,   79,
+       89,   90,   91,   93,   92,   36,   36,   94,   36,   36,
+       95,   36,   96,  106,   36,  120,   36,   36,   36,  107,
+       36,  108,  107,  107,  109,  115,   36,  107,  107,  110,
+      107,   36,   36,  116,  118,  119,  117,   36,   36,   36,
+       36,   36,   36,  114,  113,  112,  111,   36,  105,  104,
+      103,  102,  101,  100,   99,   98,   97,   88,   87,   86,
+       83,   82,   81,   80,   78,   77,   73,   72,   71,   70,
+       69,   68,   67,   66,   48,   36,   54,   53,   50,   47,
+       41,   36,   32,  121,    3,  121,  121,  121,  121,  121,
+
+      121,  121,  121,  121,  121,  121,  121,  121,  121,  121,
+      121,  121,  121,  121,  121,  121,  121,  121,  121,  121,
+      121,  121,  121,  121,  121,  121,  121,  121,  121,  121,
+      121,  121
+    } ;
+
+static yyconst flex_int16_t yy_chk[233] =
+    {   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,    2,    5,    2,
+       10,    5,    8,   13,   10,    8,   12,   13,   12,    8,
+        8,    8,   15,   14,   17,    8,   17,   15,    8,   14,
+       19,   23,   23,   19,   33,    8,    8,    8,   25,   28,
+       28,   25,   37,    8,   20,   20,   20,   34,   36,   37,
+       33,   34,   36,   38,  122,   41,   39,   38,   40,   41,
+       20,   20,   20,   39,   57,   40,   42,   42,   43,   56,
+
+       57,   43,   58,   56,  119,   61,   67,   67,   58,   61,
+       72,   72,   74,   76,   75,  118,   76,   77,   74,   75,
+       78,   77,   79,   91,   78,  117,   91,   94,   79,   92,
+       95,   94,   92,   92,   95,  108,   92,   92,   92,   96,
+       92,  108,   96,  109,  115,  116,  112,  115,  116,  109,
+      110,  107,  106,  104,  100,   99,   98,   93,   90,   89,
+       87,   86,   85,   84,   82,   81,   80,   71,   70,   69,
+       66,   65,   63,   62,   60,   59,   53,   52,   51,   50,
+       49,   47,   46,   45,   44,   35,   30,   29,   26,   24,
+       16,   11,    9,    3,  121,  121,  121,  121,  121,  121,
+
+      121,  121,  121,  121,  121,  121,  121,  121,  121,  121,
+      121,  121,  121,  121,  121,  121,  121,  121,  121,  121,
+      121,  121,  121,  121,  121,  121,  121,  121,  121,  121,
+      121,  121
+    } ;
+
+static yy_state_type yy_last_accepting_state;
+static char *yy_last_accepting_cpos;
+
+extern int yy_flex_debug;
+int yy_flex_debug = 0;
+
+/* The intent behind this definition is that it'll catch
+ * any uses of REJECT which flex missed.
+ */
+#define REJECT reject_used_but_not_detected
+#define yymore() yymore_used_but_not_detected
+#define YY_MORE_ADJ 0
+#define YY_RESTORE_YY_MORE_OFFSET
+char *yytext;
+#line 1 "tok.l"
+#line 2 "tok.l"
+
+#include <ctype.h>
+
+/*
+ * GENERIC -- This filter takes a file containing a generic operator as input
+ * and generates as output either a set of files, one for each of the data
+ * types in the generic family, or a single file wherein the generic section
+ * has been duplicated for each case.
+ */
+
+#undef	output
+extern	char	*type_string;
+extern	char	xtype_string[];
+extern	char	type_char;
+
+extern void  copy_line (void);
+extern void  copy_string (void);
+extern void  copy_comment (void);
+extern void  make_float (char type_ch);
+extern void  pass_through (void);
+extern void  do_for (void);
+extern void  do_endfor (void);
+extern void  do_if (void);
+extern void  do_else (void);
+extern void  do_endif (void);
+
+extern void  output_indef (char ch);
+extern void  output_upper (char *s);
+extern void  output (char ch);
+extern void  outstr (char *s);
+extern int   k_getc (FILE *cx_i);	  /* NOTE: lex.sed changes this to k_getc() */
+
+
+
+#line 577 "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
+
+    static 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
+static 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 = k_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 40 "tok.l"
+
+
+#line 765 "lex.yy.c"
+
+	if ( !(yy_init) )
+		{
+		(yy_init) = 1;
+
+#ifdef YY_USER_INIT
+		YY_USER_INIT;
+#endif
+
+		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_match:
+		do
+			{
+			register YY_CHAR yy_c = yy_ec[YY_SC_TO_UI(*yy_cp)];
+			if ( yy_accept[yy_current_state] )
+				{
+				(yy_last_accepting_state) = yy_current_state;
+				(yy_last_accepting_cpos) = 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 >= 122 )
+					yy_c = yy_meta[(unsigned int) yy_c];
+				}
+			yy_current_state = yy_nxt[yy_base[yy_current_state] + (unsigned int) yy_c];
+			++yy_cp;
+			}
+		while ( yy_base[yy_current_state] != 195 );
+
+yy_find_action:
+		yy_act = yy_accept[yy_current_state];
+		if ( yy_act == 0 )
+			{ /* have to back up */
+			yy_cp = (yy_last_accepting_cpos);
+			yy_current_state = (yy_last_accepting_state);
+			yy_act = yy_accept[yy_current_state];
+			}
+
+		YY_DO_BEFORE_ACTION;
+
+do_action:	/* This label is used only to access EOF actions. */
+
+		switch ( yy_act )
+	{ /* beginning of action switch */
+			case 0: /* must back up */
+			/* undo the effects of YY_DO_BEFORE_ACTION */
+			*yy_cp = (yy_hold_char);
+			yy_cp = (yy_last_accepting_cpos);
+			yy_current_state = (yy_last_accepting_state);
+			goto yy_find_action;
+
+case 1:
+YY_RULE_SETUP
+#line 42 "tok.l"
+outstr (type_string);
+	YY_BREAK
+case 2:
+YY_RULE_SETUP
+#line 43 "tok.l"
+outstr (xtype_string);
+	YY_BREAK
+case 3:
+YY_RULE_SETUP
+#line 44 "tok.l"
+output_indef (type_char);
+	YY_BREAK
+case 4:
+YY_RULE_SETUP
+#line 45 "tok.l"
+ECHO;
+	YY_BREAK
+case 5:
+YY_RULE_SETUP
+#line 46 "tok.l"
+output_upper ("SZ_");
+	YY_BREAK
+case 6:
+YY_RULE_SETUP
+#line 47 "tok.l"
+output_upper ("TY_");
+	YY_BREAK
+case 7:
+YY_RULE_SETUP
+#line 48 "tok.l"
+outstr ("PIXEL");
+	YY_BREAK
+case 8:
+YY_RULE_SETUP
+#line 49 "tok.l"
+outstr ("INDEF");
+	YY_BREAK
+case 9:
+YY_RULE_SETUP
+#line 51 "tok.l"
+{
+					yytext[strlen(yytext)-5] = '\0';
+					output_upper (yytext);
+				}
+	YY_BREAK
+case 10:
+YY_RULE_SETUP
+#line 56 "tok.l"
+{	if (isupper (type_char))
+					    output (tolower (type_char));
+					else
+					    output (type_char);
+				}
+	YY_BREAK
+case 11:
+YY_RULE_SETUP
+#line 61 "tok.l"
+{	if (islower (type_char))
+					    output (toupper (type_char));
+					else
+					    output (type_char);
+				}
+	YY_BREAK
+case 12:
+YY_RULE_SETUP
+#line 67 "tok.l"
+pass_through();
+	YY_BREAK
+case 13:
+YY_RULE_SETUP
+#line 68 "tok.l"
+make_float (type_char);
+	YY_BREAK
+case 14:
+YY_RULE_SETUP
+#line 70 "tok.l"
+do_if();
+	YY_BREAK
+case 15:
+YY_RULE_SETUP
+#line 71 "tok.l"
+do_else();
+	YY_BREAK
+case 16:
+YY_RULE_SETUP
+#line 72 "tok.l"
+do_endif(); 
+	YY_BREAK
+case 17:
+YY_RULE_SETUP
+#line 73 "tok.l"
+do_for(); 
+	YY_BREAK
+case 18:
+YY_RULE_SETUP
+#line 74 "tok.l"
+do_endfor(); 
+	YY_BREAK
+case 19:
+YY_RULE_SETUP
+#line 75 "tok.l"
+do_if();
+	YY_BREAK
+case 20:
+YY_RULE_SETUP
+#line 76 "tok.l"
+do_else();
+	YY_BREAK
+case 21:
+YY_RULE_SETUP
+#line 77 "tok.l"
+do_endif(); 
+	YY_BREAK
+case 22:
+YY_RULE_SETUP
+#line 78 "tok.l"
+do_for(); 
+	YY_BREAK
+case 23:
+YY_RULE_SETUP
+#line 79 "tok.l"
+do_endfor(); 
+	YY_BREAK
+case 24:
+YY_RULE_SETUP
+#line 81 "tok.l"
+output ('$');
+	YY_BREAK
+case 25:
+YY_RULE_SETUP
+#line 82 "tok.l"
+copy_comment();
+	YY_BREAK
+case 26:
+YY_RULE_SETUP
+#line 83 "tok.l"
+copy_string();
+	YY_BREAK
+case 27:
+YY_RULE_SETUP
+#line 85 "tok.l"
+ECHO;
+	YY_BREAK
+case 28:
+YY_RULE_SETUP
+#line 86 "tok.l"
+ECHO;
+	YY_BREAK
+case 29:
+YY_RULE_SETUP
+#line 87 "tok.l"
+ECHO;
+	YY_BREAK
+case 30:
+YY_RULE_SETUP
+#line 88 "tok.l"
+ECHO;
+	YY_BREAK
+case 31:
+YY_RULE_SETUP
+#line 90 "tok.l"
+copy_line();
+	YY_BREAK
+case 32:
+YY_RULE_SETUP
+#line 91 "tok.l"
+copy_line();
+	YY_BREAK
+case 33:
+YY_RULE_SETUP
+#line 93 "tok.l"
+ECHO;
+	YY_BREAK
+#line 1025 "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. */
+
+			/* just a shorter name for the current buffer */
+			YY_BUFFER_STATE b = YY_CURRENT_BUFFER;
+
+			int yy_c_buf_p_offset =
+				(int) ((yy_c_buf_p) - b->yy_ch_buf);
+
+			if ( b->yy_is_our_buffer )
+				{
+				yy_size_t new_size = b->yy_buf_size * 2;
+
+				if ( new_size <= 0 )
+					b->yy_buf_size += b->yy_buf_size / 8;
+				else
+					b->yy_buf_size *= 2;
+
+				b->yy_ch_buf = (char *)
+					/* Include room in for 2 EOB chars. */
+					yyrealloc((void *) b->yy_ch_buf,b->yy_buf_size + 2  );
+				}
+			else
+				/* Can't grow it, we don't own it. */
+				b->yy_ch_buf = 0;
+
+			if ( ! b->yy_ch_buf )
+				YY_FATAL_ERROR(
+				"fatal error - scanner input buffer overflow" );
+
+			(yy_c_buf_p) = &b->yy_ch_buf[yy_c_buf_p_offset];
+
+			num_to_read = YY_CURRENT_BUFFER_LVALUE->yy_buf_size -
+						number_to_move - 1;
+
+			}
+
+		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();
+
+	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);
+		if ( yy_accept[yy_current_state] )
+			{
+			(yy_last_accepting_state) = yy_current_state;
+			(yy_last_accepting_cpos) = 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 >= 122 )
+				yy_c = yy_meta[(unsigned int) yy_c];
+			}
+		yy_current_state = yy_nxt[yy_base[yy_current_state] + (unsigned int) yy_c];
+		}
+
+	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 char *yy_cp = (yy_c_buf_p);
+
+	register YY_CHAR yy_c = 1;
+	if ( yy_accept[yy_current_state] )
+		{
+		(yy_last_accepting_state) = yy_current_state;
+		(yy_last_accepting_cpos) = 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 >= 122 )
+			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 == 121);
+
+	return yy_is_jam ? 0 : yy_current_state;
+}
+
+    static 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;
+
+	(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
+    static 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');
+
+	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.
+     */
+
+    (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;
+
+/* 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;
+
+    /* 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 93 "tok.l"
+
+
+
+
+/* LEX_INPUT -- Make input() callable as a function from the .c code.
+ */
+int
+lex_input (void)
+{
+	return (input());
+}
+
+
+/* LEX_UNPUT -- Make unput() callable as a function from the .c code.
+ */
+void
+lex_unput (int ch)
+{
+	unput (ch);
+}
+
diff --git a/unix/boot/generic.new/lexyy.o b/unix/boot/generic.new/lexyy.o
new file mode 100644
index 00000000..9f67f4cf
--- /dev/null
+++ b/unix/boot/generic.new/lexyy.o
diff --git a/unix/boot/generic.new/mkpkg.sh b/unix/boot/generic.new/mkpkg.sh
new file mode 100644
index 00000000..45389d35
--- /dev/null
+++ b/unix/boot/generic.new/mkpkg.sh
@@ -0,0 +1,18 @@
+# Bootstrap the generic preprocessor.  The -lln library is not used to avoid
+# the enternal dependency.  The sed script is used to edit certain nonportable
+# constructs in the LEX code, and the filename lex.yy.c is changed to lexyy.c
+# for portability reasons.
+
+find tok.l -newer lexyy.c -exec rm lexyy.c \;
+if test -f lexyy.c; then\
+    $CC -c $HSI_CF lexyy.c;\
+else\
+    lex	tok.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	generic.c chario.c yywrap.c
+$CC $HSI_LF	generic.o lexyy.o chario.o yywrap.o $HSI_LIBS -o generic.e
+mv -f		generic.e ../../hlib
+rm		*.o
diff --git a/unix/boot/generic.new/tok.l b/unix/boot/generic.new/tok.l
new file mode 100644
index 00000000..c9bedf29
--- /dev/null
+++ b/unix/boot/generic.new/tok.l
@@ -0,0 +1,111 @@
+%{
+
+#include <ctype.h>
+
+/*
+ * GENERIC -- This filter takes a file containing a generic operator as input
+ * and generates as output either a set of files, one for each of the data
+ * types in the generic family, or a single file wherein the generic section
+ * has been duplicated for each case.
+ */
+
+#undef	output
+extern	char	*type_string;
+extern	char	xtype_string[];
+extern	char	type_char;
+
+extern void  copy_line (void);
+extern void  copy_string (void);
+extern void  copy_comment (void);
+extern void  make_float (char type_ch);
+extern void  pass_through (void);
+extern void  do_for (void);
+extern void  do_endfor (void);
+extern void  do_if (void);
+extern void  do_else (void);
+extern void  do_endif (void);
+
+extern void  output_indef (char ch);
+extern void  output_upper (char *s);
+extern void  output (char ch);
+extern void  outstr (char *s);
+extern int   getc (FILE *cx_i);	  /* NOTE: lex.sed changes this to k_getc() */
+
+
+
+%}
+
+W	[ \t]
+
+%%
+
+PIXEL				outstr (type_string);
+XPIXEL				outstr (xtype_string);
+INDEF				output_indef (type_char);
+INDEF(S|I|L|R|D|X)		ECHO;
+SZ_PIXEL			output_upper ("SZ_");
+TY_PIXEL			output_upper ("TY_");
+$PIXEL				outstr ("PIXEL");
+$INDEF				outstr ("INDEF");
+
+[A-Z][A-Z_]*PIXEL		{
+					yytext[strlen(yytext)-5] = '\0';
+					output_upper (yytext);
+				}
+
+"$t"				{	if (isupper (type_char))
+					    output (tolower (type_char));
+					else
+					    output (type_char);
+				}
+"$T"				{	if (islower (type_char))
+					    output (toupper (type_char));
+					else
+					    output (type_char);
+				}
+
+"$/"				pass_through();
+[0-9]+("$f"|"$F")		make_float (type_char);
+
+{W}*"$if"			do_if();
+{W}*"$else"			do_else();
+{W}*"$endif"			do_endif(); 
+{W}*"$for"			do_for(); 
+{W}*"$endfor"			do_endfor(); 
+{W}*"$IF"			do_if();
+{W}*"$ELSE"			do_else();
+{W}*"$ENDIF"			do_endif(); 
+{W}*"$FOR"			do_for(); 
+{W}*"$ENDFOR"			do_endfor(); 
+
+"$$"				output ('$');
+"/*"				copy_comment();
+\"				copy_string();
+
+^\#if				ECHO;
+^\#else				ECHO;
+^\#endif			ECHO;
+^\#include			ECHO;
+
+\#				copy_line();
+^\%				copy_line();
+
+%%
+
+
+/* LEX_INPUT -- Make input() callable as a function from the .c code.
+ */
+int
+lex_input (void)
+{
+	return (input());
+}
+
+
+/* LEX_UNPUT -- Make unput() callable as a function from the .c code.
+ */
+void
+lex_unput (int ch)
+{
+	unput (ch);
+}
diff --git a/unix/boot/generic.new/yywrap.c b/unix/boot/generic.new/yywrap.c
new file mode 100644
index 00000000..627dff08
--- /dev/null
+++ b/unix/boot/generic.new/yywrap.c
@@ -0,0 +1,10 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+/* YYWRAP -- Called by lex when end of file is seen.
+ */
+int
+yywrap()
+{
+    return (1);
+}
diff --git a/unix/boot/generic.new/yywrap.o b/unix/boot/generic.new/yywrap.o
new file mode 100644
index 00000000..16875620
--- /dev/null
+++ b/unix/boot/generic.new/yywrap.o
diff --git a/unix/boot/generic.new/z b/unix/boot/generic.new/z
new file mode 100644
index 00000000..c850dbe8
--- /dev/null
+++ b/unix/boot/generic.new/z
@@ -0,0 +1,16 @@
+# Bootstrap the generic preprocessor.  The -lln library is not used to avoid
+# the enternal dependency.  The sed script is used to edit certain nonportable
+# constructs in the LEX code, and the filename lex.yy.c is changed to lexyy.c
+# for portability reasons.
+
+find tok.l -newer lexyy.c -exec rm lexyy.c \;
+if test -f lexyy.c; then\
+    $CC -c $HSI_CF lexyy.c;\
+else\
+    lex	tok.l;\
+    sed -f lex.sed lex.yy.c > lexyy.c;  rm lex.yy.c;\
+    $CC -c $HSI_CF lexyy.c;\
+fi
+
+$CC -c -g $HSI_CF	generic.c chario.c yywrap.c
+$CC $HSI_LF	generic.o lexyy.o chario.o yywrap.o $HSI_LIBS -o generic.e
diff --git a/unix/boot/generic/README b/unix/boot/generic/README
new file mode 100644
index 00000000..98a1d23a
--- /dev/null
+++ b/unix/boot/generic/README
@@ -0,0 +1,3 @@
+GENERIC -- The generic preprocessor is a simple task used to process generic
+	   code into type specific code.  A different copy of the code is output
+	   for each datatype.
diff --git a/unix/boot/generic/chario.c b/unix/boot/generic/chario.c
new file mode 100644
index 00000000..09b46e40
--- /dev/null
+++ b/unix/boot/generic/chario.c
@@ -0,0 +1,188 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+
+/*
+ * OS Character I/O.  This set of routines are provided as a workaround in
+ * the event that the host system cannot execute FTELL/FSEEK reliably (VMS/C
+ * could not).  The idea here is to keep track of the character offset from
+ * the beginning of the file.  K_FTELL returns the character offset.  K_FSEEK
+ * rewinds the file and reads characters forward to the indicated offset.
+ * K_GETC keeps a count of the file position.  (the k_ stands for kludge).
+ */
+
+extern	int debug;
+
+struct context {
+	FILE	*fp;			/* file descriptor	*/
+	long	fpos;			/* saved file pointer	*/
+	char	fname[512];		/* file being scanned	*/
+};
+
+FILE *
+k_fopen (fname, mode)
+char	*fname;
+char	*mode;
+{
+	register struct context *cx;
+	register FILE	*fp;
+
+	if ((fp = fopen (fname, mode)) == NULL)
+	    return (NULL);
+
+	cx = (struct context *) malloc (sizeof(struct context));
+	strcpy (cx->fname, fname);
+	cx->fpos = 0;
+	cx->fp = fp;
+
+	return ((FILE *)cx);
+}
+
+
+int
+k_fclose (cx_i)
+FILE	*cx_i;
+{
+	register struct context *cx = (struct context *)cx_i;
+	int	status;
+
+	status = fclose (cx->fp);
+	free (cx);
+
+	return (status);
+}
+
+#ifdef vms
+
+int
+k_getc (cx_i)
+FILE	*cx_i;
+{
+	register struct context *cx = (struct context *)cx_i;
+	register int	ch;
+
+	cx->fpos++;
+	if (debug > 3) {
+	    if ((ch = getc (cx->fp)) > 0)
+		printf ("%5d %03o %c\n", cx->fpos, ch, ch > 040 ? ch : 040);
+	    return (ch);
+	} else
+	    return (getc (cx->fp));
+}
+
+char *
+k_fgets (obuf, maxch, cx_i)
+char	*obuf;
+int	maxch;
+FILE	*cx_i;
+{
+	register struct context *cx = (struct context *)cx_i;
+	register int	ch, n;
+	register char	*op;
+
+	for (op=obuf, n=maxch;  --n >= 0;  )
+	    if ((ch = k_getc(cx)) < 0)
+		return (NULL);
+	    else {
+		*op++ = ch;
+		if (ch == '\n')
+		    break;
+	    }
+
+	return (obuf);
+}
+
+seek
+k_fseek (cx_i, offset, type)
+FILE	*cx_i;
+long	offset;
+int	type;
+{
+	register struct context *cx = (struct context *)cx_i;
+	register FILE	*fp = cx->fp;
+	register int	ch;
+
+	if (debug > 1)
+	    printf ("seek (%s, %ld, %d)\n", cx->fname, offset, type);
+	    
+	if (type == 0) {
+	    fseek (fp, 0L, 0);
+	    cx->fpos = 0;
+
+	    while (cx->fpos < offset && (ch = getc(fp)) != EOF) {
+		if (debug > 1)
+		    fputc (ch, stdout);
+		cx->fpos++;
+	    }
+
+	    if (debug > 1)
+		printf ("[]\n");
+
+	    return (0);
+	}
+
+	if (fseek (fp, offset, type) == -1)
+	    return (-1);
+	else {
+	    cx->fpos = ftell (fp);
+	    return (0);
+	}
+}
+
+long
+k_ftell (cx_i)
+FILE	*cx_i;
+{
+	register struct context *cx = (struct context *)cx_i;
+
+	if (debug > 1) {
+	    printf ("ftell returns %d\n", cx->fpos);
+	    fflush (stdout);
+	}
+
+	return (cx->fpos);
+}
+
+#else
+
+int
+k_getc (cx_i)
+FILE	*cx_i;
+{
+	register struct context *cx = (struct context *)cx_i;
+	return (getc (cx->fp));
+}
+
+char *
+k_fgets (op, maxch, cx_i)
+char	*op;
+int	maxch;
+FILE	*cx_i;
+{
+	register struct context *cx = (struct context *)cx_i;
+	return (fgets (op, maxch, cx->fp));
+}
+
+int
+k_fseek (cx_i, offset, type)
+FILE	*cx_i;
+long	offset;
+int	type;
+{
+	register struct context *cx = (struct context *)cx_i;
+	return (fseek (cx->fp, offset, type));
+}
+
+int
+k_ftell (cx_i)
+FILE	*cx_i;
+{
+	register struct context *cx = (struct context *)cx_i;
+	return (ftell (cx->fp));
+}
+
+#endif
diff --git a/unix/boot/generic/generic.c b/unix/boot/generic/generic.c
new file mode 100644
index 00000000..07d19885
--- /dev/null
+++ b/unix/boot/generic/generic.c
@@ -0,0 +1,892 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#include <stdio.h>
+#include <ctype.h>
+#include <stdlib.h>
+#include <string.h>
+#include <unistd.h>
+#define	import_spp
+#include <iraf.h>
+
+/*
+ * GENERIC -- This filter takes a file containing a generic operator as input
+ * and generates as output either a set of files, one for each of the data
+ * types in the generic family, or a single file wherein the generic section
+ * has been duplicated for each case.
+ */
+
+#define	input		lex_input
+#define	unput		lex_unput
+extern	char yytext[];
+extern	int  yyleng;
+extern	FILE *yyin;
+extern	FILE *yyout;
+
+#define	MAXFILES	512
+#define	MAXNEST		50
+#define	OK		0
+#define	SZ_FORSTK	20
+
+/* $FOR contstruct descriptor.
+ */
+struct _for {
+	char	f_prevtype;		/* type before $for	*/
+	char	f_types[20];		/* "csilrdx"		*/
+	char	*f_curtype;		/* pointer into f_types	*/
+	long	f_fpos;			/* seek offset of $FOR	*/
+};
+
+struct	_for forstk[SZ_FORSTK];
+int	forlev;
+char	*type_string;
+char	xtype_string[SZ_FNAME+1];
+char	type_char;
+int	pass_output = 1;
+int	clobber = NO;
+
+extern long  k_ftell (FILE *cx_i);
+extern FILE *k_fopen (char *fname, char *mode);
+extern int   k_fseek (FILE *cx_i, long offset, int type);
+extern int   k_fclose (FILE *cx_i);
+
+extern int   yylex (void);
+extern int   lex_input (void);
+extern void  lex_unput (int ch);
+
+
+char *make_typed_filename (char *template, char type_char);
+void  set_type_string (char ch);
+void  copy_line (void);
+void  copy_string (void);
+void  copy_comment (void);
+void  make_float (char type_ch);
+void  output_indef (char ch);
+void  output_upper (char *s);
+void  pass_through (void);
+void  do_for (void);
+void  do_endfor (void);
+void  do_if (void);
+void  do_else (void);
+void  do_endif (void);
+
+int   evaluate_expr (void);
+int   parse_relational (int *size1, int *size2, int *op);
+
+int   relop (void);
+int   gsize (char ch);
+char  nextch (void);
+char  gch (void);
+void  uch (char ch);
+
+void  output (char ch);
+void  outstr (char *s);
+
+
+
+
+/**
+ *  GENERIC: e.g., generic [-k] [-t csilrdx] file
+ */
+int main (int argc, char *argv[])
+{
+	char	*files[MAXFILES], *s, **p, *ip;
+	char	fname[SZ_FNAME], *extension;
+	char	*types = "i", *t;
+	char	*prefix = "";
+	char	genfname[SZ_FNAME+1];
+	char	template[SZ_FNAME+1];
+	char	input_file[SZ_FNAME+1];
+	char	*index(), *rindex();
+	int	n, nfiles;
+	FILE	*fp;
+
+	genfname[0] = EOS;
+	nfiles = 0;
+
+	for (p = &argv[1];  *p != NULL;  p++) {
+	    s = *p;
+	    if (s[0] == '-') {
+		switch (s[1]) {
+		case 'k':
+		    clobber = YES;
+		    break;
+		case 't':
+		    if (*(p+1) != NULL)
+			types = *++p;
+		    break;
+		case 'o':
+		    if (*(p+1) != NULL)
+			strcpy (genfname, *++p);
+		    break;
+		case 'p':
+		    if (*(p+1) != NULL)
+			prefix = *++p;
+		    break;
+		}
+	    } else {
+		files[nfiles++] = s;
+		if (genfname[0] != EOS && nfiles > 1) {
+		    fprintf (stderr,
+			"Cannot process multiple files with '-o' flag\n");
+		    exit (OSOK+1);
+		}
+	    }
+	}
+ 
+	for (n=0;  n < nfiles;  n++) {
+	    strcpy (input_file, files[n]);
+	    yyin = k_fopen (input_file, "r");
+	    if (yyin == NULL) {
+		fprintf (stderr, "Cannot open input file '%s'\n", input_file);
+		continue;
+	    }
+
+	    /* Set pointer to the filename extension string.  If the file name
+	     * has an extension, lop it off by overwriting the '.' with EOS.
+	     * The first character of the extension of a generic file is
+	     * normally a 'g', e.g., ".gx" or ".gc", but we want to generate
+	     * a ".x" or ".c" file, so lop off any leading g in the extension.
+	     */
+	    if ((extension = rindex (input_file, '.')) != NULL) {
+		*extension++ = EOS;
+		if (*extension == 'g')
+		    extension++;
+	    } else
+		extension = "";
+
+	    for (t=types;  *t != EOS;  t++) {
+		/* Make output file name */
+		strcpy (fname, prefix);
+
+		/* Expand a template of the form "chars$tchars" into the root
+		 * name of the new file, replacing the $t by the type char.
+		 * If using input filename as the root, add "$t"; otherwise,
+		 * check whether or not the generic filename string has a
+		 * "$t" in it, and add one at end if it does not.
+		 */
+		if (genfname[0] == EOS) {
+		    strcpy (template, input_file);
+		    strcat (template, "$t");
+
+		} else {
+		    strcpy (template, genfname);
+
+		    for (ip=index(genfname,'$');  ip != NULL;
+			ip = index(ip,'$')) {
+
+			if (*(ip+1) == '$')
+			    ip += 2;
+			else if (*(ip+1) == 't')
+			    break;
+		    }
+
+		    if (ip == NULL && strlen(types) > 1)
+			strcat (ip, "$t");
+		}
+
+		if (genfname[0] == EOS || strlen (types) > 1)
+		    strcat (fname, make_typed_filename (template, *t));
+		else
+		    strcat (fname, template);
+
+		/* If the user supplied the output filename template, we
+		 * assume that it already contains an extension.
+		 */
+		if (genfname[0] == EOS) {
+		    strcat (fname, ".");
+		    strcat (fname, extension);
+		}
+
+		if (access(fname,0) == 0) {
+		    if (clobber == NO) {
+			fprintf (stderr, "File `%s' already exists\n", fname);
+			continue;
+		    } else
+			unlink (fname);
+		}
+		if ((fp = fopen (fname, "w")) == NULL) {
+		    fprintf (stderr, "Cannot open file `%s'\n", fname);
+		    continue;
+		}
+
+		yyout = fp;
+		set_type_string (*t);
+		type_char = *t;
+		forlev = -1;
+
+		yylex();	/* do it */
+
+		fclose (fp);
+		k_fseek (yyin,0L,0);
+	    }
+
+	    k_fclose (yyin);
+	}
+
+	exit (OSOK);
+}
+
+
+/* MAKE_TYPED_FILENAME -- Make a copy of a filename string, substituting
+ * the given type suffix character for the every sequence "$t" found in the
+ * input string.  The output string is retained in an internal static buffer.
+ * Any sequence "$$" is converted into a single "$".
+ */
+char *
+make_typed_filename (char *template, char type_char)
+{
+	register char *ip, *op;
+	char	ch;
+	static	char fname[SZ_FNAME+1];
+
+	if (isupper (type_char))
+	    ch = tolower (type_char);
+	else
+	    ch = type_char;
+
+	for (ip=template, op=fname;  *ip != EOS;  )
+	    if (*ip == '$' && *(ip+1) == '$') {
+		*op++ = '$';
+		ip += 2;
+	    } else if (*ip == '$' && *(ip+1) == 't') {
+		*op++ = ch;
+		ip += 2;
+	    } else
+		*op++ = *ip++;
+	    
+	return (fname);
+}
+
+
+/* SET_TYPE_STRING -- Given the type suffix character, set the external
+ * array "type_string" to the name of the corresponding SPP datatype.
+ */
+void
+set_type_string (char ch)
+{
+	char	*ip, *op;
+
+	switch (ch) {
+	case 'B':
+	    type_string = "ubyte";		/* unsigned byte	*/
+	    break;
+	case 'U':
+	    type_string = "ushort";
+	    break;
+	case 'b':
+	    type_string = "bool";
+	    break;
+	case 'c':
+	    type_string = "char";
+	    break;
+	case 's':
+	    type_string = "short";
+	    break;
+	case 'i':
+	    type_string = "int";
+	    break;
+	case 'l':
+	    type_string = "long";
+	    break;
+	case 'r':
+	    type_string = "real";
+	    break;
+	case 'd':
+	    type_string = "double";
+	    break;
+	case 'x':
+	    type_string = "complex";
+	    break;
+	case 'p':
+	    type_string = "pointer";
+	    break;
+	default:
+	    fprintf (stderr, "Unknown type suffix char `%c'\n", ch);
+	}
+
+	op = xtype_string;
+	*op++ = 'X';
+	for (ip=type_string;  *ip != EOS;  ip++)
+	    *op++ = toupper (*ip);
+	*op++ = EOS;
+}
+
+
+/* COPY_LINE -- Output whatever is in the yylex token buffer, followed by the
+ * remainder of the line from which the token was extracted.
+ */
+void
+copy_line (void)
+{
+	char	ch;
+
+	outstr(yytext);
+	while ((ch = input()) != '\n')
+	    output(ch);
+	unput(ch);
+}
+
+
+/* COPY_STRING -- Called when the opening quote of a string is seen in the
+ * input.  Copy the opening quote followed by all input characters until the
+ * end of string is seen.
+ */
+void
+copy_string (void)
+{
+	char	ch;
+
+	outstr(yytext);
+	for (;;) {
+	    switch (ch = input()) {
+	    case '"':
+		output(ch);
+		return;
+	    case '\\':
+		output(ch);
+		if ((ch = input()) != '\n')
+		    output(ch);
+		else
+		    unput(ch);
+		break;
+	    case '\n':
+		unput(ch);
+		return;
+	    default:
+		output(ch);
+	    }
+	}
+}
+
+
+/* COPY_COMMENT -- Copy a C style comment to the output file.
+ */
+void
+copy_comment (void)
+{
+	char	ch;
+	int	flag = 0;
+
+	outstr (yytext);
+
+	while ((ch = input()) != EOF) {
+	    output (ch);
+	    switch (ch) {
+	    case '*':
+		flag = 1;
+		break;
+	    case '/':
+		if (flag == 1)
+		    return;
+		else
+		    flag = 0;
+		break;
+	    default:
+		flag = 0;
+		break;
+	    }
+	}
+}
+
+
+/* MAKE_FLOAT -- Called when a n$f is seen in the input to convert a numeric
+ * constant to the form appropriate for the indicated datatype, e.g., "0",
+ * "0.", "0.0D0", etc.
+ */
+void
+make_float (char type_ch)
+{
+	char	*p;
+
+	for (p=yytext;  *p != '$';  p++)
+	    ;
+	*p = EOS;
+
+	if (type_ch == 'x') {
+	    output ('(');
+	    outstr (yytext);
+	    outstr (".0,");
+	    outstr (yytext);
+	    outstr (".0)");
+	} else {
+	    outstr (yytext);
+	    switch (type_ch) {
+	    case 'r':
+		outstr (".0");
+		break;
+	    case 'd':
+		outstr (".0D0");
+		break;
+	    }
+	}
+}
+
+
+/* OUTPUT_INDEF -- Output the INDEF string for the indicated datatype.
+ */
+void
+output_indef (char ch)	/* output INDEF, INDEFS, INDEFL, etc. */
+{
+	outstr(yytext);
+
+	switch (ch) {
+	case 's':
+	    output ('S');
+	    break;
+	case 'i':
+	    output ('I');
+	    break;
+	case 'l':
+	    output ('L');
+	    break;
+	case 'r':
+	    output ('R');
+	    break;
+	case 'd':
+	    output ('D');
+	    break;
+	case 'x':
+	    output ('X');
+	    break;
+	}
+}
+
+
+/* OUTPUT_UPPER -- Output the name of the current datatype (INT, REAL, etc.)
+ * in upper case.
+ */
+void
+output_upper (char *s)
+{
+	char	ch, *p;
+
+	outstr(s);
+	for (p=type_string;  (ch = *p) != EOS;  p++)
+	    output(toupper(ch));
+}
+
+
+/* PASS_THROUGH -- Used to pass text on to the output without modification.
+ * The text is delimited as "$/ (text) /" in the input file.  The delimited
+ * section may enclose newlines.
+ */
+void
+pass_through (void)
+{
+	char	ch;
+
+	while ((ch = input()) != '/')
+	    output(ch);
+}
+
+
+/* DO_FOR -- Process a "$FOR (types)" statement.  The sequence of statements
+ * bracketed by $for ... $endfor will be processed and output (to a single
+ * output stream) for each datatype named in the for predicate.
+ */
+void
+do_for (void)
+{
+	register char	*op;
+	register int	ch;
+	register struct _for *fp;
+	char	types[20];
+
+	if (++forlev + 1 >= SZ_FORSTK) {
+	    fprintf (stderr, "$for statements nested too deeply\n");
+	    exit (OSOK+1);
+	}
+
+	/* Extract list of types.
+	 */
+	while ((ch = input()) != '(')
+	    if (ch == EOF || ch == '\n') {
+		fprintf (stderr, "$for must have () delimited list of types\n");
+		strcpy (types, "i");
+		goto init_;
+	    }
+
+	for (op=types;  (ch = input()) != ')';  op++)
+	    if (ch == EOF || ch == '\n') {
+		fprintf (stderr, "missing right paren in $for statement\n");
+		break;
+	    } else
+		*op = ch;
+
+	*op = EOS;
+	if (op == types) {
+	    fprintf (stderr, "null typelist in $for statement\n");
+	    strcpy (types, "i");
+	}
+
+init_:
+	fp = &forstk[forlev];
+	fp->f_prevtype = type_char;
+	strcpy (fp->f_types, types);
+	fp->f_curtype = fp->f_types;
+	fp->f_fpos = k_ftell (yyin);
+
+	type_char = *(fp->f_curtype)++;
+	set_type_string (type_char);
+}
+
+
+/* DO_ENDFOR -- Called to process a $ENDFOR.  Set the next datatype and seek
+ * back to the line following the matching $FOR statement.  When the type list
+ * is exhausted pop the $for stack and continue normal processing.
+ */
+void
+do_endfor (void)
+{
+	register struct _for *fp;
+
+	if (forlev < 0) {
+	    fprintf (stderr, "$endfor with no matching $for\n");
+	    return;
+	}
+
+	fp = &forstk[forlev];
+	if ((type_char = *(fp->f_curtype)++) != EOS) {
+	    set_type_string (type_char);
+	    k_fseek (yyin, fp->f_fpos, 0);
+	} else {
+	    type_char = fp->f_prevtype;
+	    set_type_string (type_char);
+	    --forlev;
+	}
+}
+
+
+/*
+ * Conditional Compilation
+ * -------------------------
+ */
+
+#define	TRUE	1
+#define	FALSE	0
+#define	EQ	0
+#define	NE	1
+#define	LE	2
+#define	LT	3
+#define	GE	4
+#define	GT	5
+
+char	expr_buf[80], *expr;
+int	level = 0;
+
+struct	if_stack {
+	int	oldstate;
+	int	active;
+} stk[MAXNEST];
+
+
+/* DO_IF -- Process a $IF statement.  Evaluate the predicate and push a
+ * pass or stop output flag on the if stack.
+ */
+void
+do_if (void)
+{
+	char	ch;
+	int	expr_value;
+	struct	if_stack *p;
+
+	level += 1;
+	p = &stk[level];
+	p->oldstate = pass_output;
+	p->active = (pass_output == TRUE);
+
+	if ((expr_value = evaluate_expr()) == ERR)
+	    expr_value = FALSE;
+
+	if ((ch = input()) != '\n')
+	    unput(ch);
+
+	if (p->active == FALSE)
+	    return;
+	else if (expr_value == FALSE)
+	    pass_output = FALSE;
+}
+	
+
+/* DO_ELSE -- Process a $ELSE statement.  Toggle the pass/stop output flag
+ * on top of the if stack.
+ */
+void
+do_else (void)
+{
+	char	ch;
+
+	if (level == 0)
+	    fprintf (stderr, "Unmatched $else statement\n");
+	else if (stk[level].active)		/* toggle pass_output */
+	    pass_output = (pass_output == FALSE);
+
+	if ((ch = input()) != '\n')
+	    unput(ch);
+}
+
+
+/* DO_ENDIF -- Process a $ENDIF statement.  Pop the if stack.
+ */
+void
+do_endif (void)		/* $endif statement */
+{
+	char	ch;
+
+	if (level == 0)
+	    fprintf (stderr, "Too many $endif statements\n");
+	else
+	    pass_output = stk[level--].oldstate;
+
+	if ((ch = input()) != '\n')
+	    unput(ch);
+}
+
+
+/* EVALUATE_EXPR -- Kludge to evaluate boolean expressions in $if statements.
+ * Two kinds of expressions are permitted: (datatype relop chars), or
+ * (sizeof(char) relop sizeof(char)), where relop = (==, !=, <= etc.).
+ *
+ * Examples:		$if (datatype != dx)
+ *			    (code to be compiled if type not d or x)
+ *
+ *			$if (sizeof(i) <= sizeof(r))
+ *			    (code to be compiled if size int <= real)
+ */
+int
+evaluate_expr (void)
+{
+	char	ch=0, *p, *index(); 
+	int	lpar, size1, size2, op;
+
+
+	/* Advance to start of expression (discard '(') */
+	if (nextch() != '(')
+	    goto err;
+	else
+	    input();
+
+	/* Extract expression string into buffer */
+	expr = expr_buf;
+	nextch();
+
+	for (p=expr_buf, lpar=1;  lpar > 0 && (*p = input()) != EOF;  p++)
+	    switch (ch = *p) {
+	    case '(':
+		lpar++;
+		break;
+	    case ')':
+		if (--lpar == 0)
+		    *p = EOS;
+		break;
+	    case '\n':
+		goto err;
+	    }
+		
+	/* Is current type in set or not in set */
+	if (strncmp (expr,"datatype",8) == 0) {
+	    expr += 8;
+	    switch (relop()) {
+	    case EQ:
+		return (index(expr,type_char) != NULL);
+	    case NE:
+		return (index(expr,type_char) == NULL);
+	    default:
+		goto err;
+	    }
+
+	/* Compare sizes of two data types */
+	} else if (strncmp(expr,"sizeof",6) == 0) {
+	    if (parse_relational (&size1, &size2, &op) == ERR) {
+		ch = 0;
+		goto err;
+	    }
+	    switch (op) {
+	    case EQ:
+		return (size1 == size2);
+	    case NE:
+		return (size1 != size2);
+	    case LE:
+		return (size1 <= size2);
+	    case LT:
+		return (size1 <  size2);
+	    case GE:
+		return (size1 >= size2);
+	    case GT:
+		return (size1 >  size2);
+	    }
+
+	/* only "type" and "sizeof" are implemented */
+	} else {
+err:	    fprintf (stderr, "Syntax error in $if statement\n");
+	    if (ch != '\n') {
+		/* skip rest of line */
+		while ((ch = input()) != '\n')
+		    ;
+		unput(ch);
+	    }
+	}
+
+	return (ERR);
+}
+
+
+/* PARSE_RELATIONAL -- Parse "sizeof(t1) relop sizeof(t2)"  (via brute force...) */
+int
+parse_relational (int *size1, int *size2, int *op)
+{
+	expr += 6;				/* ... (t1) */
+
+	if (gch() != '(')
+	    return (ERR);
+	if ((*size1 = gsize(gch())) == ERR)
+	    return (ERR);
+	if (gch() != ')')
+	    return (ERR);			/* relop */
+	if ((*op = relop()) == ERR)
+	    return (ERR);
+
+	uch (gch());				/* skip whitespace */
+
+	if (strncmp(expr,"sizeof",6) != 0)	/* sizeof(t2) */
+	    return (ERR);
+
+	expr += 6;
+
+	if (gch() != '(')
+	    return (ERR);
+	if ((*size2 = gsize(gch())) == ERR)
+	    return (ERR);
+	if (gch() != ')')
+	    return (ERR);
+
+	return (OK);
+}
+
+
+/* RELOP -- Return a code for the next relational operator token in the input
+ * stream.
+ */
+int
+relop (void)
+{
+	char	ch;
+
+
+	switch (gch()) {
+	case '!':
+	    if (gch() == '=')
+		return (NE);
+	    return (ERR);
+	case '=':
+	    if (gch() == '=')
+		return (EQ);
+	    return (ERR);
+	case '<':
+	    if ((ch = gch()) == '=')
+		return (LE);
+	    uch(ch);
+	    return (LT);
+	case '>':
+	    if ((ch = gch()) == '=')
+		return (GE);
+	    uch(ch);
+	    return (GT);
+	default:
+	    return (ERR);
+	}
+}
+		    
+
+/* GSIZE -- Return the size of a datatype given its character code.
+ */
+int
+gsize (char ch)
+{
+	switch (ch) {
+	case 'B':
+	    return (sizeof(XUBYTE));
+	case 'U':
+	    return (sizeof(XUSHORT));
+	case 't':
+	    return (gsize(type_char));
+	case 'c':
+	    return (sizeof(XCHAR));
+	case 's':
+	    return (sizeof(XSHORT));
+	case 'i':
+	    return (sizeof(XINT));
+	case 'l':
+	    return (sizeof(XLONG));
+	case 'r':
+	    return (sizeof(XREAL));
+	case 'd':
+	    return (sizeof(XDOUBLE));
+	case 'x':
+	    return (sizeof(XCOMPLEX));
+	case 'p':
+	    return (sizeof(XPOINTER));
+	default:
+	    return (ERR);
+	}
+}
+
+
+/* NEXTCH -- Advance to next non-whitespace character.
+ */
+char 
+nextch (void)
+{
+	char	ch;
+
+	for (ch=input();  ch == ' ' || ch == '\t';  ch=input())
+	    ;
+	unput (ch);
+	return (ch);
+}
+
+
+/* GCH -- Get next nonwhite char from expression buffer.
+ */
+char
+gch (void)
+{
+	while (*expr == ' ' || *expr == '\t')
+	    expr++;
+
+	if (*expr != EOS)
+	    return (*expr++);
+	else
+	    return (EOS);
+}
+
+
+/* UCH -- Put char back into expression buffer.
+ */
+void
+uch (char ch)
+{
+	*--expr = ch;
+}
+
+
+/* OUTPUT -- Write a single character to the output file, if output is
+ * currently enabled (else throw it away).
+ */
+void
+output (char ch)
+{
+	if (pass_output)
+	    putc (ch, yyout);
+}
+
+
+/* OUTSTR -- Output a string.
+ */
+void
+outstr (char *s)
+{
+	if (pass_output)
+	    fputs (s, yyout);
+}
diff --git a/unix/boot/generic/generic.hlp b/unix/boot/generic/generic.hlp
new file mode 100644
index 00000000..eda8ceb2
--- /dev/null
+++ b/unix/boot/generic/generic.hlp
@@ -0,0 +1,245 @@
+.help generic Feb86 softools
+.ih
+NAME
+generic -- generic preprocessor
+.ih
+USAGE
+generic [-k] [-o ofile] [-p prefix] [-t types] files
+.ih
+PARAMETERS
+.ls 4 -k
+Allow the output files generated by \fIgeneric\fR to clobber any existing
+files.
+.le
+.ls 4 -o ofile
+The name of the output file.  If this option is selected, only a single
+file can be processed.
+.le
+.ls 4 -p prefix
+A prefix to be prepended to the output filenames.  This is useful when
+the output files are to be placed in a different directory.
+.le
+.ls 4 -t types
+The datatypes for which output is desired.  One output file will be generated
+for each type specified, with \fIgeneric\fR automatically generating the
+output filename by appending the type character to the root filename of
+the input file.  The \fItype\fR string is some subset of [ubscilrdx],
+where the type characters are as follows.
+.ls
+.nf
+u	- C unsigned short
+b	- C byte (char)
+c	- SPP character
+s	- SPP short
+i	- SPP int
+l	- SPP long
+r	- SPP real
+d	- SPP double
+x	- SPP complex
+.fi
+.le
+
+This option cannot be used in combination with the -o option, and should
+not be used when generic code is expanded inline, rather than written into
+multiple output files.
+.le
+.ls 4 files
+The input file or files to be processed.  Generic input files should have
+the extension ".gx" or ".gc", although this is not required.  Only a single
+input file can be given if the -o option is specified.
+.le
+.ih
+DESCRIPTION
+The generic preprocessor is used to translate generic source code (code
+written to work for any datatype) into type dependent source code,
+suitable for compilation and insertion into a library.  The generic source
+is translated for each datatype, producing a type dependent copy of the
+source code for each datatype.  There are two primary modes of operation:
+
+.ls
+.ls [1]
+The generic source is embedded in a normal file, bracketed by \fI$for\fR and
+\fI$endfor\fR directives.  There is one input file and one somewhat larger
+output file, with the generic code in the input file being replaced in the
+output file by several copies of the enclosed source, one for each datatype.
+This mode is most commonly used for modules to be linked in their entirety 
+into an applications package.  The "-o" parameter is used to specify
+the output filename.
+.le
+.ls [2]
+The entire input file is generic.  There may be multiple input files, and
+for each input file N output files are generated, one for each datatype
+specified with the "-t" parameter.  The output filenames are automatically
+generated by appending the type character to the root filename of the
+input file.  This mode is most commonly used for object libraries.
+.le
+.le
+
+
+The generic preprocessor operates by token replacement (currently using a
+UNIX \fILex\fR lexical analyzer).  The input stream is broken up into a
+stream of tokens.  Each token is examined to see if it is in the following
+list, and the indicated action is taken if the token is matched.  The generic
+preprocessor directives have the form "$NAME", where $ marks a \fIgeneric\fR
+directive, and where NAME is the name of the directive.
+.ls 10 PIXEL
+Replaced by the current type name, e.g., "int", "real", etc.
+.le
+.ls 10 XPIXEL
+Replaced by the current type name in upper case, preceded by an X,
+e.g., "XINT", "XREAL", etc.  This is used for generic C procedures meant
+to be called from SPP or Fortran.
+.le
+.ls 10 INDEF
+Replaced by the numeric constant denoting indefinite for the current
+datatype.
+.le
+.ls 10 INDEF[SILRDX]
+These strings are \fInot\fR replaced, since the "INDEF" in this case is
+not generic.
+.le
+.ls 10 SZ_PIXEL
+Replaced by "SZ_INT", "SZ_REAL", etc.
+.le
+.ls 10 TY_PIXEL
+Replaced by "TY_INT", "TY_REAL", etc.
+.le
+.ls 10 $PIXEL
+Replaced by the string "PIXEL".  This is used in doubly generic sources,
+where the first pass translates $PIXEL to PIXEL, and the second to the
+actual type string.
+.le
+.ls 10 $INDEF
+Replaced by the string "INDEF".
+.le
+.ls 10 $t
+Replaced by one of the characters [ubcsilrdx].
+.le
+.ls 10 $T
+Replaced by one of the characters [UBCSILRDX].
+.le
+.ls 10 $/.../
+Replaced by the string "...", i.e., whatever is within the // delimiters.
+Used to disable generic preprocessing of arbitrary text.
+.le
+.ls 10 [0-9]+("$f"|"$F")
+Replaced by the corresponding real or double constant.  For example,
+"1$f" translates as "1.0" for type real, but as "1.0D0" for type double.
+.le
+
+.ls 10 $if (expression)
+The conditional preprocessing facility.  If the $IF tests false the code
+which follows is skipped over, and is not copied to the output file.
+Control transfers to the matching $ELSE or $ENDIF.  The following may be
+used in the boolean expression:
+
+.nf
+"datatype"	denotes the current type
+ubcsilrdx	any subset of these characters denotes
+		    the corresponding datatype
+sizeof()	the size of the specified type,
+		    e.g., for comparisons
+
+!= ==		the relational operators
+ >  <  >= <=
+
+
+Examples:
+
+	$if (datatype != dx)
+	    (code to be compiled if type not d or x)
+
+	$if (sizeof(i) <= sizeof(r))
+	    (code to be compiled if size int <= real)
+.fi
+
+$IF constructs may be nested.  The directive may appear anywhere on
+a line.
+.le
+
+.ls 10 $else
+Marks the else clause of a $IF.
+.le
+.ls 10 $endif
+Marks the end of a $IF.  One is required for every $IF.
+.le
+.ls 10 $for (types)
+For each of the listed types, output a translated copy of the code between
+the $FOR and the matching $ENDFOR.  Nesting is permitted.
+
+.nf
+Example:
+	$for (silrd)
+	(any amount of generic code)
+	$endfor
+.fi
+.le
+.ls 10 $endfor
+Marks the end of a $FOR statement.
+.le
+.ls 10 $$
+Replaced by a single $.
+.le
+.ls 10 /*...*/
+C comments are not preprocessed.
+.le
+.ls 10 "..."
+Quoted strings are not preprocessed.
+.le
+.ls 10 #...(EOL)
+SPP comments are not preprocessed.
+.le
+.ls 10 %...(EOL)
+SPP Fortran escapes are not preprocessed.
+.le
+.ih
+EXAMPLES
+1. Translate the generic source "aadd.gx" to produce the six output files
+"aadds.x", "aaddi.x", etc., in the subdirectory "ak", clobbering any
+existing files therein.  The \fIgeneric\fR task is a bootstrap utility
+written in C and is implemented as a CL foreign task, hence the UNIX
+command syntax.
+
+	cl> generic -k -p ak/ -t silrdx aadd.gx
+
+2. Perform an inline transformation ($FOR directive) of the source file
+"imsum.gx", producing the single file "imsum.x" as output.
+
+	cl> generic -k -o imsum.x imsum.gx
+    
+3. The following is a simple example of a typical generic source file.
+For additional examples, see the ".gx" sources in the VOPS, IMIO, IMAGES
+and other directories.
+
+.nf
+# ALIM -- Compute the limits (minimum and maximum values) of a vector.
+# (this is a copy of the file vops$alim.gx).
+
+procedure alim$t (a, npix, minval, maxval)
+
+PIXEL	a[ARB], minval, maxval, value
+int	npix, i
+
+begin
+	minval = a[1]
+	maxval = a[1]
+
+	do i = 1, npix {
+	    value = a[i]
+	    $if (datatype == x)
+		if (abs(value) < abs(minval))
+		    minval = value
+		else if (abs(value) > abs(maxval))
+		    maxval = value
+	    $else
+		if (value < minval)
+		    minval = value
+		else if (value > maxval)
+		    maxval = value
+	    $endif
+	}
+end
+.fi
+.ih
+SEE ALSO
+xc, xyacc
diff --git a/unix/boot/generic/lex.sed b/unix/boot/generic/lex.sed
new file mode 100644
index 00000000..56df4751
--- /dev/null
+++ b/unix/boot/generic/lex.sed
@@ -0,0 +1,7 @@
+/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/getc/k_getc/
diff --git a/unix/boot/generic/lexyy.c b/unix/boot/generic/lexyy.c
new file mode 100644
index 00000000..6cda8553
--- /dev/null
+++ b/unix/boot/generic/lexyy.c
@@ -0,0 +1,679 @@
+# include <stdio.h>
+# define U(x) x
+# define NLSTATE yyprevious=YYNEWLINE
+# define BEGIN yybgin = yysvec + 1 +
+# define INITIAL 0
+# define YYLERR yysvec
+# define YYSTATE (yyestate-yysvec-1)
+# define YYOPTIM 1
+# define YYLMAX BUFSIZ
+# define output(c) putc(c,yyout)
+# define input() (((yytchar=yysptr>yysbuf?U(*--yysptr):k_getc(yyin))==10?(yylineno++,yytchar):yytchar)==EOF?0:yytchar)
+# define unput(c) {yytchar= (c);if(yytchar=='\n')yylineno--;*yysptr++=yytchar;}
+# define yymore() (yymorfg=1)
+# define ECHO fprintf(yyout, "%s",yytext)
+# define REJECT { nstr = yyreject(); goto yyfussy;}
+int yyleng; extern char yytext[];
+int yymorfg;
+extern char *yysptr, yysbuf[];
+int yytchar;
+FILE *yyin, *yyout;
+extern int yylineno;
+struct yysvf { 
+	struct yywork *yystoff;
+	struct yysvf *yyother;
+	int *yystops;};
+struct yysvf *yyestate;
+extern struct yysvf yysvec[], *yybgin;
+
+#include <ctype.h>
+
+/*
+ * GENERIC -- This filter takes a file containing a generic operator as input
+ * and generates as output either a set of files, one for each of the data
+ * types in the generic family, or a single file wherein the generic section
+ * has been duplicated for each case.
+ */
+
+#undef	output
+extern	char	*type_string;
+extern	char	xtype_string[];
+extern	char	type_char;
+
+# define YYNEWLINE 10
+yylex(){
+int nstr; extern int yyprevious;
+if (yyin==NULL) yyin = stdin;
+if (yyout==NULL) yyout = stdout;
+while((nstr = yylook()) >= 0)
+yyfussy: switch(nstr){
+case 0:
+if(yywrap()) return(0); break;
+case 1:
+			outstr (type_string);
+break;
+case 2:
+			outstr (xtype_string);
+break;
+case 3:
+			output_indef (type_char);
+break;
+case 4:
+	ECHO;
+break;
+case 5:
+		output_upper ("SZ_");
+break;
+case 6:
+		output_upper ("TY_");
+break;
+case 7:
+			outstr ("PIXEL");
+break;
+case 8:
+			outstr ("INDEF");
+break;
+case 9:
+	{
+					yytext[strlen(yytext)-5] = '\0';
+					output_upper (yytext);
+				}
+break;
+case 10:
+			{	if (isupper (type_char))
+					    output (tolower (type_char));
+					else
+					    output (type_char);
+				}
+break;
+case 11:
+			{	if (islower (type_char))
+					    output (toupper (type_char));
+					else
+					    output (type_char);
+				}
+break;
+case 12:
+			pass_through();
+break;
+case 13:
+	make_float (type_char);
+break;
+case 14:
+		do_if();
+break;
+case 15:
+		do_else();
+break;
+case 16:
+		do_endif();
+break;
+case 17:
+		do_for();
+break;
+case 18:
+		do_endfor();
+break;
+case 19:
+		do_if();
+break;
+case 20:
+		do_else();
+break;
+case 21:
+		do_endif();
+break;
+case 22:
+		do_for();
+break;
+case 23:
+		do_endfor();
+break;
+case 24:
+			output ('$');
+break;
+case 25:
+			copy_comment();
+break;
+case 26:
+			copy_string();
+break;
+case 27:
+			ECHO;
+break;
+case 28:
+			ECHO;
+break;
+case 29:
+		ECHO;
+break;
+case 30:
+		ECHO;
+break;
+case 31:
+			copy_line();
+break;
+case 32:
+			copy_line();
+break;
+case -1:
+break;
+default:
+fprintf(yyout,"bad switch yylook %d",nstr);
+} return(0); }
+/* end of yylex */
+
+
+/* LEX_INPUT -- Make input() callable as a function from the .c code.
+ */
+lex_input()
+{
+	return (input());
+}
+
+
+/* LEX_UNPUT -- Make unput() callable as a function from the .c code.
+ */
+lex_unput (ch)
+int	ch;
+{
+	unput (ch);
+}
+int yyvstop[] = {
+0,
+
+26,
+0,
+
+31,
+0,
+
+31,
+0,
+
+32,
+0,
+
+24,
+0,
+
+12,
+0,
+
+11,
+0,
+
+10,
+0,
+
+25,
+0,
+
+19,
+0,
+
+14,
+0,
+
+13,
+0,
+
+27,
+0,
+
+22,
+0,
+
+17,
+0,
+
+20,
+0,
+
+15,
+0,
+
+3,
+0,
+
+1,
+0,
+
+28,
+0,
+
+21,
+0,
+
+8,
+0,
+
+7,
+0,
+
+16,
+0,
+
+9,
+0,
+
+4,
+0,
+
+2,
+9,
+0,
+
+29,
+0,
+
+23,
+0,
+
+18,
+0,
+
+5,
+9,
+0,
+
+6,
+9,
+0,
+
+30,
+0,
+0};
+# define YYTYPE char
+struct yywork { YYTYPE verify, advance; } yycrank[] = {
+0,0,	0,0,	0,0,	0,0,	
+0,0,	0,0,	0,0,	0,0,	
+0,0,	0,0,	1,3,	0,0,	
+0,0,	0,0,	0,0,	0,0,	
+3,3,	0,0,	0,0,	0,0,	
+0,0,	0,0,	0,0,	0,0,	
+0,0,	0,0,	0,0,	0,0,	
+0,0,	0,0,	0,0,	0,0,	
+0,0,	1,3,	0,0,	1,4,	
+1,5,	1,6,	2,15,	3,3,	
+2,16,	0,0,	0,0,	3,17,	
+7,29,	0,0,	0,0,	0,0,	
+1,7,	1,8,	1,8,	1,8,	
+1,8,	1,8,	1,8,	1,8,	
+1,8,	1,8,	1,8,	0,0,	
+0,0,	0,0,	0,0,	0,0,	
+0,0,	0,0,	1,9,	1,9,	
+1,9,	1,9,	1,9,	1,9,	
+1,9,	1,9,	1,10,	1,9,	
+1,9,	1,9,	1,9,	1,9,	
+1,9,	1,11,	1,9,	1,9,	
+1,12,	1,13,	1,9,	1,9,	
+1,9,	1,14,	1,9,	1,9,	
+6,18,	8,30,	10,32,	11,33,	
+12,34,	13,35,	14,36,	20,40,	
+21,42,	20,41,	23,45,	6,19,	
+27,49,	8,8,	8,8,	8,8,	
+8,8,	8,8,	8,8,	8,8,	
+8,8,	8,8,	8,8,	15,37,	
+17,20,	17,21,	26,48,	15,38,	
+17,39,	25,46,	22,43,	25,47,	
+30,50,	6,20,	6,21,	31,51,	
+32,52,	6,22,	22,44,	33,53,	
+34,54,	35,55,	36,56,	37,57,	
+6,23,	37,58,	38,59,	39,43,	
+6,24,	40,61,	41,62,	42,63,	
+44,64,	45,65,	38,60,	46,66,	
+17,25,	17,26,	47,67,	48,68,	
+17,27,	51,69,	52,70,	53,71,	
+30,50,	6,25,	6,26,	54,72,	
+55,73,	6,27,	56,74,	57,75,	
+58,76,	60,77,	61,78,	62,79,	
+64,81,	65,82,	62,80,	66,83,	
+6,28,	9,9,	9,9,	9,9,	
+9,9,	9,9,	9,9,	9,9,	
+9,9,	9,9,	9,9,	9,9,	
+9,9,	9,9,	9,9,	9,9,	
+9,31,	9,9,	9,9,	9,9,	
+9,9,	9,9,	9,9,	9,9,	
+9,9,	9,9,	9,9,	67,84,	
+69,86,	70,87,	67,85,	9,9,	
+71,88,	72,89,	73,90,	74,91,	
+75,92,	76,93,	77,94,	79,95,	
+80,96,	81,97,	82,98,	84,99,	
+85,100,	86,101,	87,102,	89,103,	
+90,104,	91,105,	93,106,	87,102,	
+94,107,	95,108,	87,102,	99,109,	
+103,110,	104,111,	107,112,	110,113,	
+87,102,	87,102,	111,114,	112,115,	
+0,0,	0,0,	87,102,	0,0,	
+0,0};
+struct yysvf yysvec[] = {
+0,	0,	0,
+yycrank+1,	0,		0,	
+yycrank+3,	yysvec+1,	0,	
+yycrank+7,	0,		0,	
+yycrank+0,	0,		yyvstop+1,
+yycrank+0,	0,		yyvstop+3,
+yycrank+56,	0,		0,	
+yycrank+2,	0,		0,	
+yycrank+57,	0,		0,	
+yycrank+108,	0,		0,	
+yycrank+16,	yysvec+9,	0,	
+yycrank+22,	yysvec+9,	0,	
+yycrank+6,	yysvec+9,	0,	
+yycrank+8,	yysvec+9,	0,	
+yycrank+18,	yysvec+9,	0,	
+yycrank+14,	0,		yyvstop+5,
+yycrank+0,	0,		yyvstop+7,
+yycrank+47,	0,		0,	
+yycrank+0,	0,		yyvstop+9,
+yycrank+0,	0,		yyvstop+11,
+yycrank+23,	0,		0,	
+yycrank+21,	0,		0,	
+yycrank+52,	0,		0,	
+yycrank+29,	0,		0,	
+yycrank+0,	0,		yyvstop+13,
+yycrank+13,	0,		0,	
+yycrank+7,	0,		0,	
+yycrank+2,	0,		0,	
+yycrank+0,	0,		yyvstop+15,
+yycrank+0,	0,		yyvstop+17,
+yycrank+54,	0,		0,	
+yycrank+54,	yysvec+9,	0,	
+yycrank+60,	yysvec+9,	0,	
+yycrank+43,	yysvec+9,	0,	
+yycrank+37,	yysvec+9,	0,	
+yycrank+38,	yysvec+9,	0,	
+yycrank+61,	yysvec+9,	0,	
+yycrank+27,	0,		0,	
+yycrank+36,	0,		0,	
+yycrank+69,	0,		0,	
+yycrank+58,	0,		0,	
+yycrank+74,	0,		0,	
+yycrank+61,	0,		0,	
+yycrank+0,	0,		yyvstop+19,
+yycrank+76,	0,		0,	
+yycrank+57,	0,		0,	
+yycrank+32,	0,		0,	
+yycrank+50,	0,		0,	
+yycrank+37,	0,		0,	
+yycrank+0,	0,		yyvstop+21,
+yycrank+0,	0,		yyvstop+23,
+yycrank+65,	yysvec+9,	0,	
+yycrank+85,	yysvec+9,	0,	
+yycrank+86,	yysvec+9,	0,	
+yycrank+79,	yysvec+9,	0,	
+yycrank+80,	yysvec+9,	0,	
+yycrank+74,	yysvec+9,	0,	
+yycrank+48,	0,		0,	
+yycrank+64,	0,		0,	
+yycrank+0,	0,		yyvstop+25,
+yycrank+66,	0,		0,	
+yycrank+97,	0,		0,	
+yycrank+97,	0,		0,	
+yycrank+0,	0,		yyvstop+27,
+yycrank+99,	0,		0,	
+yycrank+100,	0,		0,	
+yycrank+70,	0,		0,	
+yycrank+97,	0,		0,	
+yycrank+0,	0,		yyvstop+29,
+yycrank+131,	yysvec+9,	0,	
+yycrank+131,	yysvec+9,	0,	
+yycrank+128,	yysvec+9,	0,	
+yycrank+132,	yysvec+9,	0,	
+yycrank+133,	yysvec+9,	0,	
+yycrank+138,	yysvec+9,	0,	
+yycrank+107,	0,		0,	
+yycrank+104,	0,		0,	
+yycrank+102,	0,		0,	
+yycrank+0,	0,		yyvstop+31,
+yycrank+132,	0,		0,	
+yycrank+142,	0,		0,	
+yycrank+143,	0,		0,	
+yycrank+138,	0,		0,	
+yycrank+0,	0,		yyvstop+33,
+yycrank+104,	0,		0,	
+yycrank+114,	0,		0,	
+yycrank+141,	yysvec+9,	0,	
+yycrank+150,	yysvec+9,	yyvstop+35,
+yycrank+0,	yysvec+9,	yyvstop+37,
+yycrank+131,	yysvec+9,	0,	
+yycrank+132,	yysvec+9,	0,	
+yycrank+145,	yysvec+9,	0,	
+yycrank+0,	0,		yyvstop+39,
+yycrank+120,	0,		0,	
+yycrank+107,	0,		0,	
+yycrank+143,	0,		0,	
+yycrank+0,	0,		yyvstop+41,
+yycrank+0,	0,		yyvstop+43,
+yycrank+0,	0,		yyvstop+45,
+yycrank+113,	0,		0,	
+yycrank+0,	0,		yyvstop+47,
+yycrank+0,	yysvec+9,	yyvstop+49,
+yycrank+0,	yysvec+9,	yyvstop+51,
+yycrank+159,	yysvec+9,	0,	
+yycrank+160,	yysvec+9,	0,	
+yycrank+0,	yysvec+9,	yyvstop+53,
+yycrank+0,	0,		yyvstop+56,
+yycrank+130,	0,		0,	
+yycrank+0,	0,		yyvstop+58,
+yycrank+0,	0,		yyvstop+60,
+yycrank+155,	yysvec+9,	0,	
+yycrank+158,	yysvec+9,	0,	
+yycrank+134,	0,		0,	
+yycrank+0,	yysvec+9,	yyvstop+62,
+yycrank+0,	yysvec+9,	yyvstop+65,
+yycrank+0,	0,		yyvstop+68,
+0,	0,	0};
+struct yywork *yytop = yycrank+238;
+struct yysvf *yybgin = yysvec+1;
+char yymatch[] = {
+00  ,01  ,01  ,01  ,01  ,01  ,01  ,01  ,
+01  ,011 ,01  ,01  ,01  ,01  ,01  ,01  ,
+01  ,01  ,01  ,01  ,01  ,01  ,01  ,01  ,
+01  ,01  ,01  ,01  ,01  ,01  ,01  ,01  ,
+011 ,01  ,01  ,01  ,01  ,01  ,01  ,01  ,
+01  ,01  ,01  ,01  ,01  ,01  ,01  ,01  ,
+'0' ,'0' ,'0' ,'0' ,'0' ,'0' ,'0' ,'0' ,
+'0' ,'0' ,01  ,01  ,01  ,01  ,01  ,01  ,
+01  ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,
+'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,
+'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,
+'A' ,'A' ,'A' ,01  ,01  ,01  ,01  ,'_' ,
+01  ,01  ,01  ,01  ,01  ,01  ,01  ,01  ,
+01  ,01  ,01  ,01  ,01  ,01  ,01  ,01  ,
+01  ,01  ,01  ,01  ,01  ,01  ,01  ,01  ,
+01  ,01  ,01  ,01  ,01  ,01  ,01  ,01  ,
+0};
+char yyextra[] = {
+0,0,0,0,0,0,0,0,
+0,0,0,0,0,0,0,0,
+0,0,0,0,0,0,0,0,
+0,0,0,0,0,0,0,0,
+0,0,0,0,0,0,0,0,
+0};
+#ifndef lint
+static	char ncform_sccsid[] = "@(#)ncform 1.6 88/02/08 SMI"; /* from S5R2 1.2 */
+#endif
+
+int yylineno =1;
+# define YYU(x) x
+# define NLSTATE yyprevious=YYNEWLINE
+char yytext[YYLMAX];
+struct yysvf *yylstate [YYLMAX], **yylsp, **yyolsp;
+char yysbuf[YYLMAX];
+char *yysptr = yysbuf;
+int *yyfnd;
+extern struct yysvf *yyestate;
+int yyprevious = YYNEWLINE;
+yylook(){
+	register struct yysvf *yystate, **lsp;
+	register struct yywork *yyt;
+	struct yysvf *yyz;
+	int yych, yyfirst;
+	struct yywork *yyr;
+# ifdef LEXDEBUG
+	int debug;
+# endif
+	char *yylastch;
+	/* start off machines */
+# ifdef LEXDEBUG
+	debug = 0;
+# endif
+	yyfirst=1;
+	if (!yymorfg)
+		yylastch = yytext;
+	else {
+		yymorfg=0;
+		yylastch = yytext+yyleng;
+		}
+	for(;;){
+		lsp = yylstate;
+		yyestate = yystate = yybgin;
+		if (yyprevious==YYNEWLINE) yystate++;
+		for (;;){
+# ifdef LEXDEBUG
+			if(debug)fprintf(yyout,"state %d\n",yystate-yysvec-1);
+# endif
+			yyt = yystate->yystoff;
+			if(yyt == yycrank && !yyfirst){  /* may not be any transitions */
+				yyz = yystate->yyother;
+				if(yyz == 0)break;
+				if(yyz->yystoff == yycrank)break;
+				}
+			*yylastch++ = yych = input();
+			yyfirst=0;
+		tryagain:
+# ifdef LEXDEBUG
+			if(debug){
+				fprintf(yyout,"char ");
+				allprint(yych);
+				putchar('\n');
+				}
+# endif
+			yyr = yyt;
+			if ( (int)yyt > (int)yycrank){
+				yyt = yyr + yych;
+				if (yyt <= yytop && yyt->verify+yysvec == yystate){
+					if(yyt->advance+yysvec == YYLERR)	/* error transitions */
+						{unput(*--yylastch);break;}
+					*lsp++ = yystate = yyt->advance+yysvec;
+					goto contin;
+					}
+				}
+# ifdef YYOPTIM
+			else if((int)yyt < (int)yycrank) {		/* r < yycrank */
+				yyt = yyr = yycrank+(yycrank-yyt);
+# ifdef LEXDEBUG
+				if(debug)fprintf(yyout,"compressed state\n");
+# endif
+				yyt = yyt + yych;
+				if(yyt <= yytop && yyt->verify+yysvec == yystate){
+					if(yyt->advance+yysvec == YYLERR)	/* error transitions */
+						{unput(*--yylastch);break;}
+					*lsp++ = yystate = yyt->advance+yysvec;
+					goto contin;
+					}
+				yyt = yyr + YYU(yymatch[yych]);
+# ifdef LEXDEBUG
+				if(debug){
+					fprintf(yyout,"try fall back character ");
+					allprint(YYU(yymatch[yych]));
+					putchar('\n');
+					}
+# endif
+				if(yyt <= yytop && yyt->verify+yysvec == yystate){
+					if(yyt->advance+yysvec == YYLERR)	/* error transition */
+						{unput(*--yylastch);break;}
+					*lsp++ = yystate = yyt->advance+yysvec;
+					goto contin;
+					}
+				}
+			if ((yystate = yystate->yyother) && (yyt= yystate->yystoff) != yycrank){
+# ifdef LEXDEBUG
+				if(debug)fprintf(yyout,"fall back to state %d\n",yystate-yysvec-1);
+# endif
+				goto tryagain;
+				}
+# endif
+			else
+				{unput(*--yylastch);break;}
+		contin:
+# ifdef LEXDEBUG
+			if(debug){
+				fprintf(yyout,"state %d char ",yystate-yysvec-1);
+				allprint(yych);
+				putchar('\n');
+				}
+# endif
+			;
+			}
+# ifdef LEXDEBUG
+		if(debug){
+			fprintf(yyout,"stopped at %d with ",*(lsp-1)-yysvec-1);
+			allprint(yych);
+			putchar('\n');
+			}
+# endif
+		while (lsp-- > yylstate){
+			*yylastch-- = 0;
+			if (*lsp != 0 && (yyfnd= (*lsp)->yystops) && *yyfnd > 0){
+				yyolsp = lsp;
+				if(yyextra[*yyfnd]){		/* must backup */
+					while(yyback((*lsp)->yystops,-*yyfnd) != 1 && lsp > yylstate){
+						lsp--;
+						unput(*yylastch--);
+						}
+					}
+				yyprevious = YYU(*yylastch);
+				yylsp = lsp;
+				yyleng = yylastch-yytext+1;
+				yytext[yyleng] = 0;
+# ifdef LEXDEBUG
+				if(debug){
+					fprintf(yyout,"\nmatch ");
+					sprint(yytext);
+					fprintf(yyout," action %d\n",*yyfnd);
+					}
+# endif
+				return(*yyfnd++);
+				}
+			unput(*yylastch);
+			}
+		if (yytext[0] == 0  /* && feof(yyin) */)
+			{
+			yysptr=yysbuf;
+			return(0);
+			}
+		yyprevious = yytext[0] = input();
+		if (yyprevious>0)
+			output(yyprevious);
+		yylastch=yytext;
+# ifdef LEXDEBUG
+		if(debug)putchar('\n');
+# endif
+		}
+	}
+yyback(p, m)
+	int *p;
+{
+if (p==0) return(0);
+while (*p)
+	{
+	if (*p++ == m)
+		return(1);
+	}
+return(0);
+}
+	/* the following are only used in the lex library */
+yyinput(){
+	return(input());
+	}
+yyoutput(c)
+  int c; {
+	output(c);
+	}
+yyunput(c)
+   int c; {
+	unput(c);
+	}
diff --git a/unix/boot/generic/mkpkg.sh b/unix/boot/generic/mkpkg.sh
new file mode 100644
index 00000000..5ab35c4d
--- /dev/null
+++ b/unix/boot/generic/mkpkg.sh
@@ -0,0 +1,18 @@
+# Bootstrap the generic preprocessor.  The -lln library is not used to avoid
+# the enternal dependency.  The sed script is used to edit certain nonportable
+# constructs in the LEX code, and the filename lex.yy.c is changed to lexyy.c
+# for portability reasons.
+
+find tok.l -newer lexyy.c -exec rm lexyy.c \;
+if test -f lexyy.c; then\
+    $CC -c $HSI_CF -w lexyy.c;\
+else\
+    lex	tok.l;\
+    sed -f lex.sed lex.yy.c > lexyy.c;  rm lex.yy.c;\
+    $CC -c $HSI_CF -w lexyy.c;\
+fi
+
+$CC -c $HSI_CF	generic.c chario.c yywrap.c
+$CC $HSI_LF	generic.o lexyy.o chario.o yywrap.o $HSI_LIBS -o generic.e
+mv -f		generic.e ../../hlib
+rm		*.o
diff --git a/unix/boot/generic/tok.l b/unix/boot/generic/tok.l
new file mode 100644
index 00000000..f72c1bb8
--- /dev/null
+++ b/unix/boot/generic/tok.l
@@ -0,0 +1,91 @@
+%{
+
+#include <ctype.h>
+
+/*
+ * GENERIC -- This filter takes a file containing a generic operator as input
+ * and generates as output either a set of files, one for each of the data
+ * types in the generic family, or a single file wherein the generic section
+ * has been duplicated for each case.
+ */
+
+#undef	output
+extern	char	*type_string;
+extern	char	xtype_string[];
+extern	char	type_char;
+
+%}
+
+W	[ \t]
+
+%%
+
+PIXEL				outstr (type_string);
+XPIXEL				outstr (xtype_string);
+INDEF				output_indef (type_char);
+INDEF(S|I|L|R|D|X)		ECHO;
+SZ_PIXEL			output_upper ("SZ_");
+TY_PIXEL			output_upper ("TY_");
+$PIXEL				outstr ("PIXEL");
+$INDEF				outstr ("INDEF");
+
+[A-Z][A-Z_]*PIXEL		{
+					yytext[strlen(yytext)-5] = '\0';
+					output_upper (yytext);
+				}
+
+"$t"				{	if (isupper (type_char))
+					    output (tolower (type_char));
+					else
+					    output (type_char);
+				}
+"$T"				{	if (islower (type_char))
+					    output (toupper (type_char));
+					else
+					    output (type_char);
+				}
+
+"$/"				pass_through();
+[0-9]+("$f"|"$F")		make_float (type_char);
+
+{W}*"$if"			do_if();
+{W}*"$else"			do_else();
+{W}*"$endif"			do_endif(); 
+{W}*"$for"			do_for(); 
+{W}*"$endfor"			do_endfor(); 
+{W}*"$IF"			do_if();
+{W}*"$ELSE"			do_else();
+{W}*"$ENDIF"			do_endif(); 
+{W}*"$FOR"			do_for(); 
+{W}*"$ENDFOR"			do_endfor(); 
+
+"$$"				output ('$');
+"/*"				copy_comment();
+\"				copy_string();
+
+^\#if				ECHO;
+^\#else				ECHO;
+^\#endif			ECHO;
+^\#include			ECHO;
+
+\#				copy_line();
+^\%				copy_line();
+
+%%
+
+
+/* LEX_INPUT -- Make input() callable as a function from the .c code.
+ */
+lex_input()
+{
+	return (input());
+}
+
+
+/* LEX_UNPUT -- Make unput() callable as a function from the .c code.
+ */
+lex_unput (ch)
+int	ch;
+{
+	unput (ch);
+}
diff --git a/unix/boot/generic/yywrap.c b/unix/boot/generic/yywrap.c
new file mode 100644
index 00000000..627dff08
--- /dev/null
+++ b/unix/boot/generic/yywrap.c
@@ -0,0 +1,10 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+/* YYWRAP -- Called by lex when end of file is seen.
+ */
+int
+yywrap()
+{
+    return (1);
+}
diff --git a/unix/boot/generic/z b/unix/boot/generic/z
new file mode 100644
index 00000000..91a515fe
--- /dev/null
+++ b/unix/boot/generic/z
@@ -0,0 +1,20 @@
+# Bootstrap the generic preprocessor.  The -lln library is not used to avoid
+# the enternal dependency.  The sed script is used to edit certain nonportable
+# constructs in the LEX code, and the filename lex.yy.c is changed to lexyy.c
+# for portability reasons.
+
+find tok.l -newer lexyy.c -exec rm lexyy.c \;
+if test -f lexyy.c; then\
+    $CC -c $HSI_CF -w lexyy.c;\
+else\
+    lex	tok.l;\
+    sed -f lex.sed lex.yy.c > lexyy.c;  rm lex.yy.c;\
+    $CC -c $HSI_CF -w lexyy.c;\
+fi
+
+$CC -c -g $HSI_CF	generic.c chario.c yywrap.c
+$CC $HSI_LF	generic.o lexyy.o chario.o yywrap.o $HSI_LIBS -o generic.e
+
+
+echo "Running .... "
+./generic.e -k -t csilrdx /tmp/acht.gx
diff --git a/unix/boot/mkpkg.sh b/unix/boot/mkpkg.sh
new file mode 100644
index 00000000..1ad069c1
--- /dev/null
+++ b/unix/boot/mkpkg.sh
@@ -0,0 +1,21 @@
+# Bootstrap the bootstrap utilities.  The logical directory hlib$ should be
+# defined for the cshell when this is run.
+
+echo "----------------------- BOOTLIB ------------------------"
+(cd bootlib; sh -x mkpkg.sh)
+echo "----------------------- GENERIC ------------------------"
+(cd generic; sh -x mkpkg.sh)
+echo "----------------------- MKPKG --------------------------"
+(cd mkpkg;   sh -x mkpkg.sh)
+echo "----------------------- RMBIN  -------------------------"
+(cd rmbin;   sh -x mkpkg.sh)
+echo "----------------------- RMFILES  -----------------------"
+(cd rmfiles; sh -x mkpkg.sh)
+echo "----------------------- RTAR  --------------------------"
+(cd rtar;    sh -x mkpkg.sh)
+echo "----------------------- WTAR --------------------------"
+(cd wtar;    sh -x mkpkg.sh)
+echo "----------------------- SPP ----------------------------"
+(cd spp;     sh -x mkpkg.sh)
+echo "----------------------- XYACC --------------------------"
+(cd xyacc;   sh -x mkpkg.sh)
diff --git a/unix/boot/mkpkg/README b/unix/boot/mkpkg/README
new file mode 100644
index 00000000..999d154c
--- /dev/null
+++ b/unix/boot/mkpkg/README
@@ -0,0 +1,54 @@
+MKPKG -- Package maintenance utility.
+
+    The MKPKG utility is used to maintain the IRAF system libraries as well
+as the system executables and the applications packages.  The file "mkpkg.csh"
+in this directory will make and install the initial mkpkg.e executable.
+The libraries lib$libboot.a and lib$libos.a must have been made first.
+Once MKPKG is up it can be used to remake itself.
+
+
+NOTES
+
+    The MKPKG utility is used to keep libraries and/or packages up to date.
+The dates of the library modules are compared to the corresponding SOURCE
+(not object) files in the directories contributing to the library.
+Any source files newer than their corresponding library modules are
+compiled and the library is updated.  Note that the sources contributing
+to the library may reside in multiple subdirectories as well as in the
+current directory.  Each source file may depend on zero or more other files.
+If any of these files are newer than the source file, the source file is
+recompiled and replaced in the library.
+
+MKPKG is built upon a preprocessor front end providing macro replacement
+and conditional interpretation facilities.  These facilities, in combination
+with the OS escape mechanism used to send commands to the host system,
+make it possible to use MKPKG for more than just updating libraries.
+
+As far as possible, the system dependent functions required by MKPKG have
+been isolated and placed in separate small files.  The bulk of the code is
+machine independent.  Additional system dependent functions are provided
+by the BOOTLIB library (LIBBOOT) and by the IRAF kernel (LIBOS).  The MKPKG
+specific functions required are the following:
+ 
+	[1] Given the NAME of a source file, return the date of the
+	    corresponding object module in a library.
+	[2] Replace (or add) a series of object modules in a library,
+	    creating the library if it does not already exist.
+	[3] "Rebuild" the library after all updates are complete.
+
+The library functions are normally implemented by formatting a command
+for the host librarian utility and sending it to the host with the ZOSCMD
+utility.  Note that an entire command script can be built in a temporary
+file if the ZOSCMD interface is too inefficient for multiple small calls
+on your system.
+
+All filenames in the portable code (and in the Makelib files) are in the
+IRAF format, which is very similar to UNIX format.  Do not change the high
+level code to manipulate host system filenames directly.  All filename
+mapping should be performed in the host interface code; the VFN2OSFN
+function is convenient to use for this purpose.
+
+For simplicity, most buffers are fixed in size.  Dynamically allocating
+everything is less efficient and is not warranted since the memory
+requirements of this program are modest.  If a buffer overflows simply
+increase the allocation below and remake mkpkg.
diff --git a/unix/boot/mkpkg/char.c b/unix/boot/mkpkg/char.c
new file mode 100644
index 00000000..9532dfd6
--- /dev/null
+++ b/unix/boot/mkpkg/char.c
@@ -0,0 +1,478 @@
+/* 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>
+
+#define	import_spp
+#define	import_error
+#include <iraf.h>
+
+#include "mkpkg.h"
+#include "extern.h"
+
+/*
+ * CHAR.C -- Character functions, character i/o.
+ */
+
+/* M_GETC -- Get a (possibly pushed back) character from the mkpkgfile
+ * associated with the given context.  If the sequence $( is encountered
+ * in the input, fetch the value of the named macro and push it back into
+ * the input stream and continue scanning.  Implementing recursive macro
+ * expansion at this low level permits the use of macros in any part of
+ * the input except comments.
+ */
+int
+m_getc (register struct context *cx)
+{
+	register int	ch, nch;
+	register char	*op;
+	char	name[SZ_FNAME+1], *val;
+	char	lbuf[SZ_CMD+1];
+
+	while ((ch = m_rawgetc (cx)) == '$') {
+	    /* Check for the escape sequence "$$" and return the literal $
+	     * if this is seen.  Also return if $ is seen but the next char
+	     * is not left paren ("$(..)" is a macro reference).
+	     */
+	    nch = m_rawgetc (cx);
+	    if (nch == '$')
+		return (nch);
+	    else if (nch != '(') {
+		m_ungetc (nch, cx);
+		break;
+	    }
+
+	    /* Extract the name of the macro from the input stream.
+	     */
+	    for (op=name;  (*op = m_rawgetc(cx)) != ')';  op++)
+		if (*op == '\n' || *op == EOF) {
+		    *op = EOS;
+		    warns ("missing right paren in $(M) macro reference: `%s'",
+			name);
+		    *op++ = '\n';
+		    *op = EOS;
+		    val = name;
+		    goto push;
+		    break;
+		}
+	    *op = EOS;
+
+	    /* If the symbol name is prefixed by a question mark, e.g., $(?sym),
+	     * query for the symbol and read the value from the standard input.
+	     * If the syntax is "$(@file)" return the contents of the named
+	     * file as the value of the macro reference.  Otherwise look in
+	     * the symbol table and then in the environment for the named
+	     * symbol.  If the symbol cannot be found in either place push
+	     * its name and hope for the best.
+	     */
+	    if (name[0] == '?') {
+		/* Interactive query. */
+		if ((cx->fp == stdin)) {
+		    warns ("`$(%s)': cannot query in -f stdin mode", name);
+		    val = &name[1];
+		} else {
+		    printf ("%s: ", &name[1]);
+		    fflush (stdout);
+		    if (fgets (lbuf, SZ_CMD, stdin) == NULL)
+			strcpy (lbuf, name);
+		    if ((val = index (lbuf, '\n')))
+			*val = EOS;
+		    val = lbuf;
+		}
+	    } else if (name[0] == '@') {
+		/* Return contents of a file. */
+		FILE    *fp;
+		int     ch, n;
+
+		if ((fp = fopen (&name[1], "r")) == NULL) {
+		    warns ("`$(%s)': cannot open file", name);
+		    val = &name[1];
+		} else {
+		    for (n=SZ_CMD,op=lbuf; --n >= 0 && (ch=getc(fp)) != EOF; )
+			*op++ = isspace(ch) ? ' ' : ch;
+		    while (op > lbuf) {
+			ch = *(op-1);
+			if (isspace (ch))
+			    --op;
+			else
+			    break;
+		    }
+		    *op = EOS;
+		    val = lbuf;
+		    fclose (fp);
+		}
+
+	    } else if ((val = getsym (name)) == NULL) {
+		if ((val = os_getenv (name)) == NULL) {
+		    warns ("macro `%s' not found", name);
+		    val = name;
+		}
+	    }
+push:
+	    if (debug > 1) {
+		printf ("pushback macro `%s' = `%s'\n", name, val);
+		fflush (stdout);
+	    }
+
+	    m_pushstr (cx, val);
+	}
+
+	/* Get rid of the tabs once and for all.
+	 */
+	return ((ch == '\t') ? ' ' : ch);
+}
+
+
+
+/* M_RAWGETC -- Get a (possibly pushed back) character from the mkpkgfile
+ * associated with the given context.
+ */
+int
+m_rawgetc (register struct context *cx)
+{
+	register struct	pushback *pb;
+	register int	ch;
+
+	for (;;) {
+	    /* Check for single character pushback first.  This type of pushback
+	     * occurs at the end of every token.
+	     */
+	    if ((ch = cx->pbchar)) {
+		if (debug > 3) {
+		    if (ch <= 040)
+			printf ("return pushback character 0%o\n", ch);
+		    else
+			printf ("return pushback character `%c'\n", ch);
+		    fflush (stdout);
+		}
+		cx->pbchar = 0;
+		break;
+	    }
+
+	    /* Check for string type pushback; return character directly from
+	     * file if no pushback.
+	     */
+	    if (!cx->pushback) {
+		ch = k_getc (cx);
+		break;
+	    }
+
+	    /* Get pushed back character from pushback buffer.
+	     */
+	    pb = cx->pb;
+	    if ((ch = *(pb->ip)++) != EOS) {
+		if (debug > 3) {
+		    if (ch <= 040)
+			printf ("return pbbuf character 0%o\n", ch);
+		    else
+			printf ("return pbbuf character `%c'\n", ch);
+		    fflush (stdout);
+		}
+		break;
+	    }
+
+	    /* End of pushed back string; pop pushback stack.
+	     */
+	    if (debug > 3) {
+		printf ("pop pushback stack at level=%d\n", pb->npb);
+		fflush (stdout);
+	    }
+
+	    pb->op = pb->pbstk[--(pb->npb)];
+	    pb->ip = pb->pbstk[--(pb->npb)];
+
+	    if (pb->npb <= 0)
+		cx->pushback = 0;
+	}
+
+	if (ch == '\n')
+	    cx->lineno++;
+
+	return (ch);
+}
+
+
+/* M_UNGETC -- Pushback a single character, last in first out.  Only a single
+ * character of this type of pushback is normally allowed, however by using
+ * PUSHSTR we can provide additional pushback at additional expense (no
+ * problem provided it is not used a lot).
+ */ 
+void
+m_ungetc (
+  int	ch,
+  struct context *cx
+)
+{
+	static	char ps[2] = "\0";
+
+	if (ch == '\n')
+	    --cx->lineno;
+	    
+	if ((ps[0] = cx->pbchar))
+	    m_pushstr (cx, ps);
+
+	cx->pbchar = ch;
+
+	if (debug > 3) {
+	    if (ch <= 040)
+		printf ("ungetc 0%o\n", ch);
+	    else
+		printf ("ungetc `%c'\n", ch);
+	    fflush (stdout);
+	}
+}
+
+
+/* M_PUSHSTR -- Pushback a string.  Pushed strings are read back LIFO, although
+ * of course the individual characters are returned FIFO.
+ */ 
+void
+m_pushstr (
+  struct context *cx,
+  char	*str
+)
+{
+	register struct	pushback *pb;
+	register char	*ip, *op, *otop, ch;
+
+	if (debug > 2) {
+	    if (str[0] <= 040)
+		printf ("pushback punct char 0x%lx\n", (long) str);
+	    else
+		printf ("pushback string `%s'\n", str);
+	    fflush (stdout);
+	}
+
+	cx->pushback++;
+	while ((pb = cx->pb) == NULL)
+	    mk_pbbuf (cx);
+
+	pb->pbstk[(pb->npb)++] = pb->ip;
+	pb->pbstk[(pb->npb)++] = pb->op;
+	otop = pb->otop;
+
+	for (ip=str, op=pb->op;  (*op++ = ch = *ip++);  ) {
+	    if (ch == '\n')
+		--cx->lineno;
+	    if (op >= otop)
+		break;
+	}
+
+	pb->ip = pb->op;
+	pb->op = op;
+
+	if (debug > 2) {
+	    printf ("pb status: ");
+	    printf ("level=%d(%d) nleft=%ld ip=%ld op=%ld bp=%ld otop=%ld\n",
+		pb->npb, SZ_PBSTK, 
+		(long) (otop-op), 
+		(long) pb->ip, 
+		(long) pb->op, 
+		(long) pb->pbbuf, 
+		(long) otop);
+	    fflush (stdout);
+	}
+
+	if (pb->npb + 2 >= SZ_PBSTK || pb->op >= pb->otop)
+	    fatals ("excessive pushback in `%s'; macro recursion?",
+		cx->mkpkgfile);
+}
+
+
+/* MK_PBBUF -- Allocate and initialize the pushback descriptor.
+ */
+void
+mk_pbbuf (register struct context *cx)
+{
+	register struct	pushback *pb;
+
+	pb = cx->pb = (struct pushback *) malloc (sizeof (struct pushback));
+	if (pb == NULL)
+	    fatals ("out of memory in `%s'", cx->mkpkgfile);
+
+	pb->npb  = 0;
+	pb->ip   = pb->pbbuf;
+	pb->op   = pb->pbbuf;
+	pb->otop = &pb->pbbuf[SZ_PBBUF];
+}
+
+
+/* PB_CANCEL -- Cancel any pushback.
+ */
+void
+pb_cancel (register struct context *cx)
+{
+	register struct	pushback *pb;
+
+	cx->pushback = 0;
+	cx->pbchar   = 0;
+
+	if ((pb = cx->pb) != NULL) {
+	    pb->npb  = 0;
+	    pb->ip   = pb->pbbuf;
+	    pb->op   = pb->pbbuf;
+	    pb->otop = &pb->pbbuf[SZ_PBBUF];
+	}
+}
+
+
+/* PUTSTR -- Add a string to end of the string buffer.  It is a fatal error
+ * if the string buffer overflows.
+ */
+char *
+putstr (char *s)
+{
+	register char *ip, *op, *otop;
+	char	*start;
+
+	start = cp;
+	otop  = ctop;
+
+	for (ip=s, op=cp;  (*op++ = *ip++);  )
+	    if (op >= otop)
+		fatals ("string buffer overflow at `%s'", s);
+
+	cp = op;
+
+	if (debug > 2) {
+	    printf ("putstr `%s': nleft=%ld\n", s, (long)(otop-op));
+	    fflush (stdout);
+	}
+
+	return (start);
+}
+
+
+/*
+ * OS Character I/O.  This set of routines are provided as a workaround in
+ * the event that the host system cannot execute FTELL/FSEEK reliably (VMS/C
+ * could not).  The idea here is to keep track of the character offset from
+ * the beginning of the file.  K_FTELL returns the character offset.  K_FSEEK
+ * rewinds the file and reads characters forward to the indicated offset.
+ * K_GETC keeps a count of the file position.  (the k_ stands for kludge).
+ */
+
+#ifdef vms
+
+int
+k_getc (register struct context *cx)
+{
+	register int	ch;
+
+	cx->fpos++;
+	if (debug > 3) {
+	    if ((ch = getc (cx->fp)) > 0)
+		printf ("%5d %03o %c\n", cx->fpos, ch, ch > 040 ? ch : 040);
+	    return (ch);
+	} else
+	    return (getc (cx->fp));
+}
+
+char *
+k_fgets (
+  char	*obuf,
+  int	maxch,
+  register struct context *cx
+)
+{
+	register int	ch, n;
+	register char	*op;
+
+	for (op=obuf, n=maxch;  --n >= 0;  )
+	    if ((ch = k_getc(cx)) < 0)
+		return (NULL);
+	    else {
+		*op++ = ch;
+		if (ch == '\n')
+		    break;
+	    }
+
+	return (obuf);
+}
+
+int
+k_fseek (
+  register struct context *cx,
+  long	offset,
+  int	type
+)
+{
+	register FILE	*fp = cx->fp;
+	register int	ch;
+
+	if (debug > 1)
+	    printf ("seek (%s, %ld, %d)\n", cx->mkpkgfile, offset, type);
+	    
+	if (type == 0) {
+	    fseek (fp, 0L, 0);
+	    cx->fpos = 0;
+
+	    while (cx->fpos < offset && (ch = getc(fp)) != EOF) {
+		if (debug > 1)
+		    fputc (ch, stdout);
+		cx->fpos++;
+	    }
+
+	    if (debug > 1)
+		printf ("[]\n");
+
+	    return (0);
+	}
+
+	if (fseek (fp, offset, type) == ERR)
+	    return (ERR);
+	else {
+	    cx->fpos = ftell (fp);
+	    return (0);
+	}
+}
+
+long
+k_ftell (register struct context *cx)
+{
+	if (debug > 1) {
+	    printf ("ftell returns %d\n", cx->fpos);
+	    fflush (stdout);
+	}
+	return (cx->fpos);
+}
+
+#else
+
+int
+k_getc (struct	context *cx)
+{
+	return (getc (cx->fp));
+}
+
+char *
+k_fgets (
+  char	*op,
+  int	maxch,
+  register struct context *cx
+)
+{
+	return (fgets (op, maxch, cx->fp));
+}
+
+int
+k_fseek (
+  struct context *cx,
+  long	offset,
+  int	type 
+)
+{
+	return (fseek (cx->fp, offset, type));
+}
+
+long
+k_ftell (struct context *cx)
+{
+	return (ftell (cx->fp));
+}
+
+#endif
diff --git a/unix/boot/mkpkg/extern.h b/unix/boot/mkpkg/extern.h
new file mode 100644
index 00000000..6ade9584
--- /dev/null
+++ b/unix/boot/mkpkg/extern.h
@@ -0,0 +1,18 @@
+/* EXTERN.H -- External static variables.
+ */
+extern	char	sbuf[];			/* string buffer		*/
+extern	struct	symbol symtab[];	/* symbol table (macros)	*/
+extern	struct	context *topcx;		/* currently active context	*/
+extern	char	*cp;			/* pointer into sbuf		*/
+extern	char	*ctop;			/* top of sbuf			*/
+extern	char	irafdir[];		/* iraf root directory		*/
+extern	int	nsymbols;		/* number of defined symbols	*/
+extern	int	ifstate[];		/* $IF stack			*/
+extern	int	iflev;			/* $IF stack pointer		*/
+extern	int	debug;			/* print debug messages		*/
+extern	int	dbgout;			/* compile for debugging	*/
+extern	int	verbose;		/* print informative messages	*/
+extern	int	ignore;			/* ignore warns			*/
+extern	int	execute;		/* think but don't act?		*/
+extern	int	exit_status;		/* exit status of last syscall	*/
+extern	int	forceupdate;		/* foribly update libmod dates	*/
diff --git a/unix/boot/mkpkg/fdcache.c b/unix/boot/mkpkg/fdcache.c
new file mode 100644
index 00000000..7dfca1a3
--- /dev/null
+++ b/unix/boot/mkpkg/fdcache.c
@@ -0,0 +1,190 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#include <stdio.h>
+#include <string.h>
+#include <stdlib.h>
+
+/*
+ * FDCACHE -- Maintain a cache of filenames and their associated modification
+ * dates.  This can greatly reduce the amount of time required to determine
+ * which, if any, of the modules in a library need updating because an include
+ * file they depend upon has been modified.
+ *
+ * External entry points:
+ *
+ *   l = m_fdate (fname)		# return file (modification) date
+ *	m_fdinit (debug)		# initialize cache
+ */
+
+#define	MAX_FILES	20		/* size of the cache		*/
+#define	SZ_NAME		32		/* size of filename slot	*/
+#define	EOS		'\0'
+
+struct _fdate {				/* cache list element structure	*/
+	struct	_fdate *uplnk;
+	struct	_fdate *dnlnk;
+	int	nrefs;			/* number of references		*/
+	int	chksum;			/* speeds searches		*/
+	long	fdate;			/* file modification date	*/
+	char	fname[SZ_NAME+1];	/* file name			*/
+};
+
+struct	_fdate fdcache[MAX_FILES];	/* the cache			*/
+struct	_fdate *fd_head;		/* doubly linked list		*/
+struct	_fdate *fd_tail;
+int	fd_hits, fd_misses;
+
+struct	_fdate *fd_unlink();
+struct	_fdate *fd_tohead();
+struct	_fdate *fd_totail();
+
+long  m_fdate (char *fname);
+void  m_fdinit (int debug);
+int   fd_chksum (char *s);
+
+extern  long         os_fdate (char *fname);
+
+
+/* M_FDATE -- Get file modification date.  This is functionally equivalent to
+ * os_fdate().
+ */
+long
+m_fdate (char *fname)
+{
+	register struct _fdate *fd;
+	register int	chksum;
+
+	/* Look in the cache first.
+	 */
+	chksum = fd_chksum (fname);
+	for (fd=fd_head;  fd != NULL;  fd=fd->dnlnk)
+	    if (fd->chksum == chksum && strcmp (fname, fd->fname) == 0) {
+		fd_tohead (fd_unlink (fd));
+		fd->nrefs++;
+		fd_hits++;
+		return (fd->fdate);
+	    }
+
+	/* Cache miss.  Don't put in cache it name is too long.
+	 */
+	fd_misses++;
+	if (strlen (fname) > SZ_NAME)
+	    return (os_fdate (fname));
+
+	/* Put fname in the cache.  Reuse slot at tail of list.
+	 */
+	fd = fd_tohead (fd_unlink (fd_tail));
+	strncpy (fd->fname, fname, SZ_NAME);
+	fd->chksum = fd_chksum (fname);
+	fd->fdate  = os_fdate (fname);
+	fd->nrefs  = 1;
+
+	return (fd->fdate);
+}
+
+
+/* M_FDINIT -- Initialize (clear) the fdate cache.
+ */
+void
+m_fdinit (int debug)
+{
+	register struct _fdate *fd;
+	register int	i;
+	int	total;
+
+	if (debug) {
+	    total = fd_hits + fd_misses;
+	    printf ("file date cache: %d hits, %d misses, %d%% of %d\n",
+		fd_hits, fd_misses, (total ? fd_hits * 100 / total : 0), total);
+
+	    for (fd=fd_head;  fd != NULL;  fd=fd->dnlnk)
+		if (fd->fname[0])
+		    printf ("%3d %10ld (%05d) %s\n",
+			fd->nrefs, fd->fdate, fd->chksum, fd->fname);
+
+	    fd_hits   = 0;
+	    fd_misses = 0;
+
+	    fflush (stdout);
+	}
+
+	fd = fd_head = fd_tail = &fdcache[0];
+	fd->uplnk   = NULL;
+	fd->dnlnk   = NULL;
+	fd->nrefs   = 0;
+	fd->chksum  = -1;
+	fd->fname[0] = EOS;
+
+	for (i=1;  i < MAX_FILES;  i++) {
+	    fd = fd_tohead (&fdcache[i]);
+	    fd->fname[0] = EOS;
+	    fd->chksum   = -1;
+	    fd->nrefs    = 0;
+	}
+}
+
+
+/* FD_TOHEAD -- Link a fdate struct at the head of the list.
+ */
+struct _fdate *
+fd_tohead (register struct _fdate *fd)
+{
+	if (fd != fd_head) {
+	    fd->uplnk = NULL;
+	    fd->dnlnk = fd_head;
+	    fd_head->uplnk = fd;
+	    fd_head = fd;
+	}
+
+	return (fd);
+}
+
+
+/* FD_TOTAIL -- Link a fdate struct at the tail of the list.
+ */
+struct _fdate *
+fd_totail (register struct _fdate *fd)
+{
+	if (fd != fd_tail) {
+	    fd->uplnk = fd_tail;
+	    fd->dnlnk = NULL;
+	    fd_tail->dnlnk = fd;
+	    fd_tail = fd;
+	}
+
+	return (fd);
+}
+
+
+/* FD_UNLINK -- Unlink an fdate struct.
+ */
+struct _fdate *
+fd_unlink (register struct _fdate *fd)
+{
+	if (fd == fd_head)
+	    fd_head = fd->dnlnk;
+	if (fd == fd_tail)
+	    fd_tail = fd->uplnk;
+
+	if (fd->uplnk)
+	    fd->uplnk->dnlnk = fd->dnlnk;
+	if (fd->dnlnk)
+	    fd->dnlnk->uplnk = fd->uplnk;
+	
+	return (fd);
+}
+
+
+/* FD_CHKSUM -- Compute the checksum of a character string.
+ */
+int
+fd_chksum (char *s)
+{
+	register int sum=0;
+
+	while (*s)
+	    sum += *s++;
+
+	return (sum);
+}
diff --git a/unix/boot/mkpkg/fncache.c b/unix/boot/mkpkg/fncache.c
new file mode 100644
index 00000000..2053f2fe
--- /dev/null
+++ b/unix/boot/mkpkg/fncache.c
@@ -0,0 +1,228 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#include <stdio.h>
+#include <string.h>
+#include <stdlib.h>
+
+//#include "../bootProto.h"
+
+
+/*
+ * FNCACHE -- Maintain a cache of system logical filenames (e.g., <config.h>)
+ * and their associated virtual filenames (e.g., "host$hlib/config.h").
+ * This can greatly reduce the amount of time required to resolve references
+ * to system include files in dependency file lists.
+ *
+ * External entry points:
+ *
+ *   nc = m_sysfile (lname, fname, maxch)	# return file name
+ *	   m_fninit (debug)			# initialize cache
+ */
+
+#define	MAX_FILES	20		/* size of the cache		*/
+#define	SZ_LNAME	32		/* size of logical name		*/
+#define	SZ_FNAME	32		/* size of virtual file name	*/
+#define	EOS		'\0'
+
+struct _sysfile {			/* cache list element structure	*/
+	struct	_sysfile *uplnk;
+	struct	_sysfile *dnlnk;
+	int	nrefs;			/* number of references		*/
+	int	chksum;			/* speeds searches		*/
+	char	lname[SZ_LNAME+1];	/* logical name			*/
+	char	fname[SZ_FNAME+1];	/* file name			*/
+};
+
+struct	_sysfile fncache[MAX_FILES];	/* the cache			*/
+struct	_sysfile *fn_head;		/* doubly linked list		*/
+struct	_sysfile *fn_tail;
+int	fn_hits, fn_misses;
+
+struct	_sysfile *fn_unlink();
+struct	_sysfile *fn_tohead();
+struct	_sysfile *fn_totail();
+
+
+extern  int  os_sysfile (char *sysfile, char *fname, int maxch);
+
+int   m_sysfile (char *lname, char *fname, int maxch);
+void  m_fninit (int debug);
+int   fn_chksum (char *s);
+int   fn_strncpy (char *out, char *in, int maxch);
+
+
+
+/* M_SYSFILE -- Search for the named system file and return the virtual file
+ * name in the output string if the system file is found.  This is functionally
+ * equivalent to os_sysfile().
+ */
+int
+m_sysfile (
+  char	*lname,			/* logical name of system file	*/
+  char	*fname,			/* receives virtual file name	*/
+  int	maxch 
+)
+{
+	register struct _sysfile *fn;
+	register int	chksum;
+	int	fnlen;
+
+	/* Look in the cache first.  For a small cache a linear search is
+	 * plenty fast enough.
+	 */
+	chksum = fn_chksum (lname);
+	for (fn=fn_head;  fn != NULL;  fn=fn->dnlnk)
+	    if (fn->chksum == chksum && strcmp (lname, fn->lname) == 0) {
+		fn_tohead (fn_unlink (fn));
+		fn->nrefs++;
+		fn_hits++;
+		return (fn_strncpy (fname, fn->fname, maxch));
+	    }
+
+	/* Cache miss.  Don't put in cache it name is too long.
+	 */
+	fn_misses++;
+	fnlen = os_sysfile (lname, fname, maxch);
+	if (fnlen > SZ_FNAME || strlen(lname) > SZ_LNAME)
+	    return (fnlen);
+
+	/* Put fname in the cache.  Reuse slot at tail of list.
+	 */
+	fn = fn_tohead (fn_unlink (fn_tail));
+	strcpy (fn->lname, lname);
+	strcpy (fn->fname, fname);
+	fn->chksum = fn_chksum (lname);
+	fn->nrefs  = 1;
+
+	return (fnlen);
+}
+
+
+/* M_FNINIT -- Initialize (clear) the sysfile cache.
+ */
+void
+m_fninit (int debug)
+{
+	register struct _sysfile *fn;
+	register int	i;
+	int	total;
+
+	if (debug) {
+	    char    lname[SZ_FNAME+1];
+
+	    total = fn_hits + fn_misses;
+	    printf ("file name cache: %d hits, %d misses, %d%% of %d\n",
+		fn_hits, fn_misses, (total ? fn_hits * 100 / total : 0), total);
+
+	    for (fn=fn_head;  fn != NULL;  fn=fn->dnlnk)
+		if (fn->lname[0]) {
+		    sprintf (lname, "<%s>", fn->lname);
+		    printf ("%3d (%05d) %-20s => %s\n",
+			fn->nrefs, fn->chksum, lname, fn->fname);
+		}
+
+	    fn_hits   = 0;
+	    fn_misses = 0;
+
+	    fflush (stdout);
+	}
+
+	fn = fn_head = fn_tail = &fncache[0];
+	fn->uplnk   = NULL;
+	fn->dnlnk   = NULL;
+	fn->nrefs   = 0;
+	fn->chksum  = -1;
+	fn->lname[0] = EOS;
+
+	for (i=1;  i < MAX_FILES;  i++) {
+	    fn = fn_tohead (&fncache[i]);
+	    fn->lname[0] = EOS;
+	    fn->chksum   = -1;
+	    fn->nrefs    = 0;
+	}
+}
+
+
+/* FN_TOHEAD -- Link a sysfile struct at the head of the list.
+ */
+struct _sysfile *
+fn_tohead (register struct _sysfile *fn)
+{
+	if (fn != fn_head) {
+	    fn->uplnk = NULL;
+	    fn->dnlnk = fn_head;
+	    fn_head->uplnk = fn;
+	    fn_head = fn;
+	}
+
+	return (fn);
+}
+
+
+/* FN_TOTAIL -- Link a sysfile struct at the tail of the list.
+ */
+struct _sysfile *
+fn_totail (register struct _sysfile *fn)
+{
+	if (fn != fn_tail) {
+	    fn->uplnk = fn_tail;
+	    fn->dnlnk = NULL;
+	    fn_tail->dnlnk = fn;
+	    fn_tail = fn;
+	}
+
+	return (fn);
+}
+
+
+/* FN_UNLINK -- Unlink an sysfile struct.
+ */
+struct _sysfile *
+fn_unlink (register struct _sysfile *fn)
+{
+	if (fn == fn_head)
+	    fn_head = fn->dnlnk;
+	if (fn == fn_tail)
+	    fn_tail = fn->uplnk;
+
+	if (fn->uplnk)
+	    fn->uplnk->dnlnk = fn->dnlnk;
+	if (fn->dnlnk)
+	    fn->dnlnk->uplnk = fn->uplnk;
+	
+	return (fn);
+}
+
+
+/* FN_CHKSUM -- Compute the checksum of a character string.
+ */
+int
+fn_chksum (char *s)
+{
+	register int sum=0;
+
+	while (*s)
+	    sum += *s++;
+
+	return (sum);
+}
+
+
+/* FN_STRNCPY -- Copy up to maxch characters from a string and return the
+ * number of characters copied as the function value.
+ */
+int
+fn_strncpy (
+  char	*out,
+  char	*in,
+  int	maxch 
+)
+{
+	register char	*ip, *op;
+	register int	n;
+
+	for (ip=in, op=out, n=maxch;  --n >= 0 && (*op++ = *ip++);  )
+	    ;
+	return (op-1 - out);
+}
diff --git a/unix/boot/mkpkg/host.c b/unix/boot/mkpkg/host.c
new file mode 100644
index 00000000..2f7c140b
--- /dev/null
+++ b/unix/boot/mkpkg/host.c
@@ -0,0 +1,917 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#include <stdio.h>
+#include <unistd.h>
+#include <stdlib.h>
+#include <string.h>
+#include <fcntl.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <sys/time.h>
+
+#define import_spp
+#define import_error
+#include <iraf.h>
+#include "mkpkg.h"
+#include "extern.h"
+#include "../bootProto.h"
+
+#ifdef LINUX
+#  undef SYSV
+#  undef i386
+#  define GNUAR
+#else
+#  ifdef BSD
+#    undef SYSV
+#  endif
+#endif
+
+/*
+ * HOST.C -- [MACHDEP] Special host interface routines required by the MKPKG
+ * utility.
+ */
+
+#define	SZ_COPYBUF	4096
+#ifndef SZ_CMD
+#define	SZ_CMD		2048		/* max size OS command, see mkpkg.h */
+#endif
+#define	SZ_LIBPATH	512		/* path to library 		    */
+#define	LIBRARIAN	"ar"
+#define	LIBTOOL		"libtool"
+#define	LIBFLAGS	"r"
+#define	REBUILD		"ranlib"
+#define	XC		"xc"
+#define	INTERRUPT	SYS_XINT
+
+extern	char *makeobj();
+extern	char *vfn2osfn();
+extern	char *getenv();
+
+extern  void fatals (char *fmt, char *arg);
+
+char	*resolvefname();
+char	*mkpath();
+
+int   h_updatelibrary (char *library, char *flist[], int totfiles, 
+                char *xflags, char *irafdir);
+int   h_rebuildlibrary (char *library);
+int   h_incheck (char *file, char *dir);
+int   h_outcheck (char *file, char *dir, int clobber);
+void  h_getlibname (char *file, char *fname);
+int   h_xc (char *cmd);
+int   h_purge (char *dir);
+int   h_copyfile (char *oldfile, char *newfile);
+ 
+int   u_fcopy (char *old, char *new);
+int   h_movefile (char *old, char *new);
+int   u_fmove (char *old, char *new );
+int   add_sources (char *cmd, int maxch, char *flist[], 
+                int totfiles, int hostnames, int  *nsources);
+int   add_objects (char *cmd, int maxch, char *flist[], 
+                int totfiles, int hostnames);
+
+char *makeobj (char *fname);
+char *mkpath (char *module, char *directory, char *outstr);
+char *resolvefname (char *fname);
+int   h_direq (char *dir1, char *dir2);
+
+
+
+/* H_UPDATELIBRARY -- Compile a list of source files and replace them in the
+ * host library.  This is done by formatting a command for the XC compiler
+ * and passing it to the host system.  Since XC is pretty much the same on
+ * all systems, this should be close to portable.  Note that when we are
+ * called we are not necessarily in the same directory as the library, but
+ * we are always in the same directory as the files in the file list.
+ * Note also that the file list may contain object files which cannot be
+ * compiled, but which must be replaced in the library.
+ */
+int
+h_updatelibrary (
+    char   *library,		/* pathname of library		*/
+    char   *flist[],		/* pointers to filename strings	*/
+    int	    totfiles,		/* number of files in list	*/
+    char   *xflags,		/* XC compiler flags		*/
+    char   *irafdir 		/* iraf root directory		*/
+)
+{
+	char	cmd[SZ_CMD+1], *args;
+	int	exit_status, baderr, npass;
+	int	nsources, nfiles, ndone, nleft;
+	int	hostnames, status;
+	char	libfname[SZ_PATHNAME+1];
+	char   *lname = NULL;
+
+	/* Get the library file name. */
+	h_getlibname (library, libfname);
+	lname = resolvefname(libfname);
+
+	/*
+	 * Compile the files.
+	 * -------------------
+	 */
+	if (irafdir[0])
+	    sprintf (cmd, "%s -r %s %s", XC, irafdir, xflags);
+	else
+	    sprintf (cmd, "%s %s", XC, xflags);
+
+	if (debug)
+	    strcat (cmd, " -d");
+	if (dbgout)
+	    strcat (cmd, " -x");
+
+	/* Compute offset to the file list and initialize loop variables.
+	 * Since the maximum command length is limited, only a few files
+	 * are typically processed in each iteration.
+	 */
+	exit_status = OK;
+	baderr = NO;
+	args  = &cmd[strlen(cmd)];
+	nleft = totfiles;
+	ndone = 0;
+
+	while (nleft > 0) {
+	    /* Add as many filenames as will fit on the command line.
+	     */
+	    nfiles = add_sources (cmd, SZ_CMD, &flist[ndone], nleft,
+		hostnames=NO, &nsources);
+
+	    /* This should not happen.
+	     */
+	    if (nfiles <= 0) {
+		printf ("OS command overflow; cannot compile files\n");
+		fflush (stdout);
+		exit_status = ERR;
+		return 0;
+	    }
+
+	    if (verbose) {
+		if (nsources > 0)
+		    printf ("%s\n", cmd);
+		else
+		    printf ("file list contains only object files\n");
+		fflush (stdout);
+	    }
+
+	    if (execute && nsources > 0)
+		if ((status = os_cmd (cmd)) != OK) {
+		    if (status == INTERRUPT)
+			fatals ("<ctrl/c> interrupt %s", library);
+		    if (!ignore)
+			baderr++;
+		    exit_status += status;
+		}
+
+	    /* Truncate command and repeat with the next few files.
+	     */
+	    (*args) = EOS;
+
+	    ndone += nfiles;
+	    nleft -= nfiles;
+	}
+
+	/* Do not update object modules in library if a compilation error
+	 * occurred.  The object files will be left on disk and the user
+	 * will rerun us after fixing the problem; the next time around we
+	 * will see that the objects exist and are up to date, hence will
+	 * not recompile them.  When all have been successfully compiled
+	 * the library will be updated.
+	 */
+	if (baderr)
+	    return 0;
+
+	/*
+	 * Update the library.
+	 * ---------------------
+	 */
+#if defined(LINUX) || defined(BSD) || defined(MACOSX)
+#if defined(MACOSX) && !defined(MACH64)
+	/* For FAT libraries we need to use libtool to update.
+	 */
+	if (access (lname, F_OK) == 0)
+	    sprintf (cmd, "%s %s %s %s", LIBTOOL, "-a -T -o", lname, lname);
+	else
+	    sprintf (cmd, "%s %s %s ", LIBTOOL, "-a -T -o", lname);
+#else
+	sprintf (cmd, "%s %s %s", LIBRARIAN, LIBFLAGS, resolvefname(libfname));
+#endif
+#else
+	sprintf (cmd, "%s %s %s", LIBRARIAN, LIBFLAGS, libfname);
+#endif
+
+	/* Compute offset to the file list and initialize loop variables.
+	 * Since the maximum command length is limited, only a few files
+	 * are typically processed in each iteration.
+	 */
+	args  = &cmd[strlen(cmd)];
+	nleft = totfiles;
+	ndone = 0;
+
+	for (npass=0; nleft > 0; npass++) {
+
+#if defined(MACOSX) && !defined(MACH64)
+	    if (npass > 0) {
+	        /* For FAT libraries we need to use libtool to update.
+	         */
+	        if (access (lname, F_OK) == 0)
+	            sprintf (cmd, "%s %s %s %s", LIBTOOL, "-a -T -o", 
+			lname, lname);
+	        else
+	            sprintf (cmd, "%s %s %s ", LIBTOOL, "-a -T -o", lname);
+	    }
+#endif
+
+	    /* Add as many filenames as will fit on the command line.  */
+	    nfiles = add_objects (cmd, SZ_CMD, &flist[ndone], nleft,
+		hostnames=NO);
+
+	    /* This should not happen.  */
+	    if (nfiles <= 0) {
+		printf ("OS command overflow; cannot update library `%s'\n",
+		    libfname);
+		fflush (stdout);
+		exit_status = ERR;
+		return 0;
+	    }
+
+	    if (verbose) {
+		printf ("%s\n", cmd);
+		fflush (stdout);
+	    }
+
+	    if (execute) {
+		if ((exit_status = os_cmd (cmd)) == OK) {
+		    /* Delete the object files.
+		     */
+		    int	i;
+
+		    for (i=0;  i < nfiles;  i++)
+			os_delete (makeobj (flist[ndone+i]));
+		} else if (exit_status == INTERRUPT)
+		    fatals ("<ctrl/c> interrupt %s", library);
+	    }
+
+	    /* Truncate command and repeat with the next few files.
+	     */
+	    (*args) = EOS;
+
+	    ndone += nfiles;
+	    nleft -= nfiles;
+
+#if defined(MACOSX) && !defined(MACH64)
+	    h_rebuildlibrary (lname);
+#endif
+	}
+
+	return (exit_status);
+}
+
+
+/* H_REBUILDLIBRARY -- Called after all recently recompiled modules have been
+ * replaced in the library.  When we are called we are in the same directory
+ * as the library.
+ */
+int
+h_rebuildlibrary (
+    char  *library 		/* filename of library	*/
+)
+{
+#ifdef SYSV
+	/* Skip the library rebuild if COFF format library. */
+	return (OK);
+#else
+	char cmd[SZ_LINE+1];
+	char libfname[SZ_PATHNAME+1];
+	char *libpath;
+
+	/* Get the library file name. */
+	h_getlibname (library, libfname);
+	libpath = resolvefname (vfn2osfn(libfname,0));
+
+	sprintf (cmd, "%s %s", REBUILD, libpath);
+	if (verbose) {
+	    printf ("%s\n", cmd);
+	    fflush (stdout);
+	}
+
+	if (execute)
+	    return (os_cmd (cmd));
+	else
+	    return (OK);
+#endif
+}
+
+
+/* H_INCHECK -- Check a file, e.g., a library, back into the directory it
+ * was originally checked out from.  If the directory name pointer is NULL
+ * merely delete the checked out copy of the file.  On a UNIX system the
+ * checked out file is a symbolic link, so all we do is delete the link.
+ * On a VMS system the checked out file is a copy, and we have to physically
+ * copy the new file back, creating a new version of the original file.
+ */
+int
+h_incheck (
+    char  *file,		/* file to be checked in	*/
+    char  *dir 			/* where to put the file	*/
+)
+{
+	char    backup[SZ_PATHNAME+1];
+	char    path[SZ_PATHNAME+1];
+	char	fname[SZ_PATHNAME+1];
+	char	*osfn, *ip;
+	struct	stat fi;
+	int	status;
+
+	/* Get the library file name. */
+	h_getlibname (file, fname);
+	osfn = vfn2osfn (fname, 0);
+
+	if (verbose) {
+	    printf ("check file `%s' into `%s'\n", fname, dir ? dir : "");
+	    fflush (stdout);
+	}
+
+	if (stat (osfn, &fi) == ERR) {
+	    printf ("$checkin: file `%s' not found\n", osfn);
+	    fflush (stdout);
+	    return (ERR);
+	}
+
+	/* If the file is not a symbolic link to an existing remote file it
+	 * is probably a new library, so move it to the destination directory,
+	 * otherwise just delete the link.  If the named file exists in
+	 * IRAFULIB update that version of the file instead of the standard one.
+	 */
+	if (dir != NULL && !(fi.st_mode & S_IFLNK)) {
+	    path[0] = EOS;
+	    if ((ip = getenv("IRAFULIB")))
+		if (access (mkpath(fname,ip,path), 0) < 0)
+		    path[0] = EOS;
+
+	    if (path[0] == EOS)
+		status = h_movefile (osfn, mkpath(fname,dir,path));
+	    else
+		status = h_movefile (osfn, path);
+
+	} else
+	    status = unlink (osfn);
+
+	/* If there was a local copy of the file it will have been renamed
+	 * with a .cko extension when the file was checked out, and should be
+	 * restored.
+	 */
+	sprintf (backup, "%s.cko", fname);
+	if (access (backup, 0) == 0) {
+	    if (debug) {
+		printf ("h_incheck: rename %s -> %s\n", backup, fname);
+		fflush (stdout);
+	    }
+	    if (rename (backup, fname) == -1)
+		printf ("cannot rename %s -> %s\n", backup, fname);
+	}
+
+	return (status);
+}
+
+
+/* H_OUTCHECK -- Check out a file, e.g., gain access to a library in the
+ * current directory so that it can be updated.  If the file has already
+ * been checked out do not check it out again.  In principle we should also
+ * place some sort of a lock on the file while it is checked out, but...
+ */
+int
+h_outcheck (
+    char  *file,		/* file to be checked out		*/
+    char  *dir,			/* where to get the file		*/
+    int	   clobber 		/* clobber existing copy of file?	*/
+)
+{
+	register char	*ip, *op;
+	char path[SZ_PATHNAME+1];
+	char fname[SZ_PATHNAME+1];
+
+	/* Get the library file name. */
+	h_getlibname (file, fname);
+
+	/* Make the UNIX pathname of the destination file.	[MACHDEP]
+	 * Use the IRAFULIB version of the file if there is one.
+	 */
+	path[0] = EOS;
+	if ((ip = getenv("IRAFULIB")))
+	    if (access (mkpath(fname,ip,path), 0) < 0)
+		path[0] = EOS;
+
+	if (path[0] == EOS) {
+	    for (ip=vfn2osfn(dir,0), op=path;  (*op = *ip++);  op++)
+		;
+	    if (*(op-1) != '/')
+		*op++ = '/';
+	    for (ip=vfn2osfn(fname,0);  (*op = *ip++);  op++)
+		;
+	    *op = EOS;
+	}
+
+	if (verbose) {
+	    printf ("check out file `%s = %s'\n", fname, path);
+	    fflush (stdout);
+	}
+
+	/* If the file already exists and clobber is enabled, delete it.
+	 * If the file is a symbolic link (a pathname), and IRAF has been
+	 * moved since the link was created, then the symlink will be
+	 * pointing off into never never land and must be redone.  If clobber
+	 * is NOT enabled, then probably the remote copy of the file is an
+	 * alternate source for the local file, which must be preserved.
+	 */
+	if (access (fname, 0) != -1) {
+	    char    backup[SZ_PATHNAME+1];
+
+	    if (clobber) {
+		if (debug) {
+		    printf ("h_outcheck: deleting %s\n", fname);
+		    fflush (stdout);
+		}
+		unlink (fname);
+	    } else {
+		/* Do not rename the file twice; if the .cko file already
+		 * exists, the second time would clobber it.  Note that if a
+		 * mkpkg run is aborted, the checked out file and renamed
+		 * local file will remain, but a subsequent successful mkpkg
+		 * will restore everything.
+		 */
+		sprintf (backup, "%s.cko", fname);
+		if (access (backup, 0) == -1) {
+		    if (debug) {
+			printf ("h_outcheck: rename %s -> %s\n", fname, backup);
+			fflush (stdout);
+		    }
+		    if (rename (fname, backup) == -1)
+			printf ("cannot rename %s -> %s\n", fname, backup);
+		}
+	    }
+	}
+
+	return (symlink (path, fname));
+}
+
+
+/* H_GETLIBNAME -- Get a library filename.  If debug output is enabled (-g
+ * or -x), and we are checking out a library file (.a), update the debug
+ * version of the library (XX_p.a).
+ */
+void
+h_getlibname (
+    char  *file,
+    char  *fname
+)
+{
+	register char *ip;
+
+	strcpy (fname, file);
+	if (dbgout) {
+	    for (ip=fname;  *ip;  ip++)
+		;
+	    if (*(ip-2) == '.' && *(ip-1) == 'a' &&
+		    !(*(ip-4) == '_' && *(ip-3) == 'p')) {
+		*(ip-2) = '_';
+		*(ip-1) = 'p';
+		*(ip-0) = '.';
+		*(ip+1) = 'a';
+		*(ip+2) = '\0';
+	    }
+	}
+}
+
+
+/* H_XC -- Host interface to the XC compiler.  On UNIX all we do is use the
+ * oscmd facility to pass the XC command line on to UNIX.
+ */
+int
+h_xc (char *cmd)
+{
+	return (os_cmd (cmd));
+}
+
+
+/* H_PURGE -- Purge all old versions of all files in the named directory.
+ * This is a no-op on UNIX since multiple file versions are not supported.
+ */
+int
+h_purge (
+    char  *dir		/* LOGICAL directory name */
+)
+{
+	if (verbose) {
+	    printf ("purge directory `%s'\n", dir);
+	    fflush (stdout);
+	}
+
+	/*
+	 * format command "purge [dir]*.*;*"
+	 * if (verbose)
+	 *     echo command to stdout
+	 * if (execute)
+	 *     call os_cmd to execute purge command
+	 */
+
+	 return (OK);
+}
+
+
+/* H_COPYFILE -- Copy a file.  If the new file already exists it is
+ * clobbered (updated).
+ */
+int
+h_copyfile (
+    char  *oldfile,		/* existing file to be copied	*/
+    char  *newfile 		/* new file, not a directory name */
+)
+{
+	char	old[SZ_PATHNAME+1];
+	char	new[SZ_PATHNAME+1];
+
+	strcpy (old, vfn2osfn (oldfile, 0));
+	strcpy (new, vfn2osfn (newfile, 1));
+
+	if (verbose) {
+	    printf ("copy %s to %s\n", old, new);
+	    fflush (stdout);
+	}
+
+	if (execute) {
+	    if (os_access (old, 0,0) == NO) {
+		printf ("$copy: file `%s' not found\n", oldfile);
+		fflush (stdout);
+		return (ERR);
+	    } else
+		return (u_fcopy (old, new));
+	}
+
+	return (OK);
+}
+
+
+/* U_FCOPY -- Copy a file, UNIX.
+ */
+int
+u_fcopy (
+    char  *old,
+    char  *new
+)
+{
+	char	buf[SZ_COPYBUF], *ip;
+	int	in, out, nbytes;
+	struct	stat fi;
+	long	totbytes;
+
+	/* Open the old file and create the new one with the same mode bits
+	 * as the original.
+	 */
+	if ((in  = open(old,0)) == ERR || fstat(in,&fi) == ERR) {
+	    printf ("$copy: cannot open input file `%s'\n", old);
+	    fflush (stdout);
+	    return (ERR);
+	} if ((out = creat(new,0644)) == ERR || fchmod(out,fi.st_mode) == ERR) {
+	    printf ("$copy: cannot create output file `%s'\n", new);
+	    fflush (stdout);
+	    close (in);
+	    return (ERR);
+	}
+
+	/* Copy the file.
+	 */
+	totbytes = 0;
+	while ((nbytes = read (in, buf, SZ_COPYBUF)) > 0)
+	    if (write (out, buf, nbytes) == ERR) {
+		close (in); close (out);
+		printf ("$copy: file write error on `%s'\n", new);
+		fflush (stdout);
+		return (ERR);
+	    } else
+		totbytes += nbytes;
+
+	close (in);
+	close (out);
+
+	/* Check for premature termination of the copy.
+	 */
+	if (totbytes != fi.st_size) {
+	    printf ("$copy: file changed size `%s' oldsize=%d, newsize=%d\n",
+		old, (int)fi.st_size, (int)totbytes);
+	    fflush (stdout);
+	    return (ERR);
+	}
+
+	/* If file is a library (".a" extension in UNIX), preserve the
+	 * modify date else UNIX will think the library symbol table is
+	 * out of date.
+	 */
+	for (ip=old;  *ip;  ip++)
+	    ;
+	ip -= 2;
+	if (ip > old && strcmp (ip, ".a") == 0) {
+	    struct  timeval tv[2];
+
+	    tv[0].tv_sec = fi.st_atime;
+	    tv[1].tv_sec = fi.st_mtime;
+	    utimes (new, tv);
+	}
+
+	return (OK);
+}
+
+
+/* H_MOVEFILE -- Move a file from the current directory to another directory,
+ * or rename the file within the current directory.  If the destination file
+ * already exists it is clobbered.
+ */
+int
+h_movefile (
+    char  *old,		/* file to be moved		*/
+    char  *new 		/* new pathname of file		*/
+)
+{
+	char	old_osfn[SZ_PATHNAME+1];
+	char	new_osfn[SZ_PATHNAME+1];
+
+	strcpy (old_osfn, vfn2osfn (old, 0));
+	strcpy (new_osfn, vfn2osfn (new, 0));
+
+	if (debug) {
+	    printf ("move %s to %s\n", old_osfn, new_osfn);
+	    fflush (stdout);
+	}
+
+	if (execute) {
+	    if (os_access (old_osfn, 0,0) == NO) {
+		printf ("$move: file `%s' not found\n", old);
+		fflush (stdout);
+		return (ERR);
+	    } else
+		return (u_fmove (old_osfn, new_osfn));
+	}
+
+	return (OK);
+}
+
+
+/* U_FMOVE -- Unix procedure to move or rename a file.  Will move file to a
+ * different device (via a file copy) if necessary.
+ */
+int
+u_fmove (
+    char  *old,
+    char  *new 
+)
+{
+	unlink (new);
+	if (link (old, new) == ERR)
+	    if (u_fcopy (old, new) == ERR) {
+		printf ("$move: cannot create `%s'\n", new);
+		fflush (stdout);
+		return (ERR);
+	    }
+
+	if (unlink (old) == ERR) {
+	    printf ("$move: cannot unlink `%s'\n", old);
+	    fflush (stdout);
+	    return (ERR);
+	}
+
+	return (OK);
+}
+
+
+/* ADD_SOURCES -- Append source files from the file list to the command
+ * buffer.  Omit object files.  Return a count of the number of files to
+ * be compiled.  This code is machine dependent since Unix permits arbitrarily
+ * long command lines, but most systems do not, in which case something
+ * else must be done (e.g., write a command file and have the host system
+ * process that).
+ */
+int
+add_sources (
+    char *cmd,			/* concatenate to this		*/
+    int	  maxch,			/* max chars out		*/
+    char *flist[],		/* pointers to filename strings	*/
+    int	  totfiles,		/* number of files in list	*/
+    int	  hostnames,		/* return host filenames?	*/
+    int	 *nsources 		/* receives number of src files */
+)
+{
+	register char	*ip, *op, *otop;
+	register int	i;
+	int	nfiles;
+
+	*nsources = 0;
+	nfiles    = 0;
+
+	otop = &cmd[maxch];
+	for (op=cmd;  *op;  op++)
+	    ;
+
+	for (i=0;  i < totfiles;  i++) {
+	    /* Skip over object files.
+	     */
+	    for (ip=flist[i];  *ip;  ip++)
+		;
+	    if (strcmp (ip-2, ".o") == 0) {
+		nfiles++;
+		continue;
+	    }
+
+	    if (op + strlen (flist[i]) + 1 >= otop)
+		break;
+
+	    nfiles++;
+	    (*nsources)++;
+	    *op++ = ' ';
+
+	    if (hostnames)
+		ip = vfn2osfn (flist[i], 0);
+	    else
+		ip = flist[i];
+
+	    for (;  (*op = *ip++);  op++)
+		;
+	}
+
+	return (nfiles);
+}
+
+
+/* ADD_OBJECTS -- Append the ".o" equivalent of each file name to the
+ * output command buffer.  Return the number of file names appended.
+ */
+int
+add_objects (
+    char *cmd,			/* concatenate to this		*/
+    int	  maxch,		/* max chars out		*/
+    char *flist[],		/* pointers to filename strings	*/
+    int	  totfiles,		/* number of files in list	*/
+    int	  hostnames 		/* return host filenames?	*/
+)
+{
+	register char	*ip, *op, *otop;
+	register int	i;
+	int	nfiles;
+
+	otop = &cmd[maxch];
+	for (op=cmd;  *op;  op++)
+	    ;
+
+	for (i=0, nfiles=0;  i < totfiles;  i++) {
+	    if (op + strlen (flist[i]) + 1 >= otop)
+		break;
+
+	    nfiles++;
+	    *op++ = ' ';
+
+	    ip = makeobj (flist[i]);
+	    if (hostnames)
+		ip = vfn2osfn (ip,0);
+
+	    for (;  (*op = *ip++);  op++)
+		;
+	}
+
+	return (nfiles);
+}
+
+
+/* MAKEOBJ -- Return a pointer to the ".o" equivalent of the input file
+ * name.  The last period in the input filename is assumed to delimit the
+ * filename extension.
+ */
+char *
+makeobj (char *fname)
+{
+	register char	*ip, *op;
+	static	char objfile[SZ_FNAME+1];
+	char	*lastdot;
+
+	for (ip=fname, op=objfile, lastdot=NULL;  (*op = *ip++);  op++)
+	    if (*op == '.')
+		lastdot = op;
+
+	if (lastdot != NULL)
+	    op = lastdot;
+	strcpy (op, ".o");
+
+	return (objfile);
+}
+
+
+/* MKPATH -- Given a module name and a directory name, return the pathname of
+ * the module in the output string.  Do not use the directory pathname if the
+ * module name is already a pathname.
+ */
+char *
+mkpath (
+    char  *module,
+    char  *directory,
+    char  *outstr
+)
+{
+	register char	*ip, *op;
+
+	if (directory && module[0] != '/') {
+	    for (ip=directory, op=outstr;  (*op = *ip++);  op++)
+		;
+	    if (op > outstr && *(op-1) != '/') {
+		*op++ = '/';
+		*op = EOS;
+	    }
+	    for (ip=module;  (*op = *ip++);  op++)
+		;
+	} else
+	    strcpy (outstr, module);
+
+	return (outstr);
+}
+
+
+/* RESOLVEFNAME -- If a filename reference is a symbolic link resolve it to
+ * the pathname of an actual file by tracing back through all symbolic links
+ * to the fully resolved file or path.
+ * 
+ * Example:
+ *
+ *     ./libsys.a -> /iraf/iraf/lib/libsys.a
+ *        /iraf/iraf/lib/libsys.a -> ../bin/libsys.a
+ *	    -> /iraf/iraf/bin/libsys.a
+ *
+ * Note that the "fully resolved" filename may still contain unresolved links
+ * for directory elements - it is only the filename which is fully resolved
+ * in the output pathname.
+ */
+char *
+resolvefname (char *fname)
+{
+	static char pathname[SZ_LIBPATH];
+	char relpath[SZ_LIBPATH];
+	extern char *strrchr();
+
+	strcpy (pathname, fname);
+	while (os_symlink (pathname, relpath, SZ_LIBPATH)) {
+	    if (relpath[0] == '/') {
+		/* Link to an absolute pathname, just use new path. */
+		strcpy (pathname, relpath);
+	    } else {
+		/* Relative path.  This includes upwards references such
+		 * as ../foo.  Replace the filename by the relative path.
+		 * Let unix resolve any upwards references later, when the
+		 * file is accessed.
+		 */
+                char *str = strrchr(pathname,'/');
+                strcpy ((str ? (str+1) : pathname), relpath);
+	    }
+	}
+
+	return (pathname);
+}
+
+
+/* H_DIREQ -- Compare two directory pathnames for equality.  This is easy
+ * in most cases, but the comparison can fail when it shouldn't due to aliases
+ * for directory names, e.g., a directory may be referred to by a symbolic
+ * name, but get-cwd will return a different path, causing the comparison to
+ * fail.
+ */
+int
+h_direq (char *dir1, char *dir2)
+{
+	register char	*ip1, *ip2;
+
+	/* If the pathname contains a directory named "irafXXX" (where the
+	 * XXX are optional characters in the directory name) everything to
+	 * the left for the purposes of this comparision.  This allows the
+	 * iraf root directory to be specified with a path such as
+	 *
+	 *		/<whatever>/iraf/iraf.version/
+	 *
+	 * and the directory name comparision will take place using only
+	 * the portion of the path following this prefix.
+	 */
+	for (ip1=dir1;  *ip1;  ip1++)
+	    if (*ip1 == '/' && *(ip1+1) == 'i')
+		if (strncmp (ip1+1, "iraf", 4) == 0) {
+		    for (ip1++;  *ip1 && *ip1 != '/';  ip1++)
+			;
+		    if (*ip1 == '/')
+			dir1 = ip1 + 1;
+		    --ip1;
+		}
+	for (ip2=dir2;  *ip2;  ip2++)
+	    if (*ip2 == '/' && *(ip2+1) == 'i')
+		if (strncmp (ip2+1, "iraf", 4) == 0) {
+		    for (ip2++;  *ip2 && *ip2 != '/';  ip2++)
+			;
+		    if (*ip2 == '/')
+			dir2 = ip2 + 1;
+		    --ip2;
+		}
+
+	return (strcmp (dir1, dir2) == 0);
+}
diff --git a/unix/boot/mkpkg/main.c b/unix/boot/mkpkg/main.c
new file mode 100644
index 00000000..eb2cb5c3
--- /dev/null
+++ b/unix/boot/mkpkg/main.c
@@ -0,0 +1,347 @@
+/* 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>
+
+#define	import_spp
+#define	import_knames
+#define	import_error
+
+#include <iraf.h>
+
+#include "mkpkg.h"
+#include "../bootProto.h"
+
+/*
+ * MKPKG -- Make a package or library, following the instructions given in
+ * the mkpkg file in the current directory.
+ *
+ *	mkpkg [-flags] [module] [sym=val ...]
+ *
+ *		-dddd		output debug info; up to 4 levels
+ *		-i		ignore errors (cannot ignore interrupt)
+ *		-f fname	set mkpkg filename; default "mkpkg"
+ *		-n		no execute, just go through the motions
+ *		-p pkg		load environment for the named package
+ *		-u		forcibly update library module dates
+ *		-v		verbose: show actions (implied by -n)
+ *
+ * The switch "-f stdin" causes MKPKG to read its commands from the standard
+ * input, e.g., the terminal.  If a module name is given execution will start
+ * at the mkpkg entry for the module, else execution starts at the beginning
+ * of file.  See the manual page, etc. for additional documentation.
+ */
+
+char	sbuf[SZ_SBUF];			/* string buffer		*/
+struct	symbol symtab[MAX_SYMBOLS];	/* symbol table (macros)	*/
+struct	context *topcx;			/* currently active context	*/
+char	*cp = sbuf;			/* pointer into sbuf		*/
+char	*ctop = &sbuf[SZ_SBUF];		/* top of sbuf			*/
+int	npkg = 0;			/* number of packages		*/
+char	*pkgenv[MAX_PKGENV];		/* package environments		*/
+char	v_pkgenv[SZ_PKGENV+1];		/* buffer for pkgenv names	*/
+char	irafdir[SZ_PATHNAME+1];		/* iraf root directory		*/
+int	nsymbols = 0;			/* number of defined symbols	*/
+int	ifstate[SZ_IFSTACK];		/* $IF stack			*/
+int	iflev;				/* $IF stack pointer		*/
+int	debug = 0;			/* print debug messages		*/
+int	dbgout = 0;			/* compile for debugging	*/
+int	verbose = NO;			/* print informative messages	*/
+int	ignore = YES;			/* ignore warns			*/
+int	execute = YES;			/* think but don't act?		*/
+int	exit_status;			/* exit status of last syscall	*/
+int	forceupdate = NO;		/* forcibly update libmod dates	*/
+extern	char *os_getenv();
+
+
+void warns (char *fmt, char *arg);
+void fatals (char *fmt, char *arg);
+
+extern  int  ZZSTRT (void);
+extern  int  ZZSTOP (void);
+
+extern  int  do_mkpkg (struct context *cx, int islib);
+
+
+
+void zzpause () { printf ("ready ...."); (void) getc(stdin); }
+
+
+/* MAIN -- Entry point of mkpkg.e
+ */
+int
+main (int argc, char *argv[])
+{
+	struct	context *cx;
+	char	flags[SZ_LINE+1];
+	char	*symargs[MAX_ARGS], *modules[MAX_ARGS];
+	int	islib, nsymargs=0, nmodules=0, i;
+	char	**argp, *ip, *op;
+
+	ZZSTRT();
+
+	/* Initialize the MKPKG context.
+	 */
+	irafdir[0] = EOS;
+	topcx = cx = (struct context *) calloc (1, sizeof (struct context));
+	if (cx == NULL)
+	    fatals ("out of memory (%s)", "mkpkg.e");
+
+	strcpy (cx->mkpkgfile, MKPKGFILE);
+	os_fpathname ("", cx->dirpath, SZ_PATHNAME);
+	m_fninit (0);
+	m_fdinit (0);
+
+	exit_status = OK;
+	ifstate[0]  = PASS;
+	iflev       = 0;
+	flags[0]    = EOS;
+	islib       = YES;
+	npkg	    = 0;
+
+	/* Process the command line.
+	 */
+	for (argp = &argv[1];  *argp;  ) {
+	    if (**argp == '-') {
+		/* A Mkpkg switch, or a flag to be passed on to XC.
+		 */
+		for (ip = *argp++ + 1;  *ip;  ip++) {
+		    switch (*ip) {
+		    case 'f':
+			if (*argp == NULL)
+			    warns ("missing argument to switch `-f'", NULL);
+			else
+			    strcpy (cx->mkpkgfile, *argp++);
+			break;
+		    case 'i':
+			ignore = YES;
+			break;
+		    case 'd':
+			/* There are multiple levels of "debug"; each
+			 * -d in the arg list adds a level.
+			 */
+			debug++;
+			verbose = YES;
+			break;
+		    case 'x':
+		    case 'g':
+			dbgout++;
+			goto addflag;
+		    case 'n':
+			execute = NO;
+			verbose = YES;
+			break;
+		    case 'p':
+			if (*argp == NULL)
+			    warns ("missing argument to switch `-p'", NULL);
+			else {
+			    pkgenv[npkg] = *argp++;
+			    loadpkgenv (pkgenv[npkg]);
+			    if (npkg++ >= MAX_PKGENV)
+				fatals ("too many -p package arguments", NULL);
+			}
+			break;
+		    case 'u':
+			forceupdate = YES;
+			break;
+		    case 'v':
+			verbose = YES;
+			break;
+		    case 'w':
+			zzpause();
+			break;
+		    case 'r':
+			if (*argp == NULL)
+			    warns ("missing argument to switch `-r'", NULL);
+			else
+			    strcpy (irafdir, *argp++);
+			break;
+		    default:
+addflag:		for (op=flags;  *op;  op++)
+			    ;
+			*op++ = ' ';
+			*op++ = '-';
+			*op++ = *ip;
+			*op++ = EOS;
+			break;
+		    }
+		}
+
+	    } else if (index (*argp, '=') != NULL) {
+		/* Mark the position of a symbol definition argument.  Wait
+		 * to enter this into the symbol table until after the command
+		 * line has been processed and the mkpkg global include file
+		 * has been read in, but go ahead and update the environment
+		 * in case a logical name is affected which is referenced while
+		 * processing the rest of the argument list.
+		 */
+		char    symbol[SZ_FNAME+1];
+		char    *ip, *op;
+
+		ip = symargs[nsymargs++] = *argp++;
+		for (op=symbol;  (*op = *ip++) != '=';  op++)
+		    ;
+		*op = EOS;
+		os_putenv (symbol, ip);
+
+	    } else {
+		/* The name of a module to be processed.
+		 */
+		modules[nmodules++] = *argp++;
+	    }
+	}
+
+	if (debug) {
+	    printf ("mkpkg");
+	    for (argp = &argv[1];  *argp;  argp++)
+		printf (" %s", *argp);
+	    printf ("\n");
+	    fflush (stdout);
+	}
+
+	/* Initialize the package environment.  This has already been done
+	 * if any -p pkgname arguments were given on the command line,
+	 * otherwise look for the name PKGENV in the user's environment.
+	 */
+	if (npkg <= 0)
+	    if ((pkgenv[0] = os_getenv (PKGENV))) {
+		char    *ip;
+
+		strcpy (v_pkgenv, pkgenv[0]);
+		for (ip=v_pkgenv;  *ip;  ) {
+		    while (isspace (*ip))
+			ip++;
+		    pkgenv[npkg] = ip;
+		    while (*ip && !isspace (*ip))
+			ip++;
+		    *ip++ = EOS;
+		    loadpkgenv (pkgenv[npkg]);
+		    if (npkg++ >= MAX_PKGENV)
+			fatals ("too many -p package arguments", NULL);
+		}
+	    }
+
+	/* Initialize the symbol table from the system dependent global
+	 * MKPKG include file.
+	 */
+	do_include (cx, MKPKGINC);
+
+	/* Likewise load the package global mkpkg.inc files for each
+	 * reference package.
+	 */
+	if (npkg > 0) {
+	    char   fname[SZ_PATHNAME+1];
+	    int    i;
+
+	    for (i=0;  i < npkg;  i++) {
+		sprintf (fname, "%s$lib/mkpkg.inc", pkgenv[i]);
+		do_include (cx, fname);
+	    }
+	}
+
+	/* Append any flags given on the command line to XFLAGS.
+	 */
+	if (flags[0]) {
+	    char   new_xflags[SZ_LINE+1];
+	    sprintf (new_xflags, "%s %s", getsym(XFLAGS), flags);
+	    putsym (XFLAGS, new_xflags);
+	}
+
+	/* Append any flags given on the command line to XVFLAGS.
+	 */
+	if (flags[0]) {
+	    char   new_xvflags[SZ_LINE+1];
+	    sprintf (new_xvflags, "%s %s", getsym(XVFLAGS), flags);
+	    putsym (XVFLAGS, new_xvflags);
+	}
+
+	/* Append any flags given on the command line to LFLAGS.
+	 */
+	if (flags[0]) {
+	    char   new_lflags[SZ_LINE+1];
+	    sprintf (new_lflags, "%s %s", getsym(LFLAGS), flags);
+	    putsym (LFLAGS, new_lflags);
+	}
+
+	/* Define the symbol "DEBUG" if building for debugging (-x).
+	 */
+	if (dbgout)
+	    putsym (DEBUGSYM, "1");
+
+	/* Enter any symbols or macros defined on the command line into the
+	 * symbol table and environment.  Must be given without embedded
+	 * whitespace, e.g., "symbol=value".
+	 */
+	for (i=0;  i < nsymargs;  i++) {
+	    char    symbol[SZ_FNAME+1];
+	    char    *ip, *op, *value;
+
+	    for (ip = symargs[i], op=symbol;  (*op = *ip++) != '=';  op++)
+		;
+	    *op = EOS;
+	    value = ip;
+	    putsym (symbol, value);
+	    os_putenv (symbol, value);
+	}
+
+	/* Process the named modules (or the first module in the mkpkg file
+	 * if no modules were named.
+	 */
+	if (nmodules == 0) {
+	    cx->library[0] = EOS;
+	    exit_status = do_mkpkg (cx, islib = 0);
+	} else {
+	    for (i=0;  i < nmodules;  i++) {
+		/* If the module is a library specification, the module name,
+		 * which is the filename of the library, must end in ".a".
+		 */
+		char    *ip, *op;
+		for (ip = modules[i], op=cx->library;  (*op = *ip++);  op++)
+		    ;
+		islib = (strcmp (op - 2, ".a") == 0);
+		exit_status += do_mkpkg (cx, islib);
+	    }
+	}
+
+	free (cx);
+	m_fninit (debug);
+	m_fdinit (debug);
+
+	ZZSTOP();
+	exit (exit_status == OK ? OSOK : exit_status);
+}
+
+
+/* WARNS -- Print error message with one string argument but do not terminate
+ * program execution.
+ */
+void
+warns (char *fmt, char *arg)
+{
+	char	errmsg[SZ_LINE+1];
+
+	sprintf (errmsg, fmt, arg);
+	printf ("Warning, %s line %d: %s\n", topcx->mkpkgfile, topcx->lineno,
+	    errmsg);
+	fflush (stdout);
+}
+
+
+/* FATALS -- Print error message with one string argument and terminate
+ * program execution.
+ */
+void
+fatals (char *fmt, char	*arg)
+{
+	char	errmsg[SZ_LINE+1];
+
+	sprintf (errmsg, fmt, arg);
+	printf ("Fatal error, %s line %d: %s\n", topcx->mkpkgfile,
+	    topcx->lineno, errmsg);
+	fflush (stdout);
+	exit (OSOK+1);
+}
diff --git a/unix/boot/mkpkg/mkpkg b/unix/boot/mkpkg/mkpkg
new file mode 100644
index 00000000..d842357d
--- /dev/null
+++ b/unix/boot/mkpkg/mkpkg
@@ -0,0 +1,33 @@
+# Make the MKPKG utility [MACHDEP].
+
+$call	relink
+$exit
+
+update:
+	$call	relink
+	$call	install
+	;
+
+relink:
+	$set	LIBS = "$(HSI_LIBS)"
+	$set	XFLAGS = "-c $(HSI_XF)"
+
+	$update	libpkg.a
+	$omake	main.c mkpkg.h <libc/error.h>
+	!$(CC)	$(HSI_LF) main.o libpkg.a $(LIBS) $(HSI_OSLIBS) -o mkpkg.e
+	;
+
+install:
+	$move	mkpkg.e $(hlib)
+	;
+
+libpkg.a:
+	char.c		extern.h mkpkg.h <libc/error.h> <libc/spp.h>
+	fdcache.c	
+	fncache.c	
+	host.c		<libc/error.h> <libc/spp.h> <libc/knames.h> <libc/spp.h>
+	pkg.c		extern.h mkpkg.h <libc/error.h> <libc/spp.h>
+	scanlib.c	<libc/spp.h>
+	sflist.c	<libc/error.h> <libc/spp.h> mkpkg.h extern.h
+	tok.c		extern.h mkpkg.h <libc/error.h> <libc/spp.h>
+	;
diff --git a/unix/boot/mkpkg/mkpkg.h b/unix/boot/mkpkg/mkpkg.h
new file mode 100644
index 00000000..9b8073d7
--- /dev/null
+++ b/unix/boot/mkpkg/mkpkg.h
@@ -0,0 +1,254 @@
+/* MKPKG.H -- Global definitions for MKPKG.
+ */
+
+#define	SZ_SBUF		10240	/* string buffer size (fixed)		*/
+#define	SZ_PBSTK	50	/* push back stack 			*/
+#define	SZ_PBBUF	2048	/* push back buffer			*/
+#define	SZ_CMD		2048	/* buf for os escape			*/
+#define	SZ_IFSTACK	50	/* max $IF nesting			*/
+#define	SZ_PREDBUF	1024	/* largest $IF predicate		*/
+#define	SZ_PKGENV	256	/* pkgenv package list buffer		*/
+#define	MAX_ARGS	50	/* max args to a $IF			*/
+#define	MAX_FILES	512	/* max files in a module list		*/
+#define MAX_LIBFILES    8192    /* max files in a library index         */
+#define	MAX_DEPFILES	100	/* max dependency files			*/
+#define	MAX_SYMBOLS	256	/* max macros				*/
+#define	MAX_SFDIRS	128	/* max dirs containing special 	files	*/
+#define	MAX_SFFILES	1024	/* max special files			*/
+#define	MAX_PKGENV	20	/* max package environments		*/
+
+#define	INTERRUPT	SYS_XINT
+#define	MKPKGFILE	"mkpkg"
+#define	MKPKGINC	"hlib$mkpkg.inc"
+#define	PKGENV		"PKGENV"
+#define	LFLAGS		"lflags"
+#define	XFLAGS		"xflags"
+#define	XVFLAGS		"xvflags"
+#define	DEBUGSYM	"debug"
+#define	XC		"xc"
+#define	GENERIC		"generic"
+#define	GFLAGS		"gflags"
+#define	BACK		".."
+
+#define	BEGIN_CHAR	':'
+#define	END_CHAR	';'
+#define	SUBDIR_CHAR	'@'
+#define COMMENT		'#'
+#define PREPROCESSOR	'$'
+#define	SYSCMD		'!'
+#define SYSFILE_BEGIN	'<'
+#define SYSFILE_END	'>'
+#define	ESCAPE		'\\'
+
+#define	PASS		1
+#define	STOP		0
+#define	TOK_FNAME	1
+#define	TOK_NEWLINE	2
+#define	TOK_BEGIN	3
+#define	TOK_END		4
+#define	TOK_WHITESPACE	5
+
+/* Pushback structure, used to implement macro expansion.
+ */
+struct pushback {
+	char	*ip;			/* next char to return		*/
+	char	*op;			/* next avail char in buffer	*/
+	char	*otop;			/* top of buffer		*/
+	int	npb;			/* number of pushed ips		*/
+	char	*pbstk[SZ_PBSTK];	/* save pushed ips		*/
+	char	pbbuf[SZ_PBBUF+1];	/* push back buffer		*/
+};
+
+/* Mkpkg context descriptor.
+ */
+struct context {
+	FILE	*fp;			/* mkpkg file descriptor	*/
+	long	fpos;			/* saved file pointer		*/
+	struct	pushback *pb;		/* pushback descriptor		*/
+	int	pbchar;			/* single char pushback		*/
+	int	pushback;		/* flag that is pushback	*/
+	struct	context *prev;		/* previous mkpkg context	*/
+	int	totfiles;		/* total library files updated	*/
+	int	nfiles;			/* nfiles last updated		*/
+	int	nrfiles;		/* nrfiles last updated		*/
+	int	lineno;			/* lineno in mkpkg file		*/
+	int	level;			/* subdirectory level		*/
+	int	sublib;			/* called from lib module list	*/
+	char	*old_cp;		/* old cp when pushing new ctx	*/
+	int	old_nsymbols;		/* old nsymbols			*/
+	int	old_iflev;		/* old IF stack pointer		*/
+	char	*flist[MAX_FILES];	/* file list			*/
+	char	*rflist[MAX_FILES];	/* remote file list		*/
+	char	curdir[SZ_PATHNAME+1];	/* cwd for printed output	*/ 
+	char	dirpath[SZ_PATHNAME+1];	/* os path of cwd		*/
+	char	library[SZ_PATHNAME+1];	/* library being updated	*/
+	char	libpath[SZ_PATHNAME+1];	/* pathname of library		*/
+	char	mkpkgfile[SZ_FNAME+1];	/* mkpkg file being scanned	*/
+};
+
+/* Macros.
+ */
+struct symbol {
+	char	*s_name;		/* symbol name			*/
+	char	*s_value;		/* symbol value			*/
+};
+
+/* Special file list.
+ */
+struct	sfile {
+	char	*sf_stname;		/* standard filename		*/
+	char	*sf_sfname;		/* special filename		*/
+	char	*sf_mkobj;		/* MKPKG command to make object	*/
+	struct	sfile *sf_next;		/* next file in directory	*/
+};
+
+
+/* External functions.
+ */
+struct	sfile	*sf_dirsearch(), *sf_filesearch();
+struct	context *push_context();
+struct	context *pop_context();
+char	*vfn2osfn();
+char	*os_getenv();
+char	*mklower();
+char	*getargs();
+char	*makeobj();
+char	*getsym();
+char	*putstr();
+/*
+char	*malloc();
+char	*calloc();
+*/
+long	os_fdate();
+long	m_fdate();
+char	*index();
+char	*k_fgets();
+
+
+/*****************************************************************************/
+
+/*  main.c  */
+void warns (char *fmt, char *arg);
+void fatals (char *fmt, char *arg);
+
+
+/*  char.c  */
+int   m_getc (register struct context *cx);
+int   m_rawgetc (register struct context *cx);
+void  m_ungetc (int ch, struct context *cx);
+void  m_pushstr (struct context *cx, char *str);
+void  mk_pbbuf (register struct context *cx);
+void  pb_cancel (register struct context *cx);
+char *putstr (char *s);
+
+int   k_getc (register struct context *cx);
+char *k_fgets (char *obuf, int maxch, register struct context *cx);
+int   k_fseek (register struct context *cx, long offset, int type);
+long  k_ftell (register struct context *cx);
+
+
+/*  fdcache.c  */
+long  m_fdate (char *fname);
+void  m_fdinit (int debug);
+int   fd_chksum (char *s);
+
+
+/*  fncache.c  */
+int   m_sysfile (char *lname, char *fname, int maxch);
+void  m_fninit (int debug);
+int   fn_chksum (char *s);
+int   fn_strncpy (char *out, char *in, int maxch);
+
+
+/*  host.c  */ 
+int   h_updatelibrary (char *library, char *flist[], int totfiles, 
+		char *xflags, char *irafdir);
+int   h_rebuildlibrary (char *library);
+int   h_incheck (char *file, char *dir);
+int   h_outcheck (char *file, char *dir, int clobber);
+void  h_getlibname (char *file, char *fname);
+int   h_xc (char *cmd);
+int   h_purge (char *dir);
+int   h_copyfile (char *oldfile, char *newfile);
+
+int   u_fcopy (char *old, char *new);
+int   h_movefile (char *old, char *new);
+int   u_fmove (char *old, char *new );
+
+int   add_sources (char *cmd, int maxch, char *flist[], 
+		int totfiles, int hostnames, int  *nsources);
+int   add_objects (char *cmd, int maxch, char *flist[], 
+		int totfiles, int hostnames);
+
+char *makeobj (char *fname);
+char *mkpath (char *module, char *directory, char *outstr);
+char *resolvefname (char *fname);
+int   h_direq (char *dir1, char *dir2);
+
+
+/*  pkg.c  */
+int   do_mkpkg (struct context *cx, int islib);
+int   scan_modlist (struct context *cx, int islib);
+void  parse_modname (char *modname, char *module, char *subdir, char *fname);
+void  parse_fname (char *path, char *dname, char *fname);
+struct context *push_context (register struct context *cx, char *module,
+                char *newdir, char *fname);
+struct context *pop_context (register struct context *cx);
+void  get_dependency_list (struct context *cx, char *module, 
+                char *dflist[], int maxfiles);
+int   up_to_date (struct context *cx, char *module, char *lname, 
+                char *dflist[], int *useobj);
+int   open_mkpkgfile (register struct context *cx);
+void  close_mkpkgfile (register struct context *cx);
+struct context *find_mkpkgfile ( struct context *head_cx, 
+                char *mkpkgfile, int level);
+int   search_mkpkgfile (register struct context *cx);
+
+
+/*  tok.c  */
+int   gettok (register struct context *cx, char *outstr, int maxch );
+
+void  do_osescape (register struct context *cx);
+void  do_ppdir (struct context *cx, char *token);
+void  do_if (struct context *cx, char *keyword);
+void  do_else (struct context *cx);
+void  do_endif (struct context *cx);
+void  do_end (struct context *cx);
+void  do_call (struct context *cx, char *program, int  islib);
+void  do_echo (struct context *cx, char *msg);
+int   do_goto (struct context *cx, char *symbol);
+int   do_include (struct context *cx, char *fname);
+void  do_omake (struct context *cx, char *fname);
+int   do_xc (struct context *cx);
+int   do_link (struct context *cx);
+int   do_generic (struct context *cx);
+void  do_set (struct context *cx);
+int   do_incheck (struct context *cx);
+int   do_outcheck (struct context *cx);
+int   do_copyfile (struct context *cx);
+int   do_movefile (struct context *cx);
+void  do_delete (struct context *cx);
+void  do_purge (struct context *cx, char *dname);
+
+int   getcmd (register struct context *cx, char *prefix, char *cmd, int maxch);
+char *getargs (register struct context *cx);
+int   getstr (register struct context *cx, char *outstr, int maxch, int delim);
+int   getkwvpair (register struct context *cx, char *symbol, char *value);
+int   getword (char **str, char *outstr, int maxch);
+void  putsym (char *name, char *value);
+char *getsym (char *name);
+char *mklower (char *s);
+
+
+/*  sflist.c  */
+int    sf_scanlist (struct context *cx);
+struct sfile *sf_dirsearch (char *dirname);
+struct sfile *sf_filesearch (struct sfile *sflist, char	*stname);
+void   sf_prune (register char *cp);
+
+
+/*  scanlib.c  */
+int   h_scanlibrary (char *library);
+long  h_ardate (char *fname);
+int   mlb_setdate (char *modname, long fdate);
+long  mlb_getdate (char *modname);
diff --git a/unix/boot/mkpkg/mkpkg.hlp b/unix/boot/mkpkg/mkpkg.hlp
new file mode 100644
index 00000000..39dd1163
--- /dev/null
+++ b/unix/boot/mkpkg/mkpkg.hlp
@@ -0,0 +1,626 @@
+.help mkpkg Mar90 "softools"
+.ih
+NAME
+mkpkg - make or update a package or library
+.ih
+USAGE
+mkpkg [switches] [module ...] [name=value ...]
+.ih
+ARGUMENTS
+.ls 10 \fB-d[ddd]\fR
+Debug mode.  Print detailed messages describing what \fImkpkg\fR is doing.
+There are four levels of debug messages, selected by repeating the "d"
+character in the switch, e.g., "-d" is level one, "-dd" is level two, and
+so on.  The debug messages get progressively more detailed as the debug level
+increases.  Debug mode automatically enables the verbose mode messages.
+.le
+.ls 10 \fB-f file\fR
+Set the name of the file to be interpreted (default: "mkpkg").
+The special value "stdin" (lower case) allows commands to be entered
+interactively from the standard input, e.g., for debugging \fImkpkg\fR.
+.le
+.ls 10 \fB-i\fR
+Ignore errors.  Execution continues even if an error occurs.  In most cases
+it does anyhow, so this switch has little effect at present.
+.le
+.ls 10 \fB-n\fR
+No execute.  Go through the motions, but do not touch any files.
+No execute mode automatically enables verbose mode (flag "-v").
+This switch should be used to verify new mkpkg files before execution.
+.le
+.ls 10 \fB-p \fIpkgname\fR
+Load the package environment for the named external package, e.g.,
+"mkpkg -p noao update".  If the same package is always specified
+the environment variable or logical name PKGENV may be defined at the
+host level to accomplish the same thing.  The package name \fImust\fR
+be specified when doing software development in an external or layered
+package.
+.le
+.ls 10 \fB-u\fR    [AOSVS/IRAF only]
+Forcibly update the dates of improperly dated library modules.  This option
+is used when a binary archive is restored on a machine which cannot restore
+the file modify dates.  In this case, all source file dates would appear to
+have been modified since the libraries were updated, causing all sources to
+be recompiled.  By running \fImkpkg\fR with the \fI-u\fR flag, one can update
+the library module dates without recompiling the associated files.  This is
+done by setting the date of each library module to be no older than the
+file \fIhlib$iraf.h\fR, which should be "touched" after the system has fully
+been restored to disk to mark the installation time.  Note that files which
+have been modified \fIsince\fR the system was restored to disk will still
+cause the affected library modules to be updated, even when the \fI-u\fR flag
+is specfied.
+.le
+.ls 10 \fB-v\fR
+Verbose mode.  A message is printed whenever a file is touched.
+Recommended when running large mkpkg jobs in batch mode.
+.le
+.ls 10 \fBmodule\fR
+The names of the module or modules (named entries in the "mkpkg" file) to be
+executed.  If no module is named the first module encountered is executed,
+unless a \fImkpkg\fR macro preprocessor directive at the beginning of the file
+specifies a different default action.
+.le
+.ls 10 \fBname=value [name=value...]\fR
+Enter the named symbol/value pair into the symbol table of the \fImkpkg\fR
+macro preprocessor.  The symbols \fIXFLAGS\fR (for the XC compiler) and
+\fILFLAGS\fR (for the linker) are predefined but may be redefined on the
+command line.  Case is ignored in symbol names for portability reasons.
+.le
+.ih
+DESCRIPTION
+The \fImkpkg\fR utility is used to make or update IRAF packages or libraries.
+\fIMkpkg\fR is used to bootstrap the IRAF system hence is implemented as
+a foreign task, callable either from within the IRAF environment or from the
+host system.  Usage is identical in either case (except that the details of
+when a particular argument may need to be quoted will vary depending on the
+command language used).  \fIMkpkg\fR is upwards compatible with the old
+\fImklib\fR utility.
+
+
+.tp 4
+1. \fBIntroduction\fR
+
+    \fIMkpkg\fR provides two major facilities: a library update capability and
+a macro preprocessor.  The macro preprocessor provides symbol definition and
+replacement, conditional execution, and a number of builtin commands.
+The usefulness of these facilities is enhanced by the ability of \fImkpkg\fR
+to update entire directory trees, or to enter the hierarchy of \fImkpkg\fR
+descriptors at any level.  For example, typing "mkpkg" in the root directory
+of IRAF will make or update the entire system, whereas in the "iraf$sys"
+directory \fImkpkg\fR will update only the system libraries, and in the
+"iraf$sys/fio" directory \fImkpkg\fR will update only the FIO portion of the
+system library "libsys.a".
+
+The \fImkpkg\fR utility is quite simple to use to maintain small packages
+or libraries, despite the complexity of the discussion which follows.
+The reader is encouraged to study several examples of working mkpkg-files
+before reading further; examples will be found throughout the IRAF system.
+The mkpkg files for applications packages tend to be very similar to one
+another, and it is quite possible to successfully copy and modify the
+mkpkg-file from another package without studying the reference information
+given here.
+
+
+.tp 4
+2. \fBLexical Conventions\fR
+
+    The lexical conventions employed in \fImkpkg\fR are those used throughout
+IRAF.  Comments may occur anywhere, begin with the character #, and extend
+to the end of the current line.  Blank lines are ignored virtually everywhere.
+Newline may be escaped with backslash to continue on the next line.
+All filenames are IRAF virtual filenames with the following extensions.
+
+
+.ks
+.nf
+	.a		object library
+	.c		C source
+	.e		executable (e.g., "x_package.e")
+	.f		Fortran source
+	.gc		generic C source
+	.gx		generic SPP source
+	.h		C or SPP header file
+	.inc		include file
+	.l		Lex source
+	.o		object file
+	.r		Ratfor source
+	.s		assembler source
+	.y		Yacc source
+.fi
+.ke
+
+
+Since \fImkpkg\fR is an IRAF utility it recognizes the major IRAF logical
+directories; these are summarized in the list below.  The IRAF (or UNIX)
+pathname convention is used to specify pathnames rooted in the current
+directory or a logical directory.
+
+
+.ks
+.nf
+	as$		where .s files go		host$as/
+	bin$		installed executables		iraf$bin/
+	dev$		device tables			iraf$dev/
+	hlib$		machdep header files		host$hlib/
+	host$		host system interface		[MACHDEP]
+	iraf$		the root directory of IRAF	[MACHDEP]
+	lib$		system library			iraf$lib/
+	math$		math sources			iraf$math/
+	pkg$		applications packages		iraf$pkg/
+	sys$		the VOS, system libraries	iraf$sys/
+	tmp$		where temporary files go	[MACHDEP]
+.fi
+.ke
+
+
+All other directories should be referenced by giving the path from either the
+current directory or from one of the system logical directories shown above.
+For example, "pkg$system/" is the root directory of the SYSTEM package,
+and ".." is the directory one level up from the current directory.
+
+
+.tp 4
+3. \fBMaintaining Libraries with MKPKG\fR
+
+    Libraries are described by a \fBmember list\fR module in the "mkpkg" file.
+The syntax of a library member list module is shown below.  Note that the
+\fBmkpkg\fR module name for a library member list module is the same as the
+name of the actual library, hence must end with the extension ".a".
+
+
+.ks
+.nf
+	libname.a:
+		member1		dep1 dep2 ... depN
+		member2		dep1 dep2 ... depN
+		  ...
+		memberN		dep1 dep2 ... depN
+		;
+.fi
+.ke
+
+
+Here, "libname.a" is the IRAF virtual filename of the library (regardless of
+what directory it resides in), "memberN" is the name of a source file which
+may contain any number of actual library object modules, and "depN" is the
+name of a file upon which the named member depends.  If any of the named
+dependency files is newer than the corresponding member source file, or if
+the member source file is newer than the compiled library object module,
+the source file is recompiled and replaced in the library.  Both source
+files and dependency files may reside in remote directories.  The names of
+dependency files in system libraries should be enclosed in <> delimiters,
+e.g., "<fset.h>".  Each member must be described on a separate line.
+
+If the library being updated does not reside in the current directory
+(directory from which the "mkpkg" command was entered) then the library must
+be "checked out" of the remote directory before it can be updated, and checked
+back in when updating is complete.  These operations are performed by macro
+preprocessor directives, e.g.:
+
+
+.ks
+.nf
+	$checkout libsys.a lib$
+	$update   libsys.a
+	$checkin  libsys.a lib$
+	$exit
+
+	libsys.a:
+		@symtab		# update libsys.a in ./symtab
+		brktime.x	<time.h>
+		environ.x	environ.com environ.h <ctype.h>\
+				<fset.h> <knet.h>
+		main.x		<clset.h> <config.h> <ctype.h>\
+				<error.h> <fset.h> <knet.h>\
+				<printf.h> <xwhen.h>
+		onentry.x	<clset.h> <fset.h> <knet.h>
+		spline.x	<math.h> <math/interp.h>
+		;
+.fi
+.ke
+
+
+Note that the checkout operation is required only in the directory from which
+the "mkpkg" command was entered, since the library has already been checked
+out when the mkpkg-file in a subdirectory is called to update its portion
+of the library (as in the "@symtab" in the example above).  The checkout
+commands should however be included in each mkpkg-file in a hierarchy in such
+a way that the library will be automatically checked out and back in if
+\fImkpkg\fR is run from that directory.  The checkout commands are ignored
+if the mkpkg-file is entered when updating the library from a higher level,
+because in that case \fImkpkg\fR will search for the named entry for the
+library being updated, ignoring the remainder of the mkpkg-file.
+
+Sometimes it is necessary or desirable to break the library member list up
+into separate modules within the same mkpkg-file, e.g., to temporarily
+change the value of the symbol XFLAGS when compiling certain modules.
+To do this use the "@" indirection operator in the primary module list to
+reference a named sublist, as in the example below.  Normal indirection
+cannot be used unless the sublist resides in a subdirectory or in a different
+file in the current directory, e.g., "@./mki2", since a single mkpkg-file
+cannot contain two modules with the same name.  The same restrictions apply
+to the \fI$update\fR operator.
+
+
+.ks
+.nf
+	libpkg.a:
+		@(i2)
+		alpha.x
+		beta.x
+		zeta.f
+		;
+	i2:
+		$set	XFLAGS = "-cO -i2"
+		gamma.f
+		delta.f
+		;
+.fi
+.ke
+
+
+In the example above five object modules are to be updated in the library
+"libpkg.a".  The files listed in module "i2", if out of date, will be compiled
+with the nonstandard XFLAGS (compiler flags) specified by the \fI$set\fR
+statement shown.
+
+
+.tp 4
+4. \fBThe MKPKG Macro Preprocessor\fR
+
+    The \fImkpkg\fR macro preprocessor provides a simple recursive symbol
+definition and replacement facility, an include file facility, conditional
+execution facilities, an OS escape facility, and a number of builtin directives.
+The names of the preprocessor directives always begin with a dollar sign;
+whitespace is not permitted between the dollar sign and the remainder of the
+name.  Several preprocessor directives may be given on one line if desired.
+Preprocessor directives are executed as they are encountered, and may appear
+anywhere, even in the member list for a library.
+
+
+.tp 4
+4.1 Symbol Replacement
+
+    Symbol substitution in the \fImkpkg\fR macro preprocessor is carried out
+at the character level rather than at the token level, allowing macro expansion
+within tokens, quoted strings, or OS escape commands.  Macros are recursively
+expanded but may not have arguments.
+
+Macros may be defined on the \fBmkpkg\fR command line, in the argument list
+to a \fB$call\fR or \fB$update\fR directive (see below), in an include file
+referenced with the \fB$include\fR directive, or in a \fB$set\fR directive.
+All symbols are global and hence available to all lower level modules,
+but symbols are automatically discarded whenever a module exits, hence cannot
+affect higher level modules.  A local symbol may redefine a previously
+defined symbol.  The IRAF and host system environment is treated as an
+extension of the \fBmkpkg\fR symbol table, i.e., a logical directory such
+as "iraf" may be referenced like a locally defined symbol.
+
+Macro replacement occurs only when explicitly indicated in the input text,
+as in the following example, which prints the pathname of the
+\fBdev$graphcap\fR file on the \fBmkpkg\fR standard output.  The sequence
+"$(" triggers macro substitution.  The value of a symbol may be obtained
+interactively from the standard input by adding a question mark after the
+left parenthesis, i.e., "$(?terminal)" (this does not work with the -f stdin
+flag).  The contents of a file may be included using the notation
+"$(@\fIfile\fR)".   Note that case is ignored in macro names; by convention,
+logical directories are normally given in lower case, and locally defined
+symbols in upper case.
+
+
+.ks
+.nf
+	$echo $(dev)graphcap
+	!xc $(XFLAGS) filea.x fileb.x
+.fi
+.ke
+
+
+Symbols are most commonly defined locally with the \fB$set\fR directive.
+The \fB$include\fR directive is useful for sharing symbols amongst different
+modules, or for isolating any machine dependent definitions in a separate
+file.  The IRAF \fBmkpkg\fR system include file \fBhlib$mkpkg.inc\fR is
+automatically included whenever \fImkpkg\fR is run.
+.ls 4
+.ls \fB$set\fR symbol = value
+Enter the named symbol into the symbol table with the given string value.
+Any existing symbol will be silently redefined.  Symbols defined within a
+module are discarded when the module exits.
+.le
+.ls \fB$include\fR filename
+Read commands (e.g., \fB$set\fR directives) from the named include file.
+The include filename may be any legal virtual filename, but only the
+major logical directories are recognized, e.g., "iraf$", "host$", "hlib$",
+"lib$", "pkg$", and so on.
+.le
+.le
+
+
+The use of the \fB$set\fR directive is illustrated in the example below.
+Note the doubling of the preprocessor meta-character to avoid macro expansion
+when entering the value of the GEN macro into the symbol table.  The sequence
+"$$" is replaced by a single "$" whenever it is encountered in the input
+stream.
+
+
+.ks
+.nf
+	$set GFLAGS = "-k -t silrdx -p ak/"
+	$set GEN    = "$generic $$(GFLAGS)"
+
+	ifolder (amulr.x, amul.x) $(GEN) amul.x $endif
+.fi
+.ke
+
+
+.tp 4
+4.2 Conditional Execution
+
+    Conditional control flow is implemented by the \fB$if\fR directives
+introduced in the last example and described below.  The character "n" may
+be inserted after the "$if" prefix of any directive to negate the sense of
+the test, e.g., "$ifndef" tests whether the named symbol does not exist.
+Nesting is permitted.
+.ls 4
+.ls \fB$ifdef\fR (symbol [, symbol, ...])
+.sp
+Test for the existence of one of the named symbols.
+.le
+.ls \fB$ifeq\fR (symbol, value [, value,...])
+.sp
+Test if the value of the named symbol matches one of the listed value strings.
+.le
+.ls \fB$iferr\fR
+.sp
+Test for an error return from the last directive executed which touched
+a file.
+.le
+.ls \fB$iffile\fR (file [, file,...])
+.sp
+Test for the existence of any of the named files.
+.le
+.ls \fB$ifnewer\fR (file, filea)
+.in -4
+\fB$ifnewer\fR (file: filea [, fileb, ...])
+.in 4
+.sp
+Test if the named file is newer (has been modified more recently) than
+any of the named files to the right.  The colon syntax may be used for
+clarity when comparing one file to many, but a comma will do.
+.le
+.ls \fB$ifolder\fR (file, filea)
+.in -4
+\fB$ifolder\fR (file: filea [, fileb, ...])
+.in 4
+.sp
+Test if the named file is older than any of the named files.
+.le
+.ls \fB$else\fR
+.sp
+Marks the \fIelse\fR clause of an \fIif\fR statement.  The \fIelse-if\fR
+construct is implemented as "$else $if", i.e., as a combination of the two
+more primitive constructs.
+.le
+.ls \fB$endif\fR
+.sp
+Terminates a $if or $if-$else statement.
+.le
+.ls \fB$end\fR
+.sp
+Terminates an arbitrary number of $if or $if-$else statements.  This is most
+useful for terminating a long list of $if-$else clauses, where the alternative
+would be a long string of $endif directives.
+.le
+.ls \fB$exit\fR
+Terminate the current program; equivalent to a semicolon, but the latter
+is normally used only at the end of the program to match the colon at the
+beginning, whereas \fB$exit\fR is used in conditionals.
+.le
+.le
+
+
+.tp 4
+4.3 Calling Modules
+
+    The following preprocessor directives are available for calling \fImkpkg\fR
+modules or altering the normal flow of control.
+.ls
+.ls \fB$call\fR module[@subdir[/file]] [name=value] [name=value...]
+.sp
+Call the named mkpkg-file module as a subroutine.  In most cases the called
+module will be in the current mkpkg-file, but the full module name syntax
+permits the module to be in any file of any subdirectory ("./file" references
+a different file in the current directory).  Arguments may be passed to
+the called module using the symbol definition facility; any symbols
+defined in this fashion are available to any modules called in turn by
+the called module, but the symbols are discarded when the called module returns.
+.le
+.ls \fB$update\fR module[@subdir[/file]] [name=value] [name=value...]
+.sp
+Identical to \fB$call\fR except that the named module is understood to
+be a library member list.  The current value of the symbol XFLAGS is used
+if XC is called to compile any files.  If the named library does not exist
+one will be created (a warning message is issued).
+.le
+.ls \fB$goto\fR label
+.sp
+Causes execution to resume at the line following the indicated label.
+The syntax of a goto label is identical to that of a mkpkg-file module name,
+i.e., a line starting with the given name followed by a colon.
+The \fI$goto\fR statement automatically cancels any \fI$if\fR nesting.
+.le
+.le
+
+
+.tp 4
+4.4 Preprocessor Directives
+
+    The remaining preprocessor directives are described below in alphabetical
+order.  Additional capability is available via OS escapes, provided the
+resultant machine dependence is acceptable.
+.ls
+.ls \fB$echo\fR message
+.sp
+Print the given message string on the standard output.  The string must be
+quoted if it contains any spaces.
+.le
+.ls \fB$checkout\fR file directory
+.sp
+Check the named file out of the indicated directory.  The checkout operation
+makes the file accessible as if it were in the current directory; checkout
+is implemented either as a symbolic link or as a physical file copy depending
+upon the host system.  The referenced directory may be a logical directory,
+e.g., "lib$", or a path, e.g, "pkg$images/".  Checkout is not disabled by
+the "-n" flag.
+.le
+.ls \fB$checkin\fR file directory
+.sp
+Check the named file back into the indicated directory.  The checkin operation
+is implemented either as a remove link or copy and delete depending upon the
+host system.  Checkin is not disabled by the "-n" flag.
+.le
+.ls \fB$copy\fR filea fileb
+.sp
+Make a copy \fIfileb\fR of the existing file \fIfilea\fR.  On a UNIX host
+the copy operation will preserve the file modify date if the file is a library
+(to avoid the "symbol table out of date" syndrome).
+.le
+.ls \fB$delete\fR file [file ...]
+.sp
+Delete the named file or files.
+.le
+.ls \fB$generic\fR [-k] [-p prefix] [-t types] [-o root] files
+.sp
+Run the generic preprocessor on the named files.  The generic preprocessor
+is an IRAF bootstrap utility and may not be available on non-UNIX hosts.
+.le
+.ls \fB$link\fR [switches] file1 file2 ... fileN [-o file.e]
+.sp
+Call XC with the given argument list to link the indicated files and libraries.
+The value of the symbol LFLAGS (default value the null string) is automatically
+inserted at the beginning of the command line.  This is equivalent to
+"!xc $(LFLAGS) ...".
+.le
+.ls \fB$move\fR file destination
+.sp
+Move the named file to the indicated directory, or rename the file in the
+current directory.
+.le
+.ls \fB$omake\fR file [dep1] [dep2 ...]
+.sp
+Compile the named source file if it does not have a corresponding object file
+in the current directory, if the object file is older, or if any of the
+listed dependency files are newer (or not found).  The current value of the
+symbol XFLAGS is used if XC is called to compile the file.
+.le
+.ls \fB$purge\fR directory
+.sp
+Delete all old versions of all files in the named directory.  Nothing is done
+if the system does not support multiple file versions.
+.le
+.ls \fB$special\fR directory : filelist ;
+.sp
+Add one or more files to the special file list for the host system.  This is
+a system facility, not intended for use in applications \fImkpkg\fR files.
+The special file list is a list of all source files needing special processing
+for the local host system.  Examples of special files are files which are
+optimized in assembler (or some other nonstandard language), or files which
+must be compiled in a special way to get around bugs in a host compiler.
+The special file list makes it possible to flag arbitrary files for special
+processing, without having to modify the standard software distribution.
+In the IRAF system, the special file list is defined in the file
+"hlib$mkpkg.sf" which is included automatically by "hlib$mkpkg.inc" whenever
+\fImkpkg\fR is run.
+
+The syntax of a \fIfilelist\fR entry is as follows:
+
+	modname source_file mkobj_command
+
+where \fImodname\fR is the filename of a library module as it appears in a
+library module list for the named directory, \fIsource_file\fR is the virtual
+pathname of the source file to be used in lieu of the standard portable
+source file \fImodname\fR, and \fImkobj_command\fR is the \fImkpkg\fR command
+(e.g., $xc or an OS escape) to be executed to compile the named module.
+The character "&" appearing in either the source file name or mkobj command
+is replaced by \fImodname\fR.  If the \fImkobj_command\fR is omitted the
+specified source file will be compiled with $XC using the current value of
+XFLAGS.
+.le
+.ls \fB$xc\fR [switches] file1 file2 ... fileN
+.sp
+Call the XC compiler to compile the named files.  Note that the value of
+the symbol XFLAGS is \fInot\fR used when XC is explicitly called in this
+fashion (XFLAGS is used by \fB$update\fR and \fB$omake\fR).
+.le
+.ls \fB$debug\fR [on|off]
+.sp
+Turn debug mode on or off.  If no argument is supplied debug mode is turned
+on.  Turning on debug mode automatically enables verbose mode.
+.le
+.ls \fB$verbose\fR [on|off]
+.sp
+Turn verbose mode on or off.  If no argument is supplied verbose mode is turned
+on.
+.le
+.le
+
+
+.tp 4
+5. Error Recovery
+
+    \fBMkpkg\fR is implemented in such a way that it is restartable.  If a mkpkg
+operation terminates prematurely for some reason, e.g., because of a compile
+error, execution error (such as cannot find the mkpkgfile in a subdirectory),
+interrupt, etc., then the mkpkg command can be repeated after correcting
+the error, without repeating the operations already completed.  If \fBmkpkg\fR
+is interrupted it may leave checked out files, objects compiled but not yet
+updated in a library, etc. lying about, but this is harmless and the
+intermediate files will be cleaned up when the errors have been corrected
+and the run successfully completes.
+
+.ih
+EXAMPLES
+Update the current package.
+
+	cl> mkpkg
+
+Update the package library but do not relink.
+
+	cl> mkpkg libpkg.a
+
+Make a listing of the package.
+
+	cl> mkpkg listing
+
+
+.ks
+.nf
+Sample mkpkg-file for the above commands:
+
+
+	# Make my package.
+
+	$call relink
+	$exit
+
+	relink:
+		$update	libpkg.a
+		$omake	x_mypkg.x
+		$link   x_mypkg.o -lxtools
+		;
+
+	libpkg.a:
+		task1.x		pkg.h
+		task2.x
+		filea.x		pkg.com pkg.h <fset.h>
+		fileb.x		pkg.com
+		;
+
+	listing:
+		!pr task1.x task2.x file[ab].x | vpr -Pvup
+		;
+.fi
+.ke
+.ih
+SEE ALSO
+xc, generic, softools package
diff --git a/unix/boot/mkpkg/mkpkg.sh b/unix/boot/mkpkg/mkpkg.sh
new file mode 100644
index 00000000..a565cd70
--- /dev/null
+++ b/unix/boot/mkpkg/mkpkg.sh
@@ -0,0 +1,9 @@
+# Bootstrap MKPKG.
+
+$CC -c $HSI_CF	char.c fdcache.c fncache.c host.c main.c pkg.c scanlib.c\
+		    sflist.c tok.c
+$CC $HSI_LF	main.o char.o fdcache.o fncache.o host.o pkg.o scanlib.o\
+		    sflist.o tok.o $HSI_LIBS -o mkpkg.e
+
+mv -f mkpkg.e ../../hlib
+rm *.o
diff --git a/unix/boot/mkpkg/pkg.c b/unix/boot/mkpkg/pkg.c
new file mode 100644
index 00000000..a8875bc3
--- /dev/null
+++ b/unix/boot/mkpkg/pkg.c
@@ -0,0 +1,902 @@
+/* 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>
+
+#define	import_spp
+#define	import_error
+#include <iraf.h>
+
+#include "mkpkg.h"
+#include "extern.h"
+#include "../bootProto.h"
+
+
+/* DO_MKPKG -- Open the mkpkg file and scan it for the named program.  A program
+ * may be either a sequence of preprocessor directives or the module list for
+ * a library, as indicated by the ISLIB flag.  In the case of a library build
+ * up a list of library modules needing updating, and replace these modules
+ * in the library.
+ */
+int
+do_mkpkg (
+  struct context *cx,		/* current context	*/
+  int	islib 			/* update a library?	*/
+)
+{
+	if (cx->mkpkgfile[0] == EOS)
+	    strcpy (cx->mkpkgfile, MKPKGFILE);
+
+	if (debug) {
+	    printf ("do_mkpkg (file=%s, library=%s, islib=%d)\n",
+		cx->mkpkgfile, cx->library, islib);
+	    fflush (stdout);
+	}
+
+	if (open_mkpkgfile (cx) == ERR) {
+	    char    fname[SZ_PATHNAME+1];
+	    struct  context *save_cx;
+
+	    save_cx = topcx;
+	    if (cx->prev)
+		topcx = cx->prev;
+
+	    sprintf (fname, "%s%s", cx->curdir, cx->mkpkgfile);
+	    warns ("cannot open `%s'", fname);
+
+	    topcx = save_cx;
+	    return (ERR);
+	}
+
+	/* Search the mkpkg file for the module list for the named library,
+	 * or the first module list encountered if no library is named.
+	 * Any number of preprocessor directives may be executed while
+	 * searching; in particular, $EXIT will terminate the search,
+	 * causing ERR to be returned by the search procedure to indicate
+	 * that no module list was found.
+	 */
+	if (search_mkpkgfile (cx) == ERR) {
+	    if (cx->library[0] != EOS) {
+		warns ("no entry in mkpkg file for `%s'", cx->library);
+		return (ERR);
+	    } else {
+		/* Presumably we just executed a bunch of preprocessor
+		 * commands and there is no library to update, or it was
+		 * already updated by the commands just executed.
+		 */
+		return (OK);
+	    }
+	}
+
+	/* The mkpkg file is open and positioned to the entry for a library
+	 * (or any other sequence of commands with the given name).  Update
+	 * the named library, close the mkpkgfile, and exit.
+	 */
+	exit_status = scan_modlist (cx, islib);
+	close_mkpkgfile (cx);
+
+	return (exit_status);
+}
+
+
+/* SCAN_MODLIST -- Called when positioned to the module list for a library.
+ * Scan the module list and compare file and library module dates, building
+ * up a list of files to be updated.  If any files were found which need
+ * updating recompile them and replace them in the library.  Call the rebuild
+ * procedure when done to perform any library rebuild or cleanup operations
+ * necessary on the local system.
+ */
+int
+scan_modlist (
+  struct context *cx,		/* current mkpkg context	*/
+  int	islib
+)
+{
+	char	token[SZ_FNAME+1];
+	char	*dflist[MAX_DEPFILES+1];
+	struct	sfile *sflist;
+	int	root_modlist;
+	int	tok;
+
+	/* This is for the case "@(module)" in a library member list, indicating
+	 * that the named module is a library member list for the current
+	 * library, even though the module name is not the same as the library
+	 * name.  For searching purposes the cl->library field contains the
+	 * module name until we get here, and now we must overwrite this with
+	 * the name of the library being updated.
+	 */
+	if (islib && cx->sublib)
+	    strcpy (cx->library, cx->prev->library);
+
+	if (debug) {
+	    printf ("scan_modlist (file=%s, line=%d, library=%s, islib=%d)\n",
+		cx->mkpkgfile, cx->lineno, cx->library, islib);
+	    fflush (stdout);
+	}
+
+	/* Check if this directory contains any files needing special
+	 * processing.
+	 */
+	sflist = sf_dirsearch (cx->dirpath);
+
+	if (cx->prev)
+	    root_modlist = (strcmp (cx->library, cx->prev->library) != 0);
+	else
+	    root_modlist = 1;
+
+	if (islib && root_modlist) {
+	    /* Save the pathname of the library in the context descriptor.
+	     * We may be changing the current directory later, so a pathname
+	     * is required.
+	     */
+	    os_fpathname (cx->library, cx->libpath, SZ_PATHNAME);
+	    if (debug) {
+		printf ("pathname of `%s' is `%s'\n", cx->library,
+		    cx->libpath);
+		fflush (stdout);
+	    }
+
+	    /* Scan the library and build up a list of modules and their dates.
+	     * This will create a new library if necessary.  If there are any
+	     * fatal warns the scan library routine prints its own error
+	     * messages and we return, since no further processing of the
+	     * library is possible.
+	     */
+	    if ((exit_status = h_scanlibrary (cx->library)) != OK) {
+		warns ("error reading library file `%s'", cx->library);
+		return (ERR);
+	    }
+	}
+
+	/* Scan the module list in the mkpkg file.  An "@subdir" reference
+	 * causes us to push a new context and continue scanning the entry
+	 * for the same library in a subdirectory.  Any number of preprocessor
+	 * directives may be executed while we are scanning the module list.
+	 * For each module in the list, test the file dates and add the name
+	 * to the file list if the module has to be updated.
+	 */
+	for (;;) {
+next_:	    tok = gettok (cx, token, SZ_FNAME);
+
+	    if (tok == TOK_NEWLINE) {
+		; /* ignore blank lines */
+
+	    } else if (islib && tok == TOK_FNAME && token[0] != SUBDIR_CHAR) {
+		/* Check if the named module is up to date, and if not,
+		 * add to the file list for the library.  The useobj flag
+		 * is set if the module is not up to date, but the object
+		 * file has already been compiled and should be replaced
+		 * in the library.
+		 */
+		char    srcname[SZ_PATHNAME+1], modname[SZ_PATHNAME+1];
+		char    dname[SZ_FNAME+1], fname[SZ_FNAME+1];
+		struct	sfile *sfp;
+		int	useobj;
+
+		strcpy (modname, token);
+
+		/* If this directory has any files needing special processing,
+		 * determine if this is such a file, and if so obtain the name
+		 * of the actual source file to be used.
+		 */
+		sfp = sf_filesearch (sflist, modname);
+		strcpy (srcname, sfp ? sfp->sf_sfname : modname);
+		if (sfp && debug) {
+		    printf ("module %s on special file list: ", modname);
+		    if (sfp->sf_mkobj[0])
+			printf ("mkobj=`%s'\n", sfp->sf_mkobj);
+		    else
+			printf ("src=%s\n", srcname);
+		    fflush (stdout);
+		}
+
+		/* Check that the regular, standard source file has not been
+		 * modified more recently than the special file, if any.
+		 */
+		if (sfp && debug && os_fdate(modname) > os_fdate(srcname))
+		    warns ("special file for %s is out of date", modname);
+
+		/* Break filename into the logical directory and local
+		 * filenames; if file is remote a local copy will be
+		 * created temporarily (see below).  Get list of files
+		 * upon which the module is dependent, if any.
+		 */
+		parse_fname (srcname, dname, fname);
+		get_dependency_list (cx, modname, dflist, MAX_DEPFILES);
+
+		if (!up_to_date (cx, srcname, fname, dflist, &useobj)) {
+
+		    /* If file is remote add its name to the remote file list
+		     * and "checkout" the file, making it accessible in the
+		     * current directory.  The file will be checked back in
+		     * after the library is updated.  It may not be necessary
+		     * to compile the file locally, but it is too risky to
+		     * predict what the host system will do when asked to
+		     * compile a file resident in a remote directory.
+		     */
+		    if (dname[0]) {
+			int     clobber, i;
+
+			for (i=0;  i < cx->nrfiles;  i++)
+			    if (strcmp (fname, cx->rflist[i]) == 0) {
+				/* Multiple modules map to the same remote
+				 * source file, which has already been checked
+				 * out.  Skip duplicate references to the same
+				 * source file.
+				 */
+				goto next_;
+			    }
+			cx->rflist[cx->nrfiles++] = putstr (fname);
+			h_outcheck (fname, dname, clobber=NO);
+		    }
+
+		    /* If the module needs special processing and a mkobj
+		     * command string was given, but the source file has not
+		     * yet been compiled, push the command back into the input
+		     * stream to compile the source, and set the useobj flag
+		     * to defeat recompilation of this module.
+		     */
+		    if (sfp && sfp->sf_mkobj[0]) {
+			if (useobj) {
+			    warns ("module %s has already been compiled",
+				modname);
+			} else {
+			    m_pushstr (cx, "\n");
+			    m_pushstr (cx, sfp->sf_mkobj);
+			    useobj++;
+			}
+		    }
+
+		    /* Add the local filename to the list of files to be
+		     * updated.
+		     */
+		    cx->flist[cx->nfiles++] =
+			putstr (useobj ? makeobj(fname) : fname);
+
+		    if (debug) {
+			printf ("add %s to file list for %s\n",
+			    cx->flist[cx->nfiles-1], cx->library);
+			fflush (stdout);
+		    }
+
+		    if (cx->nfiles > MAX_FILES)
+			fatals ("too many modules listed for library `%s'",
+			    cx->library);
+		}
+
+	    } else if (tok == TOK_FNAME && token[0] == SUBDIR_CHAR) {
+		/* Push a new context, open mkpkg file and continue scanning
+		 * in the new subdirectory.
+		 */
+		struct	context *ncx;
+		char	module[SZ_FNAME+1];
+		char	subdir[SZ_FNAME+1];
+		char	fname[SZ_FNAME+1];
+
+		/* Parse the "module@subdir/fname" string. */
+		parse_modname (token, module, subdir, fname);
+
+		/* Push a new context and start over; recursive call.  May
+		 * "reopen" (soft) the current mkpkg file or the mkpkg in a
+		 * subdirectory.
+		 */
+		if ((ncx = push_context (cx, module, subdir, fname)) == NULL)
+		    exit_status = ERR;
+		else {
+		    exit_status = do_mkpkg (ncx, islib);
+		    cx = pop_context (ncx);
+		}
+
+		if (exit_status != OK && !ignore)
+		    return (exit_status);
+
+	    } else if (tok == TOK_END || tok == 0) {
+		/* We have reached the end of the current module list (;),
+		 * executed a $EXIT, or seen EOF on the mkpkg file.  If the
+		 * file list is nonempty update the current library, restore
+		 * the previous context, and return (from the do_mkpkg, above).
+		 */
+
+		/* The file list now contains the names of all the files that
+		 * need to be updated.  Compile and update the archive.
+		 */
+		if (islib && cx->nfiles == 0) {
+		    /* No modules were found that need updating.
+		     */
+		    if (cx->prev != NULL && cx->level > cx->prev->level) {
+			char	dirname[SZ_FNAME+1];
+			char	*ip, *op;
+
+			/* Prettify the directory name.
+			 */
+			for (ip=cx->curdir, op=dirname;  (*op = *ip++);  op++)
+			    ;
+			if (*(op-1) == '/')
+			    *(op-1) = EOS;
+
+			printf ("Subdirectory %s is up to date\n", dirname);
+			fflush (stdout);
+		    }
+		} else if (islib) {
+		    char    dname[SZ_FNAME+1], fname[SZ_FNAME+1];
+		    int     i;
+
+		    /* Compile the modules and update the library.
+		     */
+		    exit_status = h_updatelibrary (cx->libpath,
+			cx->flist, cx->nfiles, getsym(XFLAGS), irafdir);
+		    if (exit_status == INTERRUPT)
+			fatals ("<ctrl/c> interrupt %s", cx->library);
+		    cx->totfiles += cx->nfiles;
+
+		    /* Delete any local copies of (or links to) files that were
+		     * checked out of a remote directory.
+		     */
+		    for (i=0;  i < cx->nrfiles;  i++) {
+			parse_fname (cx->rflist[i], dname, fname);
+			h_incheck (fname, NULL);
+		    }
+		}
+
+		/* If the module list just terminated was a partial list,
+		 * return immediately to continue processing the next higher
+		 * level module list for the same library.
+		 */
+		if (root_modlist && islib)
+		    break;
+		else {
+		    if (debug) {
+			printf ("not root library; return to higher level\n");
+			fflush (stdout);
+		    }
+		    return (exit_status);
+		}
+
+	    } else if (islib)
+		warns ("bad token `%s' in library module list", token);
+	}
+
+	/* We get here when the end of the root module list for a library has
+	 * been reached (but only if the module being processed is a library
+	 * list).
+	 */
+	if (cx->totfiles == 0 && !forceupdate) {
+	    printf ("Library %s is up to date\n", cx->library);
+	    fflush (stdout);
+	} else if (exit_status == OK || ignore) {
+	    /* Run the system dependent library rebuild operator.
+	     */
+	    if ((exit_status = h_rebuildlibrary (cx->library)) == INTERRUPT)
+		fatals ("<ctrl/c> interrupt %s", cx->library);
+	    printf ("Updated %d files in %s\n", cx->totfiles, cx->library);
+	    fflush (stdout);
+	}
+
+	return (exit_status);
+}
+
+
+/* PARSE_MODNAME -- Parse a module reference into its component parts.
+ * 
+ * Syntax:	module@subdir/fname
+ *	or	@(module)subdir/fname
+ */
+void
+parse_modname (
+  char	*modname,		/* "module@subdir/fname"	*/
+  char	*module,		/* receives module		*/
+  char	*subdir,		/* receives subdir		*/
+  char	*fname 			/* receives fname		*/
+)
+{
+	register char	*ip, *op;
+	register int	ch;
+	char	*path;
+
+	for (ip=modname;  isspace (*ip);  ip++)
+	    ;
+
+	/* Module name XXX@ */
+	op = module;
+	for (;  (*op = *ip) && *op != '@';  op++, ip++)
+	    ;
+	*op = EOS;
+
+	/* Module name @(XXX) */
+	if (op == module && *ip == '@' && *(ip+1) == '(') {
+	    for (ip++;  (*op = *ip) && *op != ')';  op++, ip++)
+		;
+	    *(op+1) = EOS;
+	    if (*ip == ')')
+		ip++;
+	}
+
+	if (*ip == '@')
+	    ip++;
+
+	/* Get subdirectory and mkpkg file names.  If a simple identifier is
+	 * given it is taken to be the name of the subdirectory, otherwise
+	 * ($ or / found) the given pathname is parsed.
+	 */
+	fname[0] = EOS;
+	for (op=subdir, path=ip;  (ch = *op = *ip++);  op++)
+	    if (ch == '$' || ch == '/') {
+		if (*(op-1) == '\\')
+		    *--op = ch;
+		else {
+		    parse_fname (path, subdir, fname);
+		    break;
+		}
+	    }
+}
+
+
+/* PARSE_FNAME -- Return logical directory and filename fields of a filename.
+ */
+void
+parse_fname (
+  char	*path,			/* input filename		*/
+  char	*dname,			/* receives directory name	*/
+  char	*fname 			/* receives file name		*/
+)
+{
+	register char	*ip, *op;
+	register char	*delim;
+
+	delim = NULL;
+	for (ip=path, op=fname;  (*op = *ip);  op++, ip++)
+	    if (*ip == '$' || *ip == '/') {
+		if (*(ip-1) == '\\')
+		    *(--op) = *ip;
+		else
+		    delim = ip;
+	    }
+
+	if (delim == NULL) {
+	    dname[0] = EOS;
+	    return;		/* no directory name */
+	}
+
+	for (ip=path, op=dname;  ip <= delim;  )
+	    *op++ = *ip++;
+	*op = EOS;
+
+	for (op=fname;  (*op++ = *ip++);  )
+	    ;
+}
+
+
+/* PUSH_CONTEXT -- Push a new context, i.e., save the current context in the
+ * current context descriptor, allocate and initialize a new context
+ * descriptor.  Set up the new context, including the current directory,
+ * but do not open the new mkpkgfile.
+ */
+struct context *
+push_context (
+  register struct context *cx,		/* current context	*/
+  char	*module,			/* new module (library)	*/
+  char	*newdir,			/* new directory	*/
+  char	*fname 				/* mkpkgfile name	*/
+)
+{
+	register struct context *ncx;
+
+	if (debug) {
+	    printf ("push_context (module=%s, newdir=%s, fname=%s)\n",
+		module, newdir, fname);
+	    fflush (stdout);
+	}
+
+	/* Update old context.
+	 */
+	cx->old_nsymbols = nsymbols;
+	cx->old_iflev = iflev;
+	cx->old_cp = cp;
+
+	if (cx->fp && cx->fp != stdin)
+	    cx->fpos = k_ftell (cx);
+
+	/* Initialize new context.
+	 */
+	ncx = (struct context *) malloc (sizeof (struct context));
+	if (ncx == NULL)
+	    fatals ("out of memory in `%s'", fname);
+
+	*ncx = *cx;		/* copy old struct to new */
+
+	ncx->pb		= NULL;
+	ncx->prev	= cx;
+	ncx->totfiles	= 0;
+	ncx->nfiles	= 0;
+	ncx->nrfiles	= 0;
+	ncx->pbchar	= 0;
+	ncx->pushback	= 0;
+	ncx->sublib	= 0;
+
+	/* In the case of a (XXX) module name reference to a module containing
+	 * a sub-member list of the current library, strip the () and set the
+	 * sublib flag for scanlibrary().
+	 */
+	if (module[0]) {
+	    if (strcmp (module, "BOF") == 0) {
+		ncx->library[0] = EOS;
+	    } else if (module[0] == '(') {
+		char     *ip, *op;
+
+		for (ip=module+1, op=ncx->library;  (*op = *ip++);  op++)
+		    if (*op == ')')
+			break;
+		*op = EOS;
+		ncx->sublib = YES;
+	    } else
+		strcpy (ncx->library, module);
+	}
+
+	if (newdir[0] && strcmp(newdir,".") != 0 && strcmp(newdir,"./") != 0) {
+	    /* Record the directory path for printed output.  Note that this
+	     * will be a conventional pathname only if each "newdir" reference
+	     * is to a subdirectory.
+	     */
+	    strcat (ncx->curdir, newdir);
+	    strcat (ncx->curdir, "/");
+
+	    if (debug) {
+		printf ("change directory to `%s'\n", newdir);
+		fflush (stdout);
+	    }
+
+	    if (os_chdir (newdir) == ERR) {
+		warns ("cannot access subdirectory `%s'", newdir);
+		free (ncx);
+		return (NULL);
+	    } else {
+		os_fpathname ("", ncx->dirpath, SZ_PATHNAME);
+		ncx->level++;
+	    }
+
+	    /* Initialize the file date cache, since the filenames therein
+	     * often reference the current directory.
+	     */
+	    m_fdinit (debug);
+	}
+
+	if (fname[0])
+	    strcpy (ncx->mkpkgfile, fname);
+
+	return (topcx = ncx);
+}
+
+
+/* POP_CONTEXT -- Restore the previous context, including the current
+ * directory.
+ */
+struct context *
+pop_context (
+  register struct context *cx 		/* current context	*/
+)
+{
+	register struct context *pcx;
+	int     root_modlist;
+	int	level;
+
+	if (debug) {
+	    printf ("pop_context (library=%s)\n", cx->library);
+	    fflush (stdout);
+	}
+
+	/* Pop the previous context.
+	 */
+	if (cx->prev != NULL) {
+	    level = cx->level;
+	    pcx   = cx->prev;
+
+	    root_modlist = (strcmp (cx->library, pcx->library) != 0);
+	    if (!root_modlist)
+		pcx->totfiles += cx->totfiles;
+
+	    free (cx);
+	    topcx = cx = pcx;
+
+	    if (cx->fp && cx->fp != stdin)
+		k_fseek (cx, cx->fpos, 0);
+
+	    sf_prune (cp = cx->old_cp);
+	    nsymbols = cx->old_nsymbols;
+	    iflev    = cx->old_iflev;
+
+	    if (level > pcx->level) {
+		if (debug) {
+		    printf ("chdir ..\n");
+		    fflush (stdout);
+		}
+
+		if (os_chdir (pcx->dirpath) == ERR)
+		    fatals ("cannot return from subdirectory", cx->curdir);
+
+		/* Initialize the file date cache, since the filenames therein
+		 * often reference the current directory.
+		 */
+		m_fdinit (debug);
+	    }
+	}
+
+	return (cx);
+}
+
+
+/* GET_DEPENDENCY_LIST -- Each file name in a library membership list occurs
+ * on a separate line in the Makelib file.  This file name may be followed by
+ * the names of zero or more other files, upon which the primary file is
+ * dependent.  The following procedure extracts the names of these files into
+ * the string buffer, returning a list of pointers to the filenames to the
+ * caller.  Note that the string buffer space is only "borrowed" and the
+ * filenames should be used promptly, before the string buffer space is reused.
+ */
+void
+get_dependency_list (
+  struct context *cx,		/* current library context	*/
+  char	*module,		/* module list is for		*/
+  char	*dflist[],		/* receives filename pointers	*/
+  int	maxfiles 		/* maxfiles out			*/
+)
+{
+	char	fname[SZ_FNAME+1];
+	int	token, nfiles=0;
+	char	*save_cp;
+	int	i;
+
+	save_cp = cp;
+
+	while ((token = gettok (cx, fname, SZ_FNAME)) != 0) {
+	    switch (token) {
+	    case TOK_NEWLINE:
+		goto done;
+	    case TOK_FNAME:
+		if (nfiles >= MAX_DEPFILES)
+		    warns ("too many dependency files for module `%s'", module);
+		dflist[nfiles++] = putstr (fname);
+		break;
+	    case TOK_END:
+		warns ("unexpected EOF in dependency list for `%s'", module);
+	    default:
+		warns ("bad token `%s' in dependency list", fname);
+	    }
+	}
+
+done:
+	/* A null string pointer marks the end of the list.
+	 */
+	dflist[nfiles] = NULL;
+
+	if (debug) {
+	    printf ("%s:", module);
+	    for (i=0;  i < nfiles;  i++)
+		printf (" %s", dflist[i]);
+	    printf ("\n");
+	    fflush (stdout);
+	}
+
+	cp = save_cp;
+}
+
+
+/* UP_TO_DATE -- Determine if the named module is up to date.  A module is up
+ * to date if:
+ *
+ *	(1) The lib module is newer than the source file, and
+ *	(2) The source file is newer than any of its dependents.
+ *
+ * If the module is out of date, and an object file exists which is current
+ * (newer than the source, which is in turn newer than any dependents),
+ * set the USEOBJ flag to tell our caller to use the .o file, rather than
+ * recompile the module.
+ */
+int
+up_to_date (
+  struct context *cx,		/* current library context	*/
+  char	*module,		/* module to compare dates for	*/
+  char	*lname,			/* local name of module		*/
+  char	*dflist[],		/* list of dependent files	*/
+  int	*useobj 		/* obj exists and is usable	*/
+)
+{
+	long	armod_date, newest_date, date;
+	long	h_ardate();
+	char	*fname;
+	int	old, i;
+
+	armod_date  = h_ardate (lname);
+	newest_date = armod_date;
+	(*useobj)   = NO;
+
+	/* Compare lib module date and source file date.
+ 	 */
+	date = os_fdate (module);
+	if (date == 0) {
+	    warns ("module source file `%s' not found", module);
+	    return (YES);
+	} else if (armod_date < date) {
+	    if (debug > 1) {
+		printf ("(%s) ar: %ld fil: %ld\n", module, armod_date, date);
+		fflush (stdout);
+	    }
+	    old = YES;
+	    newest_date = date;
+	} else
+	    old = NO;
+
+	/* Compare dates of archive file and any dependent files.
+	 */
+	for (i=0;  (fname = dflist[i]) != NULL;  i++) {
+	    date = m_fdate (fname);
+	    if (date == 0) {
+		warns ("dependency file `%s' not found", fname);
+	    } else if (armod_date < date) {
+		old = YES;
+		if (date > newest_date)
+		    newest_date = date;
+	    }
+	}
+
+	if (old == NO) {
+	    /* Module is up to date.
+	     */
+	    return (YES);
+	} else {
+	    /* Library module is not up to date.  Check if an object file
+	     * exists which can be used w/o recompilation.
+	     */
+	    if (newest_date <= os_fdate (makeobj (module)))
+		(*useobj) = YES;
+	    return (NO);
+	}
+}
+
+
+/* OPEN_MKPKGFILE -- Open the mkpkgfile for the current library context.
+ * If the same file is already physically open by this process, this is
+ * a "soft" open.
+ */
+int
+open_mkpkgfile (register struct context *cx)
+{
+	register char	*fname = cx->mkpkgfile;
+	struct	context *find_mkpkgfile();
+	struct	context *ax;
+	
+	if (strcmp (fname, "stdin") == 0 || strcmp (fname, "STDIN") == 0) {
+	    cx->fp = stdin;
+	} else if ((ax = find_mkpkgfile (cx->prev, fname, cx->level)) == NULL) {
+	    cx->fp = fopen (vfn2osfn(fname,0), "r");
+	    if (cx->fp)
+		k_fseek (cx, 0L, 0);
+	} else {
+	    cx->fp = ax->fp;
+	    if (cx->fp && cx->fp != stdin)
+		k_fseek (cx, 0L, 0);
+	}
+
+	cx->lineno = 1;
+	return (cx->fp == NULL ? ERR : OK);
+}
+
+
+/* CLOSE_MKPKGFILE -- Close a mkpkgfile.  If the file is multiply open (in
+ * software) wait until the last context closes the file to physically close
+ * the file.
+ */
+void
+close_mkpkgfile (register struct context *cx)
+{
+	struct context *find_mkpkgfile();
+
+	if (cx->fp != stdin)
+	    if (find_mkpkgfile (cx->prev, cx->mkpkgfile, cx->level) == NULL)
+		fclose (cx->fp);
+}
+
+
+/* FIND_MKPKGFILE -- Search the list of open library contexts for an entry
+ * which already has the named mkpkgfile open.
+ */
+struct context *
+find_mkpkgfile (
+  struct context *head_cx,	/* head of context list		*/
+  char	*mkpkgfile,		/* file to search for		*/
+  int	level 			/* subdirectory level		*/
+)
+{
+	register struct context *cx;
+
+	for (cx=head_cx;  cx != NULL;  cx=cx->prev)
+	    if (cx->level == level && strcmp (cx->mkpkgfile, mkpkgfile) == 0)
+		return (cx);
+
+	return (NULL);
+}
+
+
+/* SEARCH_MKPKGFILE -- Search the mkpkgfile for the named entry.  A mkpkg
+ * entry consists of a TOK_FNAME (identifier) followed by TOK_BEGIN (colon),
+ * e.g., "entry:".  If a specific module is named, go directly there without
+ * processing any preprocessor directives.  If no module is named, search
+ * for the first entry, executing any preprocessor directives encountered
+ * while searching.
+ */
+int
+search_mkpkgfile (register struct context *cx)
+{
+	char	word1[SZ_FNAME+1], word2[SZ_FNAME+1];
+	char	*prev, *curr, *temp;
+	int	tok, gettok();
+
+	if (debug) {
+	    printf ("search_mkpkgfile (file=%s, library=%s)\n",
+		cx->mkpkgfile, cx->library);
+	    fflush (stdout);
+	}
+
+	/* If a specific module is desired and we are not in search mode,
+	 * go directly to the named module without executing any preprocessor
+	 * directives.
+	 */
+	if (cx->library[0])
+	    return (do_goto (cx, cx->library));
+
+	/* Search Makelib file until an entry for the named library is found.
+	 * Execute any preprocessor directives encountered while searching.
+	 */
+	prev = word1;
+	curr = word2;
+
+	/* Advance to the next entry.  If an @subdir reference is
+	 * encountered, go process the subdirectory in search mode
+	 * and then continue locally.
+	 */
+	while ((tok = gettok (cx, curr, SZ_FNAME)) != TOK_BEGIN) {
+	    if (tok == 0 || tok == TOK_END) {
+		/* Exit; no entry found.
+		 */
+		return (ERR);
+
+	    } else if (tok == TOK_FNAME && curr[0] == SUBDIR_CHAR) {
+		/* Continue the search in the context of a subdirectory.
+		 */
+		struct  context *ncx;
+		char    module[SZ_FNAME+1];
+		char    subdir[SZ_FNAME+1];
+		char    fname[SZ_FNAME+1];
+		int     islib;
+
+		/* Push a new context and start over; recursive call.
+		 * May "reopen" (soft) the current mkpkg file or the mkpkg
+		 * in a subdirectory.
+		 */
+		parse_modname (curr, module, subdir, fname);
+		if ((ncx = push_context (cx, module,subdir,fname)) == NULL)
+		    exit_status = ERR;
+		else {
+		    exit_status = do_mkpkg (ncx, islib=NO);
+		    cx = pop_context (ncx);
+		}
+
+		if (exit_status != OK && !ignore)
+		    return (exit_status);
+
+	    } else {
+		/* Save the old token; pointer swapping rather than copy
+		 * used for efficiency.
+		 */
+		temp = curr;
+		curr = prev;
+		prev = temp;
+	    }
+	}
+
+	strcpy (cx->library, prev);	/* return module name 	*/
+	return (OK);
+}
diff --git a/unix/boot/mkpkg/scanlib.c b/unix/boot/mkpkg/scanlib.c
new file mode 100644
index 00000000..cb70efd5
--- /dev/null
+++ b/unix/boot/mkpkg/scanlib.c
@@ -0,0 +1,355 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#include <stdio.h>
+#include <string.h>
+#include <stdlib.h>
+#include <unistd.h>
+#include <ctype.h>
+
+#include <ar.h>
+#ifdef MACOSX
+#include <ranlib.h>
+#include <mach-o/fat.h>
+#endif
+
+#define import_spp
+#include <iraf.h>
+#include "mkpkg.h"
+#include "extern.h"
+
+#ifdef  OLD_MACOSX
+#define AR_EFMT1	1
+#endif
+
+
+/*
+ * SCANLIB.C -- Routines to scan a 4.2BSD UNIX archive file and create a
+ * symbol table naming the files in the archive and their dates.
+ *
+ * External entry points:
+ *
+ *	h_scanlibrary (libname)		extract list of modules and their dates
+ *	h_ardate (modname)		return long integer module date
+ */
+
+#define	SZ_KEY		128		/* arbitrary			*/
+extern	int forceupdate;		/* NOT IMPLEMENTED for UNIX	*/
+
+char	mlb_sbuf[SZ_SBUF];		/* string buffer		*/
+int	mlb_op = 0;			/* index into string buffer	*/
+int	mlb_index[MAX_LIBFILES];	/* sbuf indices for each symbol	*/
+long	mlb_fdate[MAX_LIBFILES];	/* file date of each module	*/
+int	mlb_modified;			/* modified flag		*/
+char	*mlb_filename();
+
+struct	dbentry {			/* module entry on disk		*/
+	long	fdate;
+	int	keylen;
+	/* key chars */
+};
+
+
+/**
+ *  Local procedure declarations.
+ */
+int mlb_setdate (char *modname, long fdate);
+
+
+
+/* SCANLIBRARY -- Scan the archive file, extract module names and dates,
+ * building the "ar" module list.
+ */
+int
+h_scanlibrary (char *library)
+{
+	register char	*ip, *op;
+	register int	i, is_fat = 0;
+	char	libfname[SZ_PATHNAME+1];
+	char	modname[SZ_KEY+1];
+	char	lbuf[SZ_LINE];
+	struct	ar_hdr arf;
+	long	length, fdate;
+	int	len=0, len_arfmag, nmodules;
+	FILE	*fp;
+
+	/* Get the library file name. */
+	h_getlibname (library, libfname);
+
+	/* Clear the symbol table.
+	 */
+	mlb_modified = NO;
+	mlb_op = 1;
+	nmodules = 0;
+
+	len = 0;
+	for (i=0;  i < MAX_LIBFILES;  i++)
+	    mlb_index[i] = 0;
+
+	/* Open the UNIX archive file.
+	 */
+	if ((fp = fopen (libfname, "r")) == NULL) {
+	    printf ("warning: library `%s' not found\n", libfname);
+	    fflush (stdout);
+	    return (0);
+	}
+
+	if (debug) {
+	    printf ("scan unix archive %s:\n", libfname);
+	    fflush (stdout);
+	}
+
+	/* Verify that file is indeed an archive file.
+	 */
+	memset (lbuf, 0, SZ_LINE);
+	fread (lbuf, 1, SARMAG, fp);
+	if (strncmp (lbuf, ARMAG, SARMAG) != 0) {
+#ifndef MACOSX
+	    printf ("file `%s' is not a library\n", libfname);
+	    goto err;
+#else
+	    /* See if it's a FAT archive file.
+	    */
+	    struct fat_header fh;
+	    struct fat_arch   fa;
+	    char *ip;
+
+	    rewind (fp);
+	    memset (&fh, 0, sizeof(struct fat_header));
+	    fread (&fh, 1, sizeof(struct fat_header), fp);  /* read header */
+	    if (fh.magic == FAT_MAGIC || fh.magic == FAT_CIGAM) {
+		int   narch = 0;
+
+		is_fat++;
+
+		/* The following is a cheat to avoid byte swapping the
+		 * nfat_arch field in Intel systems.  Assumes we'll never
+		 * see more that 8-bits worth of architectures. 8-)
+		 */
+	    	ip = (char *) &fh, ip += 7;
+		memmove (&narch, ip, 1);
+		for (i=0; i < narch; i++) {	    /* skip headers */
+		    memset (&fa, 0, sizeof(struct fat_arch));
+	            fread (&fa, 1, sizeof(struct fat_arch), fp);
+	        }
+
+		/* Read the AR header.
+		 */
+		memset (lbuf, 0, SZ_LINE);
+		fread (lbuf, 1, SARMAG, fp);
+	        if (strncmp (lbuf, ARMAG, SARMAG) != 0) {
+	            printf ("file `%s' is not a library\n", libfname);
+	            goto err;
+	        }
+	    } else {
+	        printf ("file `%s' is not a library\n", libfname);
+	        goto err;
+	    }
+#endif
+	}
+
+	len_arfmag = strlen (ARFMAG);
+	memset (&arf, 0, sizeof(arf));
+	while ((int)(fread (&arf, 1, sizeof(arf), fp)) > 0) {
+
+	    /* Don't scan past the first architecture for FAT libs.
+	     */
+	    if (is_fat && strncmp (arf.ar_name, ARMAG, SARMAG) == 0) 
+		break;
+
+	    if (strncmp (arf.ar_fmag, ARFMAG, len_arfmag) != 0) {
+		printf ("cannot decode library `%s'\n", libfname);
+		goto err;
+	    }
+
+	    if (debug > 1) {
+		char     name[17], date[13];
+		strncpy (name, arf.ar_name, 16);  name[16] = '\0';
+		strncpy (date, arf.ar_date, 12);  date[12] = '\0'; 
+		printf ("objname='%s', date='%s'\n", name, date);
+	    }
+
+	    /* Extract module name.  */
+	    for (ip=arf.ar_name;  *ip == ' ';  ip++) ;
+	    for (op=modname;  (*op = *ip++) != ' ' && *op != '/';  op++) ;
+	    *op++ = EOS;
+
+	    /* Skip dummy entry with null modname (COFF format) as well
+	     * as the __SYMDEF from ranlib.
+	     */
+#ifdef MACOSX
+	    if (strncmp (modname, RANLIBMAG, 9) || modname[0] != EOS) {
+#else
+	    if (modname[0] != EOS) {
+#endif
+#if defined(AR_EFMT1) && !defined(__CYGWIN__)
+	        /*
+	         * BSD 4.4 extended AR format: #1/<namelen>, with name as the
+	         * first <namelen> bytes of the file
+	         */
+	        if ((arf.ar_name[0] == '#') &&
+		    (arf.ar_name[1] == '1') &&
+		    (arf.ar_name[2] == '/') && (isdigit(arf.ar_name[3]))) {
+
+		        char p[SZ_PATHNAME];
+
+		        len = atoi(&arf.ar_name[3]);
+	                bzero (p, SZ_PATHNAME);
+		        if (fread(p, len, 1, fp) != 1) {
+		            fprintf (stderr, "%s: premature EOF", libfname);
+		        }
+	                bzero (modname, SZ_KEY+1);
+		        sprintf (modname, "%s", p);
+	        } else 
+		    len = 0;
+#endif
+	        /* Get module date.  */
+	        sscanf (arf.ar_date, "%ld", &fdate);
+
+	        /* Insert entry into symbol table. */
+	        mlb_setdate (modname, fdate);
+	    } 
+
+	    /* Advance to the next entry.
+	     */
+	    if (sscanf (arf.ar_size, "%ld", &length) == 1) {
+		if (length & 1)				/* must be even */
+		    length++;
+#if defined(AR_EFMT1) && !defined(__CYGWIN__)
+		fseek (fp, length-len, 1);
+#else
+		fseek (fp, length, 1);
+#endif
+	    } else {
+		printf ("could not decode length `%s' of library module\n",
+		    arf.ar_size);
+		goto err;
+	    }
+	
+	    memset (&arf, 0, sizeof(arf));
+	}
+
+	fclose (fp);
+	return (nmodules);
+
+err:
+	fflush (stdout);
+	fclose (fp);
+	return (ERR);
+}
+
+
+/* H_ARDATE -- Look up file in archive.  If found, return date of archive
+ * version, otherwise return zero.  This is the entry point called by MKLIB
+ * to get the update date of a library module.
+ */
+long
+h_ardate (char *fname)
+{
+	extern	char *makeobj();
+	long	mlb_getdate();
+
+	return (mlb_getdate (makeobj (fname)));
+}
+
+
+/* MLB_SETDATE -- Enter the given module and file date into the symbol table,
+ * or update the file date if the module is already present in the table.
+ */
+int
+mlb_setdate (
+  char	*modname,		/* module name		*/
+  long	fdate 			/* object file date	*/
+)
+{
+	register int	hashval, keylen, i;
+	register char	*ip;
+	int	start;
+
+
+	if (*modname == EOS || fdate <= 0) {
+	    printf ("warning, mlb_setdate: attempted illegal entry for %s\n",
+		modname);
+	    fflush (stdout);
+	    return (ERR);
+	}
+
+	/* Hash the key.
+	 */
+	for (hashval=0, keylen=0, ip=modname;  *ip;  ip++, keylen++)
+	    hashval += hashval + *ip;
+	start = hashval % MAX_LIBFILES;
+
+	mlb_modified = YES;
+
+	/* Update the entry if the module is already in the table, else find
+	 * an empty slot, checking for table overflow in the process.
+	 */
+	for (i=start;  mlb_index[i];  ) {
+	    ip = &mlb_sbuf[mlb_index[i]];
+	    if (*ip == *modname)
+		if (strncmp (modname, ip, keylen) == 0) {
+		    mlb_fdate[i] = fdate;
+		    return (OK);
+		}
+	    if (++i >= MAX_LIBFILES)
+		i = 0;
+	    if (i == start) {
+		printf ("error: library module list overflow\n");
+		fflush (stdout);
+		return (ERR);
+	    }
+	}
+
+	if (mlb_op + keylen + 1 >= SZ_SBUF) {
+	    printf ("error: library module list string buffer overflow\n");
+	    fflush (stdout);
+	    return (ERR);
+	}
+
+	/* Enter the module into the symbol table.
+	 */
+	mlb_index[i] = mlb_op;
+	mlb_fdate[i] = fdate;
+
+	strcpy (&mlb_sbuf[mlb_op], modname);
+	mlb_op += (keylen + 1);
+
+	return (OK);
+}
+
+
+/* MLB_GETDATE -- Lookup a module in the symbol table and return its date.
+ * Return zero if the module is not found.
+ */
+long
+mlb_getdate (char *modname)
+{
+	register int	hashval, keylen, i;
+	register char	*ip;
+	int	start;
+
+	if (*modname == EOS)
+	    return (0L);
+
+	/* Hash the key.
+	 */
+	for (hashval=0, keylen=0, ip=modname;  *ip;  ip++, keylen++)
+	    hashval += hashval + *ip;
+	start = hashval % MAX_LIBFILES;
+
+	/* Search the symbol table for the named module.
+	 */
+	for (i=start;  mlb_index[i];  ) {
+	    ip = &mlb_sbuf[mlb_index[i]];
+	    if (*ip == *modname)
+		if (strncmp (modname, ip, keylen) == 0)
+		    return (mlb_fdate[i]);
+	    if (++i >= MAX_LIBFILES)
+		i = 0;
+	    if (i == start)
+		return (0L);
+	}
+
+	return (0L);
+}
diff --git a/unix/boot/mkpkg/sflist.c b/unix/boot/mkpkg/sflist.c
new file mode 100644
index 00000000..e487df77
--- /dev/null
+++ b/unix/boot/mkpkg/sflist.c
@@ -0,0 +1,321 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#include <stdio.h>
+#include <ctype.h>
+#include <string.h>
+
+#define	import_spp
+#define	import_error
+#include <iraf.h>
+
+#include "mkpkg.h"
+#include "extern.h"
+#include "../bootProto.h"
+
+
+/*
+ * SFLIST.C -- Special file list package.  The special file list is a list of
+ * library module list source files which need special processing on a given
+ * host system.  Examples of such files are files which have been optimized in
+ * a machine dependent way, e.g., in assembler or C, or files which must be
+ * compiled in a nonstandard way due to host compiler bugs.  The special file
+ * list makes this special processing possible without having to modify the
+ * mkpkg files in the portable system in a host dependent way, concentrating
+ * all knowledge of those parts of the system which have been tailored for the
+ * local host into a single, easily modifiable table file stored in HLIB.
+ *
+ * External functions:
+ *
+ *	      sf_scanlist (cx)			# parse $special file list
+ *  sflist = sf_dirsearch (dirname)		# lookup directory in sflist
+ *    sfp = sf_filesearch (sflist, filename)	# lookup file in dir file list
+ *	         sf_prune (cp)			# free space in string buffer
+ *
+ * where
+ *
+ *	struct	context	*cx;
+ *	struct	sfile	*sflist, *sfp;
+ *	char		*filename, *dirname;
+ *
+ * The special file list is organized by source directory to speed searches
+ * (most directories will not contain any files needing special processing,
+ * eliminating the need to lookup the files in module lists in that directory)
+ * and to reduce storage requirements for the list.  The special file database
+ * thus consists of a list of directories containing special files, and for
+ * each directory, a pointer to a linked list of special file entries, one
+ * for each special file in the directory.  Since the organization by directory
+ * tends to produce a database consisting of very short file lists, we use a
+ * linked list rather than a hash table for the file lists.
+ *
+ * For each special file we record the standard file name, the pathname of
+ * the special file to be used, and a command to be pushed back into the MKPKG
+ * command input stream to generate the object file for the module.
+ * The special file name may be the same as the standard file name, e.g, if
+ * the standard file only needs to be compiled in a nonstandard way.  If the
+ * mkobj string is null the special file name will simply be returned in the
+ * module list, and compiled with XC using the default compile flags.
+ */
+
+static	int	sf_ndirs = 0;			/* no. of directories	*/
+static	int	sf_nfiles = 0;			/* no. of special files	*/
+static	char	*sf_dirs[MAX_SFDIRS];		/* source directories	*/
+static	struct	sfile *sf_flist[MAX_SFDIRS];	/* directory file lists */
+static	struct	sfile sf_files[MAX_SFFILES];	/* special file list	*/
+static	char	nullstr[] = "";
+
+
+/* SF_SCANLIST -- Called when the $special macro preprocessor directive is
+ * encountered to parse a special file list, entering each file listed into
+ * the special file list database.  The syntax of a $special special file
+ * list directive is as follows:
+ *
+ *	$special dirname:
+ *		stname1	sfname1	mkobj_command1
+ *		stname2	sfname2	mkobj_command2
+ *				...
+ *		stnameN	sfnameN	mkobj_commandN
+ *		;
+ *
+ * where any string value may optionally be quoted, and the mkobj command
+ * strings are optional.  The token "&" in <sfname> or <mkobj_command> is
+ * replaced by <stname>.
+ */
+int
+sf_scanlist (
+  struct context *cx		/* current mkpkg context */
+)
+{
+	register struct	sfile *sfp;
+	register char	*ip, *op, *tp;
+
+	char	dirname[SZ_PATHNAME+1];
+	char	stname[SZ_PATHNAME+1];
+	char	sfname[SZ_PATHNAME+1];
+	char	mkobj[SZ_CMD+SZ_PATHNAME+1];
+	char	token[SZ_CMD+1];
+	struct	sfile *head, *tail;
+	int	tok, nfiles, eol=0;
+	char	*old_cp;
+
+	old_cp = cp;			/* mark position in sbuf */
+	nfiles = 0;
+
+	/* Get the directory name. */
+	if (gettok (cx, token, SZ_LINE) != TOK_FNAME) {
+	    warns ("missing directory name in special file list", "");
+	    goto err;
+	} else
+	    os_fpathname (token, dirname, SZ_PATHNAME);
+
+	if (debug) {
+	    printf ("scan special file list for directory %s\n",
+		debug > 1 ? dirname : token);
+	    fflush (stdout);
+	}
+
+	/* Advance to the start of the module list. */
+	while ((tok = gettok (cx, token, SZ_LINE)) != TOK_BEGIN)
+	    if (tok == EOF || tok == TOK_END)
+		goto err;
+
+	/* Get a pointer to the last element in the special file list for
+	 * the named directory.  If this is the first entry for the named
+	 * directory, enter the name in the symbol table and set the sflist
+	 * pointer to NULL.
+	 */
+	if ((head = sf_dirsearch (dirname)) == NULL) {
+	    sf_dirs[sf_ndirs++] = putstr (dirname);
+	    if (sf_ndirs >= MAX_SFDIRS)
+		fatals ("too many special file list directories: %s", dirname);
+	    tail = NULL;
+	} else {
+	    for (tail=sfp=head;  sfp;  sfp=sfp->sf_next)
+		tail = sfp;
+	}
+
+	/* Read successive entries from the special file list for the named
+	 * directory, entering each file at the tail of the list.
+	 */
+	while (!eol && (tok = gettok (cx, token, SZ_LINE)) != TOK_END) {
+	    if (tok == EOF || tok == TOK_END)
+		break;
+
+	    /* Get standard file name (module name). */
+	    if (tok == TOK_NEWLINE)
+		continue;			/* blank line */
+	    else if (tok != TOK_FNAME)
+		goto badline;
+	    else
+		strcpy (stname, token);
+
+	    /* Get the special file name. */
+	    if ((tok = gettok (cx, sfname, SZ_PATHNAME)) == TOK_END)
+		eol++;
+	    if (tok != TOK_FNAME)
+		goto badline;
+
+	    /* Get the mkobj command string, if any. */
+	    if ((tok = gettok (cx, token, SZ_LINE)) == TOK_NEWLINE) {
+		mkobj[0] = EOS;
+	    } else if (tok == TOK_END) {
+		mkobj[0] = EOS;
+		eol++;
+	    } else if (tok != TOK_FNAME) {
+		goto badline;
+	    } else {
+		/* Extract the command string, expanding any "&" filename
+		 * references therein.
+		 */
+		for (ip=token, op=mkobj;  (*op = *ip++);  op++)
+		    if (*op == '&') {
+			for (tp=stname;  (*op = *tp++);  op++)
+			    ;
+			--op;
+		    }
+	    }
+
+	    if (debug)
+		printf ("file %s -> %s, mkobj = `%s'\n",
+		    stname, (sfname[0] == '&') ? stname : sfname, mkobj);
+
+	    /* Add the file to the tail of the file list. */
+	    nfiles++;
+	    sfp = &sf_files[sf_nfiles++];
+	    if (sf_nfiles >= MAX_SFFILES)
+		fatals ("too many special files: %s", stname);
+	    
+	    sfp->sf_stname = putstr (stname);
+	    sfp->sf_sfname = (sfname[0]=='&') ? sfp->sf_stname : putstr(sfname);
+	    sfp->sf_mkobj  = mkobj[0] ? putstr(mkobj) : nullstr;
+	    sfp->sf_next   = NULL;
+
+	    if (tail) {
+		tail->sf_next = sfp;
+		tail = sfp;
+	    } else
+		sf_flist[sf_ndirs-1] = head = tail = sfp;
+
+	    continue;
+badline:
+	    /* Print message and discard rest of line, but do not quit. */
+	    warns ("bad token `%s' in special file list", token);
+	    while (!eol && (tok = gettok (cx, token, SZ_LINE)) != TOK_NEWLINE)
+		if (tok == TOK_END)
+		    break;
+		else if (tok == EOF)
+		    goto err;
+	}
+
+	if (debug) {
+	    printf ("%d special files added; total ndirs=%d, nfiles=%d\n",
+		nfiles, sf_ndirs, sf_nfiles);
+	    fflush (stdout);
+	}
+
+	if (nfiles == 0) {
+	    warns ("empty special file list for %s", dirname);
+	    sf_prune (cp = old_cp);
+	    return (ERR);
+	} else
+	    return (OK);
+
+err:
+	/* Discard rest of directive. */
+	while (!eol && (tok = gettok (cx, token, SZ_LINE)) != TOK_END)
+	    if (tok == EOF || tok == TOK_END)
+		break;
+
+	/* Return memory and sfile database space. */
+	sf_prune ((cp = old_cp));
+
+	return (ERR);
+}
+
+
+/* SF_DIRSEARCH -- Search the special file database for the named directory,
+ * returning a pointer to the special file list for that directory if the
+ * directory is found, else NULL.  Note that directory names are stored as
+ * host system pathnames (so that any equivalent form of reference may be used
+ * in the mkpkg files), and we assume that we are called with the directory
+ * pathname already resolved.
+ */
+struct sfile *
+sf_dirsearch (
+  char	*dirname		/* host pathname of directory */
+)
+{
+	register int	i;
+
+	if (debug) {
+	    printf ("search sflist for directory %s\n", dirname);
+	    fflush (stdout);
+	}
+
+	for (i=0;  i < sf_ndirs;  i++)
+	    if (h_direq (sf_dirs[i], dirname))
+		return (sf_flist[i]);
+
+	return (NULL);
+}
+
+
+/* SF_FILESEARCH -- Search the special file list for a directory for the named
+ * file.  File names are stored in the list by the name given in the library
+ * module list in the mkpkg file.  If the named file is found a pointer to the
+ * special file descriptor for that file is returned, otherwise NULL is
+ * returned.  Note that "file*" is a prefix match, whereas "file" requires an
+ * exact match.
+ */
+struct sfile *
+sf_filesearch (
+  struct sfile *sflist,		/* special file list	*/
+  char	*stname 		/* standard file name	*/
+)
+{
+	register struct sfile *sfp;
+	register char	*p1, *p2;
+
+	for (sfp=sflist;  sfp;  sfp=sfp->sf_next) {
+	    for (p1=sfp->sf_stname, p2=stname;  *p1 && *p1 == *p2;  p1++, p2++)
+		;
+	    if ((*p1 == EOS && *p2 == EOS) || *p1 == '*')
+		return (sfp);
+	}
+	
+	return (NULL);
+}
+
+
+/* SF_PRUNE -- Prune the special file database back to the given point in the
+ * string buffer.
+ */
+void
+sf_prune (
+  register char	*cp		/* lop off everything here and above */
+)
+{
+	register struct sfile *sfp, *sf_top;
+	register int	i;
+
+	/* Prune the directory list. */
+	for (i=0;  i < sf_ndirs;  i++)
+	    if (sf_dirs[i] >= cp || sf_flist[i]->sf_stname >= cp) {
+		sf_ndirs = i;
+		break;
+	    }
+
+	/* Prune the global file list. */
+	for (i=0;  i < sf_nfiles;  i++)
+	    if (sf_files[i].sf_stname >= cp) {
+		sf_nfiles = i;
+		break;
+	    }
+
+	/* Prune the individual directory file lists. */
+	for (i=0, sf_top = &sf_files[sf_nfiles];  i < sf_nfiles;  i++) {
+	    sfp = &sf_files[i];
+	    if (sfp->sf_next >= sf_top)
+		sfp->sf_next = NULL;
+	}
+}
diff --git a/unix/boot/mkpkg/tok.c b/unix/boot/mkpkg/tok.c
new file mode 100644
index 00000000..41bdf626
--- /dev/null
+++ b/unix/boot/mkpkg/tok.c
@@ -0,0 +1,1457 @@
+/* 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>
+
+#define	import_spp
+#define	import_error
+#include <iraf.h>
+
+#include "mkpkg.h"
+#include "extern.h"
+#include "../bootProto.h"
+
+
+
+
+/*
+ * TOK.C -- Preprocessor functions.
+ */
+
+/* GETTOK -- Get the next token from the make file currently being scanned.
+ * Conditional interpretation is provided via the $IFxxx directives.
+ */
+int
+gettok (
+  register struct context *cx,		/* current context	*/
+  char	*outstr,			/* receives token	*/
+  int	maxch 
+)
+{
+	register int	ch;
+	register char	*op;
+	char	tokbuf[SZ_COMMAND+1];
+	int	token, delim;
+
+	if (debug > 1) {
+	    printf ("gettok:\n");
+	    fflush (stdout);
+	}
+
+again:
+	/* Skip whitespace */
+	for (ch = m_getc(cx);  ch == ' ';  ch = m_getc(cx))
+	    ;
+	if (ch == EOF) {
+	    outstr[0] = EOS;
+	    return (TOK_END);
+	}
+	outstr[0] = ch;
+	outstr[1] = EOS;
+
+	/* First nonwhite character identifies each token.
+	 */
+	switch (ch) {
+	case COMMENT:
+	    /* Ignore a comment.
+	     */
+	    while ((ch = m_rawgetc(cx)) != '\n' && ch != EOF)
+		;
+	    m_ungetc ('\n', cx);
+	    goto again;
+
+	case PREPROCESSOR:
+	    /* Preprocessor directive.
+	     */
+	    for (op=tokbuf, *op++ = ch;  (ch = m_getc(cx)) != EOF;  )
+		if (islower (ch))
+		    *op++ = ch;
+		else if (isupper (ch))
+		    *op++ = tolower (ch);
+		else {
+		    m_ungetc (ch, cx);
+		    break;
+		}
+
+	    *op = EOS;
+	    if (strncmp (tokbuf, "$exit", 5) == 0)
+		return (TOK_END);
+
+	    do_ppdir (cx, tokbuf);
+	    goto again;
+
+	case SYSCMD:
+	    /* Send a command to host system.
+	     */
+	    do_osescape (cx);
+	    goto again;
+
+	case BEGIN_CHAR:
+	    /* Start of program.
+	     */
+	    token = TOK_BEGIN;
+	    break;
+
+	case END_CHAR:
+	    /* End of program.
+	     */
+	    token = TOK_END;
+	    break;
+
+	case '\n':
+	    token = TOK_NEWLINE;
+	    break;
+
+	case SYSFILE_BEGIN:
+	    /* Replace '<' by system library pathname, concatentate
+	     * filename and exit.
+	     */
+	    getstr (cx, tokbuf, SZ_COMMAND, SYSFILE_END);
+	    if (m_sysfile (tokbuf, outstr, maxch) <= 0)
+		sprintf (outstr, "<%s>", tokbuf);
+
+	    if (debug) {
+		/* Don't print diagnostic if the file was found to be
+		 * in the usual place, i.e., the system library lib$.
+		 */
+		if (strncmp (outstr, "iraf$lib/", 9) != 0) {
+		    printf ("<%s> matched with `%s'\n", tokbuf, outstr);
+		    fflush (stdout);
+		}
+	    }
+
+	    token = TOK_FNAME;
+	    break;
+
+	case '\'':
+	case '"':
+	    /* Quoted strings are treated as fname tokens, permitting
+	     * optional quoting of filenames in module lists.
+	     */
+	    getstr (cx, outstr, maxch, delim = ch);
+	    token = TOK_FNAME;
+	    break;
+
+	case '\\':
+	    if ((ch = m_getc(cx)) == '\n')
+		goto again;
+	    /* fall through */
+
+	default:
+	    /* Unquoted filename token.
+	     */
+	    m_ungetc (ch, cx);
+	    getstr (cx, outstr, maxch, delim = ' ');
+	    token = TOK_FNAME;
+	    break;
+	}
+
+	/* Discard token? */
+	if (ifstate[iflev] == STOP)
+	    goto again;
+
+	if (debug > 1) {
+	    if (outstr[0] <= 040)
+		printf ("token = char 0%o\n", outstr[0]);
+	    else
+		printf ("token = `%s'\n", outstr);
+	    fflush (stdout);
+	}
+
+	return (token);
+}
+
+
+/* DO_OSESCAPE -- Send a command to host system.  If the first char after
+ * the ! is a left paren or quote then the matching char is taken to terminate
+ * the command, otherwise an (unescaped) newline terminates the command.
+ * The parenthesized form permits additional directives on the same line.
+ */
+void
+do_osescape (register struct context *cx)
+{
+	register int	ch;
+	char	cmd[SZ_CMD+1];
+
+	if (debug > 1) {
+	    printf ("do_osescape:\n");
+	    fflush (stdout);
+	}
+
+	ch = m_getc (cx);
+	if (ch == '(' || ch == '\'' || ch == '"') {
+	    getstr (cx, cmd, SZ_CMD, (ch == '(' ? ')' : ch));
+	} else if (ch == '\n') {
+	    return;
+
+	} else {
+	    char    *op, *otop;
+
+	    op    = cmd;
+	    *op++ = ch;
+	    otop  = &cmd[SZ_CMD];
+
+	    while (op < otop && (ch = m_getc(cx)) != EOF)
+		if (ch == ESCAPE) {
+		    ch = m_getc (cx);
+		    if (ch != '\n') {
+			*op++ = ESCAPE;
+			*op++ = ch;
+		    }
+		} else if (ch == '\n') {
+		    break;
+		} else
+		    *op++ = ch;
+
+	    *op = EOS;
+	}
+
+	if (ifstate[iflev] == STOP)
+	    return;
+	if (verbose) {
+	    printf ("!%s\n", cmd);
+	    fflush (stdout);
+	}
+
+	if (execute)
+	    exit_status = os_cmd (cmd);
+	if (exit_status == INTERRUPT)
+	    fatals ("<ctrl/c> interrupt %s", cx->library);
+}
+
+
+/* DO_PPDIR -- Execute a preprocessor directive.  A hash table would be more
+ * efficient, but the complexity is not warranted since this is only called
+ * when a $ prefixed preprocessor directive has already been recognized in
+ * the input.
+ */
+void
+do_ppdir (
+    struct context *cx,		/* current context		*/
+    char	*token		/* directive to be executed	*/
+)
+{
+	int	islib;
+
+	if (debug > 1) {
+	    printf ("do_ppdir: %s\n", token);
+	    fflush (stdout);
+	}
+
+	if (     strncmp (token, "$if",		3) == 0)
+	    do_if (cx, token);
+	else if (strncmp (token, "$else",	5) == 0)
+	    do_else (cx);
+	else if (strncmp (token, "$endif",	6) == 0)
+	    do_endif (cx);
+	else if (strncmp (token, "$end",	4) == 0)
+	    do_end (cx);
+
+	else if (strncmp (token, "$call",	5) == 0)
+	    do_call (cx, getargs(cx), islib=NO);
+	else if (strncmp (token, "$echo",	5) == 0)
+	    do_echo (cx, getargs(cx));
+	else if (strncmp (token, "$goto",	5) == 0)
+	    do_goto (cx, getargs(cx));
+	else if (strncmp (token, "$include",	8) == 0)
+	    do_include (cx, getargs(cx));
+	else if (strncmp (token, "$set",	4) == 0)
+	    do_set (cx);
+	else if (strncmp (token, "$special",	8) == 0)
+	    sf_scanlist (cx);
+	else if (strncmp (token, "$update",	7) == 0)
+	    do_call (cx, getargs(cx), islib=YES);
+
+	else if (strncmp (token, "$checkin",	8) == 0)
+	    do_incheck (cx);
+	else if (strncmp (token, "$checkout",	9) == 0)
+	    do_outcheck (cx);
+	else if (strncmp (token, "$copy",	5) == 0)
+	    do_copyfile (cx);
+	else if (strncmp (token, "$delete",	7) == 0)
+	    do_delete (cx);
+	else if (strncmp (token, "$generic",	8) == 0)
+	    do_generic (cx);
+	else if (strncmp (token, "$link",	5) == 0)
+	    do_link (cx);
+	else if (strncmp (token, "$move",	5) == 0)
+	    do_movefile (cx);
+	else if (strncmp (token, "$omake",	6) == 0)
+	    do_omake (cx, getargs(cx));
+	else if (strncmp (token, "$purge",	6) == 0)
+	    do_purge (cx, getargs(cx));
+	else if (strncmp (token, "$xc",		3) == 0)
+	    do_xc (cx);
+
+	else if (strncmp (token, "$debug",	6) == 0) {
+	    if ((debug = (strcmp (getargs(cx), "off")) != 0))
+		verbose++; }
+	else if (strncmp (token, "$verbose",	8) == 0)
+	    verbose = (strcmp (getargs(cx), "off") != 0);
+
+	else
+	    warns ("illegal preprocessor directive `%s'", token);
+}
+
+
+/* DO_IF -- Called when a "$if.." token is seen in the input stream.  Read in
+ * the predicate and set the state of the ifcode accordingly.
+ */
+void
+do_if (struct context *cx, char	*keyword)
+{
+	register int	ch;
+	register char	*op;
+	char	tokbuf[SZ_COMMAND+1];
+	char	buf[SZ_PREDBUF], *argv[MAX_ARGS];
+	long    fdate, altdate, os_fdate();
+	int	argc, negate, bval, i;
+	char	*key;
+ 
+	if (debug > 1) {
+	    printf ("do_if: %s\n", keyword);
+	    fflush (stdout);
+	}
+
+	/* Set the negate flag for the "$ifn" form of the if.  Leave key
+	 * pointing to the first char of whatever follows.  Watch out for
+	 * "$ifnewer".
+	 */
+	key = &keyword[3];	/* "$if^" */
+	negate = (*key == 'n' && strncmp(key,"newer",5) != 0);
+	if (negate)
+	    key++;
+
+	/* Extract the paren delimited list of predicate strings.  This may
+	 * extend over multiple lines if the newlines are escaped.
+	 */
+	while ((ch = m_getc(cx)) != '(')
+	    if (ch == '\n')
+		warns ("illegal `%s' predicate", keyword);
+	    else if (ch == EOF)
+		warns ("unexpected EOF in `%s'", keyword);
+
+	argv[0] = buf;
+	op      = buf;
+	argc    = 0;
+
+	while ((ch = m_getc(cx)) != ')') {
+	    if (ch == ESCAPE) {
+		ch = m_getc (cx);
+		if (ch == '\n')
+		    continue;
+		else
+		    *op++ = ch;
+	    } else if (ch == '\n') {
+		warns ("missing right paren in `%s'", keyword);
+	    } else if (ch == EOF) {
+		warns ("unexpected EOF in `%s'", keyword);
+	    } else if (ch == ' ') {
+		continue;
+	    } else if (ch == SYSFILE_BEGIN && op == argv[argc]) {
+		getstr (cx, tokbuf, SZ_COMMAND, SYSFILE_END);
+		if (m_sysfile (tokbuf, op, SZ_PREDBUF+buf-op) <= 0)
+		    sprintf (op, "<%s>", tokbuf);
+		while (*op)
+		    op++;
+		continue;
+	    } else if (ch == ':' || ch == ',') {
+		*op++ = EOS;
+		if (op - buf >= SZ_PREDBUF)
+		    warns ("predicate too large in `%s'", keyword);
+		if (++argc >= MAX_ARGS)
+		    warns ("too many arguments in `%s' predicate", keyword);
+		argv[argc] = op;
+	    } else
+		*op++ = ch;
+	}
+
+	*op = EOS;
+	argc++;
+
+	if (++iflev > SZ_IFSTACK)
+	    warns ("$IFs nested too deeply (%s)", keyword);
+
+	/* If the $IF is encountered while scanning the tokens in a false-IF
+	 * clause, do not "execute" the $IF.  We still have to push the IF
+	 * onto the control stack, because the matching $ENDIF is going to
+	 * pop the stack.
+	 */
+	if (ifstate[iflev-1] == STOP) {
+	    ifstate[iflev] = STOP;
+	    return;
+	}
+
+	/* Execute the $IF statement.
+	 */
+	bval = 0;
+	if (strcmp (key, "def") == 0) {
+	    /* $IFDEF.  If the named symbol exists execute the true clause,
+	     * else go to the else clause.
+	     */
+	    if (argc > 0) {
+		bval = (getsym (argv[0]) != NULL);
+		if (!bval)
+		    bval = (os_getenv (argv[0]) != NULL);
+	    }
+
+	} else if (strcmp (key, "eq") == 0) {
+	    /* $IFEQ.  Test if the named environment variable has one of the
+	     * indicated values.
+	     */
+	    char   *valstr;
+
+	    if (argc > 0) {
+		if ((valstr = getsym (argv[0])) == NULL &&
+		    (valstr = os_getenv (argv[0])) == NULL) {
+
+		    warns ("symbol `%s' not found", argv[0]);
+		    bval = 0;
+
+		} else {
+		    if (argc == 1)
+			bval = 1;
+		    else {
+			for (i=1;  i < argc;  i++)
+			    if (strcmp (valstr, argv[i]) == 0) {
+				bval = 1;
+				break;
+			    }
+		    }
+		}
+	    }
+
+	} else if (strcmp (key, "file") == 0) {
+	    /* $IFFILE.  Check for the existence of any of the named files.
+	     */
+	    for (i=0;  i < argc;  i++)
+		if (os_access (argv[i], 0,0) == YES) {
+		    bval = 1;
+		    break;
+		}
+
+	} else if (strcmp (key, "older") == 0) {
+	    /* $IFOLDER.  Check if the named file is older than any of the
+	     * listed files.  If the named file does not exist the result
+	     * is true.  If any of the listed files do not exist a warning
+	     * is printed and they are ignored.
+	     */
+	    if (os_access (argv[1], 0,0) == NO) {
+		warns ("file `%s' not found", argv[1]);
+		bval = 1;
+	    } else if ((fdate = os_fdate(argv[0])) <= 0) {
+		warns ("file `%s' not found", argv[0]);
+		bval = 1;
+	    } else {
+		for (i=1;  i < argc;  i++) {
+		    altdate = m_fdate (argv[i]);
+		    if (altdate <= 0) {
+			warns ("file `%s' not found", argv[i]);
+			bval = 1;
+			break;
+		    } else if (fdate < altdate) {
+			bval = 1;
+			break;
+		    }
+		}
+	    }
+
+	} else if (strcmp (key, "newer") == 0) {
+	    /* $IFNEWER.  Check if the named file is newer than any of the
+	     * listed files.  If the named file does not exist the result
+	     * is false.  If any of the listed files do not exist a warning
+	     * is printed and they are ignored.
+	     */
+	    if (os_access (argv[1], 0,0) == NO) {
+		warns ("file `%s' not found", argv[1]);
+		bval = 1;
+	    } else if ((fdate = os_fdate(argv[0])) <= 0) {
+		warns ("file `%s' not found", argv[0]);
+		bval = 1;
+	    } else {
+		for (i=1;  i < argc;  i++) {
+		    altdate = m_fdate (argv[i]);
+		    if (altdate <= 0)
+			warns ("file `%s' not found", argv[i]);
+		    else if (fdate > altdate) {
+			bval = 1;
+			break;
+		    }
+		}
+	    }
+	    
+	} else if (strcmp (key, "err") == 0) {
+	    /* $IFERR.  Test the exit status of the last command executed.
+	     */
+	    bval = (exit_status != OK);
+
+	} else
+	    warns ("unrecognized $if statement `%s'", keyword);
+
+	if (negate)
+	    bval = !bval;
+	ifstate[iflev] = bval;
+
+	if (debug) {
+	    printf ("%s (", keyword);
+	    if (argc > 0)
+		printf ("%s", argv[0]);
+	    for (i=1;  i < argc;  i++)
+		printf (", %s", argv[i]);
+	    printf (") -> %s\n", bval ? "YES" : "NO");
+	    fflush (stdout);
+	}
+}
+
+
+/* DO_ELSE -- Called when the token "$else" is seen in the input stream.
+ * Toggle the if state.  Do nothing if the state one level down in STOP,
+ * indicating that this $ELSE is nested inside the false clause of an
+ * outer $IF.
+ */
+void
+do_else (struct	context *cx)
+{
+	if (debug > 1) {
+	    printf ("do_else:\n");
+	    fflush (stdout);
+	}
+
+	if (iflev < 1)
+	    warns ("%s with no matching $if", "$else");
+	else if (iflev > 1 && ifstate[iflev-1] == STOP)
+	    return;
+	else
+	    ifstate[iflev] = (ifstate[iflev] == PASS) ? STOP : PASS;
+}
+
+
+/* DO_ENDIF -- Called when the token "$endif" is seen in the input stream.
+ * Pop the if stack.
+ */
+void
+do_endif (struct context *cx)
+{
+	if (debug > 1) {
+	    printf ("do_endif:\n");
+	    fflush (stdout);
+	}
+
+	if (--iflev < 0)
+	    warns ("unmatched %s", "$endif");
+}
+
+
+/* DO_END -- Called when the token "$end" is seen in the input stream.
+ * Clear the if stack and reenable pass-token.
+ */
+void
+do_end (struct context *cx)
+{
+	if (debug > 1) {
+	    printf ("do_end:\n");
+	    fflush (stdout);
+	}
+
+	if (cx->prev && cx->prev->old_iflev >= 0)
+	    iflev = cx->prev->old_iflev;
+	else
+	    iflev = 0;
+}
+
+
+/* DO_CALL -- Call a "subroutine", i.e., named entry in a mkpkg file.  The call
+ * may include definitions for any temporary symbols (arguments) to be passed
+ * to the subroutine.  The subroutine is assumed to be in the current mkpkg
+ * file unless otherwise indicated.
+ *
+ * Syntax:
+ *	$call module
+ *	$call module (sym1=value, sym2=value, ...)
+ *	$call module@subdir/file
+ *	$call module@subdir/file (sym1=value, ...)
+ *		(etc.)
+ *
+ * Note that the statements are interpreted (as is everything in mkpkg), hence
+ * mkpkg subroutines should not be used for trivial things.
+ */
+void
+do_call (
+  struct context *cx,		/* current context		*/
+  char	*program,		/* module to be called		*/
+  int	 islib 			/* module list for a library	*/
+)
+{
+	struct	context *ncx;
+	char	module[SZ_FNAME+1], subdir[SZ_FNAME+1], fname[SZ_FNAME+1];
+	char	symbol[SZ_FNAME+1], value[SZ_COMMAND+1];
+	char	modspec[SZ_FNAME+1];
+	char	*old_cp;
+	int	old_nsymbols;
+
+	strcpy (modspec, program);
+	if (debug && ifstate[iflev] == PASS) {
+	    printf ("$call %s\n", modspec);
+	    fflush (stdout);
+	}
+
+	old_cp = cp;
+	old_nsymbols = nsymbols;
+
+	/* Process the argument list, if any, into the symbol table.
+	 */
+	while (getkwvpair (cx, symbol, value) != ERR)
+	    if (ifstate[iflev] == PASS)
+		putsym (symbol, value);
+
+	if (ifstate[iflev] == STOP)
+	    return;
+
+	/* Parse the module name, push a new context, and execute the
+	 * subroutine.
+	 */
+	parse_modname (modspec, module, subdir, fname);
+	if ((ncx = push_context (cx, module, subdir, fname)) == NULL)
+	    exit_status = ERR;
+	else {
+	    exit_status = do_mkpkg (ncx, islib);
+	    cx = pop_context (ncx);
+	}
+
+	/* Restore the old context and discard the argument temporaries.
+	 */
+	if (exit_status != OK)
+	    warns ("module `%s' not found or returned error", modspec);
+
+	cp = old_cp;
+	nsymbols = old_nsymbols;
+}
+
+
+/* DO_ECHO -- Print a message on the standard output.
+ */
+void
+do_echo (struct context *cx, char *msg)
+{
+	if (ifstate[iflev] == PASS) {
+	    printf ("%s\n", msg);
+	    fflush (stdout);
+	}
+}
+
+
+/* DO_GOTO -- Advance the file pointer to the named symbol in the current
+ * file, without changing the current context.
+ */
+int
+do_goto (struct context *cx, char *symbol)
+{
+	register char	*ip;
+	char	match[SZ_FNAME+1];
+	char	lbuf[SZ_LINE+1];
+	int	len_matchstr;
+	long	fpos;
+
+	if (ifstate[iflev] == STOP)
+	    return (OK);
+
+	if (debug) {
+	    printf ("goto %s\n", symbol);
+	    fflush (stdout);
+	}
+
+	sprintf (match, "%s:", symbol);
+	len_matchstr = strlen (match);
+
+	fpos = k_ftell (cx);
+	if (cx->fp != stdin)
+	    k_fseek (cx, 0L, 0);
+
+	while (k_fgets (lbuf, SZ_LINE, cx) != NULL) {
+	    cx->lineno++;
+	    for (ip=lbuf;  isspace (*ip);  ip++)
+		;
+	    if (strncmp (ip, match, len_matchstr) == 0) {
+		/* GOTO clears the IF stack back to where it whatever it was
+		 * upon entry to the module.
+		 */
+		if (cx->prev && cx->prev->old_iflev >= 0)
+		    iflev = cx->prev->old_iflev;
+		return (OK);
+	    }
+	}
+
+	warns ("could not find mkpkg module or label `%s'", symbol);
+	if (cx->fp != stdin)
+	    k_fseek (cx, fpos, 0);
+
+	return (ERR);
+}
+
+
+/* DO_INCLUDE -- Open a file and execute any preprocessor directives therein.
+ * Macros defined in an include are retained after the context of the include
+ * is popped.
+ */
+int
+do_include (
+  struct context *cx,		/* current context	*/
+  char *fname 			/* include file name	*/
+)
+{
+	struct	context *ncx;
+	int	islib;
+
+	if (ifstate[iflev] == STOP)
+	    return (OK);
+
+	if (debug > 1) {
+	    printf ("do_include: %s\n", fname);
+	    fflush (stdout);
+	}
+
+	ncx = push_context (cx, "BOF", "", fname);
+	do_mkpkg (ncx, islib=NO);
+	cx->old_cp = cp;			/* keep symbols */
+	cx->old_nsymbols = nsymbols;
+	cx = pop_context (ncx);
+
+	return (OK);
+}
+
+
+/* DO_OMAKE -- Generate the object module for the named source module, if
+ * the object does not exist or is older than the source module.
+ */
+void
+do_omake (
+  struct context *cx,
+  char	*fname
+)
+{
+	char	cmd[SZ_COMMAND+1];
+	char	xflags[SZ_LINE+1];
+	char	*dflist[MAX_DEPFILES+1];
+	char	*s_xflags, *dfile;
+	long	sourcedate, objdate, date;
+	int	recompile, i;
+
+
+	if (ifstate[iflev] == STOP)
+	    return;
+
+	if (debug) {
+	    printf ("omake %s\n", fname);
+	    fflush (stdout);
+	}
+
+	if ((sourcedate = os_fdate (fname)) <= 0) {
+	    warns ("file `%s' not found", fname);
+	    exit_status = ERR;
+	    return;
+
+	} else {
+	    get_dependency_list (cx, fname, dflist, MAX_DEPFILES);
+	    objdate = os_fdate (makeobj (fname));
+	    recompile = 0;
+
+	    if (sourcedate > objdate)
+		recompile++;
+	    else {
+		for (i=0;  (dfile = dflist[i]) != NULL;  i++)
+		    if ((date = m_fdate (dfile)) == 0)
+			warns ("dependency file `%s' not found", dfile);
+		    else if (date > objdate) {
+			recompile++;
+			break;
+		    }
+	    }
+	}
+
+	if (recompile) {
+	    /* Get XFLAGS. */
+	    s_xflags = getsym (XFLAGS);
+	    xflags[0] = EOS;
+	    if (debug)
+		strcat (xflags, "-d ");
+	    if (dbgout)
+		strcat (xflags, "-x ");
+	    strcat (xflags, s_xflags);
+
+	    if (irafdir[0])
+		sprintf (cmd, "%s %s -r %s %s", XC, xflags, irafdir, fname);
+	    else
+		sprintf (cmd, "%s %s %s", XC, xflags, fname);
+
+	    if (verbose) {
+		printf ("%s\n", cmd);
+		fflush (stdout);
+	    }
+
+	    if (execute)
+		exit_status = h_xc (cmd);
+	    if (exit_status == INTERRUPT)
+		fatals ("<ctrl/c> interrupt %s", cx->library);
+
+	} else if (verbose) {
+	    printf ("Object %s is up to date\n", makeobj(fname));
+	    fflush (stdout);
+	}
+}
+
+
+/* DO_XC -- Call XC.  Note that the current default xflags are not
+ * automatically included in the generated command.
+ */
+int
+do_xc (struct context *cx)
+{
+	char	cmd[SZ_CMD+1];
+
+
+	if (debug > 1) {
+	    printf ("do_xc:\n");
+	    fflush (stdout);
+	}
+
+	if (irafdir[0])
+	    sprintf (cmd, "%s -r %s", XC, irafdir);
+	else
+	    sprintf (cmd, "%s", XC);
+
+	if (debug)
+	    strcat (cmd, " -d");
+	if (dbgout)
+	    strcat (cmd, " -x");
+
+	getcmd (cx, cmd, cmd, SZ_CMD);
+
+	if (ifstate[iflev] == STOP)
+	    return 0;
+
+	if (verbose) {
+	    printf ("%s\n", cmd);
+	    fflush (stdout);
+	}
+
+	if (execute)
+	    exit_status = h_xc (cmd);
+	if (exit_status == INTERRUPT)
+	    fatals ("<ctrl/c> interrupt %s", cx->library);
+
+	return (exit_status);
+}
+
+
+/* DO_LINK -- Call XC to link a list of objects and/or libraries.  This is
+ * equivalent to $XC, except that the LFLAGS are used instead of the XFLAGS.
+ */
+int
+do_link (struct context *cx)
+{
+	register struct sfile *sflist, *sfp=NULL;
+	static int skip_sf = 0;
+	char *ip, token[SZ_FNAME+1];
+	char linkline[SZ_CMD+1];
+	char cmdbuf[SZ_CMD+1];
+	char *cmd = cmdbuf;
+	int lflags_set = 0;
+	char *lflags;
+
+
+	if (debug > 1) {
+	    printf ("do_link:\n");
+	    fflush (stdout);
+	}
+
+	/* Get the link command from the input stream. */
+	getcmd (cx, "", linkline, SZ_CMD);
+
+	/* Check whether the executable being generated is on the special
+	 * file list.
+	 */
+	if (!skip_sf && (sflist = sf_dirsearch (cx->dirpath))) {
+	    for (ip=linkline;  getword(&ip,token,SZ_FNAME);  )
+		if (strcmp (token, "-o") == 0)
+		    if (getword (&ip, token, SZ_FNAME))
+			if ((sfp = sf_filesearch (sflist, token)))
+			    break;
+	}
+
+	/* Check if LFLAGS is being substituted for this file. */
+	if (sfp && strncmp (sfp->sf_mkobj, "LFLAGS", 6) == 0) {
+	    for (ip=sfp->sf_mkobj;  *ip && *ip != '=';  ip++)
+		;
+	    lflags = (*ip == '=') ? ip + 1 : ip;
+	    lflags_set++;
+	} else
+	    lflags = getsym (LFLAGS);
+
+	if (irafdir[0])
+	    sprintf (cmd, "%s %s -r %s", XC, lflags, irafdir);
+	else
+	    sprintf (cmd, "%s %s", XC, lflags);
+
+	if (debug)
+	    strcat (cmd, " -d");
+	if (dbgout)
+	    strcat (cmd, " -x");
+
+	strcat (cmd, linkline);
+
+	if (ifstate[iflev] == STOP)
+	    return 0;
+
+	/* Check whether a special $link command or other build command
+	 * should be executed.
+	 */
+	if (sfp && !lflags_set) {
+	    /* Push back the special link command. */
+	    m_pushstr (cx, "\n");
+	    m_pushstr (cx, sfp->sf_mkobj);
+
+	    /* Avoid recursion if $link is pushed back. */
+	    if (strncmp (sfp->sf_mkobj, "$link", 5) == 0)
+		skip_sf++;
+	    return (OK);
+	}
+
+	if (verbose) {
+	    printf ("%s\n", cmd);
+	    fflush (stdout);
+	}
+
+	if (execute)
+	    exit_status = h_xc (cmd);
+	if (exit_status == INTERRUPT)
+	    fatals ("<ctrl/c> interrupt %s", cx->library);
+
+	skip_sf = 0;
+	return (exit_status);
+}
+
+
+/* DO_GENERIC -- Call the generic preprocessor.
+ */
+int
+do_generic (struct context *cx)
+{
+	char	cmd[SZ_CMD+1];
+
+	if (debug > 1) {
+	    printf ("do_generic:\n");
+	    fflush (stdout);
+	}
+
+	getcmd (cx, GENERIC, cmd, SZ_CMD);
+
+	if (ifstate[iflev] == STOP)
+	    return 0;
+
+	if (verbose) {
+	    printf ("%s\n", cmd);
+	    fflush (stdout);
+	}
+
+	if (execute)
+	    exit_status = os_cmd (cmd);
+	if (exit_status == INTERRUPT)
+	    fatals ("<ctrl/c> interrupt %s", cx->library);
+
+	return (exit_status);
+}
+
+
+/* DO_SET -- Enter the name and value of a symbol (macro) into the symbol
+ * table.
+ */
+void
+do_set (struct context *cx)
+{
+	char	symbol[SZ_FNAME+1];
+	char	value[SZ_PBBUF+1];
+
+	if (debug > 1) {
+	    printf ("do_set:\n");
+	    fflush (stdout);
+	}
+
+	if (getkwvpair (cx, symbol, value) != ERR) {
+	    if (ifstate[iflev] == STOP)
+		return;
+
+	    if (debug) {
+		printf ("set %s = `%s'\n", symbol, value);
+		fflush (stdout);
+	    }
+	    putsym (symbol, value);
+	}
+}
+
+
+/* DO_INCHECK -- Check a file (e.g, library) back into the named directory.
+ * (the "in" is first to make the external function name unique on systems
+ * which truncate external names).
+ */
+int
+do_incheck (struct context *cx)
+{
+	char	fname[SZ_FNAME+1];
+	char	dname[SZ_FNAME+1];
+
+	if (debug > 1) {
+	    printf ("do_checkin:\n");
+	    fflush (stdout);
+	}
+
+	strcpy (fname, getargs (cx));
+	strcpy (dname, getargs (cx));
+
+	exit_status = h_incheck (fname, dname);
+	if (exit_status != OK)
+	    warns ("error during checkin of %s", fname);
+
+	return (exit_status);
+}
+
+
+/* DO_OUTCHECK -- Check a file (e.g, library) out of the named directory.
+ */
+int
+do_outcheck (struct context *cx)
+{
+	char	fname[SZ_FNAME+1];
+	char	dname[SZ_FNAME+1];
+	int	clobber;
+
+	if (debug > 1) {
+	    printf ("do_checkout:\n");
+	    fflush (stdout);
+	}
+
+	strcpy (fname, getargs (cx));
+	strcpy (dname, getargs (cx));
+
+	exit_status = h_outcheck (fname, dname, clobber=YES);
+	if (exit_status != OK)
+	    warns ("error during checkout of %s", fname);
+
+	return (exit_status);
+}
+
+
+/* DO_COPYFILE -- Copy a file.
+ */
+int
+do_copyfile (struct context *cx)
+{
+	char	old[SZ_FNAME+1];
+	char	new[SZ_FNAME+1];
+
+	if (debug > 1) {
+	    printf ("do_copyfile:\n");
+	    fflush (stdout);
+	}
+
+	strcpy (old, getargs (cx));
+	strcpy (new, getargs (cx));
+
+	if (ifstate[iflev] == STOP)
+	    return 0;
+
+	if (verbose) {
+	    printf ("copy `%s' to `%s'\n", old, new);
+	    fflush (stdout);
+	}
+	
+	exit_status = h_copyfile (old, new);
+	if (exit_status != OK)
+	    warns ("error making copy of %s", old);
+
+	return (exit_status);
+}
+
+
+/* DO_MOVEFILE -- Move a file to another directory, or rename the file in the
+ * current directory.
+ */
+int
+do_movefile (struct context *cx)
+{
+	register char *ip, *op;
+	char	old[SZ_FNAME+1];
+	char	new[SZ_PATHNAME+1];
+
+	if (debug > 1) {
+	    printf ("do_movefile:\n");
+	    fflush (stdout);
+	}
+
+	strcpy (old, getargs (cx));
+	strcpy (new, getargs (cx));
+
+	if (ifstate[iflev] == STOP)
+	    return 0;
+
+	/* If NEW is a directory, concatenate the filename.  Always pass a
+	 * filename to h_movefile.
+	 */
+	for (op=new;  *op;  op++)
+	    ;
+	if (*(op-1) == '$' || *(op-1) == '/')
+	    for (ip=old;  (*op++ = *ip++);  )
+		;
+
+	if (verbose) {
+	    printf ("move `%s' to `%s'\n", old, new);
+	    fflush (stdout);
+	}
+	
+	exit_status = h_movefile (old, new);
+	if (exit_status != OK)
+	    warns ("error moving file %s", old);
+
+	return (exit_status);
+}
+
+
+/* DO_DELETE -- Delete a file or list of files.
+ */
+void
+do_delete (struct context *cx)
+{
+	char	fname[SZ_PATHNAME+1];
+
+
+	if (debug > 1) {
+	    printf ("do_delete:\n");
+	    fflush (stdout);
+	}
+
+	for (;;) {
+	    strcpy (fname, getargs (cx));
+	    if (fname[0] == EOS)
+		return;
+
+	    if (ifstate[iflev] == STOP)
+		return;
+
+	    if (execute) {
+		if (verbose) {
+		    printf ("delete file %s\n", vfn2osfn(fname,0));
+		    fflush (stdout);
+		}
+
+		exit_status = os_delete (fname);
+		if (exit_status != OK)
+		    warns ("cannot delete file %s", fname);
+	    }
+	}
+}
+
+
+/* DO_PURGE -- Purge all files in a directory.  This is a no-op on systems
+ * that do not support multiple file versions.
+ */
+void
+do_purge (
+  struct context *cx,		/* not used			*/
+  char	*dname			/* logical directory name	*/
+)
+{
+	if (debug > 1) {
+	    printf ("do_purge: %s\n", dname);
+	    fflush (stdout);
+	}
+
+	if (ifstate[iflev] == STOP)
+	    return;
+
+	exit_status = h_purge (dname);
+	if (exit_status != OK)
+	    warns ("error during purge of %s", dname);
+}
+
+
+/* GETCMD -- Extract a possibly multiline command from the input stream
+ * into a buffer, with macro replacement in the process.
+ */
+int
+getcmd (
+  register struct context *cx,
+  char	*prefix,		/* first part of command	*/
+  char	*cmd,			/* receives the command		*/
+  int	maxch
+)
+{
+	register char	*op, *otop;
+	register int	ch;
+
+
+	otop = &cmd[maxch];
+	strcpy (cmd, prefix);
+	for (op=cmd;  *op;  op++)
+	    ;
+
+	while (op < otop && (ch = m_getc(cx)) != EOF)
+	    if (ch == ESCAPE) {
+		ch = m_getc (cx);
+		if (ch != '\n') {
+		    *op++ = ESCAPE;
+		    *op++ = ch;
+		}
+	    } else if (ch == '\n') {
+		*op = EOS;
+		break;
+	    } else if (ch == PREPROCESSOR && *(op-1) == ' ') {
+		/* $ is only recognized as a command delimiter if it occurs
+		 * at the start of a new token.
+		 */
+		m_ungetc (ch, cx);
+		*op = EOS;
+		break;
+	    } else
+		*op++ = ch;
+
+	return (op - cmd);
+}
+
+
+/* GETARGS -- Accumulate the argument list of a preprocessor macro.
+ * The argument list may optionally be enclosed in parens or quotes,
+ * otherwise we look for whitespace or newline as the delimiter.
+ */
+char *
+getargs (
+  register struct context *cx	/* current context	*/
+)
+{
+	register int	ch;
+	static	char	args[SZ_PBBUF+1];
+	char	tokbuf[SZ_COMMAND+1];
+	int	delim;
+
+
+	while ((ch = m_getc(cx)) == ' ')
+	    ;
+
+	if (ch == '(')
+	    delim = ')';
+	else if (ch == '"' || ch == '\'')
+	    delim = ch;
+	else if (ch == SYSFILE_BEGIN)
+	    delim = SYSFILE_END;
+	else {
+	    delim = ' ';
+	    m_ungetc (ch, cx);
+	}
+
+	getstr (cx, tokbuf, SZ_COMMAND, delim);
+	strcpy (args, tokbuf);
+
+	if (delim == SYSFILE_END)
+	    if (m_sysfile (tokbuf, args, SZ_PBBUF) <= 0)
+		sprintf (args, "<%s>", tokbuf);
+
+	return (args);
+}
+
+
+/* GETSTR -- Accumulate a string from the input stream, stopping when the
+ * specified delimiter character is seen.  Note that macros are expanded
+ * even within quoted strings, as in MAKE (macros are defined at the character
+ * level, rather than at the token level).
+ */
+int
+getstr (
+  register struct context *cx,	/* current context	*/
+  char	*outstr,		/* receives string	*/
+  int	maxch,			/* max chars out	*/
+  int	delim 			/* delimiter character	*/
+)
+{
+	register char	*op;
+	register int	ch, n;
+
+	for (op=outstr, n=maxch;  --n >= 0 && (ch = m_getc(cx)) != delim;  )
+	    if (ch == '\\') {
+		ch = m_getc(cx);
+		if (ch == '\n')
+		    ;
+		else if (ch == delim)
+		    *op++ = ch;
+		else {
+		    *op++ = '\\';
+		    *op++ = ch;
+		}
+	    } else if (ch == '\n' || ch == EOF) {
+		*op = EOS;
+		if (delim != ' ')
+		    warns ("missing closing quote in string `%s'", outstr);
+		m_ungetc ('\n', cx);
+		break;
+	    } else
+		*op++ = ch;
+
+	*op = EOS;
+	return (op - outstr);
+}
+
+
+/* GETKWVPAIR -- Extract the keyword and value fields from a "keyword=value"
+ * construct in the input stream.
+ */
+int
+getkwvpair (
+  register struct context *cx,	/* current context		*/
+  char	*symbol,		/* receives name of symbol	*/
+  char	*value			/* receives value of symbol	*/
+)
+{
+	register char	*op;
+	register int	ch;
+
+	while ((ch = m_getc(cx)) == ' ')
+	    ;
+	if (!isalpha(ch)) {
+	    m_ungetc (ch, cx);
+	    return (ERR);
+	}
+
+	/* Extract module name */
+	for (op=symbol, *op++ = ch;  (ch = m_getc(cx)) != '=';  ) {
+	    if (ch == ' ') {
+		continue;
+	    } else if (ch == '\n') {
+		warns ("missing `=' in $set statement `%s'", symbol);
+		m_ungetc ('\n', cx);
+		return (ERR);
+	    } else
+		*op++ = ch;
+	}
+	*op = EOS;
+
+	/* Extract symbol value */
+	strcpy (value, getargs(cx));
+	return (OK);
+}
+
+
+/* GETWORD -- Extract a whitespace delimited substring from a string.
+ * The input pointer is left pointing to the first character following
+ * the extracted string.
+ */
+int
+getword (
+  char **str,
+  char *outstr,
+  int maxch
+)
+{
+	register char *ip=(*str), *op=outstr;
+	register char *otop = outstr + maxch;
+	register int ch;
+
+	while (*ip && isspace (*ip))
+	    ip++;
+
+	while (op < otop && (ch = *ip++))
+	    if (isspace (ch))
+		break;
+	    else
+		*op++ = ch;
+
+	*op = EOS;
+	*str = ip;
+
+	return (op - outstr);
+}
+
+
+/* PUTSYM -- Add a symbol (macro definition) to the symbol table.  Symbol
+ * storage is in the string buffer, with all symbols defined local to a
+ * module being discarded when the module exits.  All symbols are globally
+ * accessible, with local symbols possibly redefining (temporarily) existing
+ * external symbols (e.g., the value of "xflags" might be reset locally,
+ * but should not affect outer level code once the module has exited).
+ * Symbol names are treated in a case insensitive fashion to simplify use
+ * on systems that do not preserve case, e.g., in the MKPKG argument list.
+ */
+void
+putsym (
+  char	*name,		/* symbol name		*/
+  char	*value		/* symbol value		*/
+)
+{
+	char	*symbol;
+
+	if (debug) {
+	    printf ("put symbol %s = `%s'\n", name, value);
+	    fflush (stdout);
+	}
+
+	symbol = mklower (name);
+	symtab[nsymbols].s_name  = putstr (symbol);
+	symtab[nsymbols].s_value = putstr (value);
+
+	if (++nsymbols >= MAX_SYMBOLS)
+	    fatals ("too many symbols (`%s')", name);
+}
+
+
+/* GETSYM -- Lookup a symbol in the symbol table.  Return the symbol value
+ * as the function value if the symbol is found, else return NULL.  The symbol
+ * table is searched most-recently-defined symbols first, permitting symbols
+ * to be redefined locally.  Note that the full table is searched, hence the
+ * outer symbols are globally accessible.  The number of symbols tends to be
+ * quite small and symbol lookup only occurs when a macro is explicitly
+ * referenced as $(NAME), hence a simple linear search is best.
+ */
+char *
+getsym (
+  char	*name		/* symbol name		*/
+)
+{
+	register struct	symbol *sp, *stop;
+	register int	ch;
+	char	*symbol;
+
+	symbol = mklower (name);
+	stop = &symtab[0];
+	sp   = &symtab[nsymbols];
+	ch   = symbol[0];
+
+	/* Search the symbol table.
+	 */
+	while (--sp >= stop)
+	    if (sp->s_name[0] == ch)
+		if (strcmp (sp->s_name, symbol) == 0)
+		    return (sp->s_value);
+	
+	return (NULL);
+}
+
+
+/* MKLOWER -- Convert a small string to lower case and return a pointer to
+ * a local copy of the new string.
+ */
+char *
+mklower (char *s)
+{
+	register char	*ip, *op;
+	register int	n, ch;
+	static	char lstr[SZ_FNAME+1];
+
+	for (ip=s, op=lstr, n=SZ_FNAME;  --n >= 0 && (ch = *ip++);  )
+	    if (isupper (ch))
+		*op++ = tolower (ch);
+	    else
+		*op++ = ch;
+	*op = EOS;
+
+	return (lstr);
+}
diff --git a/unix/boot/rmbin/README b/unix/boot/rmbin/README
new file mode 100644
index 00000000..7eb6a6c4
--- /dev/null
+++ b/unix/boot/rmbin/README
@@ -0,0 +1 @@
+RMBIN -- Descend a directory tree, removing all binary files therein.
diff --git a/unix/boot/rmbin/mkpkg.sh b/unix/boot/rmbin/mkpkg.sh
new file mode 100644
index 00000000..aa2aa4ad
--- /dev/null
+++ b/unix/boot/rmbin/mkpkg.sh
@@ -0,0 +1,6 @@
+# Make and install the RMBIN utility.
+
+$CC -c $HSI_CF	rmbin.c
+$CC $HSI_LF	rmbin.o $HSI_LIBS -o rmbin.e
+mv -f		rmbin.e ../../hlib
+rm		*.o
diff --git a/unix/boot/rmbin/rmbin.c b/unix/boot/rmbin/rmbin.c
new file mode 100644
index 00000000..760a1fb3
--- /dev/null
+++ b/unix/boot/rmbin/rmbin.c
@@ -0,0 +1,264 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#define import_spp
+#define import_knames
+#include <iraf.h>
+
+#include "../bootProto.h"
+
+
+#define	MAXEXTN		128
+
+char	*only[MAXEXTN];		/* delete files with these extensions	*/
+char	*excl[MAXEXTN];		/* exclude these files			*/
+int	interactive;		/* verify if file does not have extn	*/
+int	recurse;		/* recursively descend directories	*/
+int	verbose;		/* print names of deleted files		*/
+int	execute;		/* permission to delete files		*/
+
+
+extern  int ZZSTRT(void);
+extern  int ZZSTOP(void);
+
+static void rmbin (char *dir, int recurse, char *path);
+static int  verify_delete (char *fname, char *path);
+static int  exclude_file (char *fname);
+
+
+/*
+ * RMBIN -- Delete all binary files in a directory tree or trees.
+ *
+ *	rmbin [-dinrv] [-o extns] [-e extns] dir1 dir2 ... dirN
+ *
+ *		-d	disable recursive descent
+ *		-e	exclude files with the following extensions
+ *		-i	verify before deleting files without extensions
+ *		-n	no execute; do not delete files
+ *		-o	delete only files with the following extensions
+ *		-r	enable recursive descent
+ *		-v	print names of files as they are deleted
+ *
+ * Note that flags may be inserted between directory name arguments to change
+ * switches for different directories.
+ *
+ */
+int
+main (int argc, char *argv[])
+{
+	char	path[SZ_PATHNAME+1];
+	char	*argp;
+	int	argno, i;
+
+	ZZSTRT();
+
+	if (argc < 2)
+	    goto help_;
+
+	only[0] = NULL;
+	excl[0] = NULL;
+	path[0] = EOS;
+
+	interactive = 0;
+	recurse = 0;
+	verbose = 0;
+	execute = 1;
+
+	for (argno=1;  (argp = argv[argno]) != NULL;  argno++)
+	    if (*argp == '-') {
+		for (argp++;  *argp;  argp++)
+		    switch (*argp) {
+		    case 'd':			/* disable recursion	*/
+			recurse = 0;
+			break;
+		    case 'i':			/* verify deletions	*/
+			interactive = 1;
+			break;
+		    case 'r':			/* enable recursion	*/
+			recurse = 1;
+			break;
+		    case 'n':			/* no execute		*/
+			execute = 0;
+			/* fall through */
+		    case 'v':			/* set verbose mode	*/
+			verbose = 1;
+			break;
+
+		    case 'e':			/* exclude listed files	*/
+			i = 0;
+			argno++;
+			while (argv[argno] != NULL && *(argv[argno]) == '.' &&
+			    *(argv[argno]+1) != EOS)
+			    excl[i++] = argv[argno++];
+			--argno;
+			break;
+
+		    case 'o':			/* only the listed files */
+			i = 0;
+			argno++;
+			while (argv[argno] != NULL && *(argv[argno]) == '.' &&
+			    *(argv[argno]+1) != EOS)
+			    only[i++] = argv[argno++];
+			--argno;
+			break;
+
+		    default:
+			goto help_;
+		    }
+	    } else
+		rmbin (argp, recurse, path);
+
+	ZZSTOP();
+	exit (OSOK);
+help_:
+ 	fprintf (stderr, "rmbin [-dinrv] [-o extns] [-e extns] dir dir ...\n");
+	ZZSTOP();
+	exit (OSOK+1);
+}
+
+
+/* RMBIN -- Remove all binaries in a directory or in a directory tree.
+ * We chdir to each directory to minimize path searches.
+ */
+static void
+rmbin (
+    char *dir, 
+    int	  recurse, 
+    char *path 			/* pathname of current directory */
+)
+{
+	char	newpath[SZ_PATHNAME+1];
+	char	fname[SZ_PATHNAME+1];
+	int	dp, ftype;
+
+	if ((dp = os_diropen (dir)) == ERR) {
+	    fprintf (stderr, "cannot open directory `%s'\n", dir);
+	    fflush (stderr);
+	    return;
+	}
+
+	sprintf (newpath, "%s%s/", path, dir);
+
+	/* Descend into the subdirectory.
+	 */
+	if (strcmp (dir, ".") != 0)
+	    if (os_chdir (dir) == ERR) {
+		os_dirclose (dp);
+		fprintf (stderr, "cannot change directory to `%s'\n", newpath);
+		fflush (stderr);
+		return;
+	    }
+
+	/* Scan through the directory.
+	 */
+	while (os_gfdir (dp, fname, SZ_PATHNAME) > 0) {
+	    if (os_symlink (fname, 0, 0))
+		continue;
+
+	    if ((ftype = os_filetype (fname)) == DIRECTORY_FILE)
+		rmbin (fname, recurse, newpath);
+	    else {
+		if (only[0] != NULL) {
+		    if (exclude_file (fname))
+			continue;
+		} else if (ftype != BINARY_FILE || exclude_file (fname))
+		    continue;
+
+		/* We have a binary file which is not excluded from deletion
+		 * by its extension, so delete it.
+		 */
+		if (interactive && (verify_delete (fname, newpath) == NO))
+		    continue;
+
+		if (verbose) {
+		    printf ("%s%s\n", newpath, fname);
+		    fflush (stdout);
+		}
+
+		if (execute)
+		    if (os_delete (fname) == ERR) {
+			fprintf (stderr, "cannot delete `%s'\n", fname);
+			fflush (stderr);
+		    }
+	    }
+	}
+
+	/* Return from the subdirectory.
+	 */
+	if (strcmp (dir, ".") != 0)
+	    if (os_chdir ("..") == ERR) {
+		fprintf (stderr, "cannot return from subdirectory `%s'\n",
+		    newpath);
+		fflush (stderr);
+	    }
+
+	os_dirclose (dp);
+}
+
+
+/* EXCLUDE_FILE -- Check the "only" and "exclude" file lists to see if the
+ * file should be excluded from deletion.
+ */
+static int
+exclude_file (char *fname)
+{
+	register char	*ip, *ep;
+	register int	ch, i;
+	char	*extn;
+
+	extn = NULL;
+	for (ip=fname;  (ch = *ip);  ip++)
+	    if (ch == '.')
+		extn = ip;
+
+	/* If the file has no extension all we have to do is check if there is
+	 * an "only" file list.
+	 */
+	if (extn == NULL)
+	    return (only[0] != NULL ? YES : NO);
+
+	/* Check the only and exclude file lists.
+	 */
+	ch = *(extn + 1);
+	if (only[0] != NULL) {
+	    for (i=0;  (ep = only[i]);  i++)
+		if (*(ep+1) == ch)
+		    if (strcmp (ep, extn) == 0)
+			return (NO);
+	    return (YES);
+	} else if (excl[0] != NULL) {
+	    for (i=0;  (ep = excl[i]);  i++)
+		if (*(ep+1) == ch)
+		    if (strcmp (ep, extn) == 0)
+			return (YES);
+	    return (NO);
+	} else
+	    return (NO);
+}
+
+
+/* VERIFY_DELETE -- Ask the user if they want to delete the named file.
+ */
+static int
+verify_delete (
+    char  *fname,		/* name of file to be deleted	*/
+    char  *path 		/* current directory pathname	*/
+)
+{
+	char    lbuf[SZ_LINE+1];
+	char    *ip;
+
+	fprintf (stderr, "delete file %s%s? ", path, fname);
+	fflush  (stderr);
+	fgets   (lbuf, SZ_LINE, stdin);
+
+	for (ip=lbuf;  *ip == ' ' || *ip == '\t';  ip++)
+	    ;
+	if (*ip == 'y' || *ip == 'Y')
+	    return (YES);
+	else
+	    return (NO);
+}
diff --git a/unix/boot/rmbin/rmbin.hlp b/unix/boot/rmbin/rmbin.hlp
new file mode 100644
index 00000000..30f54c9e
--- /dev/null
+++ b/unix/boot/rmbin/rmbin.hlp
@@ -0,0 +1,70 @@
+.help rmbin Feb86 "softools"
+.ih
+NAME
+rmbin -- find/remove binary files in subdirectories
+.ih
+USAGE
+rmbin [-dinrv] [-o extns] [-e extns] dir1 dir2 ... dirN
+.ih
+PARAMETERS
+.ls 4 -d
+Disable recursive descent into subdirectories.
+.le
+.ls 4 -e extns
+Exclude files with the listed extensions (whitespace delimited).
+.le
+.ls 4 -i
+Verify before deleting files without extensions.  Files with well known
+extensions like ".[aoe]" are deleted without a query.  A heuristic (ZFACSS)
+is used to determine the filetype of files with unknown extensions, and
+it can fail, though in practice it works quite well.
+.le
+.ls 4 -n
+No execute; do not delete files.  This option may be used to generate
+a list of binary files for some purpose other than deletion.  For example,
+on a UNIX host, the following command will compute the disk space used
+by the binary files in a directory tree:
+
+	% du `rmbin -n .`
+
+The -n option, of course, is also useful for verifying the delete operation
+before destroying the files.
+.le
+.ls 4 -o extns
+Delete only files with the listed extensions (whitespace delimited).
+.le
+.ls 4 -r
+Reenable recursive descent.  Recursive descent is the default, however
+it may be turned off at one point in the command line, and later reenabled
+with this switch.
+.le
+.ls 4 -v
+Print names of files as they are deleted.
+.le
+
+Note that flags may be inserted between directory name arguments to change
+switches for different directories.
+.ih
+DESCRIPTION
+The \fIrmbin\fR task is used to descend a directory tree, deleting (or listing)
+all the binary files therein.  The task may also be used to delete or list
+nonbinary files by explicitly listing their extensions.
+
+\fIRmbin\fR is used the strip the IRAF system down to the sources, prior to
+a full system rebuild.  After changing to the IRAF root directory, one runs
+\fIrmbin\fR to delete all the binaries in lib, sys, pkg, etc. (but \fInot\fR
+in hlib, else a bootstrap will be necessary too).  \fIMkpkg\fR is then run
+to recompile the system; this currently takes about 20 hours on our UNIX
+11/750 development system, provided nothing else is running on the system.
+.ih
+EXAMPLES
+1. Delete all binaries in the pkg and sys directories of IRAF.  The example
+is for a UNIX host, but this works for all other IRAF hosts as well.
+
+.nf
+	% cd $iraf
+	% rmbin -v pkg sys
+.fi
+.ih
+SEE ALSO
+rtar, wtar, mkpkg
diff --git a/unix/boot/rmfiles/README b/unix/boot/rmfiles/README
new file mode 100644
index 00000000..45bc830c
--- /dev/null
+++ b/unix/boot/rmfiles/README
@@ -0,0 +1,4 @@
+RMFILES -- Descend a directory tree, removing or listing all the specified
+	files therein.  This is similar to the RMBIN utility, except that
+	it is not limited to removing binary files.  This task is used to
+	strip production versions of the system down to the essentials.
diff --git a/unix/boot/rmfiles/mkpkg.sh b/unix/boot/rmfiles/mkpkg.sh
new file mode 100644
index 00000000..43d8dbd3
--- /dev/null
+++ b/unix/boot/rmfiles/mkpkg.sh
@@ -0,0 +1,6 @@
+# Make and install the RMFILES utility.
+
+$CC -c $HSI_CF	rmfiles.c
+$CC $HSI_LF	rmfiles.o $HSI_LIBS -o rmfiles.e
+mv -f		rmfiles.e ../../hlib
+rm		*.o
diff --git a/unix/boot/rmfiles/rmfiles.c b/unix/boot/rmfiles/rmfiles.c
new file mode 100644
index 00000000..a6321d41
--- /dev/null
+++ b/unix/boot/rmfiles/rmfiles.c
@@ -0,0 +1,383 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <ctype.h>
+#define import_spp
+#define import_knames
+#include <iraf.h>
+
+#include "../bootProto.h"
+
+
+#define	MAXEXTN		128
+#define	ALL		0	/* delete all files			*/
+#define	ALLBUT		1	/* delete all but listed files		*/
+#define	ONLY		2	/* delete only listed files		*/
+
+int	verbose;		/* print names of deleted files		*/
+int	execute;		/* permission to delete files		*/
+int	debug;			/* print debugging info			*/
+
+extern	char *vfn2osfn();
+
+
+extern int  ZZSTRT (void);
+extern int  ZZSTOP (void);
+
+static void rmfiles (char *prog, int oneliner);
+static void stripdir (char *dir, char *path, char *extnlist[], int mode);
+static int  got_one (char *fname, char *extnlist[]);
+
+
+/*
+ * RMFILES -- Delete all files with the listed extensions in the listed
+ * directory trees.
+ *
+ *	rmfiles [-dnv] [-f progfile] dir action extns
+ *
+ *		-d		debug
+ *		-n		no execute; do not delete files
+ *		-v		print names of files as they are deleted
+ *		-f progfile	name of file containing program script
+ *		dir		root directory of tree to be pruned
+ *		action		one of "-all", "-allbut", "-only"
+ *		extns		extensions of files to be deleted
+ *
+ * There is no default action as a safety measure.  If -all is specifed,
+ * the extension list is ignored.
+ */
+int main (int argc, char *argv[])
+{
+	char	prog[SZ_LINE+1];
+	char	*argp, *ip, *op;
+	int	oneliner, argno;
+
+	ZZSTRT();
+
+	if (argc < 2)
+	    goto help_;
+
+	verbose = 0;
+	execute = 1;
+	debug   = 0;
+
+	for (argno=1;  (argp = argv[argno]) != NULL;  argno++)
+	    if (*argp == '-') {
+		for (argp++;  *argp;  argp++)
+		    switch (*argp) {
+		    case 'd':
+			debug++;
+			break;
+		    case 'n':			/* no execute		*/
+			execute = 0;
+			/* fall through */
+		    case 'v':			/* set verbose mode	*/
+			verbose = 1;
+			break;
+
+		    case 'f':
+			argno++;
+			if (argv[argno] == NULL) {
+			    fprintf (stderr, "illegal `-f progfile' switch\n");
+			    exit (OSOK+1);
+			}
+			rmfiles (argv[argno], oneliner=NO);
+			break;
+
+		    default:
+			goto help_;
+		    }
+
+	    } else {
+		/* Program is on command line.  The rest of the command
+		 * line is assumed to be the program.
+		 */
+		for (op=prog;  (ip = argv[argno]) != NULL;  argno++) {
+		    while ((*op = *ip++))
+			op++;
+		    *op++ = ' ';
+		}
+		*op = EOS;
+		
+		rmfiles (prog, oneliner=YES);
+		break;
+	    }
+
+
+	ZZSTOP();
+	exit (OSOK);
+help_:
+ 	fprintf (stderr, "rmfiles [-dnv] [-p prog] [progfile]\n");
+	ZZSTOP();
+	exit (OSOK+1);
+
+	return (0);
+}
+
+
+/* RMFILES -- Strip (delete) the indicated files in the indicated
+ * directories.  We are driven either by a program in the named text file,
+ * or in the prog string itself.
+ */
+static void
+rmfiles (
+    char  *prog, 		/* program, or program file name	*/
+    int	   oneliner 		/* if !oneliner, open program file	*/
+)
+{
+	char	dir[SZ_PATHNAME+1], path[SZ_PATHNAME+1];
+	char	*extnlist[MAXEXTN], *ip, *op;
+	char	lbuf[SZ_LINE+1];
+	int	nextn, mode;
+	FILE	*fp = NULL;
+
+	if (debug) {
+	    fprintf (stderr, "rmfiles @(%s), exe=%d, ver=%d\n", prog, execute,
+		verbose);
+	    fflush (stderr);
+	}
+
+	/* Is program in a file, or in the "prog" string?
+	 */
+	if (oneliner)
+	    strcpy (lbuf, prog);
+	else {
+	    /* Open the program file.
+	     */
+	    if ((fp = fopen (vfn2osfn(prog,0), "r")) == NULL) {
+		fprintf (stderr, "cannot open progfile `%s'\n", prog);
+		fflush (stderr);
+		return;
+	    }
+	}
+
+	while (oneliner || fgets (lbuf, SZ_LINE, fp) != NULL) {
+	    /* Skip comment lines and blank lines, and any whitespace at
+	     * the beginning of program lines.
+	     */
+	    for (ip=lbuf;  isspace(*ip);  ip++)
+		;
+	    if (*ip == EOS || *ip == '#') {
+		if (oneliner)
+		    break;
+		else
+		    continue;
+	    }
+
+	    /* Check for a single filename entry of the form `-file filename',
+	     * deleting the named file if this type of entry is encountered.
+	     */
+	    if (strncmp (ip, "-file", 5) == 0) {
+		for (ip=ip+5;  isspace(*ip);  ip++)
+		    ;
+		for (op=path;  (*op = *ip);  ip++, op++)
+		    if (isspace(*op))
+			break;
+		*op = EOS;
+		if (*path == EOS)
+		    continue;
+
+		if (verbose) {
+		    printf ("%s\n", path);
+		    fflush (stdout);
+		}
+
+		if (execute) {
+		    if (os_delete (path) == ERR) {
+			fprintf (stderr, "cannot delete `%s'\n", path);
+			fflush (stderr);
+		    }
+		}
+
+		continue;
+	    }
+	    
+	    /* Parse the program line into the directory pathname, mode,
+	     * and extension list.  The program entry must be all on one
+	     * line.
+	     */
+	    for (op=dir;  (*op = *ip);  ip++, op++)
+		if (isspace(*op))
+		    break;
+	    *op = EOS;
+
+	    while (isspace(*ip))
+		ip++;
+	    if (strncmp (ip, "-allbut", 7) == 0) {
+		mode = ALLBUT;
+		ip += 7;
+	    } else if (strncmp (ip, "-all", 4) == 0) {
+		mode = ALL;
+		ip += 4;
+	    } else if (strncmp (ip, "-only", 5) == 0) {
+		mode = ONLY;
+		ip += 5;
+	    } else {
+		fprintf (stderr, "error: no action specified: %s\n", lbuf);
+		fflush (stderr);
+		if (oneliner)
+		    return;
+		else
+		    continue;
+	    }
+
+	    /* Construct a list of pointers to the extension strings.
+	     */
+	    for (nextn=0;  nextn < MAXEXTN;  nextn++) {
+		while (isspace(*ip))
+		    ip++;
+		if (*ip == EOS || *ip == '#')
+		    break;
+
+		extnlist[nextn] = ip;
+		while (*ip && !isspace(*ip))
+		    ip++;
+		*ip++ = EOS;
+	    }
+
+	    extnlist[nextn] = NULL;
+
+	    if (debug) {
+		fprintf (stderr, "rootdir=%s, mode=%d, extns:", dir, mode);
+		for (nextn=0;  extnlist[nextn];  nextn++)
+		    fprintf (stderr, " %s", extnlist[nextn]);
+		fprintf (stderr, "\n");
+		fflush (stderr);
+	    }
+
+	    /* Strip the named directory tree.
+	     */
+	    path[0] = EOS;
+	    stripdir (dir, path, extnlist, mode);
+
+	    if (oneliner)
+		break;
+	}
+
+	if (!oneliner)
+	    fclose (fp);
+}
+
+
+/* STRIPDIR -- Starting with the named directory, scan that directory and
+ * all subdirectories, deleting (or listing) the files therein depending
+ * on the mode, which can be ALL, ALLBUT, or ONLY.  We chdir to each directory
+ * to minimize path searches.
+ */
+static void
+stripdir (
+    char  *dir, 		/* start with this directory		*/
+    char  *path, 		/* pathname of current directory	*/
+    char  *extnlist[], 		/* list of file extensions		*/
+    int	   mode 		/* ALL, ALLBUT, ONLY			*/
+)
+{
+	char	oldpath[SZ_PATHNAME+1];
+	char	newpath[SZ_PATHNAME+1];
+	char	fname[SZ_PATHNAME+1];
+	int	deleteit, dp;
+
+	if (debug) {
+	    fprintf (stderr, "stripdir %s%s\n", path, dir);
+	    fflush (stderr);
+	}
+
+	if ((dp = os_diropen (dir)) == ERR) {
+	    fprintf (stderr, "cannot open subdirectory `%s'\n", dir);
+	    fflush (stderr);
+	    return;
+	}
+
+	os_fpathname ("", oldpath, SZ_PATHNAME);
+	sprintf (newpath, "%s%s/", path, dir);
+
+	/* Descend into the subdirectory.
+	 */
+	if (strcmp (dir, ".") != 0)
+	    if (os_chdir (dir) == ERR) {
+		os_dirclose (dp);
+		fprintf (stderr, "cannot change directory to `%s'\n", newpath);
+		fflush (stderr);
+		return;
+	    }
+
+	/* Scan through the directory.
+	 */
+	while (os_gfdir (dp, fname, SZ_PATHNAME) > 0) {
+	    if (os_filetype (fname) == DIRECTORY_FILE) {
+		stripdir (fname, newpath, extnlist, mode);
+		continue;
+	    } else if (mode == ALL) {
+		deleteit = YES;
+	    } else {
+		deleteit = got_one (fname, extnlist);
+		if (mode == ALLBUT)
+		    deleteit = !deleteit;
+	    }
+
+	    if (!deleteit)
+		continue;
+		
+	    if (verbose) {
+		printf ("%s%s\n", newpath, fname);
+		fflush (stdout);
+	    }
+
+	    if (execute) {
+		if (os_delete (fname) == ERR) {
+		    fprintf (stderr, "cannot delete `%s'\n", fname);
+		    fflush (stderr);
+		}
+	    }
+	}
+
+	/* Return from the subdirectory.
+	 */
+	if (strcmp (dir, ".") != 0)
+	    if (os_chdir (oldpath) == ERR) {
+		fprintf (stderr, "cannot return from subdirectory `%s'\n",
+		    newpath);
+		fflush (stderr);
+	    }
+
+	os_dirclose (dp);
+}
+
+
+/* GOT_ONE -- Check the file extension, if there is one, to see if the
+ * file is on the list of extensions.
+ */
+static int
+got_one (
+    char  *fname,		/* file to be examined		*/
+    char  *extnlist[]		/* list of extensions		*/
+)
+{
+	register char	*ip, *ep;
+	register int	ch, i;
+	char	*extn;
+
+	extn = NULL;
+	for (ip=fname;  (ch = *ip);  ip++)
+	    if (ch == '.')
+		extn = ip;
+
+	/* If the file has no extension it is not on the list.
+	 */
+	if (extn == NULL)
+	    return (NO);
+
+	/* Check the list of extensions.
+	 */
+	ch = *(extn + 1);
+	if (extnlist[0] != NULL)
+	    for (i=0;  (ep = extnlist[i]);  i++)
+		if (*(ep+1) == ch)
+		    if (strcmp (ep, extn) == 0)
+			return (YES);
+
+	return (NO);
+}
diff --git a/unix/boot/rmfiles/rmfiles.hlp b/unix/boot/rmfiles/rmfiles.hlp
new file mode 100644
index 00000000..b9e0125d
--- /dev/null
+++ b/unix/boot/rmfiles/rmfiles.hlp
@@ -0,0 +1,95 @@
+.help rmfiles Jul86 "softools"
+.ih
+NAME
+rmfiles -- find/remove files in subdirectories
+.ih
+USAGE
+rmfiles [-dnv] [-f progfile] rootdir action extns
+.ih
+PARAMETERS
+.ls 4 -d
+Print debug messages.
+.le
+.ls 4 -n
+No execute; do not delete files.  This option may be used to generate
+a list of binary files for some purpose other than deletion, or to verify
+the delete operation before destroying the files.
+.le
+.ls 4 -v
+Print names of files as they are deleted.
+.le
+.ls 4 -f progfile
+Take delete commands from the named file.  If this option is specified
+the remaining arguments are normally omitted.
+.le
+.ls 4 rootdir
+The root directory of the directory tree to be pruned.  This must be a
+path from the current directory or from a logical directory.
+.le
+.ls 4 action
+The possible actions are listed below.  This is a required parameter.
+.ls
+.ls 8 -all
+Delete all files.
+.le
+.ls 8 -allbut
+Delete all files except those with the listed extensions.
+.le
+.ls 8 -only
+Delete only those files with the listed extensions.
+.le
+.le
+.le
+.ls 4 extns
+A list of filename extensions delimited by spaces, e.g., ".a .o .e .hlp".
+.le
+.ih
+DESCRIPTION
+The \fIrmfiles\fR utility is used to delete (or list) files in one or more
+directory trees.  If only one directory tree is to be pruned the necessary
+instructions can be entered on the command line, otherwise a program file
+must be used.  When developing a program file, a dry run using the "-n"
+switch is recommended to see what files will be deleted.
+
+If a program file is used each line in the file has one of two possible
+formats.  If a directory is to be pruned the syntax is the same as is
+used when a one line program is entered on the command line, i.e.:
+
+	rootdir action extns
+
+The significance of each field is as described in the ARGUMENTS section
+above.  The program file may also contain lines of the form
+
+	-file filename
+
+to delete one or more files by name.  This is useful for removing files
+which do not fit into any recognizable class.
+
+Comments and blank lines are permitted anywhere in the program file.
+All filenames are IRAF virtual filenames (or host filenames).
+
+\fIRmfiles\fR is a bootstrap utility implemented as a foreign task, hence
+it may be called either from within IRAF or from the host system.
+.ih
+EXAMPLES
+1. Delete all .o, .e, .a, and .hd files in the directory "iraf$pkg".
+Print the names of the files as they are deleted.  Note that one must
+move to the directory containing the directory to be pruned before running
+\fIrmfiles\fR.
+
+.nf
+	cl> cd iraf
+	cl> rmfiles -v pkg .o .e .a .hd
+.fi
+
+2. Strip the entire IRAF system, using the program in file "hlib$stripper".
+The use of the $ in the filename here could cause problems on some systems
+since \fIrmfiles\fR is a foreign task.
+
+.nf
+	cl> cd iraf
+	cl> rmfiles -vf hlib$stripper
+.fi
+.ih
+SEE ALSO
+rmbin, rtar, wtar
diff --git a/unix/boot/rtar/README b/unix/boot/rtar/README
new file mode 100644
index 00000000..61e45d80
--- /dev/null
+++ b/unix/boot/rtar/README
@@ -0,0 +1,5 @@
+RTAR -- Read tar format file or tape.  This is a portable, non-UNIX, non-
+	proprietary program for reading tar format files on a variety of
+	systems.  The TAR format is an excellent choice for transporting
+	files between different machines because of its simplicity, efficiency,
+	and machine independence.
diff --git a/unix/boot/rtar/mkpkg.sh b/unix/boot/rtar/mkpkg.sh
new file mode 100644
index 00000000..ec801f5f
--- /dev/null
+++ b/unix/boot/rtar/mkpkg.sh
@@ -0,0 +1,6 @@
+# Bootstrap RTAR.
+
+$CC -c $HSI_CF	rtar.c
+$CC $HSI_LF	rtar.o $HSI_LIBS -o rtar.e
+mv		rtar.e ../../hlib
+rm -f		rtar.o
diff --git a/unix/boot/rtar/rtar.c b/unix/boot/rtar/rtar.c
new file mode 100644
index 00000000..6ef2e37e
--- /dev/null
+++ b/unix/boot/rtar/rtar.c
@@ -0,0 +1,863 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#include <stdio.h>
+#include <ctype.h>
+#include <string.h>
+#include <unistd.h>
+#include <stdlib.h>
+
+#define NOKNET
+#define	import_spp
+#define	import_knames
+#include <iraf.h>
+
+#include "../bootProto.h"
+
+
+/*
+ * RTAR -- Read a UNIX tar format tape containing files with legal IRAF
+ * virtual filenames.  Map tape filenames to host system filenames using
+ * IRAF filename mapping if the tape does not contain legal host system
+ * filenames.
+ *
+ * Switches:
+ *		a	advance to first file in filelist before doing
+ *			  anything.  useful for restarting an aborted
+ *			  operation.  first file is not otherwise used.
+ *		b	generate only C style binary byte stream output
+ *			  files (default is to write a text file when
+ *			  the input stream is text).
+ *		d	print debug messages
+ *		e	exclude, rather than include, listed files
+ *		f	read from named file rather than stdin
+ *		l	do not try to resolve links by a file copy
+ *		m	do not restore file modify times
+ *		n	do not strip tailing blank lines from text files
+ *		o	omit binary files (e.g. when foreign host has
+ *			  incompatible binary file format)
+ *		p	omit the given pathname prefix when creating files
+ *		r	replace existing file at extraction
+ *		t	print name of each file matched
+ *		u	do not attempt to restore user id
+ *		v	verbose; print full description of each file
+ *		x	extract files (extract everything if no files
+ *			  listed or if -e is set)
+ *
+ * Switches must be given in a group, in any order, e.g.:
+ *
+ *	rtar -xetvf tarfile sys/osb sys/os lib/config.h$
+ *
+ * would extract all files from tarfile with names not beginning with sys/os
+ * or sys/osb or with names not equal to lib/config.h, printing a verbose
+ * description of each file extracted.  If an exclude filename does not end
+ * with a $ all files with the given string as a prefix are excluded.
+ */
+
+#define TBLOCK		512
+#define NBLOCK		20
+#define NAMSIZ		100
+#define	MAXERR		20
+#define	MAXTRYS		100
+#define	MAXLINELEN	256
+#define	SZ_TAPEBUFFER	(TBLOCK * NBLOCK)
+#define	EOS		'\0'
+#define	ERR		(-1)
+#define	OK		0
+#define	RWXR_XR_X	0755
+#define	SZ_PADBUF	8196
+#define ctrlcode(c)	((c) >= '\007' && (c) <= '\017')
+
+#define	LF_LINK		1
+#define	LF_SYMLINK	2
+#define	LF_DIR		5
+
+/* File header structure.  One of these precedes each file on the tape.
+ * Each file occupies an integral number of TBLOCK size logical blocks
+ * on the tape.  The number of logical blocks per physical block is variable,
+ * with at most NBLOCK logical blocks per physical tape block.  Two zero
+ * blocks mark the end of the tar file.
+ */
+union hblock {
+	char dummy[TBLOCK];
+	struct header {
+		char name[NAMSIZ];	/* NULL delimited		*/
+		char mode[8];		/* octal, ascii			*/
+		char uid[8];
+		char gid[8];
+		char size[12];
+		char mtime[12];
+		char chksum[8];
+		char linkflag;
+		char linkname[NAMSIZ];
+	} dbuf;
+};
+
+
+/* Decoded file header.
+ */
+struct fheader {
+	char	name[NAMSIZ];
+	int	mode;
+	int	uid;
+	int	gid;
+	int	isdir;
+	long	size;
+	long	mtime;
+	long	chksum;
+	int	linkflag;
+	char	linkname[NAMSIZ];
+};
+
+
+static int advance;		/* Advance to named file		*/
+static int stripblanks;		/* strip blank padding at end of file	*/
+static int debug;		/* Print debugging messages		*/
+static int binaryout;		/* make only binary byte stream files	*/
+static int omitbinary;		/* omit binary files (do not write)	*/
+static int extract;		/* Extract files from the tape		*/
+static int replace;		/* Replace existing files		*/
+static int exclude;		/* Excluded named files			*/
+static int printfnames;		/* Print file names			*/
+static int verbose;		/* Print everything			*/
+static int links;		/* Defeat copy to resolve link		*/
+static int setmtime;		/* Restore file modify times		*/
+static int rsetuid;		/* Restore file user id			*/
+
+static char *pathprefix = NULL;
+static int len_pathprefix = 0;
+static struct fheader *curfil;
+static int eof;
+static int nerrs;
+static char *first_file;
+static char tapeblock[SZ_TAPEBUFFER];
+static char *nextblock;
+static int nblocks;
+
+extern int  ZZSTRT (void);
+extern int  ZZSTOP (void);
+
+extern  int tape_open (char *fname, int mode);
+extern  int tape_close (int fd);
+extern  int tape_read (int fd, char *buf, int nbytes);
+
+static int   matchfile (char *fname, register char **files);
+static int   getheader (int in, register struct fheader *fh);
+static int   cchksum (register char *p, register int nbyte);
+static void  printheader (FILE *out, register struct fheader *fh, int verbose);
+static int   filetype (int in, struct fheader *fh);
+static int   newfile (char *fname, int mode, int uid, int gid, int type);
+static int   checkdir (register char *path, int mode, int uid, int gid);
+static void  copyfile (int in, int out, struct fheader *fh, int ftype);
+static void  strip_blanks (int in, int out, long nbytes);
+static void  skipfile (int in, struct fheader *fh);
+static char *getblock (int in);
+
+
+
+
+char	*getblock();
+
+
+/* MAIN -- "rtar [xtvlef] [names]".  The default operation is to extract all
+ * files from the tar format standard input in quiet mode.
+ */
+int main (int argc, char *argv[])
+{
+	struct	fheader fh;
+	char	**argp;
+	char	*ip;
+	int	in = 0, out;
+	int	ftype;
+	int	ch;
+
+	ZZSTRT();		/* initialize the IRAF kernel	*/
+
+	advance		= 0;
+	debug		= 0;
+	binaryout	= 0;
+	omitbinary	= 0;
+	extract		= 0;
+	replace		= 0;
+	exclude		= 0;
+	printfnames	= 0;
+	verbose		= 0;
+	links		= 0;
+	setmtime	= 1;
+	rsetuid		= 1;
+	stripblanks	= 1;	/* strip blanks at end of file by default */
+
+	/* Get parameters.  Argp is left pointing at the list of files to be
+	 * extracted (default all if no files named).
+	 */
+	argp = &argv[1];
+	if (argc <= 1)
+	    extract++;
+	else {
+	    while (*argp && **argp == '-') {
+		ip = *argp++ + 1;
+		while ((ch = *ip++) != EOS) {
+		    switch (ch) {
+		    case 'a':
+			advance++;
+			break;
+		    case 'n':
+			stripblanks = 0;
+			break;
+		    case 'x':
+			extract++;
+			break;
+		    case 'b':
+			binaryout++;
+			break;
+		    case 'd':
+			debug++;
+			break;
+		    case 'e':
+			exclude++;
+			break;
+		    case 'r':
+			replace++;
+			break;
+		    case 't':
+			printfnames++;
+			break;
+		    case 'v':
+			printfnames++;
+			verbose++;
+			break;
+		    case 'l':
+			links++;
+			break;
+		    case 'm':
+			setmtime = 0;
+			break;
+		    case 'u':
+			rsetuid = 0;
+			break;
+		    case 'o':
+			omitbinary++;
+			break;
+		    case 'p':
+			if (*argp != NULL) {
+			    pathprefix = *argp++;
+			    len_pathprefix = strlen (pathprefix);
+			}
+			break;
+		    case 'f':
+			if (*argp == NULL) {
+			    fprintf (stderr, "missing filename argument\n");
+			    exit (OSOK+1);
+			}
+			in = tape_open (*argp, 0);
+			if (in == ERR) {
+			    fprintf (stderr, "cannot open `%s'\n", *argp);
+			    ZZSTOP();
+			    exit (OSOK+1);
+			}
+			argp++;
+			break;
+		    default:
+			fprintf (stderr, "Warning: unknown switch `%c'\n", ch);
+			fflush (stderr);
+			break;
+		    }
+		}
+	    }
+	}
+
+	/* If advancing to a file get the name of the file.  This file name
+	 * occurs at the beginning of the file list but is not part of the list.
+	 * Only full filenames are permitted here.
+	 */
+	if (advance)
+	    first_file = *argp++;
+
+	/* Step along through the tar format file.  Read file header and if
+	 * file is in list and extraction is enabled, extract file.
+	 */
+	while (getheader (in, &fh) != EOF) {
+	    curfil = &fh;
+	    if (advance) {
+		if (strcmp (fh.name, first_file) == 0) {
+		    if (debug)
+			fprintf (stderr, "match\n");
+		    advance = 0;
+		} else {
+		    if (debug)
+			printheader (stderr, &fh, verbose);
+		    skipfile (in, &fh);
+		    continue;
+		}
+	    }
+
+	    if (matchfile (fh.name, argp) == exclude) {
+		if (debug)
+		    fprintf (stderr, "skip file `%s'\n", fh.name);
+		skipfile (in, &fh);
+		continue;
+	    }
+
+	    if (printfnames) {
+		printheader (stdout, &fh, verbose);
+		fflush (stdout);
+	    }
+
+	    if (fh.linkflag == LF_SYMLINK || fh.linkflag == LF_LINK) {
+		/* No file follows header if file is a link.  Try to resolve
+		 * the link by copying the original file, assuming it has been
+		 * read from the tape.
+		 */
+		if (extract) {
+		    if (fh.linkflag == LF_SYMLINK) {
+			if (replace)
+			    os_delete (fh.name);
+			if (symlink (fh.linkname, fh.name) != 0) {
+			    fprintf (stderr,
+				"Cannot make symbolic link %s -> %s\n",
+				fh.name, fh.linkname);
+			}
+		    } else if (fh.linkflag == LF_LINK && !links) {
+			if (replace)
+			    os_delete (fh.name);
+			if (os_fcopy (fh.linkname, fh.name) == ERR) {
+			    fprintf (stderr, "Copy `%s' to `%s' fails\n",
+				fh.linkname, fh.name);
+			} else {
+			    os_setfmode (fh.name, fh.mode);
+			    if (rsetuid)
+				os_setowner (fh.name, fh.uid, fh.gid);
+			    if (setmtime)
+				os_setmtime (fh.name, fh.mtime);
+			}
+		    } else {
+			fprintf (stderr,
+			    "Warning: cannot make link `%s' to `%s'\n",
+			    fh.name, fh.linkname);
+		    }
+		}
+		continue;
+	    }
+
+	    if (extract) {
+		ftype = filetype (in, &fh);
+		if (fh.size > 0 && ftype == BINARY_FILE && omitbinary) {
+		    if (printfnames)
+			fprintf (stderr, "omit binary file `%s'\n", fh.name);
+		    skipfile (in, &fh);
+		    continue;
+		}
+		out = newfile (fh.name, fh.mode, fh.uid, fh.gid, ftype);
+		if (out == ERR) {
+		    fprintf (stderr, "cannot create file `%s'\n", fh.name);
+		    skipfile (in, &fh);
+		    continue;
+		}
+		if (!fh.isdir) {
+		    copyfile (in, out, &fh, ftype);
+		    os_close (out);
+		}
+		os_setfmode (fh.name, fh.mode);
+		if (rsetuid)
+		    os_setowner (fh.name, fh.uid, fh.gid);
+		if (setmtime)
+		    os_setmtime (fh.name, fh.mtime);
+	    } else
+		skipfile (in, &fh);
+	}
+
+	/* End of TAR file normally occurs when a zero tape block is read;
+	 * this is not the same as the physical end of file, leading to
+	 * problems when reading from sequential devices (e.g. pipes and
+	 * magtape).  Advance to the physical end of file before exiting.
+	 */
+	if (!eof)
+	    while (tape_read (in, tapeblock, SZ_TAPEBUFFER) > 0)
+		;
+	if (in)
+	    tape_close (in);
+
+	ZZSTOP();
+	exit (OSOK);
+
+	return (0);
+}
+
+
+/* MATCHFILE -- Search the filelist for the named file.  If the file list
+ * is empty anything is a match.  If the list element ends with a $ an
+ * exact match is required (excluding the $), otherwise we have a match if
+ * the list element is a prefix of the filename.
+ */
+static int
+matchfile (
+    char *fname,		/* filename to be compared to list	*/
+    register char **files	/* pointer to array of fname pointers	*/
+)
+{
+	register char *fn, *ln;
+	register int firstchar;
+
+	if (*files == NULL)
+	    return (1);
+
+	firstchar = *fname;
+	do {
+	    if (**files++ == firstchar) {
+		for (fn=fname, ln = *(files-1);  *ln && *ln == *fn++;  )
+		    ln++;
+		if (*ln == EOS)
+		    return (1);
+		else if (*ln == '$' && *(fn-1) == EOS)
+		    return (1);
+	    }
+	} while (*files);
+
+	return (0);
+}
+
+
+/* GETHEADER -- Read the next file block and attempt to interpret it as a
+ * file header.  A checksum error on the file header is fatal and usually
+ * indicates that the tape is not positioned to the beginning of a file.
+ * If we have a legal header, decode the character valued fields into binary.
+ */
+static int
+getheader (
+    int	in,				/* input file			*/
+    register struct fheader *fh		/* decoded file header (output)	*/
+)
+{
+	register char *ip, *op;
+	register int n;
+	union	hblock *hb;
+	int	tape_checksum, ntrys;
+
+	for (ntrys=0;  ;  ntrys++) {
+	    if ((hb = (union hblock *)getblock (in)) == NULL)
+		return (EOF);
+
+	    /* Decode the checksum value saved in the file header and then
+	     * overwrite the field with blanks, as the field was blank when
+	     * the checksum was originally computed.  Compute the actual
+	     * checksum as the sum of all bytes in the header block.  If the
+	     * sum is zero this indicates the end of the tar file, otherwise
+	     * the checksums must match.
+	     */
+	    if (*hb->dbuf.chksum == '\0' && cchksum ((char *)hb, TBLOCK) == 0)
+		return (EOF);
+	    else
+		sscanf (hb->dbuf.chksum, "%o", &tape_checksum);
+
+	    for (ip=hb->dbuf.chksum, n=8;  --n >= 0;  )
+		*ip++ = ' ';
+	    if (cchksum ((char *)hb, TBLOCK) != tape_checksum) {
+		/* If a checksum error occurs try to advance to the next
+		 * header block.
+		 */
+		if (ntrys == 0) {
+		    fprintf (stderr,
+			"rtar: file header checksum error %o != %o\n",
+	    		cchksum ((char *)hb, TBLOCK), tape_checksum);
+		} else if (ntrys >= MAXTRYS) {
+		    fprintf (stderr, "cannot recover from checksum error\n");
+		    exit (OSOK+1);
+		}
+	    } else
+		break;
+	}
+
+	if (ntrys > 1)
+	    fprintf (stderr, "found next file following checksum error\n");
+
+	/* Decode the ascii header fields into the output file header
+	 * structure.
+	 */
+	for (ip=hb->dbuf.name, op=fh->name;  (*op++ = *ip++);  )
+	    ;
+	fh->isdir = (*(op-2) == '/');
+
+	sscanf (hb->dbuf.mode,     "%o",  &fh->mode);
+	sscanf (hb->dbuf.uid,      "%o",  &fh->uid);
+	sscanf (hb->dbuf.gid,      "%o",  &fh->gid);
+	sscanf (hb->dbuf.size,     "%lo", &fh->size);
+	sscanf (hb->dbuf.mtime,    "%lo", &fh->mtime);
+
+	n = hb->dbuf.linkflag;
+	if (n >= '0' && n <= '9')
+	    fh->linkflag = n - '0';
+	else
+	    fh->linkflag = 0;
+
+	if (fh->linkflag)
+	    strcpy (fh->linkname, hb->dbuf.linkname);
+	
+	return (TBLOCK);
+}
+
+
+/* CCHKSUM -- Compute the checksum of a byte array.
+ */
+static int
+cchksum (
+    register char *p,
+    register int   nbytes
+)
+{
+	register int	sum;
+
+	for (sum=0;  --nbytes >= 0;  )
+	    sum += *p++;
+
+	return (sum);
+}
+
+
+struct _modebits {
+	int	code;
+	char	ch;
+} modebits[] = {
+    { 040000,	'd' },
+    { 0400,	'r' },
+    { 0200,	'w' },
+    { 0100,	'x' },
+    { 040,	'r' },
+    { 020,	'w' },
+    { 010,	'x' },
+    { 04,	'r' },
+    { 02,	'w' },
+    { 01,	'x' },
+    { 0,	0   }
+};
+
+
+/* PRINTHEADER -- Print the file header in either short or long (verbose)
+ * format, e.g.:
+ *		drwxr-xr-x  9 tody         1024 Nov  3 17:53 .
+ */
+static void
+printheader (
+    FILE  *out,				/* output file			*/
+    register struct fheader *fh,	/* file header struct		*/
+    int	  verbose			/* long format output		*/
+)
+{
+	register struct	_modebits *mp;
+	char	*tp, *ctime();
+
+	if (!verbose) {
+	    fprintf (out, "%s\n", fh->name);
+	    return;
+	}
+
+	for (mp=modebits;  mp->code;  mp++)
+	    fprintf (out, "%c", mp->code & fh->mode ? mp->ch : '-');
+
+	tp = ctime (&fh->mtime);
+	fprintf (out, "%3d %4d %2d %8ld %-12.12s %-4.4s %s",
+	    fh->linkflag,
+	    fh->uid,
+	    fh->gid,
+	    fh->size,
+	    tp + 4, tp + 20,
+	    fh->name);
+
+	if (fh->linkflag && *fh->linkname)
+	    fprintf (out, " -> %s\n", fh->linkname);
+	else
+	    fprintf (out, "\n");
+}
+
+
+/* FILETYPE -- Determine the file type (text, binary, or directory) of the
+ * next file on the input stream.  Directory files are easy; the tar format
+ * identifies directories unambiguously.  Discriminating between text and
+ * binary files is not possible in general because UNIX does not make such
+ * a distinction, but in practice we can apply a heuristic which will work
+ * in nearly all cases.  This can be overriden, producing only binary byte
+ * stream files as output, by a command line switch.
+ */
+static int
+filetype (
+    int	   in,			/* input file			*/
+    struct fheader *fh		/* decoded file header		*/
+)
+{
+	register char	*cp;
+	register int	n, ch;
+	int	newline_seen, nchars;
+
+	/* Easy cases first.
+	 */
+	if (fh->isdir)
+	    return (DIRECTORY_FILE);
+	else if (fh->size == 0 || binaryout)
+	    return (BINARY_FILE);
+
+	/* Get a pointer to the first block of the input file and set the
+	 * input pointers back so that the block is returned by the next
+	 * call to getblock.
+	 */
+	if ((cp = getblock (in)) == NULL)
+	    return (BINARY_FILE);
+	nextblock -= TBLOCK;
+	nblocks++;
+
+	/* Examine the data to see if it is text.  The simple heuristic
+	 * used requires that all characters be either printable ascii
+	 * or common control codes.
+	 */
+	n = nchars = (fh->size < TBLOCK) ? fh->size : TBLOCK;
+	for (newline_seen=0;  --n >= 0;  ) {
+	    ch = *cp++;
+	    if (ch == '\n')
+		newline_seen++;
+	    else if (!isprint(ch) && !isspace(ch) && !ctrlcode(ch))
+		break;
+	}
+
+	if (n >= 0 || (nchars > MAXLINELEN && !newline_seen))
+	    return (BINARY_FILE);
+	else
+	    return (TEXT_FILE);
+}
+
+
+/* NEWFILE -- Try to open a new file for writing, creating the new file
+ * with the mode bits given.  Create all directories leading to the file if
+ * necessary (and possible).
+ */
+static int
+newfile (
+    char *fname,		/* pathname of file		*/
+    int	  mode,			/* file mode bits		*/
+    int	  uid, int gid,		/* file owner, group codes	*/
+    int	  type 			/* text, binary, directory	*/
+)
+{
+	int	fd;
+	char	*cp;
+	char	*rindex();
+
+	if (len_pathprefix && strncmp(fname,pathprefix,len_pathprefix) == 0)
+	    fname += len_pathprefix;
+
+	if (debug)
+	    fprintf (stderr, "newfile `%s':\n", fname);
+
+	if (checkdir (fname, mode, uid, gid) == ERR)
+	    return (ERR);
+
+	if (type == DIRECTORY_FILE) {
+	    cp = rindex (fname, '/');
+	    if (cp && *(cp+1) == EOS)
+		*cp = EOS;
+	    fd = os_createdir (fname, mode);
+
+	    /* Ignore any error creating directory, as this may just mean
+	     * that the directory already exists.  If the directory does
+	     * not exist and cannot be created, there will be plenty of
+	     * other errors when we try to write files into it.
+	     */
+	    fd = OK;
+
+	} else {
+	    if (replace)
+		os_delete (fname);
+	    fd = os_createfile (fname, mode, type);
+	}
+
+	return (fd);
+}
+
+
+/* CHECKDIR -- Verify that all the directories in the pathname of a file
+ * exist.  If they do not exist, try to create them.
+ */
+static int
+checkdir (
+    register char *path,
+    int	mode,
+    int	uid, int gid
+)
+{
+	register char	*cp;
+	char	*rindex();
+
+	/* Quick check to see if the directory exists.
+	 */
+	if ((cp = rindex (path, '/')) == NULL)
+	    return (OK);
+
+	*cp = EOS;
+	if (os_access (path, 0, DIRECTORY_FILE) == YES) {
+	    *cp = '/';
+	    return (OK);
+	}
+	*cp = '/';
+
+	/* The directory cannot be accessed.  Try to make all directories
+	 * in the pathname.  If the file is itself a directory leave its
+	 * creation until later.
+	 */
+	for (cp=path;  *cp;  cp++) {
+	    if (*cp != '/')
+		continue;
+	    if (*(cp+1) == EOS)
+		return (OK);
+
+	    *cp = EOS;
+	    if (os_access (path, 0, DIRECTORY_FILE) == NO) {
+		if (os_createdir (path, RWXR_XR_X) == ERR) {
+		    fprintf (stderr, "cannot create directory `%s'\n", path);
+		    *cp = '/';
+		    return (ERR);
+		} else
+		    os_setowner (path, uid, gid);
+	    }
+	    *cp = '/';
+	}
+
+	return (OK);
+}
+
+
+/* COPYFILE -- Copy bytes from the input (tar) file to the output file.
+ * Each file consists of a integral number of TBLOCK size blocks on the
+ * input file.
+ */
+static void
+copyfile (
+    int	   in,			/* input file			*/
+    int	   out,			/* output file			*/
+    struct fheader *fh,		/* file header structure	*/
+    int	   ftype		/* text or binary file		*/
+)
+{
+	long	nbytes = fh->size;
+	int	nblocks = 0, maxpad;
+	char	*bp;
+
+
+	/* Link files are zero length on the tape. */
+	if (fh->linkflag)
+	    return;
+
+	if (ftype == BINARY_FILE || !stripblanks)
+	    maxpad = 0;
+	else
+	    maxpad = SZ_PADBUF;
+
+	/* Copy all but the last MAXPAD characters if the file is a text file
+	 * and stripping is enabled.
+	 */
+	while (nbytes > maxpad && (bp = getblock (in)) != NULL)
+	    if (os_write (out, bp, nbytes<TBLOCK ? (int)nbytes:TBLOCK) == ERR) {
+		fprintf (stderr, "Warning: file write error on `%s'\n",
+		    curfil->name);
+		if (nerrs++ > MAXERR) {
+		    fprintf (stderr, "Too many errors\n");
+		    exit (OSOK+1);
+		}
+	    } else {
+		nbytes -= TBLOCK;
+		nblocks++;
+	    }
+
+	/* Strip whitespace at end of file added by WTAR when the archive was
+	 * created.
+	 */
+	if (nbytes > 0)
+	    strip_blanks (in, out, nbytes);
+
+	if (debug)
+	    fprintf (stderr, "%d blocks written\n", nblocks);
+}
+
+
+/* STRIP_BLANKS -- Read the remaining file data into the pad buffer.
+ * Write out the remaining data, minus any extra blanks or empty blank lines
+ * at the end of the file.  Some versions of WTAR (e.g., VMS) do not know
+ * the actual size of a text file and have to pad with blanks at the end to
+ * make the file the size noted in the file header.
+ */
+static void
+strip_blanks (int in, int out, long nbytes)
+{
+	register char	*ip, *op;
+	char	padbuf[SZ_PADBUF+10];
+	char	*lastnl;
+	int	n;
+
+	/* Fill buffer.
+	 */
+	op = padbuf;
+	while (nbytes > 0 && (ip = getblock (in)) != NULL) {
+	    n = nbytes < TBLOCK ? (int)nbytes : TBLOCK;
+	    os_amovb (ip, op, n + sizeof(XCHAR)-1);
+	    nbytes -= n;
+	    op += n;
+	}
+
+	/* Backspace from the end of the buffer until the last nonblank line
+	 * is found.
+	 */
+	lastnl = op - 1;
+	for (ip=lastnl;  ip > padbuf;  --ip)
+	    if (*ip == '\n')
+		lastnl = ip;
+	    else if (*ip != ' ')
+		break;
+
+	/* Write out everything up to and including the newline at the end of
+	 * the last line containing anything but blanks.
+	 */
+	os_write (out, padbuf, lastnl - padbuf + 1);
+}
+
+
+/* SKIPFILE -- Skip the indicated number of bytes on the input (tar) file.
+ */
+static void
+skipfile (
+    int	   in,			/* input file			*/
+    struct fheader *fh 		/* file header			*/
+)
+{
+	register long nbytes = fh->size;
+
+	/* Link files are zero length on the tape. */
+	if (fh->linkflag)
+	    return;
+
+	while (nbytes > 0 && getblock (in) != NULL)
+	    nbytes -= TBLOCK;
+}
+
+
+/* GETBLOCK -- Return a pointer to the next file block of size TBLOCK bytes
+ * in the input file.
+ */
+static char *
+getblock (int in)
+{
+	char	*bp;
+	int	nbytes;
+
+	for (;;) {
+	    if (eof)
+		return (NULL);
+	    else if (--nblocks >= 0) {
+		bp = nextblock;
+		nextblock += TBLOCK;
+		return (bp);
+	    }
+
+	    if ((nbytes = tape_read (in, tapeblock, SZ_TAPEBUFFER)) < TBLOCK)
+		eof++;
+	    else {
+		nblocks = (nbytes + TBLOCK-1) / TBLOCK;
+		nextblock = tapeblock;
+	    }
+	}
+}
diff --git a/unix/boot/rtar/rtar.hlp b/unix/boot/rtar/rtar.hlp
new file mode 100644
index 00000000..843add6f
--- /dev/null
+++ b/unix/boot/rtar/rtar.hlp
@@ -0,0 +1,165 @@
+.help rtar Oct92 softools
+.IH
+NAME
+rtar -- read TAR format archive file
+.IH
+USAGE
+rtar [ flags ] [ archive ] [ after ] [ files ]
+.IH
+PARAMETERS
+.ls 4 -a
+Advance to the archive file named by the \fIafter\fR argument before
+performing the main operation.  The extract or list operation will begin with
+the file \fIafter\fR and continue to the end of the archive.
+.le
+.ls 4 -b
+Output only binary byte stream files.  By default, \fIrtar\fR outputs text
+files in the host system textfile format.  The conversion from the byte stream
+\fItar\fR format to host textfile format may involve modification of the
+file, e.g., conversion from ASCII to EBCDIC.  A binary extraction copies
+the file to disk without modification.
+.le
+.ls 4 -d
+Print detailed information about what \fIrtar\fR is doing.
+.le
+.ls 4 -e
+Extract the entire contents of the tape \fIexcluding\fR the files or directories
+listed in \fIfiles\fR.
+.le
+.ls 4 -f filename
+\fIRtar\fR uses the first filename argument as the host filename of the
+archive instead of reading from \fIstdin\fR.   Magtape devices should be
+specified using the host device name, e.g., "/dev/nrmt8" or "MSA0".
+Since \fIrtar\fR is a host level program and does not read the IRAF tapecap
+file, IRAF device names such as "mta" cannot be used.
+.le
+.ls 4 -l
+Do not try to resolve file links by a disk to disk file copy.  By default,
+if file A appears in the archive as a link to file B,
+\fIrtar\fR trys to resolve the link by performing a disk to disk copy of
+file B to A.  This is valid providing file B was present in the archive and
+has already been extracted.  If the \fBl\fR flag is present linked files
+will not be extracted.
+.le
+.ls 4 -m
+Do not restore the file modify time.
+.le
+.ls 4 -n
+Do not strip trailing blank lines from text files read from the tape.
+The default is to strip any blank lines at the ends of files.
+This is necessary when the file was written by \fIwtar\fR on a system
+like VMS, where the size of the file is not known before it has been
+read.  The \fIwtar\fR utility must guess at the final size and pad the
+file at the end with spaces to ensure that the size of the file actually
+written agrees with the file header.
+.le
+.ls 4 -o
+Omit binary files when performing the extraction.  A binary file is any
+file containing ASCII values other than 040 through 0176 (the printable
+ASCII characters), tab, or newline in the first 512 byte block of the file.
+.le
+.ls 4 -p pathprefix
+When creating directories and files from the pathnames recorded in the archive,
+omit the given path prefix if it matches the pathname given in the archive.
+This feature is used to relocate directories, or to read tar archives
+containing absolute pathnames.  For example, given "-p /usr/", the archive
+pathname "/usr/me/file" would be written to the file "me/file".
+.le
+.ls 4 -r
+The extracted file replaces any existing file of the same name, i.e.,
+\fIrtar\fR performs a delete before creating the extracted file.
+.le
+.ls 4 -t
+The names of the specified files are listed each time they occur on
+the tape.  If no \fIfiles\fR argument is given, all of the names on the tape
+are listed.
+.le
+.ls 4 -u
+Do not attempt to restore the owner and group identification of each file.
+.le
+.ls 4 -v
+Print more information about the tape entries than just their names.
+The verbose file list format gives the file permissions, the link flag
+(zero if there were no links to the file), the owner and group identification
+numbers of the file on the system that wrote the archive, the file size in
+bytes, the date of last modification of the file, and the file name.
+.le
+.ls 4 -x
+The named files are extracted from the tape.  If the named file
+matches a directory whose contents had been written onto the tape, this
+directory is (recursively) extracted.  The owner, modification time, and mode
+are restored (if possible).  If no file argument is given, the entire content
+of the tape is extracted.  Note that if multiple entries specifying the same
+file are on the tape, the last one overwrites all earlier.
+.le
+.IH
+DESCRIPTION
+\fIRtar\fR reads multiple files from a UNIX \fItar\fR format file,
+restoring the files to disk on the local host machine.
+Output filenames are mapped according to the IRAF filenaming conventions
+of the local host operating system.
+
+\fIRtar\fR's actions are controlled by the \fIflags\fR argument. 
+\fIFlags\fR consists of a minus sign followed by a string of characters
+containing any combination of the function flags described below.
+Other arguments to \fIrtar\fR are the name of the archive file to be read,
+the name of the file on the archive at which reading is to begin,
+and the names of the files or directories to be read or to be excluded
+from the read.  In all cases, appearance of a directory name refers to
+the files and (recursively) subdirectories of that directory.
+
+All \fIrtar\fR filename arguments are IRAF virtual filenames (or host
+filenames), except the prefix strings, which pertain to the tape format and
+hence are UNIX pathnames.  Magtape devices must be specified using a host
+physical or logical device name (i.e., IRAF device names like "mta" will not
+work).
+
+If the input archive file is a tape the blocksize must be a multiple
+of 512 bytes, with a maximum blocksize of 10240 bytes.  Each archived file
+occupies an integral number of 512 byte blocks in the archive (this is
+required by the \fItar\fR format).
+
+Filenames appearing in the file list are interpreted as prefix strings,
+i.e., a match occurs if the given string is a prefix of an actual filename
+in the archive.  If the last character in the \fIfiles\fR filename is
+a \fB$\fR then an exact match is required (excluding the $ meta-character).
+.IH
+DIAGNOSTICS
+A file read error occurring while reading the archive file is fatal unless
+caught and corrected by the host system.
+File header checksum errors result in skipping of the archive file
+currently being read, with execution continuing with the next archive
+file if possible.
+File write errors on the output file are reported but do not cause
+termination of \fIrtar\fR.  The output file being written will be corrupted.
+.ih
+EXAMPLES
+Since \fIrtar\fR is a bootstrap utility implemented as a foreign task in
+the CL, it may be called either from within the CL (as in the examples),
+or at the host system level.  The command syntax is identical on both cases.
+
+1. List the contents of the disk archive file "foo.tar".
+
+	cl> rtar -tvf foo.tar
+
+2. Unpack the tape archive on unix device /dev/nrmt8 in the current
+directory.
+
+	cl> rtar -xf /dev/nrmt8
+
+3. Unpack the tape archive on the VMS device MSA0: in the current
+directory.
+
+	cl> rtar -xf msa0
+
+When working within the CL, commands such as \fIrewind\fR may be used
+with \fIrtar\fR, but switching between IRAF and host device names may be
+confusing.
+.IH
+BUGS
+The current limit on file name length is 100 characters (this restriction
+is imposed by the standard UNIX \fItar\fR format).
+File links are not recreated.
+.ih
+SEE ALSO
+wtar, rmbin
diff --git a/unix/boot/rtar/rtar.ms b/unix/boot/rtar/rtar.ms
new file mode 100644
index 00000000..43746400
--- /dev/null
+++ b/unix/boot/rtar/rtar.ms
@@ -0,0 +1,125 @@
+.TH RTAR 1 "14 November 1984"
+.SH NAME
+rtar \- read tape archive format file
+.SH SYNOPSIS
+.B rtar
+[ flags ] [ archive ] [ after ] [ files ]
+.SH DESCRIPTION
+.PP
+.I Rtar
+reads multiple files from a UNIX \fItar\fR format file, restoring the files
+to disk on the local host machine.  Output filenames are mapped according to
+the IRAF filenaming conventions of the local host operating system.
+.IR Rtar 's
+actions are controlled by the
+.I flags
+argument. 
+.I Flags
+consists of an \fB-\fR followed by
+a string of characters containing any combination of the function flags
+described below.
+Other arguments to 
+.I rtar
+are the name of the archive file to be read,
+the name of the file on the archive at which reading is to begin,
+and the names of the files or directories to be read or to be excluded
+from the read.
+In all cases, appearance of a directory name refers to
+the files and (recursively) subdirectories of that directory.
+All
+.I rtar
+filename arguments are UNIX pathnames except
+.I archive,
+which is a host system filename.
+.PP
+The default action of \fIrtar\fR is to unpack all files from the \fItar\fR
+format standard input.  The following flag characters may be used to further
+control the function of \fIrtar\fR:
+.TP 8
+.B x
+The named files are extracted from the tape.  If the named file
+matches a directory whose contents had been written onto the tape, this
+directory is (recursively) extracted.  The owner, modification time, and mode
+are restored (if possible).  If no file argument is given, the entire content
+of the tape is extracted.  Note that if multiple entries specifying the same
+file are on the tape, the last one overwrites all earlier.
+.TP 8
+.B r
+The extracted file replaces any existing file of the same name, i.e.,
+.I rtar
+performs a delete before creating the extracted file.
+.TP 8
+.B e
+Extract the entire contents of the tape \fIexcluding\fR the files or directories
+listed in \fIfiles\fR.
+.TP 8
+.B a
+Advance to the archive file named by the \fIafter\fR argument before
+performing the main operation.  The extract or list operation will begin with
+the file \fIafter\fR and continue to the end of the archive.
+.TP 8
+.B t
+The names of the specified files are listed each time they occur on
+the tape.  If no \fIfiles\fR argument is given, all of the names on the tape
+are listed.
+.TP 8
+.B v
+Print more information about the tape entries than just their names.
+The verbose file list format gives the file permissions, the link flag
+(zero if there were no links to the file), the owner and group identification
+numbers of the file on the system that wrote the archive, the file size in
+bytes, the date of last modification of the file, and the file name.
+.TP 8
+.B d
+Print detailed information about what \fIrtar\fR is doing.
+.TP 8
+.B f
+.I Rtar
+uses the first filename argument as the host filename of the archive
+instead of reading from \fIstdin\fR.
+.TP 8
+.B l
+Do not try to resolve file links by a disk to disk file copy.  By default,
+if file A appears in the archive as a link to file B,
+\fIrtar\fR trys to resolve the link by performing a disk to disk copy of
+file B to A.  This is valid providing file B was present in the archive and
+has already been extracted.  If the \fBl\fR flag is present linked files
+will not be extracted.
+.TP 8
+.B o
+Omit binary files when performing the extraction.  A binary file is any
+file containing ASCII values other than 040 through 0176 (the printable
+ASCII characters), tab, or newline in the first 512 byte block of the file.
+.TP 8
+.B b
+Output only binary byte stream files.  By default, \fIrtar\fR outputs text
+files in the host system textfile format.  The conversion from the byte stream
+\fItar\fR format to host textfile format may involve modification of the
+file, e.g., conversion from ASCII to EBCDIC.  A binary extraction copies
+the file to disk without modification.
+.PP
+If the input archive file is a tape the blocksize must be a multiple
+of 512 bytes, with a maximum blocksize of 10240 bytes.  Each archived file
+occupies an integral number of 512 byte blocks in the archive.
+.PP
+Filenames appearing in the file list are interpreted as prefix strings,
+i.e., a match occurs if the given string is a prefix of an actual filename
+in the archive.  If the last character in the \fIfiles\fR filename is
+a \fB$\fR then an exact match is required (excluding the $ metacharacter).
+.SH DIAGNOSTICS
+.br
+A file read error occurring while reading the archive file is fatal unless
+caught and corrected by the host system.
+.br
+File header checksum errors result in skipping of the archive file
+currently being read, with execution continuing with the next archive
+file if possible.
+.br
+File write errors on the output file are reported but do not cause
+termination of \fIrtar\fR.  The output file being written will be corrupted.
+.SH BUGS
+.br
+The current limit on file name length is 100 characters (this restriction
+is imposed by the standard UNIX \fItar\fR format).
+.br
+File links are not recreated.
diff --git a/unix/boot/spp/README b/unix/boot/spp/README
new file mode 100644
index 00000000..d4d64dfc
--- /dev/null
+++ b/unix/boot/spp/README
@@ -0,0 +1,43 @@
+These directories contain the source code for the UNIX version of the compiler
+for the IRAF subset preprocessor language (SPP).  In its current implementation
+the compiler consists of the following modules:
+
+	xc.e		main program (like cc)
+	xpp.e		first pass (written in Lex and C)
+	rpp.e		second pass (written in ratfor)
+
+files:
+	xpp		subdirectory containing XPP
+	rpp		subdirectory containing RPP
+	xc.c		the XC compiler/linker
+
+runtime files:
+	lib$xc.e	installed UNIX xc compiler
+	lib$xpp.e	installed first pass
+	lib$rpp.e	installed second pass
+
+
+This implementation of the SPP preprocessor (kludgy though it may be) should be
+portable to any host computer supporting C and Fortran compilers.  A Ratfor
+compiler and runtime library is no longer required.  XPP does contain some
+machine dependencies in its internal tables describing the host Fortran
+compiler, and these should be reviewed.  RPP has a C language interface to the
+host machine which contains knowledge of how the host system permits C and
+Fortran to be mixed in the same program.  Hopefully all machine dependence
+has been concentrated in the two files xpp/xppcode.c and rpp/ratlibc/ratdef.h.
+
+This version of the preprocessor no longer knows about pathnames other than
+those defined in the C include file "iraf.h", which is also used by the
+CL and all other C files in IRAF.  The "iraf.h" file is the only file used
+by IRAF which does not reside in the IRAF directories (although a copy appears
+in lib$libc and we make a symbolic link to it on our 4.2BSD UNIX system).
+XC has to know the root directory of IRAF to reference important files in
+iraf$lib.  The root directory may be set on the command line with the "-r"
+(root) argument; if "-r ospathname" is omitted the default is the value of
+IRAFDIR given in "iraf.h"
+
+On our UNIX development system we have the executables (xc.e, xpp.e, etc.)
+linked into both the source directory and the IRAF library lib$.  Hence when
+any of these executables are relinked, the new versions do not have to
+be installed.  If your system does not support links you will need to copy
+the executable to lib$ after compilation.
diff --git a/unix/boot/spp/mkpkg.sh b/unix/boot/spp/mkpkg.sh
new file mode 100644
index 00000000..71417ba7
--- /dev/null
+++ b/unix/boot/spp/mkpkg.sh
@@ -0,0 +1,12 @@
+# Make the Subset Preprocessor language (SPP) compiler.
+
+echo "----------------------- XC  ----------------------------"
+$CC -c $HSI_CF	xc.c
+$CC $HSI_LF	xc.o $HSI_LIBS -o xc.e
+mv -f		xc.e ../../hlib
+rm -f		xc.o
+
+echo "----------------------- XPP ----------------------------"
+(cd xpp; sh -x mkpkg.sh)
+echo "----------------------- RPP ----------------------------"
+(cd rpp; sh -x mkpkg.sh)
diff --git a/unix/boot/spp/mkxc.sh b/unix/boot/spp/mkxc.sh
new file mode 100644
index 00000000..853e89bc
--- /dev/null
+++ b/unix/boot/spp/mkxc.sh
@@ -0,0 +1,6 @@
+# Make the XC driver program.
+
+$CC -c $HSI_CF xc.c
+$CC $HSI_LF xc.o $HSI_LIBS -o xc.e
+mv -f	xc.e ../../hlib
+rm xc.o
diff --git a/unix/boot/spp/mkxc_dbg.sh b/unix/boot/spp/mkxc_dbg.sh
new file mode 100644
index 00000000..c9cea5af
--- /dev/null
+++ b/unix/boot/spp/mkxc_dbg.sh
@@ -0,0 +1,6 @@
+# Make the XC driver program.
+
+$CC -c -g $HSI_CF xc.c
+$CC $HSI_LF -g xc.o $HSI_LIBS -o xc.e
+mv -f	xc.e ../../bin.redhat
+rm xc.o
diff --git a/unix/boot/spp/rpp/README b/unix/boot/spp/rpp/README
new file mode 100644
index 00000000..a9df5096
--- /dev/null
+++ b/unix/boot/spp/rpp/README
@@ -0,0 +1,40 @@
+RPP -- Second pass of the SPP preprocessor.
+
+    While RPP is derived from ratfor, it is not a ratfor preprocessor.
+It accepts as input the output of the first pass, XPP, and produces Fortran as
+output.  XPP and RPP together with the UNIX driver program XC make up the
+preprocessor for the IRAF SPP language.
+
+
+subdirectories:
+
+	ratlibc		Interface to the host system, written in C
+	ratlibf		Fortran version of the ratfor library (used by RPP)
+	ratlibr		Ratfor version of the ratfor library
+	rppfor		Fortran source for RPP
+	rpprat		Ratfor source for RPP
+
+
+RPP consists of the source for the program itself, the portable library
+functions, and the interface to the host system.  Everything required to
+compile and link RPP on a host system providing a C and Fortran compiler
+is included in these directories.  RPP is currently implemented as a stand
+alone (bootstrap) program, i.e. it can be compiled before IRAF itself is
+running.  While the ratfor sources for the preprocessor and the library
+are included in the distribution, a ratfor preprocessor is not necessary
+to compile RPP.  All ratfor sources are distributed already preprocessed
+into Fortran.
+
+To compile RPP on a UNIX host type "make".  If there are any problems they
+will most likely be in the interface routines, which are not (cannot be)
+completely portable.  In particular the definitions in ratlibc/ratdef.h
+should be examined to see is they are appropriate for your machine.  The
+single biggest difference between different host systems providing C and
+simple UNIX like STDIO is in the naming conventions of external identifiers.
+All C externals called from Fortran are defined in ratdef.h to make it
+easier to change the names.  RPP is a C program (it has a C main) even
+though most of the code is written in Fortran.
+
+Source for a Fortran (ratfor) version of the interface routines is provided
+in ratlibr/old.  Since XPP is currently written in C we have not bothered
+to try to use these routines.
diff --git a/unix/boot/spp/rpp/mkpkg.sh b/unix/boot/spp/rpp/mkpkg.sh
new file mode 100644
index 00000000..33bc0b88
--- /dev/null
+++ b/unix/boot/spp/rpp/mkpkg.sh
@@ -0,0 +1,13 @@
+# Make the second pass (RPP) of the SPP language compiler.
+
+echo "----------------------- RPPFOR -------------------------"
+(cd rppfor;	sh -x mkpkg.sh)
+echo "----------------------- RATLIBF ------------------------"
+(cd ratlibf;	sh -x mkpkg.sh)
+echo "----------------------- RATLIBC ------------------------"
+(cd ratlibc;	sh -x mkpkg.sh)
+
+$CC -c $HSI_CF	rpp.c
+$CC $HSI_LF	rpp.o librpp.a libf.a libc.a $HSI_F77LIBS -o rpp.e
+mv -f		rpp.e ../../../hlib
+rm		*.[ao]
diff --git a/unix/boot/spp/rpp/ratlibc/README b/unix/boot/spp/rpp/ratlibc/README
new file mode 100644
index 00000000..427e3969
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibc/README
@@ -0,0 +1 @@
+RPP/RATLIBC -- Host system interface routines for the RPP program.
diff --git a/unix/boot/spp/rpp/ratlibc/cant.c b/unix/boot/spp/rpp/ratlibc/cant.c
new file mode 100644
index 00000000..2d82c3e9
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibc/cant.c
@@ -0,0 +1,16 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#include "ratdef.h"
+
+extern  int  ENDST (void);
+
+
+void CANT(rname)
+register RCHAR *rname;
+{
+	while (*rname != REOS)
+		putc(*rname++, stderr);
+	fprintf(stderr, ": cant open\n");
+	ENDST();
+}
diff --git a/unix/boot/spp/rpp/ratlibc/close.c b/unix/boot/spp/rpp/ratlibc/close.c
new file mode 100644
index 00000000..a54d4a80
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibc/close.c
@@ -0,0 +1,10 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#include "ratdef.h"
+
+void CLOSE(fd)
+FINT	*fd;
+{
+	fclose(_fdtofile[*fd]);
+}
diff --git a/unix/boot/spp/rpp/ratlibc/endst.c b/unix/boot/spp/rpp/ratlibc/endst.c
new file mode 100644
index 00000000..b8f83f3d
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibc/endst.c
@@ -0,0 +1,10 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#include <stdlib.h>
+#include "ratdef.h"
+
+void ENDST()
+{
+	exit(0);
+}
diff --git a/unix/boot/spp/rpp/ratlibc/getarg.c b/unix/boot/spp/rpp/ratlibc/getarg.c
new file mode 100644
index 00000000..2952d7d7
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibc/getarg.c
@@ -0,0 +1,28 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#include "ratdef.h"
+
+FINT
+GETARG(n, s, maxsiz)
+FINT *n;
+register RCHAR *s;
+FINT *maxsiz;
+{
+	extern int xargc;
+	extern char **xargv;
+	register char *t;
+	register int i;
+
+	if(*n>=0 && *n<xargc)
+		t = xargv[*n];
+	else if (*n == -1)
+		return(xargc);
+	else
+		return(REOF);	/* non-existent argument */
+
+	for(i = 0; i<*maxsiz-1 && *t!='\0' ; ++i)
+		*s++ = *t++;
+	*s++ = REOS;	/* terminate ratfor string with eos */
+	return(i);	/* return length of argument */
+}
diff --git a/unix/boot/spp/rpp/ratlibc/getlin.c b/unix/boot/spp/rpp/ratlibc/getlin.c
new file mode 100644
index 00000000..1949f9cd
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibc/getlin.c
@@ -0,0 +1,32 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#include "ratdef.h"
+
+FINT
+GETLIN(line, fd)
+RCHAR	*line;
+FINT	*fd;
+{
+	register  int c=0;
+	register  int count=0;
+	register  RCHAR *cs;
+	FILE	  *fp;
+
+	fp = _fdtofile[*fd];
+	cs = line;
+	while (++count<MAXLINE && (c = getc(fp))>=0) {
+	    *cs++ = c;
+	    if (c == '\n') {
+		*cs++ = REOS;
+		return (count);		/* count includes newline, but does
+				           not include the EOS */
+	    }
+	}
+
+	if (c<0 && cs==line)
+	    return(REOF);
+
+	*cs++ = REOS;
+	return(count);
+}
diff --git a/unix/boot/spp/rpp/ratlibc/initst.c b/unix/boot/spp/rpp/ratlibc/initst.c
new file mode 100644
index 00000000..6cf4a9a4
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibc/initst.c
@@ -0,0 +1,18 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#include "ratdef.h"
+
+FILE	*_fdtofile[10];
+
+/*
+ * Ratfor initialization routine.  To be called as the first
+ * executable statement of every program using the tools
+ * subroutines.
+ */
+void INITST()
+{
+	_fdtofile[0] = stdin;
+	_fdtofile[1] = stdout;
+	_fdtofile[2] = stderr;
+}
diff --git a/unix/boot/spp/rpp/ratlibc/mkpkg.sh b/unix/boot/spp/rpp/ratlibc/mkpkg.sh
new file mode 100644
index 00000000..8159d992
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibc/mkpkg.sh
@@ -0,0 +1,9 @@
+# Host system interface for the RPP program.
+
+$CC -c -g $HSI_CF	cant.c close.c endst.c getarg.c getlin.c initst.c open.c\
+		putch.c putlin.c r4tocstr.c remark.c
+
+ar rv		libc.a *.o
+$RANLIB		libc.a
+mv -f		libc.a ..
+rm		*.o
diff --git a/unix/boot/spp/rpp/ratlibc/open.c b/unix/boot/spp/rpp/ratlibc/open.c
new file mode 100644
index 00000000..fa4558d9
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibc/open.c
@@ -0,0 +1,30 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#include "ratdef.h"
+
+extern void r4tocstr (register RCHAR *rstr, register char *cstr);
+
+FINT
+OPEN(rname, mode)
+RCHAR *rname;
+register FINT *mode;
+{
+	register FILE  *fp;
+	char	       cname[FILENAMESIZE];
+
+	r4tocstr(rname, cname);
+
+	if (*mode == APPEND)
+		fp = fopen(cname, "a");
+	else if (*mode == READWRITE || *mode == WRITE)
+		fp = fopen(cname, "w");
+	else
+		fp = fopen(cname, "r");
+
+	if (fp == NULL)
+		return(RERR);	/* unable to open file */
+
+	_fdtofile[fileno(fp)] = fp;
+	return(fileno(fp));
+}
diff --git a/unix/boot/spp/rpp/ratlibc/putch.c b/unix/boot/spp/rpp/ratlibc/putch.c
new file mode 100644
index 00000000..322628cc
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibc/putch.c
@@ -0,0 +1,15 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#include "ratdef.h"
+
+int PUTCH(c, fd)
+register RCHAR *c;
+register FINT  *fd;
+{
+	register FILE *file;
+
+	file = _fdtofile[*fd];
+	putc(*c, file);
+	return 0;
+}
diff --git a/unix/boot/spp/rpp/ratlibc/putlin.c b/unix/boot/spp/rpp/ratlibc/putlin.c
new file mode 100644
index 00000000..0da6c4d9
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibc/putlin.c
@@ -0,0 +1,16 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#include "ratdef.h"
+
+void PUTLIN(line, fd)
+RCHAR *line;
+FINT	*fd;
+{
+	register FILE *fp;
+	register int c;
+
+	fp = _fdtofile[*fd];
+	while((c = *line++) != REOS)
+		putc(c, fp);
+}
diff --git a/unix/boot/spp/rpp/ratlibc/r4tocstr.c b/unix/boot/spp/rpp/ratlibc/r4tocstr.c
new file mode 100644
index 00000000..36924353
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibc/r4tocstr.c
@@ -0,0 +1,22 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#include "ratdef.h"
+
+/* Convert a Ratfor string (one character per integer, terminated
+ * by an EOS) to a C string (one character per 8-bit byte, terminated
+ * by a byte of zero).
+ */
+void r4tocstr(rstr, cstr)
+register RCHAR  *rstr;
+register char   *cstr;
+{
+	while (*rstr != REOS) {
+	    if (*rstr > 0177) {
+		*cstr++ = *((char *)rstr);
+		rstr++;
+	    } else
+		*cstr++ = *rstr++;
+	}
+	*cstr = '\0';
+}
diff --git a/unix/boot/spp/rpp/ratlibc/ratdef.h b/unix/boot/spp/rpp/ratlibc/ratdef.h
new file mode 100644
index 00000000..2f5b7e1c
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibc/ratdef.h
@@ -0,0 +1,73 @@
+#include  <stdio.h>
+
+extern  FILE	*_fdtofile[];	/* map file descriptor (small integer) to
+				   FILE pointer.  Ratfor uses file descriptors,
+				   we must use FILE pointers for stdio lib */
+
+/*
+ * The following definitions must be the same as those used by the
+ * Ratfor system.
+ */
+#define		REOF	(-1)	/* Ratfor EOF */
+#define		REOS	(-2)	/* Ratfor end-of-string */
+#define		RERR	(-3)	/* Ratfor error return */
+#define		NO	0
+#define		YES	1
+#define		NOERR	0
+#define		OK	(-2)
+#define		MAXLINE 128
+#define		FILENAMESIZE 40	/* max num chars per filename */
+
+#define		READ	1	/* modes for file open */
+#define		WRITE	2
+#define		READWRITE 3
+#define		APPEND	4
+
+/*
+ * The following typedefs refer to the data types passed by the
+ * Fortran compiler (Ratfor) calling us.
+ */
+#ifdef ILP32
+typedef int RCHAR;		/* Ratfor character string */
+typedef int FINT;		/* Fortran plain vanilla integer */
+				/* integer*2 with new f77 on Unix */
+#else
+typedef long int RCHAR;		/* Ratfor character string */
+typedef long int FINT;		/* Fortran plain vanilla integer */
+				/* integer*2 with new f77 on Unix */
+#endif
+
+
+/* All names of C functions called from ratfor are defined here to make them
+ * easy to change to reflect the characteristics of the host machine.  Some
+ * versions of UNIX append an underscore to Fortran external names, some
+ * prepend an underscore, and some do both.  VMS renders C and Fortran external
+ * names the same, making it easier to mix the two languages but causing
+ * name conflicts.
+ */
+#define	AMOVE	amove_
+#define	CANT	cant_
+#define	CLOSE	rfclos_
+#define	CREATE	create_
+#define	ENDST	endst_
+#define	EXIT	rexit_
+#define	FLUSH	rfflus_
+#define	GETARG	getarg_
+#define	GETCH	getch_
+#define	GETLIN	getlin_
+#define	GETNOW	getnow_
+#define	INITST	initst_
+#define	ISATTY	isatty_
+#define	MKUNIQ	mkuniq_
+#define	NOTE	rfnote_
+#define	OPEN	rfopen_
+#define	PUTCH	putch_
+#define	PUTHOL	puthol_
+#define	PUTLIN	putlin_
+#define	RATFOR	ratfor_
+#define	READF	readf_
+#define	REMARK	remark_
+#define	REMOVE	rfrmov_
+#define	RWIND	rwind_
+#define	SEEK	rfseek_
+#define	WRITEF	writef_
diff --git a/unix/boot/spp/rpp/ratlibc/remark.c b/unix/boot/spp/rpp/ratlibc/remark.c
new file mode 100644
index 00000000..23e30213
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibc/remark.c
@@ -0,0 +1,43 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#include "ratdef.h"
+
+void REMARK (strarg)
+int	*strarg;		/* hollerith string is an integer array */
+{
+	register char  *strin = (char *)strarg;
+	register char  c;
+
+	while (((c = *strin++) != '.') && (c != '\0'))
+	    if (c == '@') {
+		switch (*strin) {
+		case '.':
+		    putc ('.', stderr);
+		    strin++;
+		    break;
+
+		case 't':
+		    putc ('\t', stderr);
+		    strin++;
+		    break;
+
+		case 'b':
+		    putc ('\b', stderr);
+		    strin++;
+		    break;
+
+		case 'n':
+		    putc ('\n', stderr);
+		    strin++;
+		    break;
+
+		default:
+		    putc ('@', stderr);
+		    break;
+		}
+	    } else
+		putc (c, stderr);
+
+	putc ('\n', stderr);
+}
diff --git a/unix/boot/spp/rpp/ratlibf/README b/unix/boot/spp/rpp/ratlibf/README
new file mode 100644
index 00000000..52be57b2
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibf/README
@@ -0,0 +1 @@
+RPP/RATLIBF -- Fortran source for the library utilities used by the RPP program.
diff --git a/unix/boot/spp/rpp/ratlibf/addset.f b/unix/boot/spp/rpp/ratlibf/addset.f
new file mode 100644
index 00000000..629b4b91
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibf/addset.f
@@ -0,0 +1,13 @@
+      integer function addset (c, str, j, maxsiz)
+      integer j, maxsiz
+      integer c, str (maxsiz)
+      if (.not.(j .gt. maxsiz))goto 23000
+      addset = 0
+      goto 23001
+23000 continue
+      str(j) = c
+      j = j + 1
+      addset = 1
+23001 continue
+      return
+      end
diff --git a/unix/boot/spp/rpp/ratlibf/addstr.f b/unix/boot/spp/rpp/ratlibf/addstr.f
new file mode 100644
index 00000000..eedc7cf3
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibf/addstr.f
@@ -0,0 +1,16 @@
+      integer function addstr (s, str, j, maxsiz)
+      integer j, maxsiz
+      integer s (100), str (maxsiz)
+      integer i, addset
+      i = 1
+23000 if (.not.(s (i) .ne. -2))goto 23002
+      if (.not.(addset (s (i), str, j, maxsiz) .eq. 0))goto 23003
+      addstr = 0
+      return
+23003 continue
+23001 i = i + 1
+      goto 23000
+23002 continue
+      addstr = 1
+      return
+      end
diff --git a/unix/boot/spp/rpp/ratlibf/amatch.f b/unix/boot/spp/rpp/ratlibf/amatch.f
new file mode 100644
index 00000000..fe23fb53
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibf/amatch.f
@@ -0,0 +1,68 @@
+      integer function amatch (lin, from, pat, tagbeg, tagend)
+      integer lin (128), pat (128)
+      integer from, tagbeg (10), tagend (10)
+      integer i, j, offset, stack
+      integer omatch, patsiz
+      i = 1
+23000 if (.not.(i .le. 10))goto 23002
+      tagbeg (i) = 0
+      tagend (i) = 0
+23001 i = i + 1
+      goto 23000
+23002 continue
+      tagbeg (1) = from
+      stack = 0
+      offset = from
+      j = 1
+23003 if (.not.(pat (j) .ne. -2))goto 23005
+      if (.not.(pat (j) .eq. 42))goto 23006
+      stack = j
+      j = j + 4
+      i = offset
+23008 if (.not.(lin (i) .ne. -2))goto 23010
+      if (.not.(omatch (lin, i, pat, j) .eq. 0))goto 23011
+      goto 23010
+23011 continue
+23009 goto 23008
+23010 continue
+      pat (stack + 1) = i - offset
+      pat (stack + 3) = offset
+      offset = i
+      goto 23007
+23006 continue
+      if (.not.(pat (j) .eq. 123))goto 23013
+      i = pat (j + 1)
+      tagbeg (i + 1) = offset
+      goto 23014
+23013 continue
+      if (.not.(pat (j) .eq. 125))goto 23015
+      i = pat (j + 1)
+      tagend (i + 1) = offset
+      goto 23016
+23015 continue
+      if (.not.(omatch (lin, offset, pat, j) .eq. 0))goto 23017
+23019 if (.not.(stack .gt. 0))goto 23021
+      if (.not.(pat (stack + 1) .gt. 0))goto 23022
+      goto 23021
+23022 continue
+23020 stack = pat (stack + 2)
+      goto 23019
+23021 continue
+      if (.not.(stack .le. 0))goto 23024
+      amatch = 0
+      return
+23024 continue
+      pat (stack + 1) = pat (stack + 1) - 1
+      j = stack + 4
+      offset = pat (stack + 3) + pat (stack + 1)
+23017 continue
+23016 continue
+23014 continue
+23007 continue
+23004 j = j + patsiz (pat, j)
+      goto 23003
+23005 continue
+      amatch = offset
+      tagend (1) = offset
+      return
+      end
diff --git a/unix/boot/spp/rpp/ratlibf/catsub.f b/unix/boot/spp/rpp/ratlibf/catsub.f
new file mode 100644
index 00000000..a7dbc318
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibf/catsub.f
@@ -0,0 +1,28 @@
+      subroutine catsub (lin, from, to, sub, new, k, maxnew)
+      integer lin(128)
+      integer from(10), to(10)
+      integer maxnew
+      integer sub(maxnew), new(128)
+      integer k
+      integer i, j, junk, ri
+      integer addset
+      i = 1
+23000 if (.not.(sub (i) .ne. -2))goto 23002
+      if (.not.(sub (i) .eq. -3))goto 23003
+      i = i + 1
+      ri = sub (i) + 1
+      j = from (ri)
+23005 if (.not.(j .lt. to (ri)))goto 23007
+      junk = addset (lin (j), new, k, maxnew)
+23006 j = j + 1
+      goto 23005
+23007 continue
+      goto 23004
+23003 continue
+      junk = addset (sub (i), new, k, maxnew)
+23004 continue
+23001 i = i + 1
+      goto 23000
+23002 continue
+      return
+      end
diff --git a/unix/boot/spp/rpp/ratlibf/clower.f b/unix/boot/spp/rpp/ratlibf/clower.f
new file mode 100644
index 00000000..e001f4fd
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibf/clower.f
@@ -0,0 +1,12 @@
+      integer function clower(c)
+      integer c
+      integer k
+      if (.not.(c .ge. 65 .and. c .le. 90))goto 23000
+      k = 97 - 65
+      clower = c + k
+      goto 23001
+23000 continue
+      clower = c
+23001 continue
+      return
+      end
diff --git a/unix/boot/spp/rpp/ratlibf/concat.f b/unix/boot/spp/rpp/ratlibf/concat.f
new file mode 100644
index 00000000..9385f2d1
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibf/concat.f
@@ -0,0 +1,8 @@
+      subroutine concat (buf1, buf2, outstr)
+      integer buf1(100), buf2(100), outstr(100)
+      integer i
+      i = 1
+      call stcopy (buf1, 1, outstr, i)
+      call scopy (buf2, 1, outstr, i)
+      return
+      end
diff --git a/unix/boot/spp/rpp/ratlibf/ctoc.f b/unix/boot/spp/rpp/ratlibf/ctoc.f
new file mode 100644
index 00000000..a5d3d4b3
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibf/ctoc.f
@@ -0,0 +1,14 @@
+      integer function ctoc (from, to, len)
+      integer len
+      integer from (100), to (len)
+      integer i
+      i = 1
+23000 if (.not.(i .lt. len .and. from (i) .ne. -2))goto 23002
+      to (i) = from (i)
+23001 i = i + 1
+      goto 23000
+23002 continue
+      to (i) = -2
+      ctoc=(i - 1)
+      return
+      end
diff --git a/unix/boot/spp/rpp/ratlibf/ctoi.f b/unix/boot/spp/rpp/ratlibf/ctoi.f
new file mode 100644
index 00000000..8aa92061
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibf/ctoi.f
@@ -0,0 +1,26 @@
+      integer function ctoi(in, i)
+      integer in (100)
+      integer i
+      integer d
+      external index
+      integer index
+      integer digits(11)
+      data digits (1) /48/, digits (2) /49/, digits (3) /50/, digits (4)
+     * /51/, digits (5) /52/, digits (6) /53/, digits (7) /54/, digits (
+     *8) /55/, digits (9) /56/, digits (10) /57/, digits (11) /-2/
+23000 if (.not.(in (i) .eq. 32 .or. in (i) .eq. 9))goto 23001
+      i = i + 1
+      goto 23000
+23001 continue
+      ctoi = 0
+23002 if (.not.(in (i) .ne. -2))goto 23004
+      d = index (digits, in (i))
+      if (.not.(d .eq. 0))goto 23005
+      goto 23004
+23005 continue
+      ctoi = 10 * ctoi + d - 1
+23003 i = i + 1
+      goto 23002
+23004 continue
+      return
+      end
diff --git a/unix/boot/spp/rpp/ratlibf/ctomn.f b/unix/boot/spp/rpp/ratlibf/ctomn.f
new file mode 100644
index 00000000..a2e0294e
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibf/ctomn.f
@@ -0,0 +1,30 @@
+      integer function ctomn (c, rep)
+      integer c, rep (4)
+      integer i
+      integer length
+      integer mntext (136)
+      data mntext /  78, 85, 76, -2, 83, 79, 72, -2, 83, 84, 88, -2, 69,
+     * 84, 88, -2, 69, 79, 84, -2, 69, 78, 81, -2, 65, 67, 75, -2, 66, 6
+     *9, 76, -2, 66, 83, -2, -2, 72, 84, -2, -2, 76, 70, -2, -2, 86, 84,
+     * -2, -2, 70, 70, -2, -2, 67, 82, -2, -2, 83, 79, -2, -2, 83, 73, -
+     *2, -2, 68, 76, 69, -2, 68, 67, 49, -2, 68, 67, 50, -2, 68, 67, 51,
+     * -2, 68, 67, 52, -2, 78, 65, 75, -2, 83, 89, 78, -2, 69, 84, 66, -
+     *2, 67, 65, 78, -2, 69, 77, -2, -2, 83, 85, 66, -2, 69, 83, 67, -2,
+     * 70, 83, -2, -2, 71, 83, -2, -2, 82, 83, -2, -2, 85, 83, -2, -2, 8
+     *3, 80, -2, -2, 68, 69, 76, -2/
+      i = mod (max0(c,0), 128)
+      if (.not.(0 .le. i .and. i .le. 32))goto 23000
+      call scopy (mntext, 4 * i + 1, rep, 1)
+      goto 23001
+23000 continue
+      if (.not.(i .eq. 127))goto 23002
+      call scopy (mntext, 133, rep, 1)
+      goto 23003
+23002 continue
+      rep (1) = c
+      rep (2) = -2
+23003 continue
+23001 continue
+      ctomn=(length (rep))
+      return
+      end
diff --git a/unix/boot/spp/rpp/ratlibf/cupper.f b/unix/boot/spp/rpp/ratlibf/cupper.f
new file mode 100644
index 00000000..549ee9df
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibf/cupper.f
@@ -0,0 +1,10 @@
+      integer function cupper (c)
+      integer c
+      if (.not.(c .ge. 97 .and. c .le. 122))goto 23000
+      cupper = c + (65 - 97)
+      goto 23001
+23000 continue
+      cupper = c
+23001 continue
+      return
+      end
diff --git a/unix/boot/spp/rpp/ratlibf/delete.f b/unix/boot/spp/rpp/ratlibf/delete.f
new file mode 100644
index 00000000..92d5fb37
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibf/delete.f
@@ -0,0 +1,13 @@
+      subroutine delete (symbol, st)
+      integer symbol (100)
+      integer st
+      integer mem( 1)
+      common/cdsmem/mem
+      integer stlu
+      integer node, pred
+      if (.not.(stlu (symbol, node, pred, st) .eq. 1))goto 23000
+      mem (pred + 0) = mem (node + 0)
+      call dsfree (node)
+23000 continue
+      return
+      end
diff --git a/unix/boot/spp/rpp/ratlibf/docant.f b/unix/boot/spp/rpp/ratlibf/docant.f
new file mode 100644
index 00000000..0bcdd7ca
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibf/docant.f
@@ -0,0 +1,13 @@
+      subroutine docant(name)
+      integer name(100), prog(30)
+      integer length
+      integer getarg
+      length = getarg(0, prog, 30)
+      if (.not.(length .ne. -1))goto 23000
+      call putlin(prog, 2)
+      call putch(58, 2)
+      call putch(32, 2)
+23000 continue
+      call cant(name)
+      return
+      end
diff --git a/unix/boot/spp/rpp/ratlibf/dodash.f b/unix/boot/spp/rpp/ratlibf/dodash.f
new file mode 100644
index 00000000..63dd7e48
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibf/dodash.f
@@ -0,0 +1,18 @@
+      subroutine dodash (valid, array, i, set, j, maxset)
+      integer i, j, maxset
+      integer valid (100), array (100), set (maxset)
+      integer esc
+      integer junk, k, limit
+      external index
+      integer addset, index
+      i = i + 1
+      j = j - 1
+      limit = index (valid, esc (array, i))
+      k = index (valid, set (j))
+23000 if (.not.(k .le. limit))goto 23002
+      junk = addset (valid (k), set, j, maxset)
+23001 k = k + 1
+      goto 23000
+23002 continue
+      return
+      end
diff --git a/unix/boot/spp/rpp/ratlibf/dsdbiu.f b/unix/boot/spp/rpp/ratlibf/dsdbiu.f
new file mode 100644
index 00000000..62efd56e
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibf/dsdbiu.f
@@ -0,0 +1,47 @@
+      subroutine dsdbiu (b, form)
+      integer b
+      integer form
+      integer mem( 1)
+      common/cdsmem/mem
+      integer l, s, lmax
+      integer blanks(6)
+      data blanks(1)/9/,blanks(2)/32/,blanks(3)/32/,blanks(4)/32/,blanks
+     *(5)/32/,blanks(6)/-2/
+      call putint (b, 5, 2)
+      call putch (32, 2)
+      call putint (mem (b + 0), 0, 2)
+      call remark (14H words in use.)
+      l = 0
+      s = b + mem (b + 0)
+      if (.not.(form .eq. 48))goto 23000
+      lmax = 5
+      goto 23001
+23000 continue
+      lmax = 50
+23001 continue
+      b = b + 2
+23002 if (.not.(b .lt. s))goto 23004
+      if (.not.(l .eq. 0))goto 23005
+      call putlin (blanks, 2)
+23005 continue
+      if (.not.(form .eq. 48))goto 23007
+      call putint (mem (b), 10, 2)
+      goto 23008
+23007 continue
+      if (.not.(form .eq. 97))goto 23009
+      call putch (mem (b), 2)
+23009 continue
+23008 continue
+      l = l + 1
+      if (.not.(l .ge. lmax))goto 23011
+      l = 0
+      call putch (10, 2)
+23011 continue
+23003 b = b + 1
+      goto 23002
+23004 continue
+      if (.not.(l .ne. 0))goto 23013
+      call putch (10, 2)
+23013 continue
+      return
+      end
diff --git a/unix/boot/spp/rpp/ratlibf/dsdump.f b/unix/boot/spp/rpp/ratlibf/dsdump.f
new file mode 100644
index 00000000..366bd5c4
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibf/dsdump.f
@@ -0,0 +1,28 @@
+      subroutine dsdump (form)
+      integer form
+      integer mem( 1)
+      common/cdsmem/mem
+      integer p, t, q
+      t = 2
+      call remark (27H** DYNAMIC STORAGE DUMP **.)
+      call putint (1, 5, 2)
+      call putch (32, 2)
+      call putint (2 + 1, 0, 2)
+      call remark (14H words in use.)
+      p = mem (t + 1)
+23000 if (.not.(p .ne. 0))goto 23001
+      call putint (p, 5, 2)
+      call putch (32, 2)
+      call putint (mem (p + 0), 0, 2)
+      call remark (17H words available.)
+      q = p + mem (p + 0)
+23002 if (.not.(q .ne. mem (p + 1) .and. q .lt. mem (1)))goto 23003
+      call dsdbiu (q, form)
+      goto 23002
+23003 continue
+      p = mem (p + 1)
+      goto 23000
+23001 continue
+      call remark (15H** END DUMP **.)
+      return
+      end
diff --git a/unix/boot/spp/rpp/ratlibf/dsfree.f b/unix/boot/spp/rpp/ratlibf/dsfree.f
new file mode 100644
index 00000000..8ab2f2a0
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibf/dsfree.f
@@ -0,0 +1,44 @@
+      subroutine dsfree (block)
+      integer block
+      integer mem( 1)
+      common/cdsmem/mem
+      integer p0, p, q
+      integer n, junk
+      integer con (10)
+      p0 = block - 2
+      n = mem (p0 + 0)
+      q = 2
+23000 continue
+      p = mem (q + 1)
+      if (.not.(p .eq. 0 .or. p .gt. p0))goto 23003
+      goto 23002
+23003 continue
+      q = p
+23001 goto 23000
+23002 continue
+      if (.not.(q + mem (q + 0) .gt. p0))goto 23005
+      call remark (45Hin dsfree:	attempt to free unallocated block.)
+      call remark (21Htype 'c' to continue.)
+      junk = getlin (con, 0)
+      if (.not.(con (1) .ne. 99 .and. con (1) .ne. 67))goto 23007
+      call endst
+23007 continue
+      return
+23005 continue
+      if (.not.(p0 + n .eq. p .and. p .ne. 0))goto 23009
+      n = n + mem (p + 0)
+      mem (p0 + 1) = mem (p + 1)
+      goto 23010
+23009 continue
+      mem (p0 + 1) = p
+23010 continue
+      if (.not.(q + mem (q + 0) .eq. p0))goto 23011
+      mem (q + 0) = mem (q + 0) + n
+      mem (q + 1) = mem (p0 + 1)
+      goto 23012
+23011 continue
+      mem (q + 1) = p0
+      mem (p0 + 0) = n
+23012 continue
+      return
+      end
diff --git a/unix/boot/spp/rpp/ratlibf/dsget.f b/unix/boot/spp/rpp/ratlibf/dsget.f
new file mode 100644
index 00000000..ef4fbcfe
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibf/dsget.f
@@ -0,0 +1,45 @@
+      integer function dsget (w)
+      integer w
+      integer mem( 1)
+      common/cdsmem/mem
+      integer p, q, l
+      integer n, k, junk
+      integer getlin
+      integer c (10)
+      n = w + 2
+      q = 2
+23000 continue
+      p = mem (q + 1)
+      if (.not.(p .eq. 0))goto 23003
+      call remark (31Hin dsget: out of storage space.)
+      call remark (41Htype 'c' or 'i' for char or integer dump.)
+      junk = getlin (c, 0)
+      if (.not.(c (1) .eq. 99 .or. c (1) .eq. 67))goto 23005
+      call dsdump (97)
+      goto 23006
+23005 continue
+      if (.not.(c (1) .eq. 105 .or. c (1) .eq. 73))goto 23007
+      call dsdump (48)
+23007 continue
+23006 continue
+      call error (19Hprogram terminated.)
+23003 continue
+      if (.not.(mem (p + 0) .ge. n))goto 23009
+      goto 23002
+23009 continue
+      q = p
+23001 goto 23000
+23002 continue
+      k = mem (p + 0) - n
+      if (.not.(k .ge. 8))goto 23011
+      mem (p + 0) = k
+      l = p + k
+      mem (l + 0) = n
+      goto 23012
+23011 continue
+      mem (q + 1) = mem (p + 1)
+      l = p
+23012 continue
+      dsget=(l + 2)
+      return
+      end
diff --git a/unix/boot/spp/rpp/ratlibf/dsinit.f b/unix/boot/spp/rpp/ratlibf/dsinit.f
new file mode 100644
index 00000000..9eb0ebad
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibf/dsinit.f
@@ -0,0 +1,17 @@
+      subroutine dsinit (w)
+      integer w
+      integer mem( 1)
+      common/cdsmem/mem
+      integer t
+      if (.not.(w .lt. 2 * 2 + 2))goto 23000
+      call error (42Hin dsinit: unreasonably small memory size.)
+23000 continue
+      t = 2
+      mem (t + 0) = 0
+      mem (t + 1) = 2 + 2
+      t = 2 + 2
+      mem (t + 0) = w - 2 - 1
+      mem (t + 1) = 0
+      mem (1) = w
+      return
+      end
diff --git a/unix/boot/spp/rpp/ratlibf/enter.f b/unix/boot/spp/rpp/ratlibf/enter.f
new file mode 100644
index 00000000..6711c57d
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibf/enter.f
@@ -0,0 +1,34 @@
+      subroutine enter (symbol, info, st)
+      integer symbol (100)
+      integer info (100)
+      integer st
+      integer mem( 1)
+      common/cdsmem/mem
+      integer i, nodsiz, j
+      integer stlu, length
+      integer node, pred
+      integer dsget
+      nodsiz = mem (st)
+      if (.not.(stlu (symbol, node, pred, st) .eq. 0))goto 23000
+      node = dsget (1 + nodsiz + length (symbol) + 1)
+      mem (node + 0) = 0
+      mem (pred + 0) = node
+      i = 1
+      j = node + 1 + nodsiz
+23002 if (.not.(symbol (i) .ne. -2))goto 23003
+      mem (j) = symbol (i)
+      i = i + 1
+      j = j + 1
+      goto 23002
+23003 continue
+      mem (j) = -2
+23000 continue
+      i = 1
+23004 if (.not.(i .le. nodsiz))goto 23006
+      j = node + 1 + i - 1
+      mem (j) = info (i)
+23005 i = i + 1
+      goto 23004
+23006 continue
+      return
+      end
diff --git a/unix/boot/spp/rpp/ratlibf/equal.f b/unix/boot/spp/rpp/ratlibf/equal.f
new file mode 100644
index 00000000..1148779c
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibf/equal.f
@@ -0,0 +1,15 @@
+      integer function equal (str1, str2)
+      integer str1(100), str2(100)
+      integer i
+      i = 1
+23000 if (.not.(str1 (i) .eq. str2 (i)))goto 23002
+      if (.not.(str1 (i) .eq. -2))goto 23003
+      equal=(1)
+      return
+23003 continue
+23001 i = i + 1
+      goto 23000
+23002 continue
+      equal=(0)
+      return
+      end
diff --git a/unix/boot/spp/rpp/ratlibf/error.f b/unix/boot/spp/rpp/ratlibf/error.f
new file mode 100644
index 00000000..f4e15821
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibf/error.f
@@ -0,0 +1,5 @@
+      subroutine error (line)
+      integer line (100)
+      call remark (line)
+      call endst
+      end
diff --git a/unix/boot/spp/rpp/ratlibf/errsub.f b/unix/boot/spp/rpp/ratlibf/errsub.f
new file mode 100644
index 00000000..63aa3c0e
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibf/errsub.f
@@ -0,0 +1,22 @@
+      integer function errsub (arg, file, access)
+      integer arg (100), file (100)
+      integer access
+      if (.not.(arg (1) .eq. 63 .and. arg (2) .ne. 63 .and. arg (2) .ne.
+     * -2))goto 23000
+      errsub = 1
+      access = 2
+      call scopy (arg, 2, file, 1)
+      goto 23001
+23000 continue
+      if (.not.(arg (1) .eq. 63 .and. arg (2) .eq. 63 .and. arg (3) .ne.
+     * -2))goto 23002
+      errsub = 1
+      access = 4
+      call scopy (arg, 3, file, 1)
+      goto 23003
+23002 continue
+      errsub = 0
+23003 continue
+23001 continue
+      return
+      end
diff --git a/unix/boot/spp/rpp/ratlibf/esc.f b/unix/boot/spp/rpp/ratlibf/esc.f
new file mode 100644
index 00000000..fd3ce7fe
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibf/esc.f
@@ -0,0 +1,27 @@
+      integer function esc (array, i)
+      integer array (100)
+      integer i
+      if (.not.(array (i) .ne. 64))goto 23000
+      esc = array (i)
+      goto 23001
+23000 continue
+      if (.not.(array (i+1) .eq. -2))goto 23002
+      esc = 64
+      goto 23003
+23002 continue
+      i = i + 1
+      if (.not.(array (i) .eq. 110 .or. array (i) .eq. 78))goto 23004
+      esc = 10
+      goto 23005
+23004 continue
+      if (.not.(array (i) .eq. 116 .or. array (i) .eq. 84))goto 23006
+      esc = 9
+      goto 23007
+23006 continue
+      esc = array (i)
+23007 continue
+23005 continue
+23003 continue
+23001 continue
+      return
+      end
diff --git a/unix/boot/spp/rpp/ratlibf/fcopy.f b/unix/boot/spp/rpp/ratlibf/fcopy.f
new file mode 100644
index 00000000..6c63dad8
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibf/fcopy.f
@@ -0,0 +1,10 @@
+      subroutine fcopy (in, out)
+      integer in, out
+      integer line (128)
+      integer getlin
+23000 if (.not.(getlin (line, in) .ne. -1))goto 23001
+      call putlin (line, out)
+      goto 23000
+23001 continue
+      return
+      end
diff --git a/unix/boot/spp/rpp/ratlibf/filset.f b/unix/boot/spp/rpp/ratlibf/filset.f
new file mode 100644
index 00000000..d5ada767
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibf/filset.f
@@ -0,0 +1,63 @@
+      subroutine filset (delim, array, i, set, j, maxset)
+      integer i, j, maxset
+      integer array (100), delim, set (maxset)
+      integer esc
+      integer junk
+      external index
+      integer addset, index
+      integer digits(11)
+      integer lowalf(27)
+      integer upalf(27)
+      data digits(1)/48/,digits(2)/49/,digits(3)/50/,digits(4)/51/,digit
+     *s(5)/52/,digits(6)/53/,digits(7)/54/,digits(8)/55/,digits(9)/56/,d
+     *igits(10)/57/,digits(11)/-2/
+      data lowalf(1)/97/,lowalf(2)/98/,lowalf(3)/99/,lowalf(4)/100/,lowa
+     *lf(5)/101/,lowalf(6)/102/,lowalf(7)/103/,lowalf(8)/104/,lowalf(9)/
+     *105/,lowalf(10)/106/,lowalf(11)/107/,lowalf(12)/108/,lowalf(13)/10
+     *9/,lowalf(14)/110/,lowalf(15)/111/,lowalf(16)/112/,lowalf(17)/113/
+     *,lowalf(18)/114/,lowalf(19)/115/,lowalf(20)/116/,lowalf(21)/117/,l
+     *owalf(22)/118/,lowalf(23)/119/,lowalf(24)/120/,lowalf(25)/121/,low
+     *alf(26)/122/,lowalf(27)/-2/
+      data upalf(1)/65/,upalf(2)/66/,upalf(3)/67/,upalf(4)/68/,upalf(5)/
+     *69/,upalf(6)/70/,upalf(7)/71/,upalf(8)/72/,upalf(9)/73/,upalf(10)/
+     *74/,upalf(11)/75/,upalf(12)/76/,upalf(13)/77/,upalf(14)/78/,upalf(
+     *15)/79/,upalf(16)/80/,upalf(17)/81/,upalf(18)/82/,upalf(19)/83/,up
+     *alf(20)/84/,upalf(21)/85/,upalf(22)/86/,upalf(23)/87/,upalf(24)/88
+     */,upalf(25)/89/,upalf(26)/90/,upalf(27)/-2/
+23000 if (.not.(array (i) .ne. delim .and. array (i) .ne. -2))goto 23002
+      if (.not.(array (i) .eq. 64))goto 23003
+      junk = addset (esc (array, i), set, j, maxset)
+      goto 23004
+23003 continue
+      if (.not.(array (i) .ne. 45))goto 23005
+      junk = addset (array (i), set, j, maxset)
+      goto 23006
+23005 continue
+      if (.not.(j .le. 1 .or. array (i + 1) .eq. -2))goto 23007
+      junk = addset (45, set, j, maxset)
+      goto 23008
+23007 continue
+      if (.not.(index (digits, set (j - 1)) .gt. 0))goto 23009
+      call dodash (digits, array, i, set, j, maxset)
+      goto 23010
+23009 continue
+      if (.not.(index (lowalf, set (j - 1)) .gt. 0))goto 23011
+      call dodash (lowalf, array, i, set, j, maxset)
+      goto 23012
+23011 continue
+      if (.not.(index (upalf, set (j - 1)) .gt. 0))goto 23013
+      call dodash (upalf, array, i, set, j, maxset)
+      goto 23014
+23013 continue
+      junk = addset (45, set, j, maxset)
+23014 continue
+23012 continue
+23010 continue
+23008 continue
+23006 continue
+23004 continue
+23001 i = i + 1
+      goto 23000
+23002 continue
+      return
+      end
diff --git a/unix/boot/spp/rpp/ratlibf/fmtdat.f b/unix/boot/spp/rpp/ratlibf/fmtdat.f
new file mode 100644
index 00000000..7a81c9c8
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibf/fmtdat.f
@@ -0,0 +1,23 @@
+      subroutine fmtdat(date, time, now, form)
+      integer date(100), time(100)
+      integer now(7), form
+      date(1) = now(2) / 10 + 48
+      date(2) = mod(now(2), 10) + 48
+      date(3) = 47
+      date(4) = now(3) / 10 + 48
+      date(5) = mod(now(3), 10) + 48
+      date(6) = 47
+      date(7) = mod(now(1), 100) / 10 + 48
+      date(8) = mod(now(1), 10) + 48
+      date(9) = -2
+      time(1) = now(4) / 10 + 48
+      time(2) = mod(now(4), 10) + 48
+      time(3) = 58
+      time(4) = now(5) / 10 + 48
+      time(5) = mod(now(5), 10) + 48
+      time(6) = 58
+      time(7) = now(6) / 10 + 48
+      time(8) = mod(now(6), 10) + 48
+      time(9) = -2
+      return
+      end
diff --git a/unix/boot/spp/rpp/ratlibf/fold.f b/unix/boot/spp/rpp/ratlibf/fold.f
new file mode 100644
index 00000000..187bb721
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibf/fold.f
@@ -0,0 +1,12 @@
+      subroutine fold (token)
+      integer token (100)
+      integer clower
+      integer i
+      i = 1
+23000 if (.not.(token (i) .ne. -2))goto 23002
+      token (i) = clower (token (i))
+23001 i = i + 1
+      goto 23000
+23002 continue
+      return
+      end
diff --git a/unix/boot/spp/rpp/ratlibf/gctoi.f b/unix/boot/spp/rpp/ratlibf/gctoi.f
new file mode 100644
index 00000000..93ac3b6d
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibf/gctoi.f
@@ -0,0 +1,61 @@
+      integer function gctoi (str, i, radix)
+      integer str (100)
+      integer i, radix
+      integer base, v, d, j
+      external index
+      integer index
+      integer clower
+      logical neg
+      integer digits(17)
+      data digits(1)/48/,digits(2)/49/,digits(3)/50/,digits(4)/51/,digit
+     *s(5)/52/,digits(6)/53/,digits(7)/54/,digits(8)/55/,digits(9)/56/,d
+     *igits(10)/57/,digits(11)/97/,digits(12)/98/,digits(13)/99/,digits(
+     *14)/100/,digits(15)/101/,digits(16)/102/,digits(17)/-2/
+      v = 0
+      base = radix
+23000 if (.not.(str (i) .eq. 32 .or. str (i) .eq. 9))goto 23001
+      i = i + 1
+      goto 23000
+23001 continue
+      neg = (str (i) .eq. 45)
+      if (.not.(str (i) .eq. 43 .or. str (i) .eq. 45))goto 23002
+      i = i + 1
+23002 continue
+      if (.not.(str (i + 2) .eq. 114 .and. str (i) .eq. 49 .and. (48.le.
+     *str (i + 1).and.str (i + 1).le.57) .or. str (i + 1) .eq. 114 .and.
+     * (48.le.str (i).and.str (i).le.57)))goto 23004
+      base = str (i) - 48
+      j = i
+      if (.not.(str (i + 1) .ne. 114))goto 23006
+      j = j + 1
+      base = base * 10 + (str (j) - 48)
+23006 continue
+      if (.not.(base .lt. 2 .or. base .gt. 16))goto 23008
+      base = radix
+      goto 23009
+23008 continue
+      i = j + 2
+23009 continue
+23004 continue
+23010 if (.not.(str (i) .ne. -2))goto 23012
+      if (.not.((48.le.str (i).and.str (i).le.57)))goto 23013
+      d = str (i) - 48
+      goto 23014
+23013 continue
+      d = index (digits, clower (str (i))) - 1
+23014 continue
+      if (.not.(d .lt. 0 .or. d .ge. base))goto 23015
+      goto 23012
+23015 continue
+      v = v * base + d
+23011 i = i + 1
+      goto 23010
+23012 continue
+      if (.not.(neg))goto 23017
+      gctoi=(-v)
+      return
+23017 continue
+      gctoi=(+v)
+      return
+23018 continue
+      end
diff --git a/unix/boot/spp/rpp/ratlibf/getc.f b/unix/boot/spp/rpp/ratlibf/getc.f
new file mode 100644
index 00000000..1dfabd93
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibf/getc.f
@@ -0,0 +1,6 @@
+      integer function getc (c)
+      integer c
+      integer getch
+      getc = getch (c, 0)
+      return
+      end
diff --git a/unix/boot/spp/rpp/ratlibf/getccl.f b/unix/boot/spp/rpp/ratlibf/getccl.f
new file mode 100644
index 00000000..67ac73fa
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibf/getccl.f
@@ -0,0 +1,25 @@
+      integer function getccl (arg, i, pat, j)
+      integer arg (128), pat (128)
+      integer i, j
+      integer jstart, junk
+      integer addset
+      i = i + 1
+      if (.not.(arg (i) .eq. 126))goto 23000
+      junk = addset (110, pat, j, 128)
+      i = i + 1
+      goto 23001
+23000 continue
+      junk = addset (91, pat, j, 128)
+23001 continue
+      jstart = j
+      junk = addset (0, pat, j, 128)
+      call filset (93, arg, i, pat, j, 128)
+      pat (jstart) = j - jstart - 1
+      if (.not.(arg (i) .eq. 93))goto 23002
+      getccl = -2
+      goto 23003
+23002 continue
+      getccl = -3
+23003 continue
+      return
+      end
diff --git a/unix/boot/spp/rpp/ratlibf/getpat.f b/unix/boot/spp/rpp/ratlibf/getpat.f
new file mode 100644
index 00000000..02d00ace
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibf/getpat.f
@@ -0,0 +1,6 @@
+      integer function getpat (str, pat)
+      integer str (100), pat (100)
+      integer makpat
+      getpat=(makpat (str, 1, -2, pat))
+      return
+      end
diff --git a/unix/boot/spp/rpp/ratlibf/getwrd.f b/unix/boot/spp/rpp/ratlibf/getwrd.f
new file mode 100644
index 00000000..f1c0f8d7
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibf/getwrd.f
@@ -0,0 +1,20 @@
+      integer function getwrd (in, i, out)
+      integer in (100), out (100)
+      integer i
+      integer j
+23000 if (.not.(in (i) .eq. 32 .or. in (i) .eq. 9))goto 23001
+      i = i + 1
+      goto 23000
+23001 continue
+      j = 1
+23002 if (.not.(in (i) .ne. -2 .and. in (i) .ne. 32 .and. in (i) .ne. 9 
+     *.and. in (i) .ne. 10))goto 23003
+      out (j) = in (i)
+      i = i + 1
+      j = j + 1
+      goto 23002
+23003 continue
+      out (j) = -2
+      getwrd = j - 1
+      return
+      end
diff --git a/unix/boot/spp/rpp/ratlibf/gfnarg.f b/unix/boot/spp/rpp/ratlibf/gfnarg.f
new file mode 100644
index 00000000..19d4655d
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibf/gfnarg.f
@@ -0,0 +1,142 @@
+      integer function gfnarg (name, state)
+      integer name (100)
+      integer state (4)
+      integer l
+      integer getarg, getlin
+      integer fd
+      integer rfopen
+      integer in1(12)
+      integer in2(12)
+      integer in3(12)
+      data in1(1)/47/,in1(2)/100/,in1(3)/101/,in1(4)/118/,in1(5)/47/,in1
+     *(6)/115/,in1(7)/116/,in1(8)/100/,in1(9)/105/,in1(10)/110/,in1(11)/
+     *49/,in1(12)/-2/
+      data in2(1)/47/,in2(2)/100/,in2(3)/101/,in2(4)/118/,in2(5)/47/,in2
+     *(6)/115/,in2(7)/116/,in2(8)/100/,in2(9)/105/,in2(10)/110/,in2(11)/
+     *50/,in2(12)/-2/
+      data in3(1)/47/,in3(2)/100/,in3(3)/101/,in3(4)/118/,in3(5)/47/,in3
+     *(6)/115/,in3(7)/116/,in3(8)/100/,in3(9)/105/,in3(10)/110/,in3(11)/
+     *51/,in3(12)/-2/
+23000 continue
+      if (.not.(state (1) .eq. 1))goto 23003
+      state (1) = 2
+      state (2) = 1
+      state (3) = -3
+      state (4) = 0
+      goto 23004
+23003 continue
+      if (.not.(state (1) .eq. 2))goto 23005
+      if (.not.(getarg (state (2), name, 128) .ne. -1))goto 23007
+      state (1) = 2
+      state (2) = state (2) + 1
+      if (.not.(name (1) .ne. 45))goto 23009
+      state (4) = state (4) + 1
+      gfnarg=(-2)
+      return
+23009 continue
+      if (.not.(name (2) .eq. -2))goto 23011
+      call scopy (in1, 1, name, 1)
+      state (4) = state (4) + 1
+      gfnarg=(-2)
+      return
+23011 continue
+      if (.not.(name (2) .eq. 49 .and. name (3) .eq. -2))goto 23013
+      call scopy (in1, 1, name, 1)
+      state (4) = state (4) + 1
+      gfnarg=(-2)
+      return
+23013 continue
+      if (.not.(name (2) .eq. 50 .and. name (3) .eq. -2))goto 23015
+      call scopy (in2, 1, name, 1)
+      state (4) = state (4) + 1
+      gfnarg=(-2)
+      return
+23015 continue
+      if (.not.(name (2) .eq. 51 .and. name (3) .eq. -2))goto 23017
+      call scopy (in3, 1, name, 1)
+      state (4) = state (4) + 1
+      gfnarg=(-2)
+      return
+23017 continue
+      if (.not.(name (2) .eq. 110 .or. name (2) .eq. 78))goto 23019
+      state (1) = 3
+      if (.not.(name (3) .eq. -2))goto 23021
+      state (3) = 0
+      goto 23022
+23021 continue
+      if (.not.(name (3) .eq. 49 .and. name (4) .eq. -2))goto 23023
+      state (3) = stdin1
+      goto 23024
+23023 continue
+      if (.not.(name (3) .eq. 50 .and. name (4) .eq. -2))goto 23025
+      state (3) = stdin2
+      goto 23026
+23025 continue
+      if (.not.(name (3) .eq. 51 .and. name (4) .eq. -2))goto 23027
+      state (3) = stdin3
+      goto 23028
+23027 continue
+      state (3) = rfopen(name (3), 1)
+      if (.not.(state (3) .eq. -3))goto 23029
+      call putlin (name, 2)
+      call remark (14H:  can't open.)
+      state (1) = 2
+23029 continue
+23028 continue
+23026 continue
+23024 continue
+23022 continue
+      goto 23020
+23019 continue
+      gfnarg=(-3)
+      return
+23020 continue
+23018 continue
+23016 continue
+23014 continue
+23012 continue
+23010 continue
+      goto 23008
+23007 continue
+      state (1) = 4
+23008 continue
+      goto 23006
+23005 continue
+      if (.not.(state (1) .eq. 3))goto 23031
+      l = getlin (name, state (3))
+      if (.not.(l .ne. -1))goto 23033
+      name (l) = -2
+      state (4) = state (4) + 1
+      gfnarg=(-2)
+      return
+23033 continue
+      if (.not.(fd .ne. -3 .and. fd .ne. 0))goto 23035
+      call rfclos(state (3))
+23035 continue
+      state (1) = 2
+      goto 23032
+23031 continue
+      if (.not.(state (1) .eq. 4))goto 23037
+      state (1) = 5
+      if (.not.(state (4) .eq. 0))goto 23039
+      call scopy (in1, 1, name, 1)
+      gfnarg=(-2)
+      return
+23039 continue
+      goto 23002
+23037 continue
+      if (.not.(state (1) .eq. 5))goto 23041
+      goto 23002
+23041 continue
+      call error (32Hin gfnarg:  bad state (1) value.)
+23042 continue
+23038 continue
+23032 continue
+23006 continue
+23004 continue
+23001 goto 23000
+23002 continue
+      name (1) = -2
+      gfnarg=(-1)
+      return
+      end
diff --git a/unix/boot/spp/rpp/ratlibf/index.f b/unix/boot/spp/rpp/ratlibf/index.f
new file mode 100644
index 00000000..d5978954
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibf/index.f
@@ -0,0 +1,13 @@
+      integer function index (str, c)
+      integer str (100), c
+      index = 1
+23000 if (.not.(str (index) .ne. -2))goto 23002
+      if (.not.(str (index) .eq. c))goto 23003
+      return
+23003 continue
+23001 index = index + 1
+      goto 23000
+23002 continue
+      index = 0
+      return
+      end
diff --git a/unix/boot/spp/rpp/ratlibf/insub.f b/unix/boot/spp/rpp/ratlibf/insub.f
new file mode 100644
index 00000000..72e50ff1
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibf/insub.f
@@ -0,0 +1,11 @@
+      integer function insub (arg, file)
+      integer arg (100), file (100)
+      if (.not.(arg (1) .eq. 60 .and. arg (2) .ne. -2))goto 23000
+      insub = 1
+      call scopy (arg, 2, file, 1)
+      goto 23001
+23000 continue
+      insub = 0
+23001 continue
+      return
+      end
diff --git a/unix/boot/spp/rpp/ratlibf/itoc.f b/unix/boot/spp/rpp/ratlibf/itoc.f
new file mode 100644
index 00000000..3ceea6a7
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibf/itoc.f
@@ -0,0 +1,35 @@
+      integer function itoc (int, str, size)
+      integer int, size
+      integer str (100)
+      integer mod
+      integer d, i, intval, j, k
+      integer digits (11)
+      data digits (1) /48/, digits (2) /49/, digits (3) /50/, digits (4)
+     * /51/, digits (5) /52/, digits (6) /53/, digits (7) /54/, digits (
+     *8) /55/, digits (9) /56/, digits (10) /57/, digits (11) /-2/
+      intval = iabs (int)
+      str (1) = -2
+      i = 1
+23000 continue
+      i = i + 1
+      d = mod (intval, 10)
+      str (i) = digits (d+1)
+      intval = intval / 10
+23001 if (.not.(intval .eq. 0 .or. i .ge. size))goto 23000
+23002 continue
+      if (.not.(int .lt. 0 .and. i .lt. size))goto 23003
+      i = i + 1
+      str (i) = 45
+23003 continue
+      itoc = i - 1
+      j = 1
+23005 if (.not.(j .lt. i))goto 23007
+      k = str (i)
+      str (i) = str (j)
+      str (j) = k
+      i = i - 1
+23006 j = j + 1
+      goto 23005
+23007 continue
+      return
+      end
diff --git a/unix/boot/spp/rpp/ratlibf/length.f b/unix/boot/spp/rpp/ratlibf/length.f
new file mode 100644
index 00000000..4bf20e40
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibf/length.f
@@ -0,0 +1,9 @@
+      integer function length (str)
+      integer str (100)
+      length = 0
+23000 if (.not.(str (length+1) .ne. -2))goto 23002
+23001 length = length + 1
+      goto 23000
+23002 continue
+      return
+      end
diff --git a/unix/boot/spp/rpp/ratlibf/locate.f b/unix/boot/spp/rpp/ratlibf/locate.f
new file mode 100644
index 00000000..6db95e25
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibf/locate.f
@@ -0,0 +1,16 @@
+      integer function locate (c, pat, offset)
+      integer c, pat (128)
+      integer offset
+      integer i
+      i = offset + pat (offset)
+23000 if (.not.(i .gt. offset))goto 23002
+      if (.not.(c .eq. pat (i)))goto 23003
+      locate=(1)
+      return
+23003 continue
+23001 i = i - 1
+      goto 23000
+23002 continue
+      locate=(0)
+      return
+      end
diff --git a/unix/boot/spp/rpp/ratlibf/lookup.f b/unix/boot/spp/rpp/ratlibf/lookup.f
new file mode 100644
index 00000000..f70e9842
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibf/lookup.f
@@ -0,0 +1,24 @@
+      integer function lookup (symbol, info, st)
+      integer symbol (100)
+      integer info (100)
+      integer st
+      integer mem( 1)
+      common/cdsmem/mem
+      integer i, nodsiz, kluge
+      integer stlu
+      integer node, pred
+      if (.not.(stlu (symbol, node, pred, st) .eq. 0))goto 23000
+      lookup = 0
+      return
+23000 continue
+      nodsiz = mem (st)
+      i = 1
+23002 if (.not.(i .le. nodsiz))goto 23004
+      kluge = node + 1 - 1 + i
+      info (i) = mem (kluge)
+23003 i = i + 1
+      goto 23002
+23004 continue
+      lookup = 1
+      return
+      end
diff --git a/unix/boot/spp/rpp/ratlibf/lower.f b/unix/boot/spp/rpp/ratlibf/lower.f
new file mode 100644
index 00000000..b3550701
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibf/lower.f
@@ -0,0 +1,5 @@
+      subroutine lower (token)
+      integer token (100)
+      call fold (token)
+      return
+      end
diff --git a/unix/boot/spp/rpp/ratlibf/makpat.f b/unix/boot/spp/rpp/ratlibf/makpat.f
new file mode 100644
index 00000000..27744665
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibf/makpat.f
@@ -0,0 +1,90 @@
+      integer function makpat (arg, from, delim, pat)
+      integer arg (128), delim, pat (128)
+      integer from
+      integer esc
+      integer i, j, junk, lastcl, lastj, lj, tagnst, tagnum, tagstk (9)
+      integer addset, getccl, stclos
+      j = 1
+      lastj = 1
+      lastcl = 0
+      tagnum = 0
+      tagnst = 0
+      i = from
+23000 if (.not.(arg (i) .ne. delim .and. arg (i) .ne. -2))goto 23002
+      lj = j
+      if (.not.(arg (i) .eq. 63))goto 23003
+      junk = addset (63, pat, j, 128)
+      goto 23004
+23003 continue
+      if (.not.(arg (i) .eq. 37 .and. i .eq. from))goto 23005
+      junk = addset (37, pat, j, 128)
+      goto 23006
+23005 continue
+      if (.not.(arg (i) .eq. 36 .and. arg (i + 1) .eq. delim))goto 23007
+      junk = addset (36, pat, j, 128)
+      goto 23008
+23007 continue
+      if (.not.(arg (i) .eq. 91))goto 23009
+      if (.not.(getccl (arg, i, pat, j) .eq. -3))goto 23011
+      makpat = -3
+      return
+23011 continue
+      goto 23010
+23009 continue
+      if (.not.(arg (i) .eq. 42 .and. i .gt. from))goto 23013
+      lj = lastj
+      if (.not.(pat (lj) .eq. 37 .or. pat (lj) .eq. 36 .or. pat (lj) .eq
+     *. 42 .or. pat (lj) .eq. 123 .or. pat (lj) .eq. 125))goto 23015
+      goto 23002
+23015 continue
+      lastcl = stclos (pat, j, lastj, lastcl)
+      goto 23014
+23013 continue
+      if (.not.(arg (i) .eq. 123))goto 23017
+      if (.not.(tagnum .ge. 9))goto 23019
+      goto 23002
+23019 continue
+      tagnum = tagnum + 1
+      tagnst = tagnst + 1
+      tagstk (tagnst) = tagnum
+      junk = addset (123, pat, j, 128)
+      junk = addset (tagnum, pat, j, 128)
+      goto 23018
+23017 continue
+      if (.not.(arg (i) .eq. 125 .and. tagnst .gt. 0))goto 23021
+      junk = addset (125, pat, j, 128)
+      junk = addset (tagstk (tagnst), pat, j, 128)
+      tagnst = tagnst - 1
+      goto 23022
+23021 continue
+      junk = addset (97, pat, j, 128)
+      junk = addset (esc (arg, i), pat, j, 128)
+23022 continue
+23018 continue
+23014 continue
+23010 continue
+23008 continue
+23006 continue
+23004 continue
+      lastj = lj
+23001 i = i + 1
+      goto 23000
+23002 continue
+      if (.not.(arg (i) .ne. delim))goto 23023
+      makpat = -3
+      goto 23024
+23023 continue
+      if (.not.(addset (-2, pat, j, 128) .eq. 0))goto 23025
+      makpat = -3
+      goto 23026
+23025 continue
+      if (.not.(tagnst .ne. 0))goto 23027
+      makpat = -3
+      goto 23028
+23027 continue
+      makpat = i
+23028 continue
+23026 continue
+23024 continue
+      return
+      end
diff --git a/unix/boot/spp/rpp/ratlibf/maksub.f b/unix/boot/spp/rpp/ratlibf/maksub.f
new file mode 100644
index 00000000..176c5321
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibf/maksub.f
@@ -0,0 +1,40 @@
+      integer function maksub (arg, from, delim, sub)
+      integer arg (128), delim, sub (128)
+      integer from
+      integer esc, type
+      integer i, j, junk
+      integer addset
+      j = 1
+      i = from
+23000 if (.not.(arg (i) .ne. delim .and. arg (i) .ne. -2))goto 23002
+      if (.not.(arg (i) .eq. 38))goto 23003
+      junk = addset (-3, sub, j, 128)
+      junk = addset (0, sub, j, 128)
+      goto 23004
+23003 continue
+      if (.not.(arg (i) .eq. 64 .and. type (arg (i + 1)) .eq. 48))goto 2
+     *3005
+      i = i + 1
+      junk = addset (-3, sub, j, 128)
+      junk = addset (arg (i) - 48, sub, j, 128)
+      goto 23006
+23005 continue
+      junk = addset (esc (arg, i), sub, j, 128)
+23006 continue
+23004 continue
+23001 i = i + 1
+      goto 23000
+23002 continue
+      if (.not.(arg (i) .ne. delim))goto 23007
+      maksub = -3
+      goto 23008
+23007 continue
+      if (.not.(addset (-2, sub, j, 128) .eq. 0))goto 23009
+      maksub = -3
+      goto 23010
+23009 continue
+      maksub = i
+23010 continue
+23008 continue
+      return
+      end
diff --git a/unix/boot/spp/rpp/ratlibf/match.f b/unix/boot/spp/rpp/ratlibf/match.f
new file mode 100644
index 00000000..de4e3638
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibf/match.f
@@ -0,0 +1,16 @@
+      integer function match (lin, pat)
+      integer lin (128), pat (128)
+      integer i, junk (9)
+      integer amatch
+      i = 1
+23000 if (.not.(lin (i) .ne. -2))goto 23002
+      if (.not.(amatch (lin, i, pat, junk, junk) .gt. 0))goto 23003
+      match = 1
+      return
+23003 continue
+23001 i = i + 1
+      goto 23000
+23002 continue
+      match = 0
+      return
+      end
diff --git a/unix/boot/spp/rpp/ratlibf/mkpkg.sh b/unix/boot/spp/rpp/ratlibf/mkpkg.sh
new file mode 100644
index 00000000..e9cb8822
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibf/mkpkg.sh
@@ -0,0 +1,18 @@
+# Utility library subroutines for RPP.
+
+$F77 -c $HSI_FF	addset.f addstr.f amatch.f catsub.f clower.f concat.f
+$F77 -c $HSI_FF	ctoc.f ctoi.f ctomn.f cupper.f delete.f docant.f dodash.f
+$F77 -c $HSI_FF	dsdbiu.f dsdump.f dsfree.f dsget.f dsinit.f enter.f equal.f
+$F77 -c $HSI_FF	error.f errsub.f esc.f fcopy.f filset.f fmtdat.f fold.f
+$F77 -c $HSI_FF	gctoi.f getc.f getccl.f getpat.f getwrd.f gfnarg.f index.f
+$F77 -c $HSI_FF	insub.f itoc.f length.f locate.f lookup.f lower.f makpat.f
+$F77 -c $HSI_FF	maksub.f match.f mktabl.f mntoc.f omatch.f outsub.f patsiz.f
+$F77 -c $HSI_FF	prompt.f putc.f putdec.f putint.f putstr.f query.f rmtabl.f
+$F77 -c $HSI_FF	scopy.f sctabl.f sdrop.f skipbl.f slstr.f stake.f stclos.f
+$F77 -c $HSI_FF	stcopy.f stlu.f strcmp.f strim.f termin.f trmout.f type.f
+$F77 -c $HSI_FF	upper.f wkday.f
+
+ar rv		libf.a *.o
+$RANLIB		libf.a
+mv -f		libf.a ..
+rm		*.o
diff --git a/unix/boot/spp/rpp/ratlibf/mktabl.f b/unix/boot/spp/rpp/ratlibf/mktabl.f
new file mode 100644
index 00000000..9c3e7908
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibf/mktabl.f
@@ -0,0 +1,17 @@
+      integer function mktabl (nodsiz)
+      integer nodsiz
+      integer mem( 1)
+      common/cdsmem/mem
+      integer st
+      integer dsget
+      integer i
+      st = dsget (43 + 1)
+      mem (st) = nodsiz
+      mktabl = st
+      do 23000 i = 1, 43
+      st = st + 1
+      mem (st) = 0
+23000 continue
+23001 continue
+      return
+      end
diff --git a/unix/boot/spp/rpp/ratlibf/mntoc.f b/unix/boot/spp/rpp/ratlibf/mntoc.f
new file mode 100644
index 00000000..5a54ec16
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibf/mntoc.f
@@ -0,0 +1,52 @@
+      integer function mntoc (buf, p, defalt)
+      integer buf (100), defalt
+      integer p
+      integer i, tp
+      integer equal
+      integer c, tmp (128)
+      integer text (170)
+      data text /  6, 97, 99, 107, -2, 7, 98, 101, 108, -2, 8, 98, 115, 
+     *-2, -2, 24, 99, 97, 110, -2, 13, 99, 114, -2, -2, 17, 100, 99, 49,
+     * -2, 18, 100, 99, 50, -2, 19, 100, 99, 51, -2, 20, 100, 99, 52, -2
+     *, 127, 100, 101, 108, -2, 16, 100, 108, 101, -2, 25, 101, 109, -2,
+     * -2, 5, 101, 110, 113, -2, 4, 101, 111, 116, -2, 27, 101, 115, 99,
+     * -2, 23, 101, 116, 98, -2, 3, 101, 116, 120, -2, 12, 102, 102, -2,
+     * -2, 28, 102, 115, -2, -2, 29, 103, 115, -2, -2, 9, 104, 116, -2, 
+     *-2, 10, 108, 102, -2, -2, 21, 110, 97, 107, -2, 0, 110, 117, 108, 
+     *-2, 30, 114, 115, -2, -2, 15, 115, 105, -2, -2, 14, 115, 111, -2, 
+     *-2, 1, 115, 111, 104, -2, 32, 115, 112, -2, -2, 2, 115, 116, 120, 
+     *-2, 26, 115, 117, 98, -2, 22, 115, 121, 110, -2, 31, 117, 115, -2,
+     * -2, 11, 118, 116, -2, -2/
+      tp = 1
+23000 continue
+      tmp (tp) = buf (p)
+      tp = tp + 1
+      p = p + 1
+23001 if (.not.(.not. (((65.le.buf (p).and.buf (p).le.90).or.(97.le.buf 
+     *(p).and.buf (p).le.122)) .or. (48.le.buf (p).and.buf (p).le.57)) .
+     *or. tp .ge. 128))goto 23000
+23002 continue
+      tmp (tp) = -2
+      if (.not.(tp .eq. 2))goto 23003
+      c = tmp (1)
+      goto 23004
+23003 continue
+      call lower (tmp)
+      i = 1
+23005 if (.not.(i .lt. 170))goto 23007
+      if (.not.(equal (tmp, text (i + 1)) .eq. 1))goto 23008
+      goto 23007
+23008 continue
+23006 i = i + 5
+      goto 23005
+23007 continue
+      if (.not.(i .lt. 170))goto 23010
+      c = text (i)
+      goto 23011
+23010 continue
+      c = defalt
+23011 continue
+23004 continue
+      mntoc=(c)
+      return
+      end
diff --git a/unix/boot/spp/rpp/ratlibf/omatch.f b/unix/boot/spp/rpp/ratlibf/omatch.f
new file mode 100644
index 00000000..60d57c83
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibf/omatch.f
@@ -0,0 +1,60 @@
+      integer function omatch (lin, i, pat, j)
+      integer lin (128), pat (128)
+      integer i, j
+      integer bump
+      integer locate
+      omatch = 0
+      if (.not.(lin (i) .eq. -2))goto 23000
+      return
+23000 continue
+      bump = -1
+      if (.not.(pat (j) .eq. 97))goto 23002
+      if (.not.(lin (i) .eq. pat (j + 1)))goto 23004
+      bump = 1
+23004 continue
+      goto 23003
+23002 continue
+      if (.not.(pat (j) .eq. 37))goto 23006
+      if (.not.(i .eq. 1))goto 23008
+      bump = 0
+23008 continue
+      goto 23007
+23006 continue
+      if (.not.(pat (j) .eq. 63))goto 23010
+      if (.not.(lin (i) .ne. 10))goto 23012
+      bump = 1
+23012 continue
+      goto 23011
+23010 continue
+      if (.not.(pat (j) .eq. 36))goto 23014
+      if (.not.(lin (i) .eq. 10))goto 23016
+      bump = 0
+23016 continue
+      goto 23015
+23014 continue
+      if (.not.(pat (j) .eq. 91))goto 23018
+      if (.not.(locate (lin (i), pat, j + 1) .eq. 1))goto 23020
+      bump = 1
+23020 continue
+      goto 23019
+23018 continue
+      if (.not.(pat (j) .eq. 110))goto 23022
+      if (.not.(lin (i) .ne. 10 .and. locate (lin (i), pat, j + 1) .eq. 
+     *0))goto 23024
+      bump = 1
+23024 continue
+      goto 23023
+23022 continue
+      call error (24Hin omatch: can't happen.)
+23023 continue
+23019 continue
+23015 continue
+23011 continue
+23007 continue
+23003 continue
+      if (.not.(bump .ge. 0))goto 23026
+      i = i + bump
+      omatch = 1
+23026 continue
+      return
+      end
diff --git a/unix/boot/spp/rpp/ratlibf/outsub.f b/unix/boot/spp/rpp/ratlibf/outsub.f
new file mode 100644
index 00000000..c8da87de
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibf/outsub.f
@@ -0,0 +1,22 @@
+      integer function outsub (arg, file, access)
+      integer arg (100), file (100)
+      integer access
+      if (.not.(arg (1) .eq. 62 .and. arg (2) .ne. 62 .and. arg (2) .ne.
+     * -2))goto 23000
+      outsub = 1
+      access = 2
+      call scopy (arg, 2, file, 1)
+      goto 23001
+23000 continue
+      if (.not.(arg (1) .eq. 62 .and. arg (2) .eq. 62 .and. arg (3) .ne.
+     * -2))goto 23002
+      access = 4
+      outsub = 1
+      call scopy (arg, 3, file, 1)
+      goto 23003
+23002 continue
+      outsub = 0
+23003 continue
+23001 continue
+      return
+      end
diff --git a/unix/boot/spp/rpp/ratlibf/patsiz.f b/unix/boot/spp/rpp/ratlibf/patsiz.f
new file mode 100644
index 00000000..e15449de
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibf/patsiz.f
@@ -0,0 +1,28 @@
+      integer function patsiz (pat, n)
+      integer pat (128)
+      integer n
+      if (.not.(pat (n) .eq. 97 .or. pat (n) .eq. 123 .or. pat (n) .eq. 
+     *125))goto 23000
+      patsiz = 2
+      goto 23001
+23000 continue
+      if (.not.(pat (n) .eq. 37 .or. pat (n) .eq. 36 .or. pat (n) .eq. 6
+     *3))goto 23002
+      patsiz = 1
+      goto 23003
+23002 continue
+      if (.not.(pat (n) .eq. 91 .or. pat (n) .eq. 110))goto 23004
+      patsiz = pat (n + 1) + 2
+      goto 23005
+23004 continue
+      if (.not.(pat (n) .eq. 42))goto 23006
+      patsiz = 4
+      goto 23007
+23006 continue
+      call error (24Hin patsiz: can't happen.)
+23007 continue
+23005 continue
+23003 continue
+23001 continue
+      return
+      end
diff --git a/unix/boot/spp/rpp/ratlibf/prompt.f b/unix/boot/spp/rpp/ratlibf/prompt.f
new file mode 100644
index 00000000..64ab202e
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibf/prompt.f
@@ -0,0 +1,11 @@
+      subroutine prompt (str, buf, fd)
+      integer str(100), buf(100)
+      integer fd
+      integer isatty
+      if (.not.(isatty(fd) .eq. 1))goto 23000
+      call putlin (str, fd)
+      call rfflus(fd)
+23000 continue
+      call getlin (buf, fd)
+      return
+      end
diff --git a/unix/boot/spp/rpp/ratlibf/putc.f b/unix/boot/spp/rpp/ratlibf/putc.f
new file mode 100644
index 00000000..c3eecfde
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibf/putc.f
@@ -0,0 +1,5 @@
+      subroutine putc (c)
+      integer c
+      call putch (c, 1)
+      return
+      end
diff --git a/unix/boot/spp/rpp/ratlibf/putdec.f b/unix/boot/spp/rpp/ratlibf/putdec.f
new file mode 100644
index 00000000..878febcf
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibf/putdec.f
@@ -0,0 +1,20 @@
+      subroutine putdec(n,w)
+      integer n, w
+      integer chars (20)
+      integer i, nd
+      integer itoc
+      nd = itoc (n, chars, 20)
+      i = nd + 1
+23000 if (.not.(i .le. w))goto 23002
+      call putc (32)
+23001 i = i + 1
+      goto 23000
+23002 continue
+      i = 1
+23003 if (.not.(i .le. nd))goto 23005
+      call putc (chars (i))
+23004 i = i + 1
+      goto 23003
+23005 continue
+      return
+      end
diff --git a/unix/boot/spp/rpp/ratlibf/putint.f b/unix/boot/spp/rpp/ratlibf/putint.f
new file mode 100644
index 00000000..182e96e2
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibf/putint.f
@@ -0,0 +1,10 @@
+      subroutine putint (n, w, fd)
+      integer n, w
+      integer fd
+      integer chars (20)
+      integer junk
+      integer itoc
+      junk = itoc (n, chars, 20)
+      call putstr (chars, w, fd)
+      return
+      end
diff --git a/unix/boot/spp/rpp/ratlibf/putstr.f b/unix/boot/spp/rpp/ratlibf/putstr.f
new file mode 100644
index 00000000..aaf0f060
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibf/putstr.f
@@ -0,0 +1,27 @@
+      subroutine putstr (str, w, fd)
+      integer str (100)
+      integer w
+      integer fd
+      integer length
+      integer i, len
+      len = length (str)
+      i = len + 1
+23000 if (.not.(i .le. w))goto 23002
+      call putch (32, fd)
+23001 i = i + 1
+      goto 23000
+23002 continue
+      i = 1
+23003 if (.not.(i .le. len))goto 23005
+      call putch (str (i), fd)
+23004 i = i + 1
+      goto 23003
+23005 continue
+      i = (-w) - len
+23006 if (.not.(i .gt. 0))goto 23008
+      call putch (32, fd)
+23007 i = i - 1
+      goto 23006
+23008 continue
+      return
+      end
diff --git a/unix/boot/spp/rpp/ratlibf/query.f b/unix/boot/spp/rpp/ratlibf/query.f
new file mode 100644
index 00000000..d12c514a
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibf/query.f
@@ -0,0 +1,12 @@
+      subroutine query (mesg)
+      integer mesg (100)
+      integer getarg
+      integer arg1 (3), arg2 (1)
+      if (.not.(getarg (1, arg1, 3) .ne. -1 .and. getarg (2, arg2, 1) .e
+     *q. -1))goto 23000
+      if (.not.(arg1 (1) .eq. 63 .and. arg1 (2) .eq. -2))goto 23002
+      call error (mesg)
+23002 continue
+23000 continue
+      return
+      end
diff --git a/unix/boot/spp/rpp/ratlibf/rmtabl.f b/unix/boot/spp/rpp/ratlibf/rmtabl.f
new file mode 100644
index 00000000..5b552cab
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibf/rmtabl.f
@@ -0,0 +1,21 @@
+      subroutine rmtabl (st)
+      integer st
+      integer mem( 1)
+      common/cdsmem/mem
+      integer i
+      integer walker, bucket, node
+      bucket = st
+      do 23000 i = 1, 43
+      bucket = bucket + 1
+      walker = mem (bucket)
+23002 if (.not.(walker .ne. 0))goto 23003
+      node = walker
+      walker = mem (node + 0)
+      call dsfree (node)
+      goto 23002
+23003 continue
+23000 continue
+23001 continue
+      call dsfree (st)
+      return
+      end
diff --git a/unix/boot/spp/rpp/ratlibf/scopy.f b/unix/boot/spp/rpp/ratlibf/scopy.f
new file mode 100644
index 00000000..a16bc5ee
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibf/scopy.f
@@ -0,0 +1,15 @@
+      subroutine scopy (from, i, to, j)
+      integer from (100), to (100)
+      integer i, j
+      integer k1, k2
+      k2 = j
+      k1 = i
+23000 if (.not.(from (k1) .ne. -2))goto 23002
+      to (k2) = from (k1)
+      k2 = k2 + 1
+23001 k1 = k1 + 1
+      goto 23000
+23002 continue
+      to (k2) = -2
+      return
+      end
diff --git a/unix/boot/spp/rpp/ratlibf/sctabl.f b/unix/boot/spp/rpp/ratlibf/sctabl.f
new file mode 100644
index 00000000..1ba16897
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibf/sctabl.f
@@ -0,0 +1,54 @@
+      integer function sctabl (table, sym, info, posn)
+      integer table, posn
+      integer sym (100)
+      integer info (100)
+      integer mem( 1)
+      common/cdsmem/mem
+      integer bucket, walker
+      integer dsget
+      integer nodsiz, i, j
+      if (.not.(posn .eq. 0))goto 23000
+      posn = dsget (2)
+      mem (posn) = 1
+      mem (posn + 1) = mem (table + 1)
+23000 continue
+      bucket = mem (posn)
+      walker = mem (posn + 1)
+      nodsiz = mem (table)
+23002 continue
+      if (.not.(walker .ne. 0))goto 23005
+      i = walker + 1 + nodsiz
+      j = 1
+23007 if (.not.(mem (i) .ne. -2))goto 23008
+      sym (j) = mem (i)
+      i = i + 1
+      j = j + 1
+      goto 23007
+23008 continue
+      sym (j) = -2
+      i = 1
+23009 if (.not.(i .le. nodsiz))goto 23011
+      j = walker + 1 + i - 1
+      info (i) = mem (j)
+23010 i = i + 1
+      goto 23009
+23011 continue
+      mem (posn) = bucket
+      mem (posn + 1) = mem (walker + 0)
+      sctabl = 1
+      return
+23005 continue
+      bucket = bucket + 1
+      if (.not.(bucket .gt. 43))goto 23012
+      goto 23004
+23012 continue
+      j = table + bucket
+      walker = mem (j)
+23006 continue
+23003 goto 23002
+23004 continue
+      call dsfree (posn)
+      posn = 0
+      sctabl = -1
+      return
+      end
diff --git a/unix/boot/spp/rpp/ratlibf/sdrop.f b/unix/boot/spp/rpp/ratlibf/sdrop.f
new file mode 100644
index 00000000..b5334b9f
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibf/sdrop.f
@@ -0,0 +1,15 @@
+      integer function sdrop (from, to, chars)
+      integer from (100), to (100)
+      integer chars
+      integer len, start
+      integer ctoc, length, min0
+      len = length (from)
+      if (.not.(chars .lt. 0))goto 23000
+      sdrop=(ctoc (from, to, len + chars + 1))
+      return
+23000 continue
+      start = min0 (chars, len)
+      sdrop=(ctoc (from (start + 1), to, len + 1))
+      return
+23001 continue
+      end
diff --git a/unix/boot/spp/rpp/ratlibf/skipbl.f b/unix/boot/spp/rpp/ratlibf/skipbl.f
new file mode 100644
index 00000000..be60610a
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibf/skipbl.f
@@ -0,0 +1,9 @@
+      subroutine skipbl(lin, i)
+      integer lin(100)
+      integer i
+23000 if (.not.(lin (i) .eq. 32 .or. lin (i) .eq. 9))goto 23001
+      i = i + 1
+      goto 23000
+23001 continue
+      return
+      end
diff --git a/unix/boot/spp/rpp/ratlibf/slstr.f b/unix/boot/spp/rpp/ratlibf/slstr.f
new file mode 100644
index 00000000..d8d98292
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibf/slstr.f
@@ -0,0 +1,32 @@
+      integer function slstr (from, to, first, chars)
+      integer from (100), to (100)
+      integer first, chars
+      integer len, i, j, k
+      integer length
+      len = length (from)
+      i = first
+      if (.not.(i .lt. 1))goto 23000
+      i = i + len + 1
+23000 continue
+      if (.not.(chars .lt. 0))goto 23002
+      i = i + chars + 1
+      chars = - chars
+23002 continue
+      j = i + chars - 1
+      if (.not.(i .lt. 1))goto 23004
+      i = 1
+23004 continue
+      if (.not.(j .gt. len))goto 23006
+      j = len
+23006 continue
+      k = 0
+23008 if (.not.(i .le. j))goto 23010
+      to (k + 1) = from (i)
+      i = i + 1
+23009 k = k + 1
+      goto 23008
+23010 continue
+      to (k + 1) = -2
+      slstr=(k)
+      return
+      end
diff --git a/unix/boot/spp/rpp/ratlibf/stake.f b/unix/boot/spp/rpp/ratlibf/stake.f
new file mode 100644
index 00000000..08ba5652
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibf/stake.f
@@ -0,0 +1,15 @@
+      integer function stake (from, to, chars)
+      integer from (100), to (100)
+      integer chars
+      integer len, start
+      integer length, ctoc, max0
+      len = length (from)
+      if (.not.(chars .lt. 0))goto 23000
+      start = max0 (len + chars, 0)
+      stake=(ctoc (from (start + 1), to, len + 1))
+      return
+23000 continue
+      stake=(ctoc (from, to, chars + 1))
+      return
+23001 continue
+      end
diff --git a/unix/boot/spp/rpp/ratlibf/stclos.f b/unix/boot/spp/rpp/ratlibf/stclos.f
new file mode 100644
index 00000000..64c041eb
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibf/stclos.f
@@ -0,0 +1,20 @@
+      integer function stclos (pat, j, lastj, lastcl)
+      integer pat (128)
+      integer j, lastj, lastcl
+      integer addset
+      integer jp, jt, junk
+      jp = j - 1
+23000 if (.not.(jp .ge. lastj))goto 23002
+      jt = jp + 4
+      junk = addset (pat (jp), pat, jt, 128)
+23001 jp = jp - 1
+      goto 23000
+23002 continue
+      j = j + 4
+      stclos = lastj
+      junk = addset (42, pat, lastj, 128)
+      junk = addset (0, pat, lastj, 128)
+      junk = addset (lastcl, pat, lastj, 128)
+      junk = addset (0, pat, lastj, 128)
+      return
+      end
diff --git a/unix/boot/spp/rpp/ratlibf/stcopy.f b/unix/boot/spp/rpp/ratlibf/stcopy.f
new file mode 100644
index 00000000..36ca2ac2
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibf/stcopy.f
@@ -0,0 +1,14 @@
+      subroutine stcopy (in, i, out, j)
+      integer in (100), out (100)
+      integer i, j
+      integer k
+      k = i
+23000 if (.not.(in (k) .ne. -2))goto 23002
+      out (j) = in (k)
+      j = j + 1
+23001 k = k + 1
+      goto 23000
+23002 continue
+      out(j) = -2
+      return
+      end
diff --git a/unix/boot/spp/rpp/ratlibf/stlu.f b/unix/boot/spp/rpp/ratlibf/stlu.f
new file mode 100644
index 00000000..6cfbd0a7
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibf/stlu.f
@@ -0,0 +1,36 @@
+      integer function stlu (symbol, node, pred, st)
+      integer symbol (100)
+      integer node, pred, st
+      integer mem( 1)
+      common/cdsmem/mem
+      integer hash, i, j, nodsiz
+      nodsiz = mem (st)
+      hash = 0
+      i = 1
+23000 if (.not.(symbol (i) .ne. -2))goto 23002
+      hash = hash + symbol (i)
+23001 i = i + 1
+      goto 23000
+23002 continue
+      hash = mod (hash, 43) + 1
+      pred = st + hash
+      node = mem (pred)
+23003 if (.not.(node .ne. 0))goto 23004
+      i = 1
+      j = node + 1 + nodsiz
+23005 if (.not.(symbol (i) .eq. mem (j)))goto 23006
+      if (.not.(symbol (i) .eq. -2))goto 23007
+      stlu=(1)
+      return
+23007 continue
+      i = i + 1
+      j = j + 1
+      goto 23005
+23006 continue
+      pred = node
+      node = mem (pred + 0)
+      goto 23003
+23004 continue
+      stlu=(0)
+      return
+      end
diff --git a/unix/boot/spp/rpp/ratlibf/strcmp.f b/unix/boot/spp/rpp/ratlibf/strcmp.f
new file mode 100644
index 00000000..9d037401
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibf/strcmp.f
@@ -0,0 +1,30 @@
+      integer function strcmp (str1, str2)
+      integer str1 (100), str2 (100)
+      integer i
+      i = 1
+23000 if (.not.(str1 (i) .eq. str2 (i)))goto 23002
+      if (.not.(str1 (i) .eq. -2))goto 23003
+      strcmp=(0)
+      return
+23003 continue
+23001 i = i + 1
+      goto 23000
+23002 continue
+      if (.not.(str1 (i) .eq. -2))goto 23005
+      strcmp = -1
+      goto 23006
+23005 continue
+      if (.not.(str2 (i) .eq. -2))goto 23007
+      strcmp = + 1
+      goto 23008
+23007 continue
+      if (.not.(str1 (i) .lt. str2 (i)))goto 23009
+      strcmp = -1
+      goto 23010
+23009 continue
+      strcmp = +1
+23010 continue
+23008 continue
+23006 continue
+      return
+      end
diff --git a/unix/boot/spp/rpp/ratlibf/strim.f b/unix/boot/spp/rpp/ratlibf/strim.f
new file mode 100644
index 00000000..f9aaa9b4
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibf/strim.f
@@ -0,0 +1,16 @@
+      integer function strim (str)
+      integer str (100)
+      integer lnb, i
+      lnb = 0
+      i = 1
+23000 if (.not.(str (i) .ne. -2))goto 23002
+      if (.not.(str (i) .ne. 32 .and. str (i) .ne. 9))goto 23003
+      lnb = i
+23003 continue
+23001 i = i + 1
+      goto 23000
+23002 continue
+      str (lnb + 1) = -2
+      strim=(lnb)
+      return
+      end
diff --git a/unix/boot/spp/rpp/ratlibf/termin.f b/unix/boot/spp/rpp/ratlibf/termin.f
new file mode 100644
index 00000000..2ba3823d
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibf/termin.f
@@ -0,0 +1,8 @@
+      subroutine termin (name)
+      integer name (100)
+      integer tname(9)
+      data tname(1)/47/,tname(2)/100/,tname(3)/101/,tname(4)/118/,tname(
+     *5)/47/,tname(6)/116/,tname(7)/116/,tname(8)/121/,tname(9)/-2/
+      call scopy (tname, 1, name, 1)
+      return
+      end
diff --git a/unix/boot/spp/rpp/ratlibf/trmout.f b/unix/boot/spp/rpp/ratlibf/trmout.f
new file mode 100644
index 00000000..398620cd
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibf/trmout.f
@@ -0,0 +1,8 @@
+      subroutine trmout (name)
+      integer name (100)
+      integer tname(9)
+      data tname(1)/47/,tname(2)/100/,tname(3)/101/,tname(4)/118/,tname(
+     *5)/47/,tname(6)/116/,tname(7)/116/,tname(8)/121/,tname(9)/-2/
+      call scopy (tname, 1, name, 1)
+      return
+      end
diff --git a/unix/boot/spp/rpp/ratlibf/type.f b/unix/boot/spp/rpp/ratlibf/type.f
new file mode 100644
index 00000000..decd4d15
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibf/type.f
@@ -0,0 +1,16 @@
+      integer function type (c)
+      integer c
+      if (.not.((97 .le. c .and. c .le. 122) .or. (65 .le. c .and. c .le
+     *. 90)))goto 23000
+      type = 97
+      goto 23001
+23000 continue
+      if (.not.(48 .le. c .and. c .le. 57))goto 23002
+      type = 48
+      goto 23003
+23002 continue
+      type = c
+23003 continue
+23001 continue
+      return
+      end
diff --git a/unix/boot/spp/rpp/ratlibf/upper.f b/unix/boot/spp/rpp/ratlibf/upper.f
new file mode 100644
index 00000000..1cf34941
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibf/upper.f
@@ -0,0 +1,12 @@
+      subroutine upper (token)
+      integer token (100)
+      integer cupper
+      integer i
+      i = 1
+23000 if (.not.(token (i) .ne. -2))goto 23002
+      token (i) = cupper (token (i))
+23001 i = i + 1
+      goto 23000
+23002 continue
+      return
+      end
diff --git a/unix/boot/spp/rpp/ratlibf/wkday.f b/unix/boot/spp/rpp/ratlibf/wkday.f
new file mode 100644
index 00000000..69d80796
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibf/wkday.f
@@ -0,0 +1,14 @@
+      integer function wkday (month, day, year)
+      integer month, day, year
+      integer lmonth, lday, lyear
+      lmonth = month - 2
+      lday = day
+      lyear = year
+      if (.not.(lmonth .le. 0))goto 23000
+      lmonth = lmonth + 12
+      lyear = lyear - 1
+23000 continue
+      wkday = mod (lday + (26 * lmonth - 2) / 10 + lyear + lyear / 4 - 3
+     *4, 7) + 1
+      return
+      end
diff --git a/unix/boot/spp/rpp/ratlibr/Makefile b/unix/boot/spp/rpp/ratlibr/Makefile
new file mode 100644
index 00000000..7c4d42b4
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibr/Makefile
@@ -0,0 +1,33 @@
+# Ratfor source for the ratfor library.  A TOOLS compatible ratfor compiler
+# is required to compile this.  The original UNIX ratfor compiler may not do
+# the job.
+
+.r.f:
+	/usr/local/bin/ratfor $*.r > $*.f
+
+SRCS=	addset.r addstr.r amatch.r catsub.r clower.r concat.r ctoc.r\
+	ctoi.r ctomn.r cupper.r delete.r docant.r dodash.r dsdbiu.r\
+	dsdump.r dsfree.r dsget.r dsinit.r enter.r equal.r error.r\
+	errsub.r esc.r fcopy.r filset.r fmtdat.r fold.r gctoi.r getc.r\
+	getccl.r getpat.r getwrd.r gfnarg.r index.r insub.r\
+	itoc.r length.r locate.r lookup.r lower.r makpat.r maksub.r\
+	match.r mktabl.r mntoc.r omatch.r outsub.r patsiz.r prompt.r\
+	putc.r putdec.r putint.r putstr.r query.r rmtabl.r scopy.r\
+	sctabl.r sdrop.r skipbl.r slstr.r stake.r stclos.r stcopy.r\
+	stlu.r strcmp.r strim.r termin.r trmout.r type.r upper.r wkday.r
+
+FORT=	addset.f addstr.f amatch.f catsub.f clower.f concat.f ctoc.f\
+	ctoi.f ctomn.f cupper.f delete.f docant.f dodash.f dsdbiu.f\
+	dsdump.f dsfree.f dsget.f dsinit.f enter.f equal.f error.f\
+	errsub.f esc.f fcopy.f filset.f fmtdat.f fold.f gctoi.f getc.f\
+	getccl.f getpat.f getwrd.f gfnarg.f index.f insub.f\
+	itoc.f length.f locate.f lookup.f lower.f makpat.f maksub.f\
+	match.f mktabl.f mntoc.f omatch.f outsub.f patsiz.f prompt.f\
+	putc.f putdec.f putint.f putstr.f query.f rmtabl.f scopy.f\
+	sctabl.f sdrop.f skipbl.f slstr.f stake.f stclos.f stcopy.f\
+	stlu.f strcmp.f strim.f termin.f trmout.f type.f upper.f wkday.f
+
+fort:	$(SRCS) defs
+	make fsrc; mv *.f ../ratlibf; touch fort
+
+fsrc:	$(FORT)
diff --git a/unix/boot/spp/rpp/ratlibr/addset.r b/unix/boot/spp/rpp/ratlibr/addset.r
new file mode 100644
index 00000000..06f9f578
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibr/addset.r
@@ -0,0 +1,18 @@
+include	defs
+
+# addset - put c in string (j) if it fits, increment j
+
+   integer function addset (c, str, j, maxsiz)
+   integer j, maxsiz
+   character c, str (maxsiz)
+
+   if (j > maxsiz)
+      addset = NO
+   else {
+      str(j) = c
+      j = j + 1
+      addset = YES
+      }
+
+   return
+   end
diff --git a/unix/boot/spp/rpp/ratlibr/addstr.r b/unix/boot/spp/rpp/ratlibr/addstr.r
new file mode 100644
index 00000000..2f88c74c
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibr/addstr.r
@@ -0,0 +1,19 @@
+include	defs
+
+# addstr - add s to str(j) if it fits, increment j
+
+   integer function addstr (s, str, j, maxsiz)
+   integer j, maxsiz
+   character s (ARB), str (maxsiz)
+
+   integer i, addset
+
+   for (i = 1; s (i) != EOS; i = i + 1)
+      if (addset (s (i), str, j, maxsiz) == NO) {
+	 addstr = NO
+	 return
+	 }
+   addstr = YES
+
+   return
+   end
diff --git a/unix/boot/spp/rpp/ratlibr/amatch.r b/unix/boot/spp/rpp/ratlibr/amatch.r
new file mode 100644
index 00000000..54a2904b
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibr/amatch.r
@@ -0,0 +1,55 @@
+include	defs
+
+# amatch --- (non-recursive) look for match starting at lin (from)
+
+   integer function amatch (lin, from, pat, tagbeg, tagend)
+   character lin (MAXLINE), pat (MAXPAT)
+   integer from, tagbeg (10), tagend (10)
+
+   integer i, j, offset, stack
+   integer omatch, patsiz
+
+   for (i = 1; i <= 10; i = i + 1) {
+      tagbeg (i) = 0
+      tagend (i) = 0
+      }
+   tagbeg (1) = from
+   stack = 0
+   offset = from      # next unexamined input character
+   for (j = 1; pat (j) != EOS; j = j + patsiz (pat, j))
+      if (pat (j) == CLOSURE) {      # a closure entry
+	 stack = j
+	 j = j + CLOSIZE      # step over CLOSURE
+	 for (i = offset; lin (i) != EOS; )	 # match as many as
+	    if (omatch (lin, i, pat, j) == NO)	 # possible
+	       break
+	 pat (stack + COUNT) = i - offset
+	 pat (stack + START) = offset
+	 offset = i	 # character that made us fail
+	 }
+      else if (pat (j) == START_TAG) {
+	 i = pat (j + 1)
+	 tagbeg (i + 1) = offset
+	 }
+      else if (pat (j) == STOP_TAG) {
+	 i = pat (j + 1)
+	 tagend (i + 1) = offset
+	 }
+      else if (omatch (lin, offset, pat, j) == NO) {  # non-closure
+	 for ( ; stack > 0; stack = pat (stack + PREVCL))
+	    if (pat (stack + COUNT) > 0)
+	       break
+	 if (stack <= 0) {	# stack is empty
+	    amatch = 0	    # return failure
+	    return
+	    }
+	 pat (stack + COUNT) = pat (stack + COUNT) - 1
+	 j = stack + CLOSIZE
+	 offset = pat (stack + START)  +  pat (stack + COUNT)
+	 }
+      # else omatch succeeded
+
+   amatch = offset
+   tagend (1) = offset
+   return      # success
+   end
diff --git a/unix/boot/spp/rpp/ratlibr/catsub.r b/unix/boot/spp/rpp/ratlibr/catsub.r
new file mode 100644
index 00000000..627e998f
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibr/catsub.r
@@ -0,0 +1,27 @@
+include	defs
+
+# catsub --- add replacement text to end of  new
+
+   subroutine catsub (lin, from, to, sub, new, k, maxnew)
+
+   character	lin(MAXLINE)
+   integer	from(10), to(10)
+   integer	maxnew
+   character	sub(maxnew), new(MAXPAT)
+   integer	k
+
+   integer	i, j, junk, ri
+   integer	addset
+
+   for (i = 1; sub (i) != EOS; i = i + 1)
+      if (sub (i) == DITTO) {
+	 i = i + 1
+	 ri = sub (i) + 1
+	 for (j = from (ri); j < to (ri); j = j + 1)
+	    junk = addset (lin (j), new, k, maxnew)
+	 }
+      else
+	 junk = addset (sub (i), new, k, maxnew)
+
+   return
+   end
diff --git a/unix/boot/spp/rpp/ratlibr/clower.r b/unix/boot/spp/rpp/ratlibr/clower.r
new file mode 100644
index 00000000..0f629ea3
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibr/clower.r
@@ -0,0 +1,18 @@
+include	defs
+
+# clower - change letter to lower case
+
+   character function clower(c)
+   character c
+
+   character k
+
+   if (c >= BIGA & c <= BIGZ) {
+      k = LETA - BIGA	# avoid integer overflow in byte machines
+      clower = c + k
+      }
+   else
+      clower = c
+
+   return
+   end
diff --git a/unix/boot/spp/rpp/ratlibr/concat.r b/unix/boot/spp/rpp/ratlibr/concat.r
new file mode 100644
index 00000000..abe55156
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibr/concat.r
@@ -0,0 +1,15 @@
+include	defs
+
+# concat - concatenate two strings together
+
+   subroutine concat (buf1, buf2, outstr)
+   character buf1(ARB), buf2(ARB), outstr(ARB)
+
+   integer i
+
+   i = 1
+   call stcopy (buf1, 1, outstr, i)
+   call scopy (buf2, 1, outstr, i)
+
+   return
+   end
diff --git a/unix/boot/spp/rpp/ratlibr/ctoc.r b/unix/boot/spp/rpp/ratlibr/ctoc.r
new file mode 100644
index 00000000..3b9a22ba
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibr/ctoc.r
@@ -0,0 +1,18 @@
+include	defs
+
+# ctoc --- convert EOS-terminated string to EOS-terminated string
+
+   integer function ctoc (from, to, len)
+   integer len
+   character from (ARB), to (len)
+
+   integer i
+
+   for (i = 1; i < len & from (i) != EOS; i = i + 1)
+      to (i) = from (i)
+
+   to (i) = EOS
+
+   return (i - 1)
+
+   end
diff --git a/unix/boot/spp/rpp/ratlibr/ctoi.r b/unix/boot/spp/rpp/ratlibr/ctoi.r
new file mode 100644
index 00000000..54a5769b
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibr/ctoi.r
@@ -0,0 +1,37 @@
+include	defs
+
+# ctoi - convert string at in(i) to integer, increment i
+
+   integer function ctoi(in, i)
+   character in (ARB)
+   integer i
+
+   integer d
+   external index
+   integer index
+
+   # string digits "0123456789"
+   character digits(11)
+   data digits (1) /DIG0/,
+      digits (2) /DIG1/,
+      digits (3) /DIG2/,
+      digits (4) /DIG3/,
+      digits (5) /DIG4/,
+      digits (6) /DIG5/,
+      digits (7) /DIG6/,
+      digits (8) /DIG7/,
+      digits (9) /DIG8/,
+      digits (10) /DIG9/,
+      digits (11) /EOS/
+
+   while (in (i) == BLANK | in (i) == TAB)
+      i = i + 1
+   for (ctoi = 0; in (i) != EOS; i = i + 1) {
+      d = index (digits, in (i))
+      if (d == 0)      # non-digit
+	 break
+      ctoi = 10 * ctoi + d - 1
+      }
+
+   return
+   end
diff --git a/unix/boot/spp/rpp/ratlibr/ctomn.r b/unix/boot/spp/rpp/ratlibr/ctomn.r
new file mode 100644
index 00000000..ef59e51a
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibr/ctomn.r
@@ -0,0 +1,59 @@
+include	defs
+
+# ctomn --- translate ASCII control character to mnemonic string
+
+   integer function ctomn (c, rep)
+   character c, rep (4)
+
+   integer i
+   integer length
+
+   character mntext (136)     # 4 chars/mnemonic; 32 control chars + SP + DEL
+   data mntext / _
+      BIGN, BIGU, BIGL, EOS,
+      BIGS, BIGO, BIGH, EOS,
+      BIGS, BIGT, BIGX, EOS,
+      BIGE, BIGT, BIGX, EOS,
+      BIGE, BIGO, BIGT, EOS,
+      BIGE, BIGN, BIGQ, EOS,
+      BIGA, BIGC, BIGK, EOS,
+      BIGB, BIGE, BIGL, EOS,
+      BIGB, BIGS, EOS,	EOS,
+      BIGH, BIGT, EOS,	EOS,
+      BIGL, BIGF, EOS,	EOS,
+      BIGV, BIGT, EOS,	EOS,
+      BIGF, BIGF, EOS,	EOS,
+      BIGC, BIGR, EOS,	EOS,
+      BIGS, BIGO, EOS,	EOS,
+      BIGS, BIGI, EOS,	EOS,
+      BIGD, BIGL, BIGE, EOS,
+      BIGD, BIGC, DIG1, EOS,
+      BIGD, BIGC, DIG2, EOS,
+      BIGD, BIGC, DIG3, EOS,
+      BIGD, BIGC, DIG4, EOS,
+      BIGN, BIGA, BIGK, EOS,
+      BIGS, BIGY, BIGN, EOS,
+      BIGE, BIGT, BIGB, EOS,
+      BIGC, BIGA, BIGN, EOS,
+      BIGE, BIGM, EOS,	EOS,
+      BIGS, BIGU, BIGB, EOS,
+      BIGE, BIGS, BIGC, EOS,
+      BIGF, BIGS, EOS,	EOS,
+      BIGG, BIGS, EOS,	EOS,
+      BIGR, BIGS, EOS,	EOS,
+      BIGU, BIGS, EOS,	EOS,
+      BIGS, BIGP, EOS,	EOS,
+      BIGD, BIGE, BIGL, EOS/
+
+   i = mod (max(c,0), 128)
+   if (0 <= i & i <= 32)     # non-printing character or space
+      call scopy (mntext, 4 * i + 1, rep, 1)
+   elif (i == 127)	      # rubout (DEL)
+      call scopy (mntext, 133, rep, 1)
+   else {		      # printing character
+      rep (1) = c
+      rep (2) = EOS
+      }
+
+   return (length (rep))
+   end
diff --git a/unix/boot/spp/rpp/ratlibr/cupper.r b/unix/boot/spp/rpp/ratlibr/cupper.r
new file mode 100644
index 00000000..9a39cf21
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibr/cupper.r
@@ -0,0 +1,14 @@
+include	defs
+
+# cupper - change letter to upper case
+
+   character function cupper (c)
+   character c
+
+   if (c >= LETA & c <= LETZ)
+      cupper = c + (BIGA - LETA)
+   else
+      cupper = c
+
+   return
+   end
diff --git a/unix/boot/spp/rpp/ratlibr/defs b/unix/boot/spp/rpp/ratlibr/defs
new file mode 100644
index 00000000..bf040c55
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibr/defs
@@ -0,0 +1,138 @@
+# common definitions for all routines comprising the ratfor preprocessor
+#---------------------------------------------------------------
+# The definition STDEFNS defines the file which contains the
+# standard definitions to be used when preprocessing a file.
+# It is opened and read automatically by the ratfor preprocessor.
+# Set STDEFNS to the name of the file in which the standard
+# definitions reside.  If you don't want the preprocessor to
+# automatically open this file, set STDENFS to "".
+#
+#---------------------------------------------------------------
+#    If you want the preprocessor to output upper case only,
+#    set the following definition:
+#
+#	       define (UPPERC,)
+#
+#---------------------------------------------------------------
+#  Some of the buffer sizes and other symbols might have to be
+#  changed.  Especially check the following:
+#
+#	 MAXDEF 	(number of characters in a definition)
+#	 SBUFSIZE	(nbr string declarations allowed per module)
+#	 MAXSTRTBL	(size of table to buffer string declarations)
+#	 MAXSWITCH	(max stack for switch statement)
+#
+#-----------------------------------------------------------------
+
+
+define (STDEFNS, string defns "")  # standard defns file
+#define (UPPERC,)	   # define if Fortran compiler wants upper case
+#define (IMPNONE,)	   # output IMPLICIT NONE in procedures
+define (NULL,0)
+define (INDENT,3)	   # number of spaces of indentation
+define (MAX_INDENT,30)	   # maximum column for indentation
+define (FIRST_LABEL,100)   # first statement label
+define (SZ_SPOOLBUF,8)	   # for breaking continuation cards
+
+define (RADIX,PERCENT)	   # % indicates alternate radix
+define (TOGGLE,PERCENT)    # toggle for literal lines
+define (ARGFLAG,DOLLAR)
+define (CUTOFF,3)	   # min nbr of cases to generate branch table
+			   # (for switch statement)
+define (DENSITY,2)	   # reciprocal of density necessary for
+			   # branch table
+define (FILLCHAR,DIG0)	   # used in long-name uniquing
+define (MAXIDLENGTH,6)	   # for Fortran 66 and 77
+define (SZ_SMEM,240)	   # memory common declarations string
+
+
+# Lexical items (codes are negative to avoid conflict with character values)
+
+define (LEXBEGIN,-83)
+define (LEXBREAK,-79)
+define (LEXCASE,-91)
+define (LEXDEFAULT,-90)
+define (LEXDIGITS,-89)
+define (LEXDO,-96)
+define (LEXELSE,-87)
+define (LEXEND,-82)
+define (LEXERRCHK,-84)
+define (LEXERROR,-73)
+define (LEXFOR,-94)
+define (LEXIF,-99)
+define (LEXIFELSE,-72)
+define (LEXIFERR,-98)
+define (LEXIFNOERR,-97)
+define (LEXLITERAL,-85)
+define (LEXNEXT,-78)
+define (LEXOTHER,-80)
+define (LEXPOINTER,-88)
+define (LEXRBRACE,-74)
+define (LEXREPEAT,-93)
+define (LEXRETURN,-77)
+define (LEXGOTO,-76)
+define (LEXSTOP,-71)
+define (LEXSTRING,-75)
+define (LEXSWITCH,-92)
+define (LEXTHEN,-86)
+define (LEXUNTIL,-70)
+define (LEXWHILE,-95)
+define (LSTRIPC,-69)
+define (RSTRIPC,-68)
+define (LEXDECL,-67)
+
+define (XPP_DIRECTIVE, -166)
+
+# Built-in macro functions:
+
+define (DEFTYPE,-4)
+define (MACTYPE,-10)
+define (IFTYPE,-11)
+define (INCTYPE,-12)
+define (SUBTYPE,-13)
+define (ARITHTYPE,-14)
+define (IFDEFTYPE,-15)
+define (IFNOTDEFTYPE,-16)
+define (PRAGMATYPE,-17)
+
+
+# Size-limiting definitions:
+
+define (MEMSIZE,60000)	   # space allotted to symbol tables and macro text
+define (BUFSIZE,4096)	   # pushback buffer for ngetch and putbak
+define (PBPOINT,3192)	   # point in buffer where pushback begins
+define (SBUFSIZE,2048)	   # buffer for string statements
+define (MAXDEF,2048)	   # max chars in a defn
+define (MAXFORSTK,200)	   # max space for for reinit clauses
+define (MAXERRSTK,30)	   # max nesting of iferr statements
+define (MAXFNAMES, arith(NFILES,*,FILENAMESIZE))
+define (MAXSTACK,100)	   # max stack depth for parser
+define (MAXSWITCH,1000)    # max stack for switch statement
+define (MAXSWNEST,10)	   # max nesting of switches in a procedure
+define (MAXTOK,100)	   # max chars in a token
+define (NFILES,5)	   # max number of include file nesting
+define (MAXNBRSTR,20)	   #max nbr string declarations per module
+define (CALLSIZE,50)
+define (ARGSIZE,100)
+define (EVALSIZE,500)
+
+
+# Where to find the common blocks:
+
+define(COMMON_BLOCKS,"common")
+
+# Data types, Dynamic Memory common:
+
+define (XPOINTER,"integer ")
+
+
+# The following external names are redefined to avoid name collisions with
+# standard library procedures on some systems.
+
+define	open	rfopen
+define	close	rfclos
+define	flush	rfflus
+define	note	rfnote
+define	seek	rfseek
+define	remove	rfrmov
+define	exit	rexit
diff --git a/unix/boot/spp/rpp/ratlibr/delete.r b/unix/boot/spp/rpp/ratlibr/delete.r
new file mode 100644
index 00000000..f4cadeb2
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibr/delete.r
@@ -0,0 +1,21 @@
+include	defs
+
+# delete --- remove a symbol from the symbol table
+
+   subroutine delete (symbol, st)
+   character symbol (ARB)
+   pointer st
+
+   DS_DECL(Mem, 1)
+
+   integer stlu
+
+   pointer node, pred
+
+   if (stlu (symbol, node, pred, st) == YES) {
+      Mem (pred + ST_LINK) = Mem (node + ST_LINK)
+      call dsfree (node)
+      }
+
+   return
+   end
diff --git a/unix/boot/spp/rpp/ratlibr/docant.r b/unix/boot/spp/rpp/ratlibr/docant.r
new file mode 100644
index 00000000..efa14ccc
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibr/docant.r
@@ -0,0 +1,25 @@
+include	defs
+
+# docant
+#
+# Similar to cant(name), however precede the messge with the name
+# of the program that was running when the file could not be
+# opened.  Helpful in a pipeline to verify which program was not
+# able to open a file.
+#
+   subroutine  docant(name)
+
+   character  name(ARB), prog(FILENAMESIZE)
+   integer    length
+   integer    getarg
+
+   length = getarg(0, prog, FILENAMESIZE)
+   if (length != EOF) {
+      call putlin(prog, STDERR)
+      call putch(COLON, STDERR)
+      call putch(BLANK, STDERR)
+   }
+   call cant(name)
+
+   return
+   end
diff --git a/unix/boot/spp/rpp/ratlibr/dodash.r b/unix/boot/spp/rpp/ratlibr/dodash.r
new file mode 100644
index 00000000..83c4f2bc
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibr/dodash.r
@@ -0,0 +1,22 @@
+include	defs
+
+# dodash --- expand array (i-1)-array (i+1) into set (j)... from valid
+
+   subroutine dodash (valid, array, i, set, j, maxset)
+   integer i, j, maxset
+   character valid (ARB), array (ARB), set (maxset)
+
+   character esc
+
+   integer junk, k, limit
+   external index
+   integer addset, index
+
+   i = i + 1
+   j = j - 1
+   limit = index (valid, esc (array, i))
+   for (k = index (valid, set (j)); k <= limit; k = k + 1)
+      junk = addset (valid (k), set, j, maxset)
+
+   return
+   end
diff --git a/unix/boot/spp/rpp/ratlibr/dsdbiu.r b/unix/boot/spp/rpp/ratlibr/dsdbiu.r
new file mode 100644
index 00000000..99c2acc0
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibr/dsdbiu.r
@@ -0,0 +1,45 @@
+include	defs
+
+# dsdbiu --- dump contents of block-in-use
+
+   subroutine dsdbiu (b, form)
+   pointer b
+   character form
+
+   DS_DECL(Mem, 1)
+
+   integer l, s, lmax
+
+   string blanks "	    "
+
+   call putint (b, 5, ERROUT)
+   call putch (BLANK, ERROUT)
+   call putint (Mem (b + DS_SIZE), 0, ERROUT)
+   call remark (" words in use.")
+
+   l = 0
+   s = b + Mem (b + DS_SIZE)
+   if (form == DIGIT)
+      lmax = 5
+   else
+      lmax = 50
+
+   for (b = b + DS_OHEAD; b < s; b = b + 1) {
+      if (l == 0)
+	 call putlin (blanks, ERROUT)
+      if (form == DIGIT)
+	 call putint (Mem (b), 10, ERROUT)
+      elif (form == LETTER)
+	 call putch (Mem (b), ERROUT)
+      l = l + 1
+      if (l >= lmax) {
+	 l = 0
+	 call putch (NEWLINE, ERROUT)
+	 }
+      }
+
+   if (l != 0)
+      call putch (NEWLINE, ERROUT)
+
+   return
+   end
diff --git a/unix/boot/spp/rpp/ratlibr/dsdump.r b/unix/boot/spp/rpp/ratlibr/dsdump.r
new file mode 100644
index 00000000..276290db
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibr/dsdump.r
@@ -0,0 +1,34 @@
+include	defs
+
+# dsdump --- produce semi-readable dump of storage
+
+   subroutine dsdump (form)
+   character form
+
+   DS_DECL(Mem, 1)
+
+   pointer p, t, q
+
+   t = DS_AVAIL
+
+   call remark ("** DYNAMIC STORAGE DUMP **.")
+   call putint (1, 5, ERROUT)
+   call putch (BLANK, ERROUT)
+   call putint (DS_OHEAD + 1, 0, ERROUT)
+   call remark (" words in use.")
+
+   p = Mem (t + DS_LINK)
+   while (p != LAMBDA) {
+      call putint (p, 5, ERROUT)
+      call putch (BLANK, ERROUT)
+      call putint (Mem (p + DS_SIZE), 0, ERROUT)
+      call remark (" words available.")
+      q = p + Mem (p + DS_SIZE)
+      while (q != Mem (p + DS_LINK) & q < Mem (DS_MEMEND))
+	 call dsdbiu (q, form)
+      p = Mem (p + DS_LINK)
+      }
+
+   call remark ("** END DUMP **.")
+   return
+   end
diff --git a/unix/boot/spp/rpp/ratlibr/dsfree.r b/unix/boot/spp/rpp/ratlibr/dsfree.r
new file mode 100644
index 00000000..34cd7e55
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibr/dsfree.r
@@ -0,0 +1,53 @@
+include	defs
+
+# dsfree --- return a block of storage to the available space list
+
+   subroutine dsfree (block)
+   pointer block
+
+   DS_DECL(Mem, 1)
+
+   pointer p0, p, q
+
+   integer n, junk
+
+   character con (10)
+
+   p0 = block - DS_OHEAD
+   n = Mem (p0 + DS_SIZE)
+   q = DS_AVAIL
+
+   repeat {
+      p = Mem (q + DS_LINK)
+      if (p == LAMBDA | p > p0)
+	 break
+      q = p
+      }
+
+   if (q + Mem (q + DS_SIZE) > p0) {
+      call remark ("in dsfree:	attempt to free unallocated block.")
+      call remark ("type 'c' to continue.")
+      junk = getlin (con, STDIN)
+      if (con (1) != LETC & con (1) != BIGC)
+	 call endst
+      return	  # do not attempt to free the block
+      }
+
+   if (p0 + n == p & p != LAMBDA) {
+      n = n + Mem (p + DS_SIZE)
+      Mem (p0 + DS_LINK) = Mem (p + DS_LINK)
+      }
+   else
+      Mem (p0 + DS_LINK) = p
+
+   if (q + Mem (q + DS_SIZE) == p0) {
+      Mem (q + DS_SIZE) = Mem (q + DS_SIZE) + n
+      Mem (q + DS_LINK) = Mem (p0 + DS_LINK)
+      }
+   else {
+      Mem (q + DS_LINK) = p0
+      Mem (p0 + DS_SIZE) = n
+      }
+
+   return
+   end
diff --git a/unix/boot/spp/rpp/ratlibr/dsget.r b/unix/boot/spp/rpp/ratlibr/dsget.r
new file mode 100644
index 00000000..4c62ce62
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibr/dsget.r
@@ -0,0 +1,50 @@
+include	defs
+
+# dsget --- get pointer to block of at least w available words
+
+   pointer function dsget (w)
+   integer w
+
+   DS_DECL(Mem, 1)
+
+   pointer p, q, l
+
+   integer n, k, junk
+   integer getlin
+
+   character c (10)
+
+   n = w + DS_OHEAD
+   q = DS_AVAIL
+
+   repeat {
+      p = Mem (q + DS_LINK)
+      if (p == LAMBDA) {
+	 call remark ("in dsget: out of storage space.")
+	 call remark ("type 'c' or 'i' for char or integer dump.")
+	 junk = getlin (c, STDIN)
+	 if (c (1) == LETC | c (1) == BIGC)
+	    call dsdump (LETTER)
+	 else if (c (1) == LETI | c (1) == BIGI)
+	    call dsdump (DIGIT)
+	 call error ("program terminated.")
+	 }
+      if (Mem (p + DS_SIZE) >= n)
+	 break
+      q = p
+      }
+
+   k = Mem (p + DS_SIZE) - n
+   if (k >= DS_CLOSE) {
+      Mem (p + DS_SIZE) = k
+      l = p + k
+      Mem (l + DS_SIZE) = n
+      }
+   else {
+      Mem (q + DS_LINK) = Mem (p + DS_LINK)
+      l = p
+      }
+
+   return (l + DS_OHEAD)
+
+   end
diff --git a/unix/boot/spp/rpp/ratlibr/dsinit.r b/unix/boot/spp/rpp/ratlibr/dsinit.r
new file mode 100644
index 00000000..926390b3
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibr/dsinit.r
@@ -0,0 +1,29 @@
+include	defs
+
+# dsinit --- initialize dynamic storage space to w words
+
+   subroutine dsinit (w)
+   integer w
+
+   DS_DECL(Mem, 1)
+
+   pointer t
+
+   if (w < 2 * DS_OHEAD + 2)
+      call error ("in dsinit: unreasonably small memory size.")
+
+   # set up avail list:
+   t = DS_AVAIL
+   Mem (t + DS_SIZE) = 0
+   Mem (t + DS_LINK) = DS_AVAIL + DS_OHEAD
+
+   # set up first block of space:
+   t = DS_AVAIL + DS_OHEAD
+   Mem (t + DS_SIZE) = w - DS_OHEAD - 1     # -1 for MEMEND
+   Mem (t + DS_LINK) = LAMBDA
+
+   # record end of memory:
+   Mem (DS_MEMEND) = w
+
+   return
+   end
diff --git a/unix/boot/spp/rpp/ratlibr/enter.r b/unix/boot/spp/rpp/ratlibr/enter.r
new file mode 100644
index 00000000..56a3d46b
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibr/enter.r
@@ -0,0 +1,40 @@
+include	defs
+
+# enter --- place a symbol in the symbol table, updating if already present
+
+   subroutine enter (symbol, info, st)
+   character symbol (ARB)
+   integer info (ARB)
+   pointer st
+
+   DS_DECL(Mem, 1)
+
+   integer i, nodsiz, j
+   integer stlu, length
+
+   pointer node, pred
+   pointer dsget
+
+   nodsiz = Mem (st)
+
+   if (stlu (symbol, node, pred, st) == NO) {
+      node = dsget (1 + nodsiz + length (symbol) + 1)
+      Mem (node + ST_LINK) = LAMBDA
+      Mem (pred + ST_LINK) = node
+      i = 1
+      j = node + ST_DATA + nodsiz
+      while (symbol (i) != EOS) {
+	 Mem (j) = symbol (i)
+	 i = i + 1
+	 j = j + 1
+	 }
+      Mem (j) = EOS
+      }
+
+   for (i = 1; i <= nodsiz; i = i + 1) {
+      j = node + ST_DATA + i - 1
+      Mem (j) = info (i)
+      }
+
+   return
+   end
diff --git a/unix/boot/spp/rpp/ratlibr/equal.r b/unix/boot/spp/rpp/ratlibr/equal.r
new file mode 100644
index 00000000..0aa24c4c
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibr/equal.r
@@ -0,0 +1,15 @@
+include	defs
+
+# equal - compare str1 to str2;  return YES if equal, NO if not
+
+   integer function equal (str1, str2)
+   character str1(ARB), str2(ARB)
+
+   integer i
+
+   for (i = 1; str1 (i) == str2 (i); i = i + 1)
+      if (str1 (i) == EOS)
+	 return (YES)
+
+   return (NO)
+   end
diff --git a/unix/boot/spp/rpp/ratlibr/error.r b/unix/boot/spp/rpp/ratlibr/error.r
new file mode 100644
index 00000000..326a8823
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibr/error.r
@@ -0,0 +1,10 @@
+include	defs
+
+# error - print message and terminate execution
+
+   subroutine error (line)
+   character line (ARB)
+
+   call remark (line)
+   call endst
+   end
diff --git a/unix/boot/spp/rpp/ratlibr/errsub.r b/unix/boot/spp/rpp/ratlibr/errsub.r
new file mode 100644
index 00000000..6e34195a
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibr/errsub.r
@@ -0,0 +1,26 @@
+include	defs
+
+# errsub - see if argument is ERROUT substitution
+
+   integer function errsub (arg, file, access)
+
+   character arg (ARB), file (ARB)
+   integer access
+
+   if (arg (1) == QMARK & arg (2) != QMARK & arg (2) != EOS) {
+      errsub = YES
+      access = WRITE
+      call scopy (arg, 2, file, 1)
+      }
+
+   else if (arg (1) == QMARK & arg (2) == QMARK & arg (3) != EOS) {
+      errsub = YES
+      access = APPEND
+      call scopy (arg, 3, file, 1)
+      }
+
+   else
+      errsub = NO
+
+   return
+   end
diff --git a/unix/boot/spp/rpp/ratlibr/esc.r b/unix/boot/spp/rpp/ratlibr/esc.r
new file mode 100644
index 00000000..bcb0d3a7
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibr/esc.r
@@ -0,0 +1,24 @@
+include	defs
+
+# esc - map array (i) into escaped character if appropriate
+
+   character function esc (array, i)
+   character array (ARB)
+   integer i
+
+   if (array (i) != ESCAPE)
+      esc = array (i)
+   else if (array (i+1) == EOS)    # @ not special at end
+      esc = ESCAPE
+   else {
+      i = i + 1
+      if (array (i) == LETN | array (i) == BIGN)
+	 esc = NEWLINE
+      else if (array (i) == LETT | array (i) == BIGT)
+	 esc = TAB
+      else
+	 esc = array (i)
+      }
+
+   return
+   end
diff --git a/unix/boot/spp/rpp/ratlibr/fcopy.r b/unix/boot/spp/rpp/ratlibr/fcopy.r
new file mode 100644
index 00000000..755f9ad7
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibr/fcopy.r
@@ -0,0 +1,16 @@
+include	defs
+
+# fcopy - copy file in to file out
+
+   subroutine fcopy (in, out)
+   filedes in, out
+
+   character line (MAXLINE)
+
+   integer getlin
+
+   while (getlin (line, in) != EOF)
+      call putlin (line, out)
+
+   return
+   end
diff --git a/unix/boot/spp/rpp/ratlibr/filset.r b/unix/boot/spp/rpp/ratlibr/filset.r
new file mode 100644
index 00000000..eba728b9
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibr/filset.r
@@ -0,0 +1,35 @@
+include	defs
+
+# filset --- expand set at  array (i)  into  set (j),  stop at	delim
+
+   subroutine filset (delim, array, i, set, j, maxset)
+   integer i, j, maxset
+   character array (ARB), delim, set (maxset)
+
+   character esc
+
+   integer junk
+   external index
+   integer addset, index
+
+   string digits "0123456789"
+   string lowalf "abcdefghijklmnopqrstuvwxyz"
+   string upalf "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
+
+   for ( ; array (i) != delim & array (i) != EOS; i = i + 1)
+      if (array (i) == ESCAPE)
+	 junk = addset (esc (array, i), set, j, maxset)
+      else if (array (i) != DASH)
+	 junk = addset (array (i), set, j, maxset)
+      else if (j <= 1 | array (i + 1) == EOS)	# literal -
+	 junk = addset (DASH, set, j, maxset)
+      else if (index (digits, set (j - 1)) > 0)
+	 call dodash (digits, array, i, set, j, maxset)
+      else if (index (lowalf, set (j - 1)) > 0)
+	 call dodash (lowalf, array, i, set, j, maxset)
+      else if (index (upalf, set (j - 1)) > 0)
+	 call dodash (upalf, array, i, set, j, maxset)
+      else
+	 junk = addset (DASH, set, j, maxset)
+   return
+   end
diff --git a/unix/boot/spp/rpp/ratlibr/fmtdat.r b/unix/boot/spp/rpp/ratlibr/fmtdat.r
new file mode 100644
index 00000000..652b6769
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibr/fmtdat.r
@@ -0,0 +1,34 @@
+include	defs
+
+# fmtdat - format date and time information
+
+   subroutine fmtdat(date, time, now, form)
+   character date(ARB), time(ARB)
+   integer now(7), form
+
+   # at present, simply return mm/dd/yy and hh:mm:ss
+   # 'form' is reserved for selecting different formats
+   # when those have been chosen.
+
+   date(1) = now(2) / 10 + DIG0
+   date(2) = mod(now(2), 10) + DIG0
+   date(3) = SLASH
+   date(4) = now(3) / 10 + DIG0
+   date(5) = mod(now(3), 10) + DIG0
+   date(6) = SLASH
+   date(7) = mod(now(1), 100) / 10 + DIG0
+   date(8) = mod(now(1), 10) + DIG0
+   date(9) = EOS
+
+   time(1) = now(4) / 10 + DIG0
+   time(2) = mod(now(4), 10) + DIG0
+   time(3) = COLON
+   time(4) = now(5) / 10 + DIG0
+   time(5) = mod(now(5), 10) + DIG0
+   time(6) = COLON
+   time(7) = now(6) / 10 + DIG0
+   time(8) = mod(now(6), 10) + DIG0
+   time(9) = EOS
+
+   return
+   end
diff --git a/unix/boot/spp/rpp/ratlibr/fold.r b/unix/boot/spp/rpp/ratlibr/fold.r
new file mode 100644
index 00000000..d6530e90
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibr/fold.r
@@ -0,0 +1,16 @@
+include	defs
+
+# fold - fold all letters in a string to lower case
+
+   subroutine fold (token)
+   character token (ARB)
+
+   character clower
+
+   integer i
+
+   for (i = 1; token (i) != EOS; i = i + 1)
+      token (i) = clower (token (i))
+
+   return
+   end
diff --git a/unix/boot/spp/rpp/ratlibr/fort b/unix/boot/spp/rpp/ratlibr/fort
new file mode 100644
index 00000000..e69de29b
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibr/fort
diff --git a/unix/boot/spp/rpp/ratlibr/gctoi.r b/unix/boot/spp/rpp/ratlibr/gctoi.r
new file mode 100644
index 00000000..8efabe4f
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibr/gctoi.r
@@ -0,0 +1,58 @@
+include	defs
+
+# gctoi --- convert any radix string to single precision integer
+
+   integer function gctoi (str, i, radix)
+   character str (ARB)
+   integer i, radix
+
+   integer base, v, d, j
+   external index
+   integer index
+
+   character clower
+
+   logical neg
+
+   string digits "0123456789abcdef"
+
+   v = 0
+   base = radix
+
+   while (str (i) == BLANK | str (i) == TAB)
+      i = i + 1
+
+   neg = (str (i) == MINUS)
+   if (str (i) == PLUS | str (i) == MINUS)
+      i = i + 1
+
+   if (str (i + 2) == LETR & str (i) == DIG1 & IS_DIGIT(str (i + 1))
+	 | str (i + 1) == LETR & IS_DIGIT(str (i))) {
+      base = str (i) - DIG0
+      j = i
+      if (str (i + 1) != LETR) {
+	 j = j + 1
+	 base = base * 10 + (str (j) - DIG0)
+	 }
+      if (base < 2 | base > 16)
+	 base = radix
+      else
+	 i = j + 2
+      }
+
+   for (; str (i) != EOS; i = i + 1) {
+      if (IS_DIGIT(str (i)))
+	 d = str (i) - DIG0
+      else
+	 d = index (digits, clower (str (i))) - 1
+      if (d < 0 | d >= base)
+	 break
+      v = v * base + d
+      }
+
+   if (neg)
+      return (-v)
+   else
+      return (+v)
+
+   end
diff --git a/unix/boot/spp/rpp/ratlibr/getc.r b/unix/boot/spp/rpp/ratlibr/getc.r
new file mode 100644
index 00000000..afd0fc81
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibr/getc.r
@@ -0,0 +1,13 @@
+include	defs
+
+# getc - get character from STDIN
+
+   character function getc (c)
+   character c
+
+   character getch
+
+   getc = getch (c, STDIN)
+
+   return
+   end
diff --git a/unix/boot/spp/rpp/ratlibr/getccl.r b/unix/boot/spp/rpp/ratlibr/getccl.r
new file mode 100644
index 00000000..727cc7d6
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibr/getccl.r
@@ -0,0 +1,29 @@
+include	defs
+
+# getccl --- expand char class at arg (i) into pat (j)
+
+   integer function getccl (arg, i, pat, j)
+   character arg (MAXARG), pat (MAXPAT)
+   integer i, j
+
+   integer jstart, junk
+   integer addset
+
+   i = i + 1	  # skip over [
+   if (arg (i) == NOT) {
+      junk = addset (NCCL, pat, j, MAXPAT)
+      i = i + 1
+      }
+   else
+      junk = addset (CCL, pat, j, MAXPAT)
+   jstart = j
+   junk = addset (0, pat, j, MAXPAT)	  # leave room for count
+   call filset (CCLEND, arg, i, pat, j, MAXPAT)
+   pat (jstart) = j - jstart - 1
+   if (arg (i) == CCLEND)
+      getccl = OK
+   else
+      getccl = ERR
+
+   return
+   end
diff --git a/unix/boot/spp/rpp/ratlibr/getpat.r b/unix/boot/spp/rpp/ratlibr/getpat.r
new file mode 100644
index 00000000..ef1dc4a2
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibr/getpat.r
@@ -0,0 +1,12 @@
+include	defs
+
+# getpat - convert str into pattern
+
+   integer function getpat (str, pat)
+   character str (ARB), pat (ARB)
+
+   integer makpat
+
+   return (makpat (str, 1, EOS, pat))
+
+   end
diff --git a/unix/boot/spp/rpp/ratlibr/getwrd.r b/unix/boot/spp/rpp/ratlibr/getwrd.r
new file mode 100644
index 00000000..ec324af0
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibr/getwrd.r
@@ -0,0 +1,25 @@
+include	defs
+
+# getwrd - get non-blank word from in (i) into out, increment i
+
+   integer function getwrd (in, i, out)
+   character in (ARB), out (ARB)
+   integer i
+
+   integer j
+
+   while (in (i) == BLANK | in (i) == TAB)
+      i = i + 1
+
+   j = 1
+   while (in (i) != EOS & in (i) != BLANK
+    & in (i) != TAB & in (i) != NEWLINE) {
+      out (j) = in (i)
+      i = i + 1
+      j = j + 1
+      }
+   out (j) = EOS
+
+   getwrd = j - 1
+   return
+   end
diff --git a/unix/boot/spp/rpp/ratlibr/gfnarg.r b/unix/boot/spp/rpp/ratlibr/gfnarg.r
new file mode 100644
index 00000000..39409592
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibr/gfnarg.r
@@ -0,0 +1,115 @@
+include	defs
+
+# gfnarg --- get the next file name from the argument list
+
+   integer function gfnarg (name, state)
+   character name (ARB)
+   integer state (4)
+
+   integer l
+   integer getarg, getlin
+
+   filedes fd
+   filedes open
+
+   string in1 "/dev/stdin1"
+   string in2 "/dev/stdin2"
+   string in3 "/dev/stdin3"
+
+   repeat {
+
+      if (state (1) == 1) {
+	 state (1) = 2	      # new state
+	 state (2) = 1	      # next argument
+	 state (3) = ERR      # current input file
+	 state (4) = 0	      # input file count
+	 }
+
+      else if (state (1) == 2) {
+	 if (getarg (state (2), name, MAXARG) != EOF) {
+	    state (1) = 2     # stay in same state
+	    state (2) = state (2) + 1  # bump argument count
+	    if (name (1) != MINUS) {
+	       state (4) = state (4) + 1    # bump input file count
+	       return (OK)
+	       }
+	    else if (name (2) == EOS) {
+	       call scopy (in1, 1, name, 1)
+	       state (4) = state (4) + 1    # bump input file count
+	       return (OK)
+	       }
+	    else if (name (2) == DIG1 & name (3) == EOS) {
+	       call scopy (in1, 1, name, 1)
+	       state (4) = state (4) + 1    # bump input file count
+	       return (OK)
+	       }
+	    else if (name (2) == DIG2 & name (3) == EOS) {
+	       call scopy (in2, 1, name, 1)
+	       state (4) = state (4) + 1    # bump input file count
+	       return (OK)
+	       }
+	    else if (name (2) == DIG3 & name (3) == EOS) {
+	       call scopy (in3, 1, name, 1)
+	       state (4) = state (4) + 1    # bump input file count
+	       return (OK)
+	       }
+
+	    else if (name (2) == LETN | name (2) == BIGN) {
+	       state (1) = 3	       # new state
+	       if (name (3) == EOS)
+		  state (3) = STDIN
+	       else if (name (3) == DIG1 & name (4) == EOS)
+		  state (3) = STDIN1
+	       else if (name (3) == DIG2 & name (4) == EOS)
+		  state (3) = STDIN2
+	       else if (name (3) == DIG3 & name (4) == EOS)
+		  state (3) = STDIN3
+	       else {
+		  state (3) = open (name (3), READ)
+		  if (state (3) == ERR) {
+		     call putlin (name, ERROUT)
+		     call remark (":  can't open.")
+		     state (1) = 2
+		     }
+		  }
+	       }
+	    else
+	       return (ERR)
+	    }
+
+	 else
+	    state (1) = 4     # EOF state
+	 }
+
+      else if (state (1) == 3) {
+	 l = getlin (name, state (3))
+	 if (l != EOF) {
+	    name (l) = EOS
+	    state (4) = state (4) + 1  # bump input file count
+	    return (OK)
+	    }
+	 if (fd != ERR & fd != STDIN)
+	    call close (state (3))
+	 state (1) = 2
+	 }
+
+      else if (state (1) == 4) {
+	 state (1) = 5
+	 if (state (4) == 0) {# no input files
+	    call scopy (in1, 1, name, 1)
+	    return (OK)
+	    }
+	 break
+	 }
+
+      else if (state (1) == 5)
+	 break
+
+      else
+	 call error ("in gfnarg:  bad state (1) value.")
+
+      } # end of infinite repeat
+
+   name (1) = EOS
+   return (EOF)
+   end
diff --git a/unix/boot/spp/rpp/ratlibr/index.r b/unix/boot/spp/rpp/ratlibr/index.r
new file mode 100644
index 00000000..f0693f02
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibr/index.r
@@ -0,0 +1,14 @@
+include	defs
+
+# index - find character  c  in string	str
+
+   integer function index (str, c)
+   character str (ARB), c
+
+   for (index = 1; str (index) != EOS; index = index + 1)
+      if (str (index) == c)
+	 return
+
+   index = 0
+   return
+   end
diff --git a/unix/boot/spp/rpp/ratlibr/insub.r b/unix/boot/spp/rpp/ratlibr/insub.r
new file mode 100644
index 00000000..7d71b95f
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibr/insub.r
@@ -0,0 +1,16 @@
+include	defs
+
+# insub - determine if argument is STDIN substitution
+
+   integer function insub (arg, file)
+   character arg (ARB), file (ARB)
+
+   if (arg (1) == LESS & arg (2) != EOS) {
+      insub = YES
+      call scopy (arg, 2, file, 1)
+      }
+   else
+      insub = NO
+
+   return
+   end
diff --git a/unix/boot/spp/rpp/ratlibr/itoc.r b/unix/boot/spp/rpp/ratlibr/itoc.r
new file mode 100644
index 00000000..18d8f4bd
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibr/itoc.r
@@ -0,0 +1,50 @@
+include	defs
+
+# itoc - convert integer  int  to char string in  str
+
+   integer function itoc (int, str, size)
+   integer int, size
+   character str (ARB)
+
+   integer mod
+   integer d, i, intval, j, k
+
+   # string digits "0123456789"
+   character digits (11)
+   data digits (1) /DIG0/,
+      digits (2) /DIG1/,
+      digits (3) /DIG2/,
+      digits (4) /DIG3/,
+      digits (5) /DIG4/,
+      digits (6) /DIG5/,
+      digits (7) /DIG6/,
+      digits (8) /DIG7/,
+      digits (9) /DIG8/,
+      digits (10) /DIG9/,
+      digits (11) /EOS/
+
+   intval = iabs (int)
+   str (1) = EOS
+   i = 1
+   repeat {			     # generate digits
+      i = i + 1
+      d = mod (intval, 10)
+      str (i) = digits (d+1)
+      intval = intval / 10
+      } until (intval == 0 | i >= size)
+
+   if (int < 0 & i < size) {	     # then sign
+      i = i + 1
+      str (i) = MINUS
+      }
+   itoc = i - 1
+
+   for (j = 1; j < i; j = j + 1) {   # then reverse
+      k = str (i)
+      str (i) = str (j)
+      str (j) = k
+      i = i - 1
+      }
+
+   return
+   end
diff --git a/unix/boot/spp/rpp/ratlibr/length.r b/unix/boot/spp/rpp/ratlibr/length.r
new file mode 100644
index 00000000..3abb3a81
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibr/length.r
@@ -0,0 +1,12 @@
+include	defs
+
+# length - compute length of string
+
+   integer function length (str)
+   character str (ARB)
+
+   for (length = 0; str (length+1) != EOS; length = length + 1)
+      ;
+
+   return
+   end
diff --git a/unix/boot/spp/rpp/ratlibr/locate.r b/unix/boot/spp/rpp/ratlibr/locate.r
new file mode 100644
index 00000000..c8d1365b
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibr/locate.r
@@ -0,0 +1,17 @@
+include	defs
+
+# locate --- look for c in char class at pat (offset)
+
+   integer function locate (c, pat, offset)
+   character c, pat (MAXPAT)
+   integer offset
+
+   integer i
+
+   # size of class is at pat (offset), characters follow
+   for (i = offset + pat (offset); i > offset; i = i - 1)
+      if (c == pat (i))
+	 return (YES)
+
+   return (NO)
+   end
diff --git a/unix/boot/spp/rpp/ratlibr/lookup.r b/unix/boot/spp/rpp/ratlibr/lookup.r
new file mode 100644
index 00000000..6cda8f08
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibr/lookup.r
@@ -0,0 +1,30 @@
+include	defs
+
+# lookup --- find a symbol in the symbol table, return its data
+
+   integer function lookup (symbol, info, st)
+   character symbol (ARB)
+   integer info (ARB)
+   pointer st
+
+   DS_DECL(Mem, 1)
+
+   integer i, nodsiz, kluge
+   integer stlu
+
+   pointer node, pred
+
+   if (stlu (symbol, node, pred, st) == NO) {
+      lookup = NO
+      return
+      }
+
+   nodsiz = Mem (st)
+   for (i = 1; i <= nodsiz; i = i + 1) {
+      kluge = node + ST_DATA - 1 + i
+      info (i) = Mem (kluge)
+      }
+   lookup = YES
+
+   return
+   end
diff --git a/unix/boot/spp/rpp/ratlibr/lower.r b/unix/boot/spp/rpp/ratlibr/lower.r
new file mode 100644
index 00000000..91161578
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibr/lower.r
@@ -0,0 +1,11 @@
+include	defs
+
+# lower - fold all letters to lower case
+
+   subroutine lower (token)
+   character token (ARB)
+
+   call fold (token)
+
+   return
+   end
diff --git a/unix/boot/spp/rpp/ratlibr/makpat.r b/unix/boot/spp/rpp/ratlibr/makpat.r
new file mode 100644
index 00000000..a310ada7
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibr/makpat.r
@@ -0,0 +1,70 @@
+include	defs
+
+# makpat --- make pattern from arg (from), terminate at delim
+
+   integer function makpat (arg, from, delim, pat)
+   character arg (MAXARG), delim, pat (MAXPAT)
+   integer from
+
+   character esc
+
+   integer i, j, junk, lastcl, lastj, lj,
+      tagnst, tagnum, tagstk (9)
+   integer addset, getccl, stclos
+
+   j = 1      # pat index
+   lastj = 1
+   lastcl = 0
+   tagnum = 0
+   tagnst = 0
+   for (i = from; arg (i) != delim & arg (i) != EOS; i = i + 1) {
+      lj = j
+      if (arg (i) == ANY)
+	 junk = addset (ANY, pat, j, MAXPAT)
+      else if (arg (i) == BOL & i == from)
+	 junk = addset (BOL, pat, j, MAXPAT)
+      else if (arg (i) == EOL & arg (i + 1) == delim)
+	 junk = addset (EOL, pat, j, MAXPAT)
+      else if (arg (i) == CCL) {
+	 if (getccl (arg, i, pat, j) == ERR) {
+	    makpat = ERR
+	    return
+	    }
+	 }
+      else if (arg (i) == CLOSURE & i > from) {
+	 lj = lastj
+	 if (pat (lj) == BOL | pat (lj) == EOL | pat (lj) == CLOSURE |
+	       pat (lj) == START_TAG | pat (lj) == STOP_TAG)
+	    break
+	 lastcl = stclos (pat, j, lastj, lastcl)
+	 }
+      else if (arg (i) == START_TAG) {
+	 if (tagnum >= 9)    # too many tagged sub-patterns
+	    break
+	 tagnum = tagnum + 1
+	 tagnst = tagnst + 1
+	 tagstk (tagnst) = tagnum
+	 junk = addset (START_TAG, pat, j, MAXPAT)
+	 junk = addset (tagnum, pat, j, MAXPAT)
+	 }
+      else if (arg (i) == STOP_TAG & tagnst > 0) {
+	 junk = addset (STOP_TAG, pat, j, MAXPAT)
+	 junk = addset (tagstk (tagnst), pat, j, MAXPAT)
+	 tagnst = tagnst - 1
+	 }
+      else {
+	 junk = addset (CHAR, pat, j, MAXPAT)
+	 junk = addset (esc (arg, i), pat, j, MAXPAT)
+	 }
+      lastj = lj
+      }
+   if (arg (i) != delim)   # terminated early
+      makpat = ERR
+   else if (addset (EOS, pat, j, MAXPAT) == NO)   # no room
+      makpat = ERR
+   else if (tagnst != 0)
+      makpat = ERR
+   else
+      makpat = i
+   return
+   end
diff --git a/unix/boot/spp/rpp/ratlibr/maksub.r b/unix/boot/spp/rpp/ratlibr/maksub.r
new file mode 100644
index 00000000..6dd5e049
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibr/maksub.r
@@ -0,0 +1,34 @@
+include	defs
+
+# maksub --- make substitution string in sub
+
+   integer function maksub (arg, from, delim, sub)
+   character arg (MAXARG), delim, sub (MAXPAT)
+   integer from
+
+   character esc, type
+
+   integer i, j, junk
+   integer addset
+
+   j = 1
+   for (i = from; arg (i) != delim & arg (i) != EOS; i = i + 1)
+      if (arg (i) == AND) {
+	 junk = addset (DITTO, sub, j, MAXPAT)
+	 junk = addset (0, sub, j, MAXPAT)
+	 }
+      else if (arg (i) == ESCAPE & type (arg (i + 1)) == DIGIT) {
+	 i = i + 1
+	 junk = addset (DITTO, sub, j, MAXPAT)
+	 junk = addset (arg (i) - DIG0, sub, j, MAXPAT)
+	 }
+      else
+	 junk = addset (esc (arg, i), sub, j, MAXPAT)
+   if (arg (i) != delim)   # missing delimiter
+      maksub = ERR
+   else if (addset (EOS, sub, j, MAXPAT) == NO)   # no room
+      maksub = ERR
+   else
+      maksub = i
+   return
+   end
diff --git a/unix/boot/spp/rpp/ratlibr/match.r b/unix/boot/spp/rpp/ratlibr/match.r
new file mode 100644
index 00000000..c708f4cd
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibr/match.r
@@ -0,0 +1,18 @@
+include	defs
+
+# match --- find match anywhere on line
+
+   integer function match (lin, pat)
+   character lin (MAXLINE), pat (MAXPAT)
+
+   integer i, junk (9)
+   integer amatch
+
+   for (i = 1; lin (i) != EOS; i = i + 1)
+      if (amatch (lin, i, pat, junk, junk) > 0) {
+	 match = YES
+	 return
+	 }
+   match = NO
+   return
+   end
diff --git a/unix/boot/spp/rpp/ratlibr/mktabl.r b/unix/boot/spp/rpp/ratlibr/mktabl.r
new file mode 100644
index 00000000..9269b18c
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibr/mktabl.r
@@ -0,0 +1,24 @@
+include	defs
+
+# mktabl --- make a new (empty) symbol table
+
+   pointer function mktabl (nodsiz)
+   integer nodsiz
+
+   DS_DECL(Mem, 1)
+
+   pointer st
+   pointer dsget
+
+   integer i
+
+   st = dsget (ST_HTABSIZE + 1)     # +1 for record of nodsiz
+   Mem (st) = nodsiz
+   mktabl = st
+   do i = 1, ST_HTABSIZE; {
+      st = st + 1
+      Mem (st) = LAMBDA 	    # null link
+      }
+
+   return
+   end
diff --git a/unix/boot/spp/rpp/ratlibr/mntoc.r b/unix/boot/spp/rpp/ratlibr/mntoc.r
new file mode 100644
index 00000000..55d3fedd
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibr/mntoc.r
@@ -0,0 +1,74 @@
+include	defs
+
+# mntoc --- translate ASCII mnemonic into a character
+
+   character function mntoc (buf, p, defalt)
+   character buf (ARB), defalt
+   integer p
+
+   integer i, tp
+   integer equal
+
+   character c, tmp (MAXLINE)
+
+   character text (170)
+   data text / _
+      ACK, LETA, LETC, LETK, EOS,
+      BEL, LETB, LETE, LETL, EOS,
+      BS,  LETB, LETS, EOS,  EOS,
+      CAN, LETC, LETA, LETN, EOS,
+      CR,  LETC, LETR, EOS,  EOS,
+      DC1, LETD, LETC, DIG1, EOS,
+      DC2, LETD, LETC, DIG2, EOS,
+      DC3, LETD, LETC, DIG3, EOS,
+      DC4, LETD, LETC, DIG4, EOS,
+      DEL, LETD, LETE, LETL, EOS,
+      DLE, LETD, LETL, LETE, EOS,
+      EM,  LETE, LETM, EOS,  EOS,
+      ENQ, LETE, LETN, LETQ, EOS,
+      EOT, LETE, LETO, LETT, EOS,
+      ESC, LETE, LETS, LETC, EOS,
+      ETB, LETE, LETT, LETB, EOS,
+      ETX, LETE, LETT, LETX, EOS,
+      FF,  LETF, LETF, EOS,  EOS,
+      FS,  LETF, LETS, EOS,  EOS,
+      GS,  LETG, LETS, EOS,  EOS,
+      HT,  LETH, LETT, EOS,  EOS,
+      LF,  LETL, LETF, EOS,  EOS,
+      NAK, LETN, LETA, LETK, EOS,
+      NUL, LETN, LETU, LETL, EOS,
+      RS,  LETR, LETS, EOS,  EOS,
+      SI,  LETS, LETI, EOS,  EOS,
+      SO,  LETS, LETO, EOS,  EOS,
+      SOH, LETS, LETO, LETH, EOS,
+      SP,  LETS, LETP, EOS,  EOS,
+      STX, LETS, LETT, LETX, EOS,
+      SUB, LETS, LETU, LETB, EOS,
+      SYN, LETS, LETY, LETN, EOS,
+      US,  LETU, LETS, EOS,  EOS,
+      VT,  LETV, LETT, EOS,  EOS/
+
+   tp = 1
+   repeat {
+      tmp (tp) = buf (p)
+      tp = tp + 1
+      p = p + 1
+      } until (! (IS_LETTER(buf (p)) | IS_DIGIT(buf (p)))
+		  | tp >= MAXLINE)
+   tmp (tp) = EOS
+
+   if (tp == 2)
+      c = tmp (1)
+   else {
+      call lower (tmp)
+      for (i = 1; i < 170; i = i + 5)  # should use binary search here
+	 if (equal (tmp, text (i + 1)) == YES)
+	    break
+      if (i < 170)
+	 c = text (i)
+      else
+	 c = defalt
+      }
+
+   return (c)
+   end
diff --git a/unix/boot/spp/rpp/ratlibr/omatch.r b/unix/boot/spp/rpp/ratlibr/omatch.r
new file mode 100644
index 00000000..598a4e24
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibr/omatch.r
@@ -0,0 +1,48 @@
+include	defs
+
+# omatch --- try to match a single pattern at pat (j)
+
+   integer function omatch (lin, i, pat, j)
+   character lin (MAXLINE), pat (MAXPAT)
+   integer i, j
+
+   integer bump
+   integer locate
+
+   omatch = NO
+   if (lin (i) == EOS)
+      return
+   bump = -1
+   if (pat (j) == CHAR) {
+      if (lin (i) == pat (j + 1))
+	 bump = 1
+      }
+   else if (pat (j) == BOL) {
+      if (i == 1)
+	 bump = 0
+      }
+   else if (pat (j) == ANY) {
+      if (lin (i) != NEWLINE)
+	 bump = 1
+      }
+   else if (pat (j) == EOL) {
+      if (lin (i) == NEWLINE)
+	 bump = 0
+      }
+   else if (pat (j) == CCL) {
+      if (locate (lin (i), pat, j + 1) == YES)
+	 bump = 1
+      }
+   else if (pat (j) == NCCL) {
+      if (lin (i) != NEWLINE & locate (lin (i), pat, j + 1) == NO)
+	 bump = 1
+      }
+   else
+      call error ("in omatch: can't happen.")
+   if (bump >= 0) {
+      i = i + bump
+      omatch = YES
+      }
+
+   return
+   end
diff --git a/unix/boot/spp/rpp/ratlibr/outsub.r b/unix/boot/spp/rpp/ratlibr/outsub.r
new file mode 100644
index 00000000..ac657efe
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibr/outsub.r
@@ -0,0 +1,25 @@
+include	defs
+
+# outsub - determine if argument is STDOUT substitution
+
+   integer function outsub (arg, file, access)
+   character arg (ARB), file (ARB)
+   integer access
+
+   if (arg (1) == GREATER & arg (2) != GREATER & arg (2) != EOS) {
+      outsub = YES
+      access = WRITE
+      call scopy (arg, 2, file, 1)
+      }
+
+   else if (arg (1) == GREATER & arg (2) == GREATER & arg (3) != EOS) {
+      access = APPEND
+      outsub = YES
+      call scopy (arg, 3, file, 1)
+      }
+
+   else
+      outsub = NO
+
+   return
+   end
diff --git a/unix/boot/spp/rpp/ratlibr/patsiz.r b/unix/boot/spp/rpp/ratlibr/patsiz.r
new file mode 100644
index 00000000..54265b64
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibr/patsiz.r
@@ -0,0 +1,21 @@
+include	defs
+
+# patsiz --- returns size of pattern entry at pat (n)
+
+   integer function patsiz (pat, n)
+   character pat (MAXPAT)
+   integer n
+
+   if (pat (n) == CHAR | pat (n) == START_TAG | pat (n) == STOP_TAG)
+      patsiz = 2
+   else if (pat (n) == BOL | pat (n) == EOL | pat (n) == ANY)
+      patsiz = 1
+   else if (pat (n) == CCL | pat (n) == NCCL)
+      patsiz = pat (n + 1) + 2
+   else if (pat (n) == CLOSURE)      # optional
+      patsiz = CLOSIZE
+   else
+      call error ("in patsiz: can't happen.")
+
+   return
+   end
diff --git a/unix/boot/spp/rpp/ratlibr/prompt.r b/unix/boot/spp/rpp/ratlibr/prompt.r
new file mode 100644
index 00000000..2648993c
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibr/prompt.r
@@ -0,0 +1,19 @@
+include	defs
+
+# prompt - write to/read from teletype
+
+   subroutine prompt (str, buf, fd)
+   character str(ARB), buf(ARB)
+   filedes fd
+
+   integer isatty
+
+   if (isatty(fd) == YES)
+	 {
+	 call putlin (str, fd)
+	 call flush (fd)
+	 }
+   call getlin (buf, fd)
+
+   return
+   end
diff --git a/unix/boot/spp/rpp/ratlibr/putc.r b/unix/boot/spp/rpp/ratlibr/putc.r
new file mode 100644
index 00000000..3ba16c13
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibr/putc.r
@@ -0,0 +1,11 @@
+include	defs
+
+# putc - put character onto STDOUT
+
+   subroutine putc (c)
+   character c
+
+   call putch (c, STDOUT)
+
+   return
+   end
diff --git a/unix/boot/spp/rpp/ratlibr/putdec.r b/unix/boot/spp/rpp/ratlibr/putdec.r
new file mode 100644
index 00000000..6f7bb195
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibr/putdec.r
@@ -0,0 +1,20 @@
+include	defs
+
+# putdec - put decimal integer n in field width >= w
+
+   subroutine putdec(n,w)
+   integer n, w
+
+   character chars (MAXCHARS)
+
+   integer i, nd
+   integer itoc
+
+   nd = itoc (n, chars, MAXCHARS)
+   for (i = nd + 1; i <= w; i = i + 1)
+      call putc (BLANK)
+   for (i = 1; i <= nd; i = i + 1)
+      call putc (chars (i))
+
+   return
+   end
diff --git a/unix/boot/spp/rpp/ratlibr/putint.r b/unix/boot/spp/rpp/ratlibr/putint.r
new file mode 100644
index 00000000..0fed044b
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibr/putint.r
@@ -0,0 +1,18 @@
+include	defs
+
+# putint - output integer in specified field
+
+   subroutine putint (n, w, fd)
+   integer n, w
+   filedes fd
+
+   character chars (MAXCHARS)
+
+   integer junk
+   integer itoc
+
+   junk = itoc (n, chars, MAXCHARS)
+   call putstr (chars, w, fd)
+
+   return
+   end
diff --git a/unix/boot/spp/rpp/ratlibr/putstr.r b/unix/boot/spp/rpp/ratlibr/putstr.r
new file mode 100644
index 00000000..497e34d9
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibr/putstr.r
@@ -0,0 +1,23 @@
+include	defs
+
+# putstr - output character string in specified field
+
+   subroutine putstr (str, w, fd)
+   character str (ARB)
+   integer w
+   filedes fd
+
+   character length
+
+   integer i, len
+
+   len = length (str)
+   for (i = len + 1; i <= w; i = i + 1)
+      call putch (BLANK, fd)
+   for (i = 1; i <= len; i = i + 1)
+      call putch (str (i), fd)
+   for (i = (-w) - len; i > 0; i = i - 1)
+      call putch (BLANK, fd)
+
+   return
+   end
diff --git a/unix/boot/spp/rpp/ratlibr/query.r b/unix/boot/spp/rpp/ratlibr/query.r
new file mode 100644
index 00000000..80e049be
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibr/query.r
@@ -0,0 +1,17 @@
+include	defs
+
+# query - print usage message if user has requested one
+
+   subroutine query (mesg)
+   character mesg (ARB)
+
+   integer getarg
+
+   character arg1 (3), arg2 (1)
+
+   if (getarg (1, arg1, 3) != EOF & getarg (2, arg2, 1) == EOF)
+      if (arg1 (1) == QMARK & arg1 (2) == EOS)
+	 call error (mesg)
+
+   return
+   end
diff --git a/unix/boot/spp/rpp/ratlibr/rmtabl.r b/unix/boot/spp/rpp/ratlibr/rmtabl.r
new file mode 100644
index 00000000..16a5d3d5
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibr/rmtabl.r
@@ -0,0 +1,27 @@
+include	defs
+
+# rmtabl --- remove a symbol table, deleting all entries
+
+   subroutine rmtabl (st)
+   pointer st
+
+   DS_DECL(Mem, 1)
+
+   integer i
+
+   pointer walker, bucket, node
+
+   bucket = st
+   do i = 1, ST_HTABSIZE; {
+      bucket = bucket + 1
+      walker = Mem (bucket)
+      while (walker != LAMBDA) {
+	 node = walker
+	 walker = Mem (node + ST_LINK)
+	 call dsfree (node)
+	 }
+      }
+
+   call dsfree (st)
+   return
+   end
diff --git a/unix/boot/spp/rpp/ratlibr/scopy.r b/unix/boot/spp/rpp/ratlibr/scopy.r
new file mode 100644
index 00000000..0878f45a
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibr/scopy.r
@@ -0,0 +1,19 @@
+include	defs
+
+# scopy - copy string at from (i) to to (j)
+
+   subroutine scopy (from, i, to, j)
+   character from (ARB), to (ARB)
+   integer i, j
+
+   integer k1, k2
+
+   k2 = j
+   for (k1 = i; from (k1) != EOS; k1 = k1 + 1) {
+      to (k2) = from (k1)
+      k2 = k2 + 1
+      }
+   to (k2) = EOS
+
+   return
+   end
diff --git a/unix/boot/spp/rpp/ratlibr/sctabl.r b/unix/boot/spp/rpp/ratlibr/sctabl.r
new file mode 100644
index 00000000..73b0b308
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibr/sctabl.r
@@ -0,0 +1,59 @@
+include	defs
+
+# sctabl --- scan symbol table, returning next entry or EOF
+
+   integer function sctabl (table, sym, info, posn)
+   pointer table, posn
+   character sym (ARB)
+   integer info (ARB)
+
+   DS_DECL(Mem, 1)
+
+   pointer bucket, walker
+   pointer dsget
+
+   integer nodsiz, i, j
+
+   if (posn == 0) {		    # just starting scan?
+      posn = dsget (2)		       # get space for position info
+      Mem (posn) = 1		       # get index of first bucket
+      Mem (posn + 1) = Mem (table + 1) # get pointer to first chain
+      }
+
+   bucket = Mem (posn)		    # recover previous position
+   walker = Mem (posn + 1)
+   nodsiz = Mem (table)
+
+   repeat {    # until the next symbol, or none are left
+      if (walker != LAMBDA) {	    # symbol available?
+	 i = walker + ST_DATA + nodsiz
+	 j = 1
+	 while (Mem (i) != EOS) {
+	    sym (j) = Mem (i)
+	    i = i + 1
+	    j = j + 1
+	    }
+	 sym (j) = EOS
+	 for (i = 1; i <= nodsiz; i = i + 1) {
+	    j = walker + ST_DATA + i - 1
+	    info (i) = Mem (j)
+	    }
+	 Mem (posn) = bucket	    # save position of next symbol
+	 Mem (posn + 1) = Mem (walker + ST_LINK)
+	 sctabl = 1  # not EOF
+	 return
+	 }
+      else {
+	 bucket = bucket + 1
+	 if (bucket > ST_HTABSIZE)
+	    break
+	 j = table + bucket
+	 walker = Mem (j)
+	 }
+      }
+
+   call dsfree (posn)	   # throw away position information
+   posn = 0
+   sctabl = EOF
+   return
+   end
diff --git a/unix/boot/spp/rpp/ratlibr/sdrop.r b/unix/boot/spp/rpp/ratlibr/sdrop.r
new file mode 100644
index 00000000..fb3169cd
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibr/sdrop.r
@@ -0,0 +1,20 @@
+include	defs
+
+# sdrop --- drop characters from a string APL-style
+
+   integer function sdrop (from, to, chars)
+   character from (ARB), to (ARB)
+   integer chars
+
+   integer len, start
+   integer ctoc, length, min0
+
+   len = length (from)
+   if (chars < 0)
+      return (ctoc (from, to, len + chars + 1))
+   else {
+      start = min0 (chars, len)
+      return (ctoc (from (start + 1), to, len + 1))
+      }
+
+   end
diff --git a/unix/boot/spp/rpp/ratlibr/skipbl.r b/unix/boot/spp/rpp/ratlibr/skipbl.r
new file mode 100644
index 00000000..9058d09b
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibr/skipbl.r
@@ -0,0 +1,13 @@
+include	defs
+
+# skipbl - skip blanks and tabs at lin(i)
+
+   subroutine skipbl(lin, i)
+   character lin(ARB)
+   integer i
+
+   while (lin (i) == BLANK | lin (i) == TAB)
+      i = i + 1
+
+   return
+   end
diff --git a/unix/boot/spp/rpp/ratlibr/slstr.r b/unix/boot/spp/rpp/ratlibr/slstr.r
new file mode 100644
index 00000000..92d82123
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibr/slstr.r
@@ -0,0 +1,36 @@
+include	defs
+
+# slstr --- slice a substring from a string
+
+   integer function slstr (from, to, first, chars)
+   character from (ARB), to (ARB)
+   integer first, chars
+
+   integer len, i, j, k
+   integer length
+
+   len = length (from)
+
+   i = first
+   if (i < 1)
+      i = i + len + 1
+
+   if (chars < 0) {
+      i = i + chars + 1
+      chars = - chars
+      }
+
+   j = i + chars - 1
+   if (i < 1)
+      i = 1
+   if (j > len)
+      j = len
+
+   for (k = 0; i <= j; k = k + 1) {
+      to (k + 1) = from (i)
+      i = i + 1
+      }
+   to (k + 1) = EOS
+
+   return (k)
+   end
diff --git a/unix/boot/spp/rpp/ratlibr/stake.r b/unix/boot/spp/rpp/ratlibr/stake.r
new file mode 100644
index 00000000..52a9a096
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibr/stake.r
@@ -0,0 +1,20 @@
+include	defs
+
+# stake --- take characters from a string APL-style
+
+   integer function stake (from, to, chars)
+   character from (ARB), to (ARB)
+   integer chars
+
+   integer len, start
+   integer length, ctoc, max0
+
+   len = length (from)
+   if (chars < 0) {
+      start = max0 (len + chars, 0)
+      return (ctoc (from (start + 1), to, len + 1))
+      }
+   else
+      return (ctoc (from, to, chars + 1))
+
+   end
diff --git a/unix/boot/spp/rpp/ratlibr/stclos.r b/unix/boot/spp/rpp/ratlibr/stclos.r
new file mode 100644
index 00000000..37cac0c5
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibr/stclos.r
@@ -0,0 +1,24 @@
+include	defs
+
+# stclos --- insert closure entry at pat (j)
+
+   integer function stclos (pat, j, lastj, lastcl)
+   character pat (MAXPAT)
+   integer j, lastj, lastcl
+
+   integer addset
+   integer jp, jt, junk
+
+   for (jp = j - 1; jp >= lastj; jp = jp - 1) {   # make a hole
+      jt = jp + CLOSIZE
+      junk = addset (pat (jp), pat, jt, MAXPAT)
+      }
+   j = j + CLOSIZE
+   stclos = lastj
+   junk = addset (CLOSURE, pat, lastj, MAXPAT)	 # put closure in it
+   junk = addset (0, pat, lastj, MAXPAT)	 # COUNT
+   junk = addset (lastcl, pat, lastj, MAXPAT)	 # PREVCL
+   junk = addset (0, pat, lastj, MAXPAT)	 # START
+
+   return
+   end
diff --git a/unix/boot/spp/rpp/ratlibr/stcopy.r b/unix/boot/spp/rpp/ratlibr/stcopy.r
new file mode 100644
index 00000000..5c5b2396
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibr/stcopy.r
@@ -0,0 +1,17 @@
+include	defs
+
+# stcopy - copy string from in (i) to out (j), updating j, excluding EOS
+
+   subroutine stcopy (in, i, out, j)
+   character in (ARB), out (ARB)
+   integer i, j
+
+   integer k
+
+   for (k = i; in (k) != EOS; k = k + 1) {
+      out (j) = in (k)
+      j = j + 1
+      }
+   out(j) = EOS
+   return
+   end
diff --git a/unix/boot/spp/rpp/ratlibr/stlu.r b/unix/boot/spp/rpp/ratlibr/stlu.r
new file mode 100644
index 00000000..2f173b1c
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibr/stlu.r
@@ -0,0 +1,36 @@
+include	defs
+
+# stlu --- symbol table lookup primitive
+
+   integer function stlu (symbol, node, pred, st)
+   character symbol (ARB)
+   pointer node, pred, st
+
+   DS_DECL(Mem, 1)
+
+   integer hash, i, j, nodsiz
+
+   nodsiz = Mem (st)
+
+   hash = 0
+   for (i = 1; symbol (i) != EOS; i = i + 1)
+      hash = hash + symbol (i)
+   hash = mod (hash, ST_HTABSIZE) + 1
+
+   pred = st + hash
+   node = Mem (pred)
+   while (node != LAMBDA) {
+      i = 1
+      j = node + ST_DATA + nodsiz
+      while (symbol (i) == Mem (j)) {
+	 if (symbol (i) == EOS)
+	    return (YES)
+	 i = i + 1
+	 j = j + 1
+	 }
+      pred = node
+      node = Mem (pred + ST_LINK)
+      }
+
+   return (NO)
+   end
diff --git a/unix/boot/spp/rpp/ratlibr/strcmp.r b/unix/boot/spp/rpp/ratlibr/strcmp.r
new file mode 100644
index 00000000..9bc12c6a
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibr/strcmp.r
@@ -0,0 +1,24 @@
+include	defs
+
+# strcmp - compare 2 strings; return -1 if <, 0 if =, +1 if >
+
+   integer function strcmp (str1, str2)
+   character str1 (ARB), str2 (ARB)
+
+   integer i
+
+   for (i = 1; str1 (i) == str2 (i); i = i + 1)
+      if (str1 (i) == EOS)
+	 return (0)
+
+   if (str1 (i) == EOS)
+      strcmp = -1
+   else if (str2 (i) == EOS)
+      strcmp = + 1
+   else if (str1 (i) < str2 (i))
+      strcmp = -1
+   else
+      strcmp = +1
+
+   return
+   end
diff --git a/unix/boot/spp/rpp/ratlibr/strim.r b/unix/boot/spp/rpp/ratlibr/strim.r
new file mode 100644
index 00000000..ed082ef2
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibr/strim.r
@@ -0,0 +1,18 @@
+include	defs
+
+# strim --- trim trailing blanks and tabs from a string
+
+   integer function strim (str)
+   character str (ARB)
+
+   integer lnb, i
+
+   lnb = 0
+   for (i = 1; str (i) != EOS; i = i + 1)
+      if (str (i) != BLANK & str (i) != TAB)
+	 lnb = i
+
+   str (lnb + 1) = EOS
+   return (lnb)
+
+   end
diff --git a/unix/boot/spp/rpp/ratlibr/termin.r b/unix/boot/spp/rpp/ratlibr/termin.r
new file mode 100644
index 00000000..0eb0c78b
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibr/termin.r
@@ -0,0 +1,12 @@
+include	defs
+
+# termin - pick up name of input channel to users teletype
+
+   subroutine termin (name)
+   character name (ARB)
+
+   string tname TERMINAL_IN
+
+   call scopy (tname, 1, name, 1)
+   return
+   end
diff --git a/unix/boot/spp/rpp/ratlibr/trmout.r b/unix/boot/spp/rpp/ratlibr/trmout.r
new file mode 100644
index 00000000..672bc0fe
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibr/trmout.r
@@ -0,0 +1,12 @@
+include	defs
+
+# trmout - pick up name of output channel to users teletype
+
+   subroutine trmout (name)
+   character name (ARB)
+
+   string tname TERMINAL_OUT
+
+   call scopy (tname, 1, name, 1)
+   return
+   end
diff --git a/unix/boot/spp/rpp/ratlibr/type.r b/unix/boot/spp/rpp/ratlibr/type.r
new file mode 100644
index 00000000..c98c9655
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibr/type.r
@@ -0,0 +1,99 @@
+include	defs
+
+# type - determine type of character
+
+   character function type (c)
+
+   character c
+
+   if ((LETA <= c & c <= LETZ) | (BIGA <= c & c <= BIGZ))
+      type = LETTER
+   else if (DIG0 <= c & c <= DIG9)
+      type = DIGIT
+   else
+      type = c
+
+   # The original version used a table look-up; you'll have to
+   # use that method if you have subverted the convention to
+   # use ASCII characters internally:
+   # integer index
+   # character digits(11), lowalf(27), upalf(27)
+   # data digits(1) /DIG0/
+   # data digits(2) /DIG1/
+   # data digits(3) /DIG2/
+   # data digits(4) /DIG3/
+   # data digits(5) /DIG4/
+   # data digits(6) /DIG5/
+   # data digits(7) /DIG6/
+   # data digits(8) /DIG7/
+   # data digits(9) /DIG8/
+   # data digits(10) /DIG9/
+   # data digits(11) /EOS/
+   #
+   # data lowalf(1) /LETA/
+   # data lowalf(2) /LETB/
+   # data lowalf(3) /LETC/
+   # data lowalf(4) /LETD/
+   # data lowalf(5) /LETE/
+   # data lowalf(6) /LETF/
+   # data lowalf(7) /LETG/
+   # data lowalf(8) /LETH/
+   # data lowalf(9) /LETI/
+   # data lowalf(10) /LETJ/
+   # data lowalf(11) /LETK/
+   # data lowalf(12) /LETL/
+   # data lowalf(13) /LETM/
+   # data lowalf(14) /LETN/
+   # data lowalf(15) /LETO/
+   # data lowalf(16) /LETP/
+   # data lowalf(17) /LETQ/
+   # data lowalf(18) /LETR/
+   # data lowalf(19) /LETS/
+   # data lowalf(20) /LETT/
+   # data lowalf(21) /LETU/
+   # data lowalf(22) /LETV/
+   # data lowalf(23) /LETW/
+   # data lowalf(24) /LETX/
+   # data lowalf(25) /LETY/
+   # data lowalf(26) /LETZ/
+   # data lowalf(27) /EOS/
+   #
+   # data upalf(1) /BIGA/
+   # data upalf(2) /BIGB/
+   # data upalf(3) /BIGC/
+   # data upalf(4) /BIGD/
+   # data upalf(5) /BIGE/
+   # data upalf(6) /BIGF/
+   # data upalf(7) /BIGG/
+   # data upalf(8) /BIGH/
+   # data upalf(9) /BIGI/
+   # data upalf(10) /BIGJ/
+   # data upalf(11) /BIGK/
+   # data upalf(12) /BIGL/
+   # data upalf(13) /BIGM/
+   # data upalf(14) /BIGN/
+   # data upalf(15) /BIGO/
+   # data upalf(16) /BIGP/
+   # data upalf(17) /BIGQ/
+   # data upalf(18) /BIGR/
+   # data upalf(19) /BIGS/
+   # data upalf(20) /BIGT/
+   # data upalf(21) /BIGU/
+   # data upalf(23) /BIGW/
+   # data upalf(24) /BIGX/
+   # data upalf(25) /BIGY/
+   # data upalf(26) /BIGZ/
+   # data upalf(27) /EOS/
+   #
+   # if (index(lowalf, c) > 0)
+   #	    type = LETTER
+   # else if (index(upalf,c) >0)
+   #	    type = LETTER
+   # else if (index(digits,c) > 0)
+   #	    type = DIGIT
+   # else
+   #	    type = c
+
+
+   return
+   end
diff --git a/unix/boot/spp/rpp/ratlibr/upper.r b/unix/boot/spp/rpp/ratlibr/upper.r
new file mode 100644
index 00000000..0fc337bb
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibr/upper.r
@@ -0,0 +1,16 @@
+include	defs
+
+# upper - fold all alphas to upper case
+
+   subroutine upper (token)
+   character token (ARB)
+
+   character cupper
+
+   integer i
+
+   for (i = 1; token (i) != EOS; i = i + 1)
+      token (i) = cupper (token (i))
+
+   return
+   end
diff --git a/unix/boot/spp/rpp/ratlibr/wkday.r b/unix/boot/spp/rpp/ratlibr/wkday.r
new file mode 100644
index 00000000..027d14a2
--- /dev/null
+++ b/unix/boot/spp/rpp/ratlibr/wkday.r
@@ -0,0 +1,23 @@
+include	defs
+
+# wkday --- get day-of-week corresponding to month,day,year
+
+   integer function wkday (month, day, year)
+   integer month, day, year
+
+   integer lmonth, lday, lyear
+
+   lmonth = month - 2
+   lday = day
+   lyear = year
+
+   if (lmonth <= 0) {
+      lmonth = lmonth + 12
+      lyear = lyear - 1
+      }
+
+   wkday = mod (lday + (26 * lmonth - 2) / 10 + lyear + lyear / 4 - 34,
+       7) + 1
+
+   return
+   end
diff --git a/unix/boot/spp/rpp/rpp.c b/unix/boot/spp/rpp/rpp.c
new file mode 100644
index 00000000..b9215a9d
--- /dev/null
+++ b/unix/boot/spp/rpp/rpp.c
@@ -0,0 +1,31 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#include "ratlibc/ratdef.h"
+
+int	xargc;
+char	**xargv;
+
+extern  int INITST (void);
+extern  int RATFOR (void);
+extern  int ENDST (void);
+
+
+/* RPP -- Second pass of the SPP preprocessor.  Converts a Ratfor like
+ * input language into Fortran.  RPP differs from standard tools ratfor
+ * in a number of ways.  Its input language is the output of XPP and
+ * contains tokens not intended for use in any programming language.
+ * Support is provided for SPP language features, and the output fortran
+ * is pretty-printed.
+ */
+int main (int argc, char *argv[])
+{
+	xargc = argc;
+	xargv = argv;
+
+	INITST();
+	RATFOR();
+	ENDST();
+
+	return (0);
+}
diff --git a/unix/boot/spp/rpp/rppfor/README b/unix/boot/spp/rpp/rppfor/README
new file mode 100644
index 00000000..74fcacdc
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/README
@@ -0,0 +1 @@
+RPP/RPPFOR -- Fortran source for the RPP program.
diff --git a/unix/boot/spp/rpp/rppfor/addchr.f b/unix/boot/spp/rpp/rppfor/addchr.f
new file mode 100644
index 00000000..f5ed486c
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/addchr.f
@@ -0,0 +1,10 @@
+      subroutine addchr (c, buf, bp, maxsiz)
+      integer bp, maxsiz
+      integer c, buf (100)
+      if (.not.(bp .gt. maxsiz))goto 23000
+      call baderr (16Hbuffer overflow.)
+23000 continue
+      buf (bp) = c
+      bp = bp + 1
+      return
+      end
diff --git a/unix/boot/spp/rpp/rppfor/allblk.f b/unix/boot/spp/rpp/rppfor/allblk.f
new file mode 100644
index 00000000..235267a5
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/allblk.f
@@ -0,0 +1,15 @@
+      integer function allblk (buf)
+      integer buf (100)
+      integer i
+      allblk = 1
+      i = 1
+23000 if (.not.(buf (i) .ne. 10 .and. buf (i) .ne. -2))goto 23002
+      if (.not.(buf (i) .ne. 32))goto 23003
+      allblk = 0
+      goto 23002
+23003 continue
+23001 i = i + 1
+      goto 23000
+23002 continue
+      return
+      end
diff --git a/unix/boot/spp/rpp/rppfor/alldig.f b/unix/boot/spp/rpp/rppfor/alldig.f
new file mode 100644
index 00000000..d922e37f
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/alldig.f
@@ -0,0 +1,18 @@
+      integer function alldig (str)
+      integer str (100)
+      integer i
+      alldig = 0
+      if (.not.(str (1) .eq. -2))goto 23000
+      return
+23000 continue
+      i = 1
+23002 if (.not.(str (i) .ne. -2))goto 23004
+      if (.not.(.not.(48.le.str (i).and.str (i).le.57)))goto 23005
+      return
+23005 continue
+23003 i = i + 1
+      goto 23002
+23004 continue
+      alldig = 1
+      return
+      end
diff --git a/unix/boot/spp/rpp/rppfor/baderr.f b/unix/boot/spp/rpp/rppfor/baderr.f
new file mode 100644
index 00000000..8b6564f5
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/baderr.f
@@ -0,0 +1,5 @@
+      subroutine baderr (msg)
+      integer msg (100)
+      call synerr (msg)
+      call endst
+      end
diff --git a/unix/boot/spp/rpp/rppfor/balpar.f b/unix/boot/spp/rpp/rppfor/balpar.f
new file mode 100644
index 00000000..2c2b67c9
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/balpar.f
@@ -0,0 +1,41 @@
+      subroutine balpar
+      integer t, token (100)
+      integer gettok, gnbtok
+      integer nlpar
+      if (.not.(gnbtok (token, 100) .ne. 40))goto 23000
+      call synerr (19Hmissing left paren.)
+      return
+23000 continue
+      call outstr (token)
+      nlpar = 1
+23002 continue
+      t = gettok (token, 100)
+      if (.not.(t .eq. 59 .or. t .eq. 123 .or. t .eq. 125 .or. t .eq. -1
+     *))goto 23005
+      call pbstr (token)
+      goto 23004
+23005 continue
+      if (.not.(t .eq. 10))goto 23007
+      token (1) = -2
+      goto 23008
+23007 continue
+      if (.not.(t .eq. 40))goto 23009
+      nlpar = nlpar + 1
+      goto 23010
+23009 continue
+      if (.not.(t .eq. 41))goto 23011
+      nlpar = nlpar - 1
+23011 continue
+23010 continue
+23008 continue
+      if (.not.(t .eq. -9))goto 23013
+      call squash (token)
+23013 continue
+      call outstr (token)
+23003 if (.not.(nlpar .le. 0))goto 23002
+23004 continue
+      if (.not.(nlpar .ne. 0))goto 23015
+      call synerr (33Hmissing parenthesis in condition.)
+23015 continue
+      return
+      end
diff --git a/unix/boot/spp/rpp/rppfor/beginc.f b/unix/boot/spp/rpp/rppfor/beginc.f
new file mode 100644
index 00000000..bf6dd872
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/beginc.f
@@ -0,0 +1,72 @@
+      subroutine beginc
+      integer labgen
+      common /cdefio/ bp, buf (4096)
+      integer bp
+      integer buf
+      common /cfname/ fcname (30)
+      integer fcname
+      common /cfor/ fordep, forstk (200)
+      integer fordep
+      integer forstk
+      common /cgoto/ xfer
+      integer xfer
+      common /clabel/ label, retlab, memflg, col, logic0
+      integer label
+      integer retlab
+      integer memflg
+      integer col
+      integer logic0
+      common /cline/ dbgout, dbglev, level, linect (5), infile (5), fnam
+     *p, fnames ( 150)
+      integer dbgout
+      integer dbglev
+      integer level
+      integer linect
+      integer infile
+      integer fnamp
+      integer fnames
+      common /cmacro/ cp, ep, evalst (500), deftbl
+      integer cp
+      integer ep
+      integer evalst
+      integer deftbl
+      common /coutln/ outp, outbuf (74)
+      integer outp
+      integer outbuf
+      common /csbuf/ sbp, sbuf(2048), smem(240)
+      integer sbp
+      integer sbuf
+      integer smem
+      common /cswtch/ swtop, swlast, swstak(1000), swvnum, swvlev, swvst
+     *k(10), swinrg
+      integer swtop
+      integer swlast
+      integer swstak
+      integer swvnum
+      integer swvlev
+      integer swvstk
+      integer swinrg
+      common /ckword/ rkwtbl
+      integer rkwtbl
+      common /clname/ fkwtbl, namtbl, gentbl, errtbl, xpptbl
+      integer fkwtbl
+      integer namtbl
+      integer gentbl
+      integer errtbl
+      integer xpptbl
+      common /erchek/ ername, body, esp, errstk(30)
+      integer ername
+      integer body
+      integer esp
+      integer errstk
+      integer mem( 60000)
+      common/cdsmem/mem
+      body = 1
+      ername = 0
+      esp = 0
+      label = 100
+      retlab = labgen (1)
+      logic0 = 6 + 3
+      col = logic0
+      end
+c     logic0  logical_column
diff --git a/unix/boot/spp/rpp/rppfor/brknxt.f b/unix/boot/spp/rpp/rppfor/brknxt.f
new file mode 100644
index 00000000..7bc70a77
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/brknxt.f
@@ -0,0 +1,108 @@
+      subroutine brknxt (sp, lextyp, labval, token)
+      integer labval (100), lextyp (100), sp, token
+      integer i, n
+      integer alldig, ctoi
+      integer t, ptoken (100)
+      integer gnbtok
+      common /cdefio/ bp, buf (4096)
+      integer bp
+      integer buf
+      common /cfname/ fcname (30)
+      integer fcname
+      common /cfor/ fordep, forstk (200)
+      integer fordep
+      integer forstk
+      common /cgoto/ xfer
+      integer xfer
+      common /clabel/ label, retlab, memflg, col, logic0
+      integer label
+      integer retlab
+      integer memflg
+      integer col
+      integer logic0
+      common /cline/ dbgout, dbglev, level, linect (5), infile (5), fnam
+     *p, fnames ( 150)
+      integer dbgout
+      integer dbglev
+      integer level
+      integer linect
+      integer infile
+      integer fnamp
+      integer fnames
+      common /cmacro/ cp, ep, evalst (500), deftbl
+      integer cp
+      integer ep
+      integer evalst
+      integer deftbl
+      common /coutln/ outp, outbuf (74)
+      integer outp
+      integer outbuf
+      common /csbuf/ sbp, sbuf(2048), smem(240)
+      integer sbp
+      integer sbuf
+      integer smem
+      common /cswtch/ swtop, swlast, swstak(1000), swvnum, swvlev, swvst
+     *k(10), swinrg
+      integer swtop
+      integer swlast
+      integer swstak
+      integer swvnum
+      integer swvlev
+      integer swvstk
+      integer swinrg
+      common /ckword/ rkwtbl
+      integer rkwtbl
+      common /clname/ fkwtbl, namtbl, gentbl, errtbl, xpptbl
+      integer fkwtbl
+      integer namtbl
+      integer gentbl
+      integer errtbl
+      integer xpptbl
+      common /erchek/ ername, body, esp, errstk(30)
+      integer ername
+      integer body
+      integer esp
+      integer errstk
+      integer mem( 60000)
+      common/cdsmem/mem
+      n = 0
+      t = gnbtok (ptoken, 100)
+      if (.not.(alldig (ptoken) .eq. 1))goto 23000
+      i = 1
+      n = ctoi (ptoken, i) - 1
+      goto 23001
+23000 continue
+      if (.not.(t .ne. 59))goto 23002
+      call pbstr (ptoken)
+23002 continue
+23001 continue
+      i = sp
+23004 if (.not.(i .gt. 0))goto 23006
+      if (.not.(lextyp (i) .eq. -95 .or. lextyp (i) .eq. -96 .or. lextyp
+     * (i) .eq. -94 .or. lextyp (i) .eq. -93))goto 23007
+      if (.not.(n .gt. 0))goto 23009
+      n = n - 1
+      goto 23005
+23009 continue
+      if (.not.(token .eq. -79))goto 23011
+      call outgo (labval (i) + 1)
+      goto 23012
+23011 continue
+      call outgo (labval (i))
+23012 continue
+23010 continue
+      xfer = 1
+      return
+23007 continue
+23005 i = i - 1
+      goto 23004
+23006 continue
+      if (.not.(token .eq. -79))goto 23013
+      call synerr (14Hillegal break.)
+      goto 23014
+23013 continue
+      call synerr (13Hillegal next.)
+23014 continue
+      return
+      end
+c     logic0  logical_column
diff --git a/unix/boot/spp/rpp/rppfor/cascod.f b/unix/boot/spp/rpp/rppfor/cascod.f
new file mode 100644
index 00000000..e6b256fe
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/cascod.f
@@ -0,0 +1,146 @@
+      subroutine cascod (lab, token)
+      integer lab, token
+      common /cdefio/ bp, buf (4096)
+      integer bp
+      integer buf
+      common /cfname/ fcname (30)
+      integer fcname
+      common /cfor/ fordep, forstk (200)
+      integer fordep
+      integer forstk
+      common /cgoto/ xfer
+      integer xfer
+      common /clabel/ label, retlab, memflg, col, logic0
+      integer label
+      integer retlab
+      integer memflg
+      integer col
+      integer logic0
+      common /cline/ dbgout, dbglev, level, linect (5), infile (5), fnam
+     *p, fnames ( 150)
+      integer dbgout
+      integer dbglev
+      integer level
+      integer linect
+      integer infile
+      integer fnamp
+      integer fnames
+      common /cmacro/ cp, ep, evalst (500), deftbl
+      integer cp
+      integer ep
+      integer evalst
+      integer deftbl
+      common /coutln/ outp, outbuf (74)
+      integer outp
+      integer outbuf
+      common /csbuf/ sbp, sbuf(2048), smem(240)
+      integer sbp
+      integer sbuf
+      integer smem
+      common /cswtch/ swtop, swlast, swstak(1000), swvnum, swvlev, swvst
+     *k(10), swinrg
+      integer swtop
+      integer swlast
+      integer swstak
+      integer swvnum
+      integer swvlev
+      integer swvstk
+      integer swinrg
+      common /ckword/ rkwtbl
+      integer rkwtbl
+      common /clname/ fkwtbl, namtbl, gentbl, errtbl, xpptbl
+      integer fkwtbl
+      integer namtbl
+      integer gentbl
+      integer errtbl
+      integer xpptbl
+      common /erchek/ ername, body, esp, errstk(30)
+      integer ername
+      integer body
+      integer esp
+      integer errstk
+      integer mem( 60000)
+      common/cdsmem/mem
+      integer t, l, lb, ub, i, j, junk
+      integer caslab, labgen, gnbtok
+      integer tok (100)
+      if (.not.(swtop .le. 0))goto 23000
+      call synerr (24Hillegal case or default.)
+      return
+23000 continue
+      call indent (-1)
+      call outgo (lab + 1)
+      xfer = 1
+      l = labgen (1)
+      if (.not.(token .eq. -91))goto 23002
+23004 if (.not.(caslab (lb, t) .ne. -1))goto 23005
+      ub = lb
+      if (.not.(t .eq. 45))goto 23006
+      junk = caslab (ub, t)
+23006 continue
+      if (.not.(lb .gt. ub))goto 23008
+      call synerr (28Hillegal range in case label.)
+      ub = lb
+23008 continue
+      if (.not.(swlast + 3 .gt. 1000))goto 23010
+      call baderr (22Hswitch table overflow.)
+23010 continue
+      i = swtop + 3
+23012 if (.not.(i .lt. swlast))goto 23014
+      if (.not.(lb .le. swstak (i)))goto 23015
+      goto 23014
+23015 continue
+      if (.not.(lb .le. swstak (i+1)))goto 23017
+      call synerr (21Hduplicate case label.)
+23017 continue
+23016 continue
+23013 i = i + 3
+      goto 23012
+23014 continue
+      if (.not.(i .lt. swlast .and. ub .ge. swstak (i)))goto 23019
+      call synerr (21Hduplicate case label.)
+23019 continue
+      j = swlast
+23021 if (.not.(j .gt. i))goto 23023
+      swstak (j+2) = swstak (j-1)
+23022 j = j - 1
+      goto 23021
+23023 continue
+      swstak (i) = lb
+      swstak (i + 1) = ub
+      swstak (i + 2) = l
+      swstak (swtop + 1) = swstak (swtop + 1) + 1
+      swlast = swlast + 3
+      if (.not.(t .eq. 58))goto 23024
+      goto 23005
+23024 continue
+      if (.not.(t .ne. 44))goto 23026
+      call synerr (20Hillegal case syntax.)
+23026 continue
+23025 continue
+      goto 23004
+23005 continue
+      goto 23003
+23002 continue
+      t = gnbtok (tok, 100)
+      if (.not.(swstak (swtop + 2) .ne. 0))goto 23028
+      call error (38Hmultiple defaults in switch statement.)
+      goto 23029
+23028 continue
+      swstak (swtop + 2) = l
+23029 continue
+23003 continue
+      if (.not.(t .eq. -1))goto 23030
+      call synerr (15Hunexpected EOF.)
+      goto 23031
+23030 continue
+      if (.not.(t .ne. 58))goto 23032
+      call error (39Hmissing colon in case or default label.)
+23032 continue
+23031 continue
+      xfer = 0
+      call outcon (l)
+      call indent (1)
+      return
+      end
+c     logic0  logical_column
diff --git a/unix/boot/spp/rpp/rppfor/caslab.f b/unix/boot/spp/rpp/rppfor/caslab.f
new file mode 100644
index 00000000..0262fadc
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/caslab.f
@@ -0,0 +1,54 @@
+      integer function caslab (n, t)
+      integer n, t
+      integer tok(100)
+      integer i, s, lev
+      integer gnbtok, ctoi
+      caslab=0
+      t = gnbtok (tok, 100)
+23000 if (.not.(t .eq. 10))goto 23001
+      t = gnbtok (tok, 100)
+      goto 23000
+23001 continue
+      if (.not.(t .eq. -1))goto 23002
+      caslab=(t)
+      return
+23002 continue
+      lev=0
+23004 if (.not.(t .eq. 40))goto 23006
+      lev = lev + 1
+23005 t = gnbtok (tok, 100)
+      goto 23004
+23006 continue
+      if (.not.(t .eq. 45))goto 23007
+      s = -1
+      goto 23008
+23007 continue
+      s = +1
+23008 continue
+      if (.not.(t .eq. 45 .or. t .eq. 43))goto 23009
+      t = gnbtok (tok, 100)
+23009 continue
+      if (.not.(t .ne. 48))goto 23011
+      goto 99
+c     goto 23012
+23011 continue
+      i = 1
+      n = s * ctoi (tok, i)
+23012 continue
+      t=gnbtok(tok,100)
+23013 if (.not.(t .eq. 41))goto 23015
+      lev = lev - 1
+23014 t=gnbtok(tok,100)
+      goto 23013
+23015 continue
+      if (.not.(lev .ne. 0))goto 23016
+      goto 99
+23016 continue
+23018 if (.not.(t .eq. 10))goto 23019
+      t = gnbtok (tok, 100)
+      goto 23018
+23019 continue
+      return
+99    call synerr (19HInvalid case label.)
+      n = 0
+      end
diff --git a/unix/boot/spp/rpp/rppfor/declco.f b/unix/boot/spp/rpp/rppfor/declco.f
new file mode 100644
index 00000000..683bd901
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/declco.f
@@ -0,0 +1,120 @@
+      subroutine declco (id)
+      integer id(100)
+      integer newid(100), tok, tokbl
+      integer junk, ludef, equal, gettok
+      common /cdefio/ bp, buf (4096)
+      integer bp
+      integer buf
+      common /cfname/ fcname (30)
+      integer fcname
+      common /cfor/ fordep, forstk (200)
+      integer fordep
+      integer forstk
+      common /cgoto/ xfer
+      integer xfer
+      common /clabel/ label, retlab, memflg, col, logic0
+      integer label
+      integer retlab
+      integer memflg
+      integer col
+      integer logic0
+      common /cline/ dbgout, dbglev, level, linect (5), infile (5), fnam
+     *p, fnames ( 150)
+      integer dbgout
+      integer dbglev
+      integer level
+      integer linect
+      integer infile
+      integer fnamp
+      integer fnames
+      common /cmacro/ cp, ep, evalst (500), deftbl
+      integer cp
+      integer ep
+      integer evalst
+      integer deftbl
+      common /coutln/ outp, outbuf (74)
+      integer outp
+      integer outbuf
+      common /csbuf/ sbp, sbuf(2048), smem(240)
+      integer sbp
+      integer sbuf
+      integer smem
+      common /cswtch/ swtop, swlast, swstak(1000), swvnum, swvlev, swvst
+     *k(10), swinrg
+      integer swtop
+      integer swlast
+      integer swstak
+      integer swvnum
+      integer swvlev
+      integer swvstk
+      integer swinrg
+      common /ckword/ rkwtbl
+      integer rkwtbl
+      common /clname/ fkwtbl, namtbl, gentbl, errtbl, xpptbl
+      integer fkwtbl
+      integer namtbl
+      integer gentbl
+      integer errtbl
+      integer xpptbl
+      common /erchek/ ername, body, esp, errstk(30)
+      integer ername
+      integer body
+      integer esp
+      integer errstk
+      integer mem( 60000)
+      common/cdsmem/mem
+      integer xptyp(9)
+      integer xpntr(7)
+      integer xfunc(7)
+      integer xsubr(7)
+      data xptyp(1)/105/,xptyp(2)/110/,xptyp(3)/116/,xptyp(4)/101/,xptyp
+     *(5)/103/,xptyp(6)/101/,xptyp(7)/114/,xptyp(8)/32/,xptyp(9)/-2/
+      data xpntr(1)/120/,xpntr(2)/36/,xpntr(3)/112/,xpntr(4)/110/,xpntr(
+     *5)/116/,xpntr(6)/114/,xpntr(7)/-2/
+      data xfunc(1)/120/,xfunc(2)/36/,xfunc(3)/102/,xfunc(4)/117/,xfunc(
+     *5)/110/,xfunc(6)/99/,xfunc(7)/-2/
+      data xsubr(1)/120/,xsubr(2)/36/,xsubr(3)/115/,xsubr(4)/117/,xsubr(
+     *5)/98/,xsubr(6)/114/,xsubr(7)/-2/
+      if (.not.(ludef (id, newid, xpptbl) .eq. 1))goto 23000
+      if (.not.(equal (id, xpntr) .eq. 1))goto 23002
+      tokbl = gettok (newid, 100)
+      if (.not.(tokbl .eq. 32))goto 23004
+      tok = gettok (newid, 100)
+      goto 23005
+23004 continue
+      tok = tokbl
+23005 continue
+      if (.not.(tok .eq.  -166 .and. equal (newid, xfunc) .eq. 1))goto 2
+     *3006
+      call outtab
+      call outstr (xptyp)
+      junk = ludef (newid, newid, xpptbl)
+      call outstr (newid)
+      call eatup
+      call outdon
+      call poicod (0)
+      goto 23007
+23006 continue
+      call pbstr (newid)
+      call poicod (1)
+23007 continue
+      goto 23003
+23002 continue
+      if (.not.(equal (id, xsubr) .eq. 1))goto 23008
+      call outtab
+      call outstr (newid)
+      call eatup
+      call outdon
+      goto 23009
+23008 continue
+      call outtab
+      call outstr (newid)
+      call outch (32)
+23009 continue
+23003 continue
+      goto 23001
+23000 continue
+      call synerr (32HInvalid x$type type declaration.)
+23001 continue
+      end
+c     logic0  logical_column
diff --git a/unix/boot/spp/rpp/rppfor/deftok.f b/unix/boot/spp/rpp/rppfor/deftok.f
new file mode 100644
index 00000000..edd7213a
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/deftok.f
@@ -0,0 +1,237 @@
+      integer function deftok (token, toksiz)
+      integer token (100)
+      integer toksiz
+      common /cdefio/ bp, buf (4096)
+      integer bp
+      integer buf
+      common /cfname/ fcname (30)
+      integer fcname
+      common /cfor/ fordep, forstk (200)
+      integer fordep
+      integer forstk
+      common /cgoto/ xfer
+      integer xfer
+      common /clabel/ label, retlab, memflg, col, logic0
+      integer label
+      integer retlab
+      integer memflg
+      integer col
+      integer logic0
+      common /cline/ dbgout, dbglev, level, linect (5), infile (5), fnam
+     *p, fnames ( 150)
+      integer dbgout
+      integer dbglev
+      integer level
+      integer linect
+      integer infile
+      integer fnamp
+      integer fnames
+      common /cmacro/ cp, ep, evalst (500), deftbl
+      integer cp
+      integer ep
+      integer evalst
+      integer deftbl
+      common /coutln/ outp, outbuf (74)
+      integer outp
+      integer outbuf
+      common /csbuf/ sbp, sbuf(2048), smem(240)
+      integer sbp
+      integer sbuf
+      integer smem
+      common /cswtch/ swtop, swlast, swstak(1000), swvnum, swvlev, swvst
+     *k(10), swinrg
+      integer swtop
+      integer swlast
+      integer swstak
+      integer swvnum
+      integer swvlev
+      integer swvstk
+      integer swinrg
+      common /ckword/ rkwtbl
+      integer rkwtbl
+      common /clname/ fkwtbl, namtbl, gentbl, errtbl, xpptbl
+      integer fkwtbl
+      integer namtbl
+      integer gentbl
+      integer errtbl
+      integer xpptbl
+      common /erchek/ ername, body, esp, errstk(30)
+      integer ername
+      integer body
+      integer esp
+      integer errstk
+      integer mem( 60000)
+      common/cdsmem/mem
+      integer t, c, defn (2048), mdefn (2048)
+      integer gtok
+      integer equal
+      integer ap, argstk (100), callst (50), nlb, plev (50), ifl
+      integer ludef, push, ifparm
+      integer balp(3)
+      integer pswrg(22)
+      data balp(1)/40/,balp(2)/41/,balp(3)/-2/
+      data pswrg(1)/115/,pswrg(2)/119/,pswrg(3)/105/,pswrg(4)/116/,pswrg
+     *(5)/99/,pswrg(6)/104/,pswrg(7)/95/,pswrg(8)/110/,pswrg(9)/111/,psw
+     *rg(10)/95/,pswrg(11)/114/,pswrg(12)/97/,pswrg(13)/110/,pswrg(14)/1
+     *03/,pswrg(15)/101/,pswrg(16)/95/,pswrg(17)/99/,pswrg(18)/104/,pswr
+     *g(19)/101/,pswrg(20)/99/,pswrg(21)/107/,pswrg(22)/-2/
+      cp = 0
+      ap = 1
+      ep = 1
+      t = gtok (token, toksiz)
+23000 if (.not.(t .ne. -1))goto 23002
+      if (.not.(t .eq. -9))goto 23003
+      if (.not.(ludef (token, defn, deftbl) .eq. 0))goto 23005
+      if (.not.(cp .eq. 0))goto 23007
+      goto 23002
+23007 continue
+      call puttok (token)
+23008 continue
+      goto 23006
+23005 continue
+      if (.not.(defn (1) .eq. -4))goto 23009
+      call getdef (token, toksiz, defn, 2048)
+      call entdef (token, defn, deftbl)
+      goto 23010
+23009 continue
+      if (.not.(defn (1) .eq. -15 .or. defn (1) .eq. -16))goto 23011
+      c = defn (1)
+      call getdef (token, toksiz, defn, 2048)
+      ifl = ludef (token, mdefn, deftbl)
+      if (.not.((ifl .eq. 1 .and. c .eq. -15) .or. (ifl .eq. 0 .and. c .
+     *eq. -16)))goto 23013
+      call pbstr (defn)
+23013 continue
+      goto 23012
+23011 continue
+      if (.not.(defn(1) .eq. -17 .and. cp .eq. 0))goto 23015
+      if (.not.(gtok (defn, 2048) .eq. 32))goto 23017
+      if (.not.(gtok (defn, 2048) .eq. -9))goto 23019
+      if (.not.(equal (defn, pswrg) .eq. 1))goto 23021
+      swinrg = 1
+      goto 23022
+23021 continue
+      goto 10
+23022 continue
+      goto 23020
+23019 continue
+10    call pbstr (defn)
+      call putbak (32)
+      goto 23002
+23020 continue
+      goto 23018
+23017 continue
+      call pbstr (defn)
+      goto 23002
+23018 continue
+      goto 23016
+23015 continue
+      cp = cp + 1
+      if (.not.(cp .gt. 50))goto 23023
+      call baderr (20Hcall stack overflow.)
+23023 continue
+      callst (cp) = ap
+      ap = push (ep, argstk, ap)
+      call puttok (defn)
+      call putchr (-2)
+      ap = push (ep, argstk, ap)
+      call puttok (token)
+      call putchr (-2)
+      ap = push (ep, argstk, ap)
+      t = gtok (token, toksiz)
+      if (.not.(t .eq. 32))goto 23025
+      t = gtok (token, toksiz)
+      call pbstr (token)
+      if (.not.(t .ne. 40))goto 23027
+      call putbak (32)
+23027 continue
+      goto 23026
+23025 continue
+      call pbstr (token)
+23026 continue
+      if (.not.(t .ne. 40))goto 23029
+      call pbstr (balp)
+      goto 23030
+23029 continue
+      if (.not.(ifparm (defn) .eq. 0))goto 23031
+      call pbstr (balp)
+23031 continue
+23030 continue
+      plev (cp) = 0
+23016 continue
+23012 continue
+23010 continue
+23006 continue
+      goto 23004
+23003 continue
+      if (.not.(t .eq. -69))goto 23033
+      nlb = 1
+23035 continue
+      t = gtok (token, toksiz)
+      if (.not.(t .eq. -69))goto 23038
+      nlb = nlb + 1
+      goto 23039
+23038 continue
+      if (.not.(t .eq. -68))goto 23040
+      nlb = nlb - 1
+      if (.not.(nlb .eq. 0))goto 23042
+      goto 23037
+23042 continue
+      goto 23041
+23040 continue
+      if (.not.(t .eq. -1))goto 23044
+      call baderr (14HEOF in string.)
+23044 continue
+23041 continue
+23039 continue
+      call puttok (token)
+23036 goto 23035
+23037 continue
+      goto 23034
+23033 continue
+      if (.not.(cp .eq. 0))goto 23046
+      goto 23002
+23046 continue
+      if (.not.(t .eq. 40))goto 23048
+      if (.not.(plev (cp) .gt. 0))goto 23050
+      call puttok (token)
+23050 continue
+      plev (cp) = plev (cp) + 1
+      goto 23049
+23048 continue
+      if (.not.(t .eq. 41))goto 23052
+      plev (cp) = plev (cp) - 1
+      if (.not.(plev (cp) .gt. 0))goto 23054
+      call puttok (token)
+      goto 23055
+23054 continue
+      call putchr (-2)
+      call evalr (argstk, callst (cp), ap - 1)
+      ap = callst (cp)
+      ep = argstk (ap)
+      cp = cp - 1
+23055 continue
+      goto 23053
+23052 continue
+      if (.not.(t .eq. 44 .and. plev (cp) .eq. 1))goto 23056
+      call putchr (-2)
+      ap = push (ep, argstk, ap)
+      goto 23057
+23056 continue
+      call puttok (token)
+23057 continue
+23053 continue
+23049 continue
+23047 continue
+23034 continue
+23004 continue
+23001 t = gtok (token, toksiz)
+      goto 23000
+23002 continue
+      deftok = t
+      if (.not.(t .eq. -9))goto 23058
+      call fold (token)
+23058 continue
+      return
+      end
+c     logic0  logical_column
diff --git a/unix/boot/spp/rpp/rppfor/doarth.f b/unix/boot/spp/rpp/rppfor/doarth.f
new file mode 100644
index 00000000..6d45409d
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/doarth.f
@@ -0,0 +1,93 @@
+      subroutine doarth (argstk, i, j)
+      integer argstk (100), i, j
+      common /cdefio/ bp, buf (4096)
+      integer bp
+      integer buf
+      common /cfname/ fcname (30)
+      integer fcname
+      common /cfor/ fordep, forstk (200)
+      integer fordep
+      integer forstk
+      common /cgoto/ xfer
+      integer xfer
+      common /clabel/ label, retlab, memflg, col, logic0
+      integer label
+      integer retlab
+      integer memflg
+      integer col
+      integer logic0
+      common /cline/ dbgout, dbglev, level, linect (5), infile (5), fnam
+     *p, fnames ( 150)
+      integer dbgout
+      integer dbglev
+      integer level
+      integer linect
+      integer infile
+      integer fnamp
+      integer fnames
+      common /cmacro/ cp, ep, evalst (500), deftbl
+      integer cp
+      integer ep
+      integer evalst
+      integer deftbl
+      common /coutln/ outp, outbuf (74)
+      integer outp
+      integer outbuf
+      common /csbuf/ sbp, sbuf(2048), smem(240)
+      integer sbp
+      integer sbuf
+      integer smem
+      common /cswtch/ swtop, swlast, swstak(1000), swvnum, swvlev, swvst
+     *k(10), swinrg
+      integer swtop
+      integer swlast
+      integer swstak
+      integer swvnum
+      integer swvlev
+      integer swvstk
+      integer swinrg
+      common /ckword/ rkwtbl
+      integer rkwtbl
+      common /clname/ fkwtbl, namtbl, gentbl, errtbl, xpptbl
+      integer fkwtbl
+      integer namtbl
+      integer gentbl
+      integer errtbl
+      integer xpptbl
+      common /erchek/ ername, body, esp, errstk(30)
+      integer ername
+      integer body
+      integer esp
+      integer errstk
+      integer mem( 60000)
+      common/cdsmem/mem
+      integer k, l
+      integer ctoi
+      integer op
+      k = argstk (i + 2)
+      l = argstk (i + 4)
+      op = evalst (argstk (i + 3))
+      if (.not.(op .eq. 43))goto 23000
+      call pbnum (ctoi (evalst, k) + ctoi (evalst, l))
+      goto 23001
+23000 continue
+      if (.not.(op .eq. 45))goto 23002
+      call pbnum (ctoi (evalst, k) - ctoi (evalst, l))
+      goto 23003
+23002 continue
+      if (.not.(op .eq. 42 ))goto 23004
+      call pbnum (ctoi (evalst, k) * ctoi (evalst, l))
+      goto 23005
+23004 continue
+      if (.not.(op .eq. 47 ))goto 23006
+      call pbnum (ctoi (evalst, k) / ctoi (evalst, l))
+      goto 23007
+23006 continue
+      call remark (11Harith error)
+23007 continue
+23005 continue
+23003 continue
+23001 continue
+      return
+      end
+c     logic0  logical_column
diff --git a/unix/boot/spp/rpp/rppfor/docode.f b/unix/boot/spp/rpp/rppfor/docode.f
new file mode 100644
index 00000000..0d5dbdb9
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/docode.f
@@ -0,0 +1,87 @@
+      subroutine docode (lab)
+      integer lab
+      integer labgen
+      common /cdefio/ bp, buf (4096)
+      integer bp
+      integer buf
+      common /cfname/ fcname (30)
+      integer fcname
+      common /cfor/ fordep, forstk (200)
+      integer fordep
+      integer forstk
+      common /cgoto/ xfer
+      integer xfer
+      common /clabel/ label, retlab, memflg, col, logic0
+      integer label
+      integer retlab
+      integer memflg
+      integer col
+      integer logic0
+      common /cline/ dbgout, dbglev, level, linect (5), infile (5), fnam
+     *p, fnames ( 150)
+      integer dbgout
+      integer dbglev
+      integer level
+      integer linect
+      integer infile
+      integer fnamp
+      integer fnames
+      common /cmacro/ cp, ep, evalst (500), deftbl
+      integer cp
+      integer ep
+      integer evalst
+      integer deftbl
+      common /coutln/ outp, outbuf (74)
+      integer outp
+      integer outbuf
+      common /csbuf/ sbp, sbuf(2048), smem(240)
+      integer sbp
+      integer sbuf
+      integer smem
+      common /cswtch/ swtop, swlast, swstak(1000), swvnum, swvlev, swvst
+     *k(10), swinrg
+      integer swtop
+      integer swlast
+      integer swstak
+      integer swvnum
+      integer swvlev
+      integer swvstk
+      integer swinrg
+      common /ckword/ rkwtbl
+      integer rkwtbl
+      common /clname/ fkwtbl, namtbl, gentbl, errtbl, xpptbl
+      integer fkwtbl
+      integer namtbl
+      integer gentbl
+      integer errtbl
+      integer xpptbl
+      common /erchek/ ername, body, esp, errstk(30)
+      integer ername
+      integer body
+      integer esp
+      integer errstk
+      integer mem( 60000)
+      common/cdsmem/mem
+      integer gnbtok
+      integer lexstr (100)
+      integer sdo(3)
+      data sdo(1)/100/,sdo(2)/111/,sdo(3)/-2/
+      xfer = 0
+      call outtab
+      call outstr (sdo)
+      call outch (32)
+      lab = labgen (2)
+      if (.not.(gnbtok (lexstr, 100) .eq. 48))goto 23000
+      call outstr (lexstr)
+      goto 23001
+23000 continue
+      call pbstr (lexstr)
+      call outnum (lab)
+23001 continue
+      call outch (32)
+      call eatup
+      call outdwe
+      call indent (1)
+      return
+      end
+c     logic0  logical_column
diff --git a/unix/boot/spp/rpp/rppfor/doif.f b/unix/boot/spp/rpp/rppfor/doif.f
new file mode 100644
index 00000000..3eabc389
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/doif.f
@@ -0,0 +1,81 @@
+      subroutine doif (argstk, i, j)
+      integer argstk (100), i, j
+      common /cdefio/ bp, buf (4096)
+      integer bp
+      integer buf
+      common /cfname/ fcname (30)
+      integer fcname
+      common /cfor/ fordep, forstk (200)
+      integer fordep
+      integer forstk
+      common /cgoto/ xfer
+      integer xfer
+      common /clabel/ label, retlab, memflg, col, logic0
+      integer label
+      integer retlab
+      integer memflg
+      integer col
+      integer logic0
+      common /cline/ dbgout, dbglev, level, linect (5), infile (5), fnam
+     *p, fnames ( 150)
+      integer dbgout
+      integer dbglev
+      integer level
+      integer linect
+      integer infile
+      integer fnamp
+      integer fnames
+      common /cmacro/ cp, ep, evalst (500), deftbl
+      integer cp
+      integer ep
+      integer evalst
+      integer deftbl
+      common /coutln/ outp, outbuf (74)
+      integer outp
+      integer outbuf
+      common /csbuf/ sbp, sbuf(2048), smem(240)
+      integer sbp
+      integer sbuf
+      integer smem
+      common /cswtch/ swtop, swlast, swstak(1000), swvnum, swvlev, swvst
+     *k(10), swinrg
+      integer swtop
+      integer swlast
+      integer swstak
+      integer swvnum
+      integer swvlev
+      integer swvstk
+      integer swinrg
+      common /ckword/ rkwtbl
+      integer rkwtbl
+      common /clname/ fkwtbl, namtbl, gentbl, errtbl, xpptbl
+      integer fkwtbl
+      integer namtbl
+      integer gentbl
+      integer errtbl
+      integer xpptbl
+      common /erchek/ ername, body, esp, errstk(30)
+      integer ername
+      integer body
+      integer esp
+      integer errstk
+      integer mem( 60000)
+      common/cdsmem/mem
+      integer a2, a3, a4, a5
+      integer equal
+      if (.not.(j - i .lt. 5))goto 23000
+      return
+23000 continue
+      a2 = argstk (i + 2)
+      a3 = argstk (i + 3)
+      a4 = argstk (i + 4)
+      a5 = argstk (i + 5)
+      if (.not.(equal (evalst (a2), evalst (a3)) .eq. 1))goto 23002
+      call pbstr (evalst (a4))
+      goto 23003
+23002 continue
+      call pbstr (evalst (a5))
+23003 continue
+      return
+      end
+c     logic0  logical_column
diff --git a/unix/boot/spp/rpp/rppfor/doincr.f b/unix/boot/spp/rpp/rppfor/doincr.f
new file mode 100644
index 00000000..8bcc3e14
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/doincr.f
@@ -0,0 +1,70 @@
+      subroutine doincr (argstk, i, j)
+      integer argstk (100), i, j
+      common /cdefio/ bp, buf (4096)
+      integer bp
+      integer buf
+      common /cfname/ fcname (30)
+      integer fcname
+      common /cfor/ fordep, forstk (200)
+      integer fordep
+      integer forstk
+      common /cgoto/ xfer
+      integer xfer
+      common /clabel/ label, retlab, memflg, col, logic0
+      integer label
+      integer retlab
+      integer memflg
+      integer col
+      integer logic0
+      common /cline/ dbgout, dbglev, level, linect (5), infile (5), fnam
+     *p, fnames ( 150)
+      integer dbgout
+      integer dbglev
+      integer level
+      integer linect
+      integer infile
+      integer fnamp
+      integer fnames
+      common /cmacro/ cp, ep, evalst (500), deftbl
+      integer cp
+      integer ep
+      integer evalst
+      integer deftbl
+      common /coutln/ outp, outbuf (74)
+      integer outp
+      integer outbuf
+      common /csbuf/ sbp, sbuf(2048), smem(240)
+      integer sbp
+      integer sbuf
+      integer smem
+      common /cswtch/ swtop, swlast, swstak(1000), swvnum, swvlev, swvst
+     *k(10), swinrg
+      integer swtop
+      integer swlast
+      integer swstak
+      integer swvnum
+      integer swvlev
+      integer swvstk
+      integer swinrg
+      common /ckword/ rkwtbl
+      integer rkwtbl
+      common /clname/ fkwtbl, namtbl, gentbl, errtbl, xpptbl
+      integer fkwtbl
+      integer namtbl
+      integer gentbl
+      integer errtbl
+      integer xpptbl
+      common /erchek/ ername, body, esp, errstk(30)
+      integer ername
+      integer body
+      integer esp
+      integer errstk
+      integer mem( 60000)
+      common/cdsmem/mem
+      integer k
+      integer ctoi
+      k = argstk (i + 2)
+      call pbnum (ctoi (evalst, k) + 1)
+      return
+      end
+c     logic0  logical_column
diff --git a/unix/boot/spp/rpp/rppfor/domac.f b/unix/boot/spp/rpp/rppfor/domac.f
new file mode 100644
index 00000000..b954ee64
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/domac.f
@@ -0,0 +1,72 @@
+      subroutine domac (argstk, i, j)
+      integer argstk (100), i, j
+      common /cdefio/ bp, buf (4096)
+      integer bp
+      integer buf
+      common /cfname/ fcname (30)
+      integer fcname
+      common /cfor/ fordep, forstk (200)
+      integer fordep
+      integer forstk
+      common /cgoto/ xfer
+      integer xfer
+      common /clabel/ label, retlab, memflg, col, logic0
+      integer label
+      integer retlab
+      integer memflg
+      integer col
+      integer logic0
+      common /cline/ dbgout, dbglev, level, linect (5), infile (5), fnam
+     *p, fnames ( 150)
+      integer dbgout
+      integer dbglev
+      integer level
+      integer linect
+      integer infile
+      integer fnamp
+      integer fnames
+      common /cmacro/ cp, ep, evalst (500), deftbl
+      integer cp
+      integer ep
+      integer evalst
+      integer deftbl
+      common /coutln/ outp, outbuf (74)
+      integer outp
+      integer outbuf
+      common /csbuf/ sbp, sbuf(2048), smem(240)
+      integer sbp
+      integer sbuf
+      integer smem
+      common /cswtch/ swtop, swlast, swstak(1000), swvnum, swvlev, swvst
+     *k(10), swinrg
+      integer swtop
+      integer swlast
+      integer swstak
+      integer swvnum
+      integer swvlev
+      integer swvstk
+      integer swinrg
+      common /ckword/ rkwtbl
+      integer rkwtbl
+      common /clname/ fkwtbl, namtbl, gentbl, errtbl, xpptbl
+      integer fkwtbl
+      integer namtbl
+      integer gentbl
+      integer errtbl
+      integer xpptbl
+      common /erchek/ ername, body, esp, errstk(30)
+      integer ername
+      integer body
+      integer esp
+      integer errstk
+      integer mem( 60000)
+      common/cdsmem/mem
+      integer a2, a3
+      if (.not.(j - i .gt. 2))goto 23000
+      a2 = argstk (i + 2)
+      a3 = argstk (i + 3)
+      call entdef (evalst (a2), evalst (a3), deftbl)
+23000 continue
+      return
+      end
+c     logic0  logical_column
diff --git a/unix/boot/spp/rpp/rppfor/dostat.f b/unix/boot/spp/rpp/rppfor/dostat.f
new file mode 100644
index 00000000..038f5b72
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/dostat.f
@@ -0,0 +1,7 @@
+      subroutine dostat (lab)
+      integer lab
+      call indent (-1)
+      call outcon (lab)
+      call outcon (lab + 1)
+      return
+      end
diff --git a/unix/boot/spp/rpp/rppfor/dosub.f b/unix/boot/spp/rpp/rppfor/dosub.f
new file mode 100644
index 00000000..c0efa5cb
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/dosub.f
@@ -0,0 +1,90 @@
+      subroutine dosub (argstk, i, j)
+      integer argstk (100), i, j
+      common /cdefio/ bp, buf (4096)
+      integer bp
+      integer buf
+      common /cfname/ fcname (30)
+      integer fcname
+      common /cfor/ fordep, forstk (200)
+      integer fordep
+      integer forstk
+      common /cgoto/ xfer
+      integer xfer
+      common /clabel/ label, retlab, memflg, col, logic0
+      integer label
+      integer retlab
+      integer memflg
+      integer col
+      integer logic0
+      common /cline/ dbgout, dbglev, level, linect (5), infile (5), fnam
+     *p, fnames ( 150)
+      integer dbgout
+      integer dbglev
+      integer level
+      integer linect
+      integer infile
+      integer fnamp
+      integer fnames
+      common /cmacro/ cp, ep, evalst (500), deftbl
+      integer cp
+      integer ep
+      integer evalst
+      integer deftbl
+      common /coutln/ outp, outbuf (74)
+      integer outp
+      integer outbuf
+      common /csbuf/ sbp, sbuf(2048), smem(240)
+      integer sbp
+      integer sbuf
+      integer smem
+      common /cswtch/ swtop, swlast, swstak(1000), swvnum, swvlev, swvst
+     *k(10), swinrg
+      integer swtop
+      integer swlast
+      integer swstak
+      integer swvnum
+      integer swvlev
+      integer swvstk
+      integer swinrg
+      common /ckword/ rkwtbl
+      integer rkwtbl
+      common /clname/ fkwtbl, namtbl, gentbl, errtbl, xpptbl
+      integer fkwtbl
+      integer namtbl
+      integer gentbl
+      integer errtbl
+      integer xpptbl
+      common /erchek/ ername, body, esp, errstk(30)
+      integer ername
+      integer body
+      integer esp
+      integer errstk
+      integer mem( 60000)
+      common/cdsmem/mem
+      integer ap, fc, k, nc
+      integer ctoi, length
+      if (.not.(j - i .lt. 3))goto 23000
+      return
+23000 continue
+      if (.not.(j - i .lt. 4))goto 23002
+      nc = 100
+      goto 23003
+23002 continue
+      k = argstk (i + 4)
+      nc = ctoi (evalst, k)
+23003 continue
+      k = argstk (i + 3)
+      ap = argstk (i + 2)
+      fc = ap + ctoi (evalst, k) - 1
+      if (.not.(fc .ge. ap .and. fc .lt. ap + length (evalst (ap))))goto
+     * 23004
+      k = fc + min0(nc, length (evalst (fc))) - 1
+23006 if (.not.(k .ge. fc))goto 23008
+      call putbak (evalst (k))
+23007 k = k - 1
+      goto 23006
+23008 continue
+23004 continue
+      return
+      end
+c     logic0  logical_column
diff --git a/unix/boot/spp/rpp/rppfor/eatup.f b/unix/boot/spp/rpp/rppfor/eatup.f
new file mode 100644
index 00000000..65ba16b3
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/eatup.f
@@ -0,0 +1,127 @@
+      subroutine eatup
+      integer ptoken (100), t, token (100)
+      integer gettok
+      integer nlpar, equal
+      common /cdefio/ bp, buf (4096)
+      integer bp
+      integer buf
+      common /cfname/ fcname (30)
+      integer fcname
+      common /cfor/ fordep, forstk (200)
+      integer fordep
+      integer forstk
+      common /cgoto/ xfer
+      integer xfer
+      common /clabel/ label, retlab, memflg, col, logic0
+      integer label
+      integer retlab
+      integer memflg
+      integer col
+      integer logic0
+      common /cline/ dbgout, dbglev, level, linect (5), infile (5), fnam
+     *p, fnames ( 150)
+      integer dbgout
+      integer dbglev
+      integer level
+      integer linect
+      integer infile
+      integer fnamp
+      integer fnames
+      common /cmacro/ cp, ep, evalst (500), deftbl
+      integer cp
+      integer ep
+      integer evalst
+      integer deftbl
+      common /coutln/ outp, outbuf (74)
+      integer outp
+      integer outbuf
+      common /csbuf/ sbp, sbuf(2048), smem(240)
+      integer sbp
+      integer sbuf
+      integer smem
+      common /cswtch/ swtop, swlast, swstak(1000), swvnum, swvlev, swvst
+     *k(10), swinrg
+      integer swtop
+      integer swlast
+      integer swstak
+      integer swvnum
+      integer swvlev
+      integer swvstk
+      integer swinrg
+      common /ckword/ rkwtbl
+      integer rkwtbl
+      common /clname/ fkwtbl, namtbl, gentbl, errtbl, xpptbl
+      integer fkwtbl
+      integer namtbl
+      integer gentbl
+      integer errtbl
+      integer xpptbl
+      common /erchek/ ername, body, esp, errstk(30)
+      integer ername
+      integer body
+      integer esp
+      integer errstk
+      integer mem( 60000)
+      common/cdsmem/mem
+      integer serror(6)
+      data serror(1)/101/,serror(2)/114/,serror(3)/114/,serror(4)/111/,s
+     *error(5)/114/,serror(6)/-2/
+      nlpar = 0
+      token(1) = -2
+23000 continue
+      call outstr (token)
+      t = gettok (token, 100)
+23001 if (.not.(t .ne. 32 .and. t .ne. 9))goto 23000
+23002 continue
+      if (.not.(t .eq. -9))goto 23003
+      if (.not.(equal (token, serror) .eq. 1))goto 23005
+      ername = 1
+23005 continue
+23003 continue
+      goto 10
+23007 continue
+      t = gettok (token, 100)
+10    if (.not.(t .eq. 59 .or. t .eq. 10))goto 23010
+      goto 23009
+23010 continue
+      if (.not.(t .eq. 125 .or. t .eq. 123))goto 23012
+      call pbstr (token)
+      goto 23009
+23012 continue
+      if (.not.(t .eq. -1))goto 23014
+      call synerr (15Hunexpected EOF.)
+      call pbstr (token)
+      goto 23009
+23014 continue
+      if (.not.(t .eq. 44 .or. t .eq. 43 .or. t .eq. 45 .or. t .eq. 42 .
+     *or. (t .eq. 47 .and. body .eq. 1) .or. t .eq. 40 .or. t .eq. 38 .o
+     *r. t .eq. 124 .or. t .eq. 33 .or. t .eq. 126 .or. t .eq. 126 .or. 
+     *t .eq. 94 .or. t .eq. 61 .or. t .eq. 95))goto 23016
+23018 if (.not.(gettok (ptoken, 100) .eq. 10))goto 23019
+      goto 23018
+23019 continue
+      call pbstr (ptoken)
+      if (.not.(t .eq. 95))goto 23020
+      token (1) = -2
+23020 continue
+23016 continue
+      if (.not.(t .eq. 40))goto 23022
+      nlpar = nlpar + 1
+      goto 23023
+23022 continue
+      if (.not.(t .eq. 41))goto 23024
+      nlpar = nlpar - 1
+23024 continue
+23023 continue
+      if (.not.(t .eq. -9))goto 23026
+      call squash (token)
+23026 continue
+      call outstr (token)
+23008 if (.not.(nlpar .lt. 0))goto 23007
+23009 continue
+      if (.not.(nlpar .ne. 0))goto 23028
+      call synerr (23Hunbalanced parentheses.)
+23028 continue
+      return
+      end
+c     logic0  logical_column
diff --git a/unix/boot/spp/rpp/rppfor/elseif.f b/unix/boot/spp/rpp/rppfor/elseif.f
new file mode 100644
index 00000000..d0ecab46
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/elseif.f
@@ -0,0 +1,8 @@
+      subroutine elseif (lab)
+      integer lab
+      call outgo (lab+1)
+      call indent (-1)
+      call outcon (lab)
+      call indent (1)
+      return
+      end
diff --git a/unix/boot/spp/rpp/rppfor/endcod.f b/unix/boot/spp/rpp/rppfor/endcod.f
new file mode 100644
index 00000000..da8bfffc
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/endcod.f
@@ -0,0 +1,96 @@
+      subroutine endcod (endstr)
+      integer endstr(1)
+      common /cdefio/ bp, buf (4096)
+      integer bp
+      integer buf
+      common /cfname/ fcname (30)
+      integer fcname
+      common /cfor/ fordep, forstk (200)
+      integer fordep
+      integer forstk
+      common /cgoto/ xfer
+      integer xfer
+      common /clabel/ label, retlab, memflg, col, logic0
+      integer label
+      integer retlab
+      integer memflg
+      integer col
+      integer logic0
+      common /cline/ dbgout, dbglev, level, linect (5), infile (5), fnam
+     *p, fnames ( 150)
+      integer dbgout
+      integer dbglev
+      integer level
+      integer linect
+      integer infile
+      integer fnamp
+      integer fnames
+      common /cmacro/ cp, ep, evalst (500), deftbl
+      integer cp
+      integer ep
+      integer evalst
+      integer deftbl
+      common /coutln/ outp, outbuf (74)
+      integer outp
+      integer outbuf
+      common /csbuf/ sbp, sbuf(2048), smem(240)
+      integer sbp
+      integer sbuf
+      integer smem
+      common /cswtch/ swtop, swlast, swstak(1000), swvnum, swvlev, swvst
+     *k(10), swinrg
+      integer swtop
+      integer swlast
+      integer swstak
+      integer swvnum
+      integer swvlev
+      integer swvstk
+      integer swinrg
+      common /ckword/ rkwtbl
+      integer rkwtbl
+      common /clname/ fkwtbl, namtbl, gentbl, errtbl, xpptbl
+      integer fkwtbl
+      integer namtbl
+      integer gentbl
+      integer errtbl
+      integer xpptbl
+      common /erchek/ ername, body, esp, errstk(30)
+      integer ername
+      integer body
+      integer esp
+      integer errstk
+      integer mem( 60000)
+      common/cdsmem/mem
+      integer sret(7)
+      integer sepro(12)
+      data sret(1)/114/,sret(2)/101/,sret(3)/116/,sret(4)/117/,sret(5)/1
+     *14/,sret(6)/110/,sret(7)/-2/
+      data sepro(1)/99/,sepro(2)/97/,sepro(3)/108/,sepro(4)/108/,sepro(5
+     *)/32/,sepro(6)/122/,sepro(7)/122/,sepro(8)/101/,sepro(9)/112/,sepr
+     *o(10)/114/,sepro(11)/111/,sepro(12)/-2/
+      if (.not.(esp .ne. 0))goto 23000
+      call synerr (36HUnmatched 'iferr' or 'then' keyword.)
+23000 continue
+      esp = 0
+      body = 0
+      ername = 0
+      if (.not.(errtbl .ne. 0))goto 23002
+      call rmtabl (errtbl)
+23002 continue
+      errtbl = 0
+      memflg = 0
+      if (.not.(retlab .ne. 0))goto 23004
+      call outnum (retlab)
+23004 continue
+      call outtab
+      call outstr (sepro)
+      call outdon
+      call outtab
+      call outstr (sret)
+      call outdon
+      col = 6
+      call outtab
+      call outstr (endstr)
+      call outdon
+      end
+c     logic0  logical_column
diff --git a/unix/boot/spp/rpp/rppfor/entdef.f b/unix/boot/spp/rpp/rppfor/entdef.f
new file mode 100644
index 00000000..ccbb82a3
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/entdef.f
@@ -0,0 +1,12 @@
+      subroutine entdef (name, defn, table)
+      integer name (100), defn (100)
+      integer table
+      integer lookup
+      integer text
+      integer sdupl
+      if (.not.(lookup (name, text, table) .eq. 1))goto 23000
+      call dsfree (text)
+23000 continue
+      call enter (name, sdupl (defn), table)
+      return
+      end
diff --git a/unix/boot/spp/rpp/rppfor/entdkw.f b/unix/boot/spp/rpp/rppfor/entdkw.f
new file mode 100644
index 00000000..d8ac6ea9
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/entdkw.f
@@ -0,0 +1,14 @@
+      subroutine entdkw
+      integer deft(2), prag(2)
+      integer defnam(7)
+      integer prgnam(7)
+      data defnam(1)/100/,defnam(2)/101/,defnam(3)/102/,defnam(4)/105/,d
+     *efnam(5)/110/,defnam(6)/101/,defnam(7)/-2/
+      data prgnam(1)/112/,prgnam(2)/114/,prgnam(3)/97/,prgnam(4)/103/,pr
+     *gnam(5)/109/,prgnam(6)/97/,prgnam(7)/-2/
+      data deft (1), deft (2) /-4, -2/
+      data prag (1), prag (2) /-17, -2/
+      call ulstal (defnam, deft)
+      call ulstal (prgnam, prag)
+      return
+      end
diff --git a/unix/boot/spp/rpp/rppfor/entfkw.f b/unix/boot/spp/rpp/rppfor/entfkw.f
new file mode 100644
index 00000000..ba484c96
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/entfkw.f
@@ -0,0 +1,69 @@
+      subroutine entfkw
+      common /cdefio/ bp, buf (4096)
+      integer bp
+      integer buf
+      common /cfname/ fcname (30)
+      integer fcname
+      common /cfor/ fordep, forstk (200)
+      integer fordep
+      integer forstk
+      common /cgoto/ xfer
+      integer xfer
+      common /clabel/ label, retlab, memflg, col, logic0
+      integer label
+      integer retlab
+      integer memflg
+      integer col
+      integer logic0
+      common /cline/ dbgout, dbglev, level, linect (5), infile (5), fnam
+     *p, fnames ( 150)
+      integer dbgout
+      integer dbglev
+      integer level
+      integer linect
+      integer infile
+      integer fnamp
+      integer fnames
+      common /cmacro/ cp, ep, evalst (500), deftbl
+      integer cp
+      integer ep
+      integer evalst
+      integer deftbl
+      common /coutln/ outp, outbuf (74)
+      integer outp
+      integer outbuf
+      common /csbuf/ sbp, sbuf(2048), smem(240)
+      integer sbp
+      integer sbuf
+      integer smem
+      common /cswtch/ swtop, swlast, swstak(1000), swvnum, swvlev, swvst
+     *k(10), swinrg
+      integer swtop
+      integer swlast
+      integer swstak
+      integer swvnum
+      integer swvlev
+      integer swvstk
+      integer swinrg
+      common /ckword/ rkwtbl
+      integer rkwtbl
+      common /clname/ fkwtbl, namtbl, gentbl, errtbl, xpptbl
+      integer fkwtbl
+      integer namtbl
+      integer gentbl
+      integer errtbl
+      integer xpptbl
+      common /erchek/ ername, body, esp, errstk(30)
+      integer ername
+      integer body
+      integer esp
+      integer errstk
+      integer mem( 60000)
+      common/cdsmem/mem
+      integer sequiv(12)
+      data sequiv(1)/101/,sequiv(2)/113/,sequiv(3)/117/,sequiv(4)/105/,s
+     *equiv(5)/118/,sequiv(6)/97/,sequiv(7)/108/,sequiv(8)/101/,sequiv(9
+     *)/110/,sequiv(10)/99/,sequiv(11)/101/,sequiv(12)/-2/
+      call enter (sequiv, 0, fkwtbl)
+      end
+c     logic0  logical_column
diff --git a/unix/boot/spp/rpp/rppfor/entrkw.f b/unix/boot/spp/rpp/rppfor/entrkw.f
new file mode 100644
index 00000000..5deaa3de
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/entrkw.f
@@ -0,0 +1,151 @@
+      subroutine entrkw
+      common /cdefio/ bp, buf (4096)
+      integer bp
+      integer buf
+      common /cfname/ fcname (30)
+      integer fcname
+      common /cfor/ fordep, forstk (200)
+      integer fordep
+      integer forstk
+      common /cgoto/ xfer
+      integer xfer
+      common /clabel/ label, retlab, memflg, col, logic0
+      integer label
+      integer retlab
+      integer memflg
+      integer col
+      integer logic0
+      common /cline/ dbgout, dbglev, level, linect (5), infile (5), fnam
+     *p, fnames ( 150)
+      integer dbgout
+      integer dbglev
+      integer level
+      integer linect
+      integer infile
+      integer fnamp
+      integer fnames
+      common /cmacro/ cp, ep, evalst (500), deftbl
+      integer cp
+      integer ep
+      integer evalst
+      integer deftbl
+      common /coutln/ outp, outbuf (74)
+      integer outp
+      integer outbuf
+      common /csbuf/ sbp, sbuf(2048), smem(240)
+      integer sbp
+      integer sbuf
+      integer smem
+      common /cswtch/ swtop, swlast, swstak(1000), swvnum, swvlev, swvst
+     *k(10), swinrg
+      integer swtop
+      integer swlast
+      integer swstak
+      integer swvnum
+      integer swvlev
+      integer swvstk
+      integer swinrg
+      common /ckword/ rkwtbl
+      integer rkwtbl
+      common /clname/ fkwtbl, namtbl, gentbl, errtbl, xpptbl
+      integer fkwtbl
+      integer namtbl
+      integer gentbl
+      integer errtbl
+      integer xpptbl
+      common /erchek/ ername, body, esp, errstk(30)
+      integer ername
+      integer body
+      integer esp
+      integer errstk
+      integer mem( 60000)
+      common/cdsmem/mem
+      integer sif(3)
+      integer selse(5)
+      integer swhile(6)
+      integer sdo(3)
+      integer sbreak(6)
+      integer snext(5)
+      integer sfor(4)
+      integer srept(7)
+      integer suntil(6)
+      integer sret(7)
+      integer sstr(7)
+      integer sswtch(7)
+      integer scase(5)
+      integer sdeflt(8)
+      integer send(4)
+      integer serrc0(7)
+      integer siferr(6)
+      integer sifno0(8)
+      integer sthen(5)
+      integer sbegin(6)
+      integer spoint(8)
+      integer sgoto(5)
+      data sif(1)/105/,sif(2)/102/,sif(3)/-2/
+      data selse(1)/101/,selse(2)/108/,selse(3)/115/,selse(4)/101/,selse
+     *(5)/-2/
+      data swhile(1)/119/,swhile(2)/104/,swhile(3)/105/,swhile(4)/108/,s
+     *while(5)/101/,swhile(6)/-2/
+      data sdo(1)/100/,sdo(2)/111/,sdo(3)/-2/
+      data sbreak(1)/98/,sbreak(2)/114/,sbreak(3)/101/,sbreak(4)/97/,sbr
+     *eak(5)/107/,sbreak(6)/-2/
+      data snext(1)/110/,snext(2)/101/,snext(3)/120/,snext(4)/116/,snext
+     *(5)/-2/
+      data sfor(1)/102/,sfor(2)/111/,sfor(3)/114/,sfor(4)/-2/
+      data srept(1)/114/,srept(2)/101/,srept(3)/112/,srept(4)/101/,srept
+     *(5)/97/,srept(6)/116/,srept(7)/-2/
+      data suntil(1)/117/,suntil(2)/110/,suntil(3)/116/,suntil(4)/105/,s
+     *until(5)/108/,suntil(6)/-2/
+      data sret(1)/114/,sret(2)/101/,sret(3)/116/,sret(4)/117/,sret(5)/1
+     *14/,sret(6)/110/,sret(7)/-2/
+      data sstr(1)/115/,sstr(2)/116/,sstr(3)/114/,sstr(4)/105/,sstr(5)/1
+     *10/,sstr(6)/103/,sstr(7)/-2/
+      data sswtch(1)/115/,sswtch(2)/119/,sswtch(3)/105/,sswtch(4)/116/,s
+     *swtch(5)/99/,sswtch(6)/104/,sswtch(7)/-2/
+      data scase(1)/99/,scase(2)/97/,scase(3)/115/,scase(4)/101/,scase(5
+     *)/-2/
+      data sdeflt(1)/100/,sdeflt(2)/101/,sdeflt(3)/102/,sdeflt(4)/97/,sd
+     *eflt(5)/117/,sdeflt(6)/108/,sdeflt(7)/116/,sdeflt(8)/-2/
+      data send(1)/101/,send(2)/110/,send(3)/100/,send(4)/-2/
+      data serrc0(1)/101/,serrc0(2)/114/,serrc0(3)/114/,serrc0(4)/99/,se
+     *rrc0(5)/104/,serrc0(6)/107/,serrc0(7)/-2/
+      data siferr(1)/105/,siferr(2)/102/,siferr(3)/101/,siferr(4)/114/,s
+     *iferr(5)/114/,siferr(6)/-2/
+      data sifno0(1)/105/,sifno0(2)/102/,sifno0(3)/110/,sifno0(4)/111/,s
+     *ifno0(5)/101/,sifno0(6)/114/,sifno0(7)/114/,sifno0(8)/-2/
+      data sthen(1)/116/,sthen(2)/104/,sthen(3)/101/,sthen(4)/110/,sthen
+     *(5)/-2/
+      data sbegin(1)/98/,sbegin(2)/101/,sbegin(3)/103/,sbegin(4)/105/,sb
+     *egin(5)/110/,sbegin(6)/-2/
+      data spoint(1)/112/,spoint(2)/111/,spoint(3)/105/,spoint(4)/110/,s
+     *point(5)/116/,spoint(6)/101/,spoint(7)/114/,spoint(8)/-2/
+      data sgoto(1)/103/,sgoto(2)/111/,sgoto(3)/116/,sgoto(4)/111/,sgoto
+     *(5)/-2/
+      call enter (sif, -99, rkwtbl)
+      call enter (selse, -87, rkwtbl)
+      call enter (swhile, -95, rkwtbl)
+      call enter (sdo, -96, rkwtbl)
+      call enter (sbreak, -79, rkwtbl)
+      call enter (snext, -78, rkwtbl)
+      call enter (sfor, -94, rkwtbl)
+      call enter (srept, -93, rkwtbl)
+      call enter (suntil, -70, rkwtbl)
+      call enter (sret, -77, rkwtbl)
+      call enter (sstr, -75, rkwtbl)
+      call enter (sswtch, -92, rkwtbl)
+      call enter (scase, -91, rkwtbl)
+      call enter (sdeflt, -90, rkwtbl)
+      call enter (send, -82, rkwtbl)
+      call enter (serrc0, -84, rkwtbl)
+      call enter (siferr, -98, rkwtbl)
+      call enter (sifno0, -97, rkwtbl)
+      call enter (sthen, -86, rkwtbl)
+      call enter (sbegin, -83, rkwtbl)
+      call enter (spoint, -88, rkwtbl)
+      call enter (sgoto, -76, rkwtbl)
+      return
+      end
+c     sifno0  sifnoerr
+c     logic0  logical_column
+c     serrc0  serrchk
diff --git a/unix/boot/spp/rpp/rppfor/entxkw.f b/unix/boot/spp/rpp/rppfor/entxkw.f
new file mode 100644
index 00000000..e8b97b69
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/entxkw.f
@@ -0,0 +1,172 @@
+      subroutine entxkw
+      common /cdefio/ bp, buf (4096)
+      integer bp
+      integer buf
+      common /cfname/ fcname (30)
+      integer fcname
+      common /cfor/ fordep, forstk (200)
+      integer fordep
+      integer forstk
+      common /cgoto/ xfer
+      integer xfer
+      common /clabel/ label, retlab, memflg, col, logic0
+      integer label
+      integer retlab
+      integer memflg
+      integer col
+      integer logic0
+      common /cline/ dbgout, dbglev, level, linect (5), infile (5), fnam
+     *p, fnames ( 150)
+      integer dbgout
+      integer dbglev
+      integer level
+      integer linect
+      integer infile
+      integer fnamp
+      integer fnames
+      common /cmacro/ cp, ep, evalst (500), deftbl
+      integer cp
+      integer ep
+      integer evalst
+      integer deftbl
+      common /coutln/ outp, outbuf (74)
+      integer outp
+      integer outbuf
+      common /csbuf/ sbp, sbuf(2048), smem(240)
+      integer sbp
+      integer sbuf
+      integer smem
+      common /cswtch/ swtop, swlast, swstak(1000), swvnum, swvlev, swvst
+     *k(10), swinrg
+      integer swtop
+      integer swlast
+      integer swstak
+      integer swvnum
+      integer swvlev
+      integer swvstk
+      integer swinrg
+      common /ckword/ rkwtbl
+      integer rkwtbl
+      common /clname/ fkwtbl, namtbl, gentbl, errtbl, xpptbl
+      integer fkwtbl
+      integer namtbl
+      integer gentbl
+      integer errtbl
+      integer xpptbl
+      common /erchek/ ername, body, esp, errstk(30)
+      integer ername
+      integer body
+      integer esp
+      integer errstk
+      integer mem( 60000)
+      common/cdsmem/mem
+      integer sbool(7)
+      integer schar(7)
+      integer sshort(8)
+      integer sint(6)
+      integer slong(7)
+      integer sreal(7)
+      integer sdble(7)
+      integer scplx(7)
+      integer spntr(7)
+      integer sfchr(7)
+      integer sfunc(7)
+      integer ssubr(7)
+      integer sextn(7)
+      integer dbool(8)
+      integer dchar(10)
+      integer dshort(10)
+C     integer dint(10)
+C     integer dlong(10)
+C     integer dpntr(10)
+      integer dint(8)
+      integer dlong(8)
+      integer dpntr(8)
+      integer dreal(5)
+      integer ddble(17)
+      integer dcplx(8)
+      integer dfchr(10)
+      integer dfunc(9)
+      integer dsubr(11)
+      integer dextn(9)
+      data sbool(1)/120/,sbool(2)/36/,sbool(3)/98/,sbool(4)/111/,sbool(5
+     *)/111/,sbool(6)/108/,sbool(7)/-2/
+      data schar(1)/120/,schar(2)/36/,schar(3)/99/,schar(4)/104/,schar(5
+     *)/97/,schar(6)/114/,schar(7)/-2/
+      data sshort(1)/120/,sshort(2)/36/,sshort(3)/115/,sshort(4)/104/,ss
+     *hort(5)/111/,sshort(6)/114/,sshort(7)/116/,sshort(8)/-2/
+      data sint(1)/120/,sint(2)/36/,sint(3)/105/,sint(4)/110/,sint(5)/11
+     *6/,sint(6)/-2/
+      data slong(1)/120/,slong(2)/36/,slong(3)/108/,slong(4)/111/,slong(
+     *5)/110/,slong(6)/103/,slong(7)/-2/
+      data sreal(1)/120/,sreal(2)/36/,sreal(3)/114/,sreal(4)/101/,sreal(
+     *5)/97/,sreal(6)/108/,sreal(7)/-2/
+      data sdble(1)/120/,sdble(2)/36/,sdble(3)/100/,sdble(4)/98/,sdble(5
+     *)/108/,sdble(6)/101/,sdble(7)/-2/
+      data scplx(1)/120/,scplx(2)/36/,scplx(3)/99/,scplx(4)/112/,scplx(5
+     *)/108/,scplx(6)/120/,scplx(7)/-2/
+      data spntr(1)/120/,spntr(2)/36/,spntr(3)/112/,spntr(4)/110/,spntr(
+     *5)/116/,spntr(6)/114/,spntr(7)/-2/
+      data sfchr(1)/120/,sfchr(2)/36/,sfchr(3)/102/,sfchr(4)/99/,sfchr(5
+     *)/104/,sfchr(6)/114/,sfchr(7)/-2/
+      data sfunc(1)/120/,sfunc(2)/36/,sfunc(3)/102/,sfunc(4)/117/,sfunc(
+     *5)/110/,sfunc(6)/99/,sfunc(7)/-2/
+      data ssubr(1)/120/,ssubr(2)/36/,ssubr(3)/115/,ssubr(4)/117/,ssubr(
+     *5)/98/,ssubr(6)/114/,ssubr(7)/-2/
+      data sextn(1)/120/,sextn(2)/36/,sextn(3)/101/,sextn(4)/120/,sextn(
+     *5)/116/,sextn(6)/110/,sextn(7)/-2/
+      data dbool(1)/108/,dbool(2)/111/,dbool(3)/103/,dbool(4)/105/,dbool
+     *(5)/99/,dbool(6)/97/,dbool(7)/108/,dbool(8)/-2/
+      data dchar(1)/105/,dchar(2)/110/,dchar(3)/116/,dchar(4)/101/,dchar
+     *(5)/103/,dchar(6)/101/,dchar(7)/114/,dchar(8)/42/,dchar(9)/50/,dch
+     *ar(10)/-2/
+      data dshort(1)/105/,dshort(2)/110/,dshort(3)/116/,dshort(4)/101/,d
+     *short(5)/103/,dshort(6)/101/,dshort(7)/114/,dshort(8)/42/,dshort(9
+     *)/50/,dshort(10)/-2/
+C     data dint(1)/105/,dint(2)/110/,dint(3)/116/,dint(4)/101/,dint(5)/1
+C    *03/,dint(6)/101/,dint(7)/114/,dint(8)/42/,dint(9)/56/,dint(10)/-2/
+      data dint(1)/105/,dint(2)/110/,dint(3)/116/,dint(4)/101/,dint(5)/1
+     *03/,dint(6)/101/,dint(7)/114/,dint(8)/-2/
+C     data dlong(1)/105/,dlong(2)/110/,dlong(3)/116/,dlong(4)/101/,dlong
+C    *(5)/103/,dlong(6)/101/,dlong(7)/114/,dlong(8)/42/,dlong(9)/52/,dlo
+C    *ng(10)/-2/
+      data dlong(1)/105/,dlong(2)/110/,dlong(3)/116/,dlong(4)/101/,dlong
+     *(5)/103/,dlong(6)/101/,dlong(7)/114/,dlong(8)/-2/
+C     data dpntr(1)/105/,dpntr(2)/110/,dpntr(3)/116/,dpntr(4)/101/,dpntr
+C    *(5)/103/,dpntr(6)/101/,dpntr(7)/114/,dpntr(8)/42/,dpntr(9)/56/,dpn
+C    *tr(10)/-2/
+      data dpntr(1)/105/,dpntr(2)/110/,dpntr(3)/116/,dpntr(4)/101/,dpntr
+     *(5)/103/,dpntr(6)/101/,dpntr(7)/114/,dpntr(8)/-2/
+      data dreal(1)/114/,dreal(2)/101/,dreal(3)/97/,dreal(4)/108/,dreal(
+     *5)/-2/
+      data ddble(1)/100/,ddble(2)/111/,ddble(3)/117/,ddble(4)/98/,ddble(
+     *5)/108/,ddble(6)/101/,ddble(7)/32/,ddble(8)/112/,ddble(9)/114/,ddb
+     *le(10)/101/,ddble(11)/99/,ddble(12)/105/,ddble(13)/115/,ddble(14)/
+     *105/,ddble(15)/111/,ddble(16)/110/,ddble(17)/-2/
+      data dcplx(1)/99/,dcplx(2)/111/,dcplx(3)/109/,dcplx(4)/112/,dcplx(
+     *5)/108/,dcplx(6)/101/,dcplx(7)/120/,dcplx(8)/-2/
+      data dfchr(1)/99/,dfchr(2)/104/,dfchr(3)/97/,dfchr(4)/114/,dfchr(5
+     *)/97/,dfchr(6)/99/,dfchr(7)/116/,dfchr(8)/101/,dfchr(9)/114/,dfchr
+     *(10)/-2/
+      data dfunc(1)/102/,dfunc(2)/117/,dfunc(3)/110/,dfunc(4)/99/,dfunc(
+     *5)/116/,dfunc(6)/105/,dfunc(7)/111/,dfunc(8)/110/,dfunc(9)/-2/
+      data dsubr(1)/115/,dsubr(2)/117/,dsubr(3)/98/,dsubr(4)/114/,dsubr(
+     *5)/111/,dsubr(6)/117/,dsubr(7)/116/,dsubr(8)/105/,dsubr(9)/110/,ds
+     *ubr(10)/101/,dsubr(11)/-2/
+      data dextn(1)/101/,dextn(2)/120/,dextn(3)/116/,dextn(4)/101/,dextn
+     *(5)/114/,dextn(6)/110/,dextn(7)/97/,dextn(8)/108/,dextn(9)/-2/
+      call entdef (sbool, dbool, xpptbl)
+      call entdef (schar, dchar, xpptbl)
+      call entdef (sshort, dshort, xpptbl)
+      call entdef (sint, dint, xpptbl)
+      call entdef (slong, dlong, xpptbl)
+      call entdef (spntr, dpntr, xpptbl)
+      call entdef (sreal, dreal, xpptbl)
+      call entdef (sdble, ddble, xpptbl)
+      call entdef (scplx, dcplx, xpptbl)
+      call entdef (sfchr, dfchr, xpptbl)
+      call entdef (sfunc, dfunc, xpptbl)
+      call entdef (ssubr, dsubr, xpptbl)
+      call entdef (sextn, dextn, xpptbl)
+      end
+c     logic0  logical_column
diff --git a/unix/boot/spp/rpp/rppfor/errchk.f b/unix/boot/spp/rpp/rppfor/errchk.f
new file mode 100644
index 00000000..140ae204
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/errchk.f
@@ -0,0 +1,124 @@
+      subroutine errchk
+      integer tok, lastt0, gnbtok, token(100)
+      integer ntok
+      integer mktabl
+      common /cdefio/ bp, buf (4096)
+      integer bp
+      integer buf
+      common /cfname/ fcname (30)
+      integer fcname
+      common /cfor/ fordep, forstk (200)
+      integer fordep
+      integer forstk
+      common /cgoto/ xfer
+      integer xfer
+      common /clabel/ label, retlab, memflg, col, logic0
+      integer label
+      integer retlab
+      integer memflg
+      integer col
+      integer logic0
+      common /cline/ dbgout, dbglev, level, linect (5), infile (5), fnam
+     *p, fnames ( 150)
+      integer dbgout
+      integer dbglev
+      integer level
+      integer linect
+      integer infile
+      integer fnamp
+      integer fnames
+      common /cmacro/ cp, ep, evalst (500), deftbl
+      integer cp
+      integer ep
+      integer evalst
+      integer deftbl
+      common /coutln/ outp, outbuf (74)
+      integer outp
+      integer outbuf
+      common /csbuf/ sbp, sbuf(2048), smem(240)
+      integer sbp
+      integer sbuf
+      integer smem
+      common /cswtch/ swtop, swlast, swstak(1000), swvnum, swvlev, swvst
+     *k(10), swinrg
+      integer swtop
+      integer swlast
+      integer swstak
+      integer swvnum
+      integer swvlev
+      integer swvstk
+      integer swinrg
+      common /ckword/ rkwtbl
+      integer rkwtbl
+      common /clname/ fkwtbl, namtbl, gentbl, errtbl, xpptbl
+      integer fkwtbl
+      integer namtbl
+      integer gentbl
+      integer errtbl
+      integer xpptbl
+      common /erchek/ ername, body, esp, errstk(30)
+      integer ername
+      integer body
+      integer esp
+      integer errstk
+      integer mem( 60000)
+      common/cdsmem/mem
+      integer serrc0(27)
+      integer serrd0(31)
+      data serrc0(1)/108/,serrc0(2)/111/,serrc0(3)/103/,serrc0(4)/105/,s
+     *errc0(5)/99/,serrc0(6)/97/,serrc0(7)/108/,serrc0(8)/32/,serrc0(9)/
+     *120/,serrc0(10)/101/,serrc0(11)/114/,serrc0(12)/102/,serrc0(13)/10
+     *8/,serrc0(14)/103/,serrc0(15)/44/,serrc0(16)/32/,serrc0(17)/120/,s
+     *errc0(18)/101/,serrc0(19)/114/,serrc0(20)/112/,serrc0(21)/97/,serr
+     *c0(22)/100/,serrc0(23)/40/,serrc0(24)/56/,serrc0(25)/52/,serrc0(26
+     *)/41/,serrc0(27)/-2/
+      data serrd0(1)/99/,serrd0(2)/111/,serrd0(3)/109/,serrd0(4)/109/,se
+     *rrd0(5)/111/,serrd0(6)/110/,serrd0(7)/32/,serrd0(8)/47/,serrd0(9)/
+     *120/,serrd0(10)/101/,serrd0(11)/114/,serrd0(12)/99/,serrd0(13)/111
+     */,serrd0(14)/109/,serrd0(15)/47/,serrd0(16)/32/,serrd0(17)/120/,se
+     *rrd0(18)/101/,serrd0(19)/114/,serrd0(20)/102/,serrd0(21)/108/,serr
+     *d0(22)/103/,serrd0(23)/44/,serrd0(24)/32/,serrd0(25)/120/,serrd0(2
+     *6)/101/,serrd0(27)/114/,serrd0(28)/112/,serrd0(29)/97/,serrd0(30)/
+     *100/,serrd0(31)/-2/
+      ntok = 0
+      tok = 0
+23000 continue
+      lastt0 = tok
+      tok = gnbtok (token, 100)
+      I23003=(tok)
+      goto 23003
+23005 continue
+      if (.not.(errtbl .eq. 0))goto 23006
+      errtbl = mktabl(0)
+      call outtab
+      call outstr (serrc0)
+      call outdon
+      call outtab
+      call outstr (serrd0)
+      call outdon
+23006 continue
+      call enter (token, 0, errtbl)
+      goto 23004
+23008 continue
+      goto 23004
+23009 continue
+      if (.not.(lastt0 .ne. 44))goto 23010
+      goto 23002
+23010 continue
+      goto 23004
+23012 continue
+      call synerr (35HSyntax error in ERRCHK declaration.)
+      goto 23004
+23003 continue
+      if (I23003.eq.-9)goto 23005
+      if (I23003.eq.10)goto 23009
+      if (I23003.eq.44)goto 23008
+      goto 23012
+23004 continue
+23001 goto 23000
+23002 continue
+      end
+c     lastt0  last_tok
+c     logic0  logical_column
+c     serrc0  serrcom1
+c     serrd0  serrcom2
diff --git a/unix/boot/spp/rpp/rppfor/errgo.f b/unix/boot/spp/rpp/rppfor/errgo.f
new file mode 100644
index 00000000..040a5ce7
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/errgo.f
@@ -0,0 +1,84 @@
+      subroutine errgo
+      common /cdefio/ bp, buf (4096)
+      integer bp
+      integer buf
+      common /cfname/ fcname (30)
+      integer fcname
+      common /cfor/ fordep, forstk (200)
+      integer fordep
+      integer forstk
+      common /cgoto/ xfer
+      integer xfer
+      common /clabel/ label, retlab, memflg, col, logic0
+      integer label
+      integer retlab
+      integer memflg
+      integer col
+      integer logic0
+      common /cline/ dbgout, dbglev, level, linect (5), infile (5), fnam
+     *p, fnames ( 150)
+      integer dbgout
+      integer dbglev
+      integer level
+      integer linect
+      integer infile
+      integer fnamp
+      integer fnames
+      common /cmacro/ cp, ep, evalst (500), deftbl
+      integer cp
+      integer ep
+      integer evalst
+      integer deftbl
+      common /coutln/ outp, outbuf (74)
+      integer outp
+      integer outbuf
+      common /csbuf/ sbp, sbuf(2048), smem(240)
+      integer sbp
+      integer sbuf
+      integer smem
+      common /cswtch/ swtop, swlast, swstak(1000), swvnum, swvlev, swvst
+     *k(10), swinrg
+      integer swtop
+      integer swlast
+      integer swstak
+      integer swvnum
+      integer swvlev
+      integer swvstk
+      integer swinrg
+      common /ckword/ rkwtbl
+      integer rkwtbl
+      common /clname/ fkwtbl, namtbl, gentbl, errtbl, xpptbl
+      integer fkwtbl
+      integer namtbl
+      integer gentbl
+      integer errtbl
+      integer xpptbl
+      common /erchek/ ername, body, esp, errstk(30)
+      integer ername
+      integer body
+      integer esp
+      integer errstk
+      integer mem( 60000)
+      common/cdsmem/mem
+      integer serrc0(13)
+      data serrc0(1)/105/,serrc0(2)/102/,serrc0(3)/32/,serrc0(4)/40/,ser
+     *rc0(5)/120/,serrc0(6)/101/,serrc0(7)/114/,serrc0(8)/102/,serrc0(9)
+     */108/,serrc0(10)/103/,serrc0(11)/41/,serrc0(12)/32/,serrc0(13)/-2/
+      if (.not.(ername .eq. 1))goto 23000
+      call outtab
+      if (.not.(esp .gt. 0))goto 23002
+      if (.not.(errstk(esp) .gt. 0))goto 23004
+      call outstr (serrc0)
+      call ogotos (errstk(esp)+2, 0)
+23004 continue
+      goto 23003
+23002 continue
+      call outstr (serrc0)
+      call ogotos (retlab, 0)
+      call outdon
+23003 continue
+      ername = 0
+23000 continue
+      end
+c     logic0  logical_column
+c     serrc0  serrchk
diff --git a/unix/boot/spp/rpp/rppfor/errorc.f b/unix/boot/spp/rpp/rppfor/errorc.f
new file mode 100644
index 00000000..d587a001
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/errorc.f
@@ -0,0 +1,73 @@
+      subroutine errorc (str)
+      integer str(1)
+      common /cdefio/ bp, buf (4096)
+      integer bp
+      integer buf
+      common /cfname/ fcname (30)
+      integer fcname
+      common /cfor/ fordep, forstk (200)
+      integer fordep
+      integer forstk
+      common /cgoto/ xfer
+      integer xfer
+      common /clabel/ label, retlab, memflg, col, logic0
+      integer label
+      integer retlab
+      integer memflg
+      integer col
+      integer logic0
+      common /cline/ dbgout, dbglev, level, linect (5), infile (5), fnam
+     *p, fnames ( 150)
+      integer dbgout
+      integer dbglev
+      integer level
+      integer linect
+      integer infile
+      integer fnamp
+      integer fnames
+      common /cmacro/ cp, ep, evalst (500), deftbl
+      integer cp
+      integer ep
+      integer evalst
+      integer deftbl
+      common /coutln/ outp, outbuf (74)
+      integer outp
+      integer outbuf
+      common /csbuf/ sbp, sbuf(2048), smem(240)
+      integer sbp
+      integer sbuf
+      integer smem
+      common /cswtch/ swtop, swlast, swstak(1000), swvnum, swvlev, swvst
+     *k(10), swinrg
+      integer swtop
+      integer swlast
+      integer swstak
+      integer swvnum
+      integer swvlev
+      integer swvstk
+      integer swinrg
+      common /ckword/ rkwtbl
+      integer rkwtbl
+      common /clname/ fkwtbl, namtbl, gentbl, errtbl, xpptbl
+      integer fkwtbl
+      integer namtbl
+      integer gentbl
+      integer errtbl
+      integer xpptbl
+      common /erchek/ ername, body, esp, errstk(30)
+      integer ername
+      integer body
+      integer esp
+      integer errstk
+      integer mem( 60000)
+      common/cdsmem/mem
+      xfer = 1
+      call outstr (str)
+      call balpar
+      ername = 0
+      call outdon
+      call outtab
+      call ogotos (retlab, 0)
+      call outdon
+      end
+c     logic0  logical_column
diff --git a/unix/boot/spp/rpp/rppfor/evalr.f b/unix/boot/spp/rpp/rppfor/evalr.f
new file mode 100644
index 00000000..f471c0b0
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/evalr.f
@@ -0,0 +1,134 @@
+      subroutine evalr (argstk, i, j)
+      integer argstk (100), i, j
+      common /cdefio/ bp, buf (4096)
+      integer bp
+      integer buf
+      common /cfname/ fcname (30)
+      integer fcname
+      common /cfor/ fordep, forstk (200)
+      integer fordep
+      integer forstk
+      common /cgoto/ xfer
+      integer xfer
+      common /clabel/ label, retlab, memflg, col, logic0
+      integer label
+      integer retlab
+      integer memflg
+      integer col
+      integer logic0
+      common /cline/ dbgout, dbglev, level, linect (5), infile (5), fnam
+     *p, fnames ( 150)
+      integer dbgout
+      integer dbglev
+      integer level
+      integer linect
+      integer infile
+      integer fnamp
+      integer fnames
+      common /cmacro/ cp, ep, evalst (500), deftbl
+      integer cp
+      integer ep
+      integer evalst
+      integer deftbl
+      common /coutln/ outp, outbuf (74)
+      integer outp
+      integer outbuf
+      common /csbuf/ sbp, sbuf(2048), smem(240)
+      integer sbp
+      integer sbuf
+      integer smem
+      common /cswtch/ swtop, swlast, swstak(1000), swvnum, swvlev, swvst
+     *k(10), swinrg
+      integer swtop
+      integer swlast
+      integer swstak
+      integer swvnum
+      integer swvlev
+      integer swvstk
+      integer swinrg
+      common /ckword/ rkwtbl
+      integer rkwtbl
+      common /clname/ fkwtbl, namtbl, gentbl, errtbl, xpptbl
+      integer fkwtbl
+      integer namtbl
+      integer gentbl
+      integer errtbl
+      integer xpptbl
+      common /erchek/ ername, body, esp, errstk(30)
+      integer ername
+      integer body
+      integer esp
+      integer errstk
+      integer mem( 60000)
+      common/cdsmem/mem
+      integer argno, k, m, n, t, td, instr0, delim
+      external index
+      integer index, length
+      integer digits(11)
+      data digits(1)/48/,digits(2)/49/,digits(3)/50/,digits(4)/51/,digit
+     *s(5)/52/,digits(6)/53/,digits(7)/54/,digits(8)/55/,digits(9)/56/,d
+     *igits(10)/57/,digits(11)/-2/
+      t = argstk (i)
+      td = evalst (t)
+      if (.not.(td .eq. -10))goto 23000
+      call domac (argstk, i, j)
+      goto 23001
+23000 continue
+      if (.not.(td .eq. -12))goto 23002
+      call doincr (argstk, i, j)
+      goto 23003
+23002 continue
+      if (.not.(td .eq. -13))goto 23004
+      call dosub (argstk, i, j)
+      goto 23005
+23004 continue
+      if (.not.(td .eq. -11))goto 23006
+      call doif (argstk, i, j)
+      goto 23007
+23006 continue
+      if (.not.(td .eq. -14))goto 23008
+      call doarth (argstk, i, j)
+      goto 23009
+23008 continue
+      instr0 = 0
+      k = t + length (evalst (t)) - 1
+23010 if (.not.(k .gt. t))goto 23012
+      if (.not.(evalst(k) .eq. 39 .or. evalst(k) .eq. 34))goto 23013
+      if (.not.(instr0 .eq. 0))goto 23015
+      delim = evalst(k)
+      instr0 = 1
+      goto 23016
+23015 continue
+      instr0 = 0
+23016 continue
+      call putbak (evalst(k))
+      goto 23014
+23013 continue
+      if (.not.(evalst(k-1) .ne. 36 .or. instr0 .eq. 1))goto 23017
+      call putbak (evalst (k))
+      goto 23018
+23017 continue
+      argno = index (digits, evalst (k)) - 1
+      if (.not.(argno .ge. 0 .and. argno .lt. j - i))goto 23019
+      n = i + argno + 1
+      m = argstk (n)
+      call pbstr (evalst (m))
+23019 continue
+      k = k - 1
+23018 continue
+23014 continue
+23011 k = k - 1
+      goto 23010
+23012 continue
+      if (.not.(k .eq. t))goto 23021
+      call putbak (evalst (k))
+23021 continue
+23009 continue
+23007 continue
+23005 continue
+23003 continue
+23001 continue
+      return
+      end
+c     logic0  logical_column
+c     instr0  in_string
diff --git a/unix/boot/spp/rpp/rppfor/finit.f b/unix/boot/spp/rpp/rppfor/finit.f
new file mode 100644
index 00000000..eef0ee6e
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/finit.f
@@ -0,0 +1,79 @@
+      subroutine finit
+      common /cdefio/ bp, buf (4096)
+      integer bp
+      integer buf
+      common /cfname/ fcname (30)
+      integer fcname
+      common /cfor/ fordep, forstk (200)
+      integer fordep
+      integer forstk
+      common /cgoto/ xfer
+      integer xfer
+      common /clabel/ label, retlab, memflg, col, logic0
+      integer label
+      integer retlab
+      integer memflg
+      integer col
+      integer logic0
+      common /cline/ dbgout, dbglev, level, linect (5), infile (5), fnam
+     *p, fnames ( 150)
+      integer dbgout
+      integer dbglev
+      integer level
+      integer linect
+      integer infile
+      integer fnamp
+      integer fnames
+      common /cmacro/ cp, ep, evalst (500), deftbl
+      integer cp
+      integer ep
+      integer evalst
+      integer deftbl
+      common /coutln/ outp, outbuf (74)
+      integer outp
+      integer outbuf
+      common /csbuf/ sbp, sbuf(2048), smem(240)
+      integer sbp
+      integer sbuf
+      integer smem
+      common /cswtch/ swtop, swlast, swstak(1000), swvnum, swvlev, swvst
+     *k(10), swinrg
+      integer swtop
+      integer swlast
+      integer swstak
+      integer swvnum
+      integer swvlev
+      integer swvstk
+      integer swinrg
+      common /ckword/ rkwtbl
+      integer rkwtbl
+      common /clname/ fkwtbl, namtbl, gentbl, errtbl, xpptbl
+      integer fkwtbl
+      integer namtbl
+      integer gentbl
+      integer errtbl
+      integer xpptbl
+      common /erchek/ ername, body, esp, errstk(30)
+      integer ername
+      integer body
+      integer esp
+      integer errstk
+      integer mem( 60000)
+      common/cdsmem/mem
+      outp = 0
+      level = 1
+      linect (1) = 0
+      sbp = 1
+      fnamp = 2
+      fnames (1) = -2
+      bp = 3192
+      buf (bp) = -2
+      fordep = 0
+      fcname (1) = -2
+      swtop = 0
+      swlast = 1
+      swvnum = 0
+      swvlev = 0
+      return
+      end
+c     logic0  logical_column
diff --git a/unix/boot/spp/rpp/rppfor/forcod.f b/unix/boot/spp/rpp/rppfor/forcod.f
new file mode 100644
index 00000000..3d855456
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/forcod.f
@@ -0,0 +1,183 @@
+      subroutine forcod (lab)
+      integer lab
+      common /cdefio/ bp, buf (4096)
+      integer bp
+      integer buf
+      common /cfname/ fcname (30)
+      integer fcname
+      common /cfor/ fordep, forstk (200)
+      integer fordep
+      integer forstk
+      common /cgoto/ xfer
+      integer xfer
+      common /clabel/ label, retlab, memflg, col, logic0
+      integer label
+      integer retlab
+      integer memflg
+      integer col
+      integer logic0
+      common /cline/ dbgout, dbglev, level, linect (5), infile (5), fnam
+     *p, fnames ( 150)
+      integer dbgout
+      integer dbglev
+      integer level
+      integer linect
+      integer infile
+      integer fnamp
+      integer fnames
+      common /cmacro/ cp, ep, evalst (500), deftbl
+      integer cp
+      integer ep
+      integer evalst
+      integer deftbl
+      common /coutln/ outp, outbuf (74)
+      integer outp
+      integer outbuf
+      common /csbuf/ sbp, sbuf(2048), smem(240)
+      integer sbp
+      integer sbuf
+      integer smem
+      common /cswtch/ swtop, swlast, swstak(1000), swvnum, swvlev, swvst
+     *k(10), swinrg
+      integer swtop
+      integer swlast
+      integer swstak
+      integer swvnum
+      integer swvlev
+      integer swvstk
+      integer swinrg
+      common /ckword/ rkwtbl
+      integer rkwtbl
+      common /clname/ fkwtbl, namtbl, gentbl, errtbl, xpptbl
+      integer fkwtbl
+      integer namtbl
+      integer gentbl
+      integer errtbl
+      integer xpptbl
+      common /erchek/ ername, body, esp, errstk(30)
+      integer ername
+      integer body
+      integer esp
+      integer errstk
+      integer mem( 60000)
+      common/cdsmem/mem
+      integer t, token (100)
+      integer gettok, gnbtok
+      integer i, j, nlpar
+      integer length, labgen
+      integer ifnot(10)
+      integer serrc0(22)
+      data ifnot(1)/105/,ifnot(2)/102/,ifnot(3)/32/,ifnot(4)/40/,ifnot(5
+     *)/46/,ifnot(6)/110/,ifnot(7)/111/,ifnot(8)/116/,ifnot(9)/46/,ifnot
+     *(10)/-2/
+      data serrc0(1)/46/,serrc0(2)/97/,serrc0(3)/110/,serrc0(4)/100/,ser
+     *rc0(5)/46/,serrc0(6)/40/,serrc0(7)/46/,serrc0(8)/110/,serrc0(9)/11
+     *1/,serrc0(10)/116/,serrc0(11)/46/,serrc0(12)/120/,serrc0(13)/101/,
+     *serrc0(14)/114/,serrc0(15)/102/,serrc0(16)/108/,serrc0(17)/103/,se
+     *rrc0(18)/41/,serrc0(19)/41/,serrc0(20)/41/,serrc0(21)/32/,serrc0(2
+     *2)/-2/
+      lab = labgen (3)
+      call outcon (0)
+      if (.not.(gnbtok (token, 100) .ne. 40))goto 23000
+      call synerr (19Hmissing left paren.)
+      return
+23000 continue
+      if (.not.(gnbtok (token, 100) .ne. 59))goto 23002
+      call pbstr (token)
+      call outtab
+      call eatup
+      call outdwe
+23002 continue
+      if (.not.(gnbtok (token, 100) .eq. 59))goto 23004
+      call outcon (lab)
+      goto 23005
+23004 continue
+      call pbstr (token)
+      call outnum (lab)
+      call outtab
+      call outstr (ifnot)
+      call outch (40)
+      nlpar = 0
+23006 if (.not.(nlpar .ge. 0))goto 23007
+      t = gettok (token, 100)
+      if (.not.(t .eq. 59))goto 23008
+      goto 23007
+23008 continue
+      if (.not.(t .eq. 40))goto 23010
+      nlpar = nlpar + 1
+      goto 23011
+23010 continue
+      if (.not.(t .eq. 41))goto 23012
+      nlpar = nlpar - 1
+23012 continue
+23011 continue
+      if (.not.(t .eq. -1))goto 23014
+      call pbstr (token)
+      return
+23014 continue
+      if (.not.(t .eq. -9))goto 23016
+      call squash (token)
+23016 continue
+      if (.not.(t .ne. 10 .and. t .ne. 95))goto 23018
+      call outstr (token)
+23018 continue
+      goto 23006
+23007 continue
+      if (.not.(ername .eq. 1))goto 23020
+      call outstr (serrc0)
+      goto 23021
+23020 continue
+      call outch (41)
+      call outch (41)
+      call outch (32)
+23021 continue
+      call outgo (lab+2)
+      if (.not.(nlpar .lt. 0))goto 23022
+      call synerr (19Hinvalid for clause.)
+23022 continue
+23005 continue
+      fordep = fordep + 1
+      j = 1
+      i = 1
+23024 if (.not.(i .lt. fordep))goto 23026
+      j = j + length (forstk (j)) + 1
+23025 i = i + 1
+      goto 23024
+23026 continue
+      forstk (j) = -2
+      nlpar = 0
+      t = gnbtok (token, 100)
+      call pbstr (token)
+23027 if (.not.(nlpar .ge. 0))goto 23028
+      t = gettok (token, 100)
+      if (.not.(t .eq. 40))goto 23029
+      nlpar = nlpar + 1
+      goto 23030
+23029 continue
+      if (.not.(t .eq. 41))goto 23031
+      nlpar = nlpar - 1
+23031 continue
+23030 continue
+      if (.not.(t .eq. -1))goto 23033
+      call pbstr (token)
+      goto 23028
+23033 continue
+      if (.not.(nlpar .ge. 0 .and. t .ne. 10 .and. t .ne. 95))goto 23035
+      if (.not.(t .eq. -9))goto 23037
+      call squash (token)
+23037 continue
+      if (.not.(j + length (token) .ge. 200))goto 23039
+      call baderr (20Hfor clause too long.)
+23039 continue
+      call scopy (token, 1, forstk, j)
+      j = j + length (token)
+23035 continue
+      goto 23027
+23028 continue
+      lab = lab + 1
+      call indent (1)
+      call errgo
+      return
+      end
+c     logic0  logical_column
+c     serrc0  serrchk
diff --git a/unix/boot/spp/rpp/rppfor/fors.f b/unix/boot/spp/rpp/rppfor/fors.f
new file mode 100644
index 00000000..cde5f501
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/fors.f
@@ -0,0 +1,87 @@
+      subroutine fors (lab)
+      integer lab
+      common /cdefio/ bp, buf (4096)
+      integer bp
+      integer buf
+      common /cfname/ fcname (30)
+      integer fcname
+      common /cfor/ fordep, forstk (200)
+      integer fordep
+      integer forstk
+      common /cgoto/ xfer
+      integer xfer
+      common /clabel/ label, retlab, memflg, col, logic0
+      integer label
+      integer retlab
+      integer memflg
+      integer col
+      integer logic0
+      common /cline/ dbgout, dbglev, level, linect (5), infile (5), fnam
+     *p, fnames ( 150)
+      integer dbgout
+      integer dbglev
+      integer level
+      integer linect
+      integer infile
+      integer fnamp
+      integer fnames
+      common /cmacro/ cp, ep, evalst (500), deftbl
+      integer cp
+      integer ep
+      integer evalst
+      integer deftbl
+      common /coutln/ outp, outbuf (74)
+      integer outp
+      integer outbuf
+      common /csbuf/ sbp, sbuf(2048), smem(240)
+      integer sbp
+      integer sbuf
+      integer smem
+      common /cswtch/ swtop, swlast, swstak(1000), swvnum, swvlev, swvst
+     *k(10), swinrg
+      integer swtop
+      integer swlast
+      integer swstak
+      integer swvnum
+      integer swvlev
+      integer swvstk
+      integer swinrg
+      common /ckword/ rkwtbl
+      integer rkwtbl
+      common /clname/ fkwtbl, namtbl, gentbl, errtbl, xpptbl
+      integer fkwtbl
+      integer namtbl
+      integer gentbl
+      integer errtbl
+      integer xpptbl
+      common /erchek/ ername, body, esp, errstk(30)
+      integer ername
+      integer body
+      integer esp
+      integer errstk
+      integer mem( 60000)
+      common/cdsmem/mem
+      integer i, j
+      integer length
+      xfer = 0
+      call outnum (lab)
+      j = 1
+      i = 1
+23000 if (.not.(i .lt. fordep))goto 23002
+      j = j + length (forstk (j)) + 1
+23001 i = i + 1
+      goto 23000
+23002 continue
+      if (.not.(length (forstk (j)) .gt. 0))goto 23003
+      call outtab
+      call outstr (forstk (j))
+      call outdon
+23003 continue
+      call outgo (lab - 1)
+      call indent (-1)
+      call outcon (lab + 1)
+      fordep = fordep - 1
+      ername = 0
+      return
+      end
+c     logic0  logical_column
diff --git a/unix/boot/spp/rpp/rppfor/getdef.f b/unix/boot/spp/rpp/rppfor/getdef.f
new file mode 100644
index 00000000..06644ec7
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/getdef.f
@@ -0,0 +1,136 @@
+      subroutine getdef (token, toksiz, defn, defsiz)
+      integer token (100), defn (2048)
+      integer toksiz, defsiz
+      common /cdefio/ bp, buf (4096)
+      integer bp
+      integer buf
+      common /cfname/ fcname (30)
+      integer fcname
+      common /cfor/ fordep, forstk (200)
+      integer fordep
+      integer forstk
+      common /cgoto/ xfer
+      integer xfer
+      common /clabel/ label, retlab, memflg, col, logic0
+      integer label
+      integer retlab
+      integer memflg
+      integer col
+      integer logic0
+      common /cline/ dbgout, dbglev, level, linect (5), infile (5), fnam
+     *p, fnames ( 150)
+      integer dbgout
+      integer dbglev
+      integer level
+      integer linect
+      integer infile
+      integer fnamp
+      integer fnames
+      common /cmacro/ cp, ep, evalst (500), deftbl
+      integer cp
+      integer ep
+      integer evalst
+      integer deftbl
+      common /coutln/ outp, outbuf (74)
+      integer outp
+      integer outbuf
+      common /csbuf/ sbp, sbuf(2048), smem(240)
+      integer sbp
+      integer sbuf
+      integer smem
+      common /cswtch/ swtop, swlast, swstak(1000), swvnum, swvlev, swvst
+     *k(10), swinrg
+      integer swtop
+      integer swlast
+      integer swstak
+      integer swvnum
+      integer swvlev
+      integer swvstk
+      integer swinrg
+      common /ckword/ rkwtbl
+      integer rkwtbl
+      common /clname/ fkwtbl, namtbl, gentbl, errtbl, xpptbl
+      integer fkwtbl
+      integer namtbl
+      integer gentbl
+      integer errtbl
+      integer xpptbl
+      common /erchek/ ername, body, esp, errstk(30)
+      integer ername
+      integer body
+      integer esp
+      integer errstk
+      integer mem( 60000)
+      common/cdsmem/mem
+      integer c, t, ptoken (100)
+      integer gtok, ngetch
+      integer i, nlpar
+      call skpblk
+      c = gtok (ptoken, 100)
+      if (.not.(c .eq. 40))goto 23000
+      t = 40
+      goto 23001
+23000 continue
+      t = 32
+      call pbstr (ptoken)
+23001 continue
+      call skpblk
+      if (.not.(gtok (token, toksiz) .ne. -9))goto 23002
+      call baderr (22Hnon-alphanumeric name.)
+23002 continue
+      call skpblk
+      c = gtok (ptoken, 100)
+      if (.not.(t .eq. 32))goto 23004
+      call pbstr (ptoken)
+      i = 1
+23006 continue
+      c = ngetch (c)
+      if (.not.(i .gt. defsiz))goto 23009
+      call baderr (20Hdefinition too long.)
+23009 continue
+      defn (i) = c
+      i = i + 1
+23007 if (.not.(c .eq. 35 .or. c .eq. 10 .or. c .eq. -1))goto 23006
+23008 continue
+      if (.not.(c .eq. 35))goto 23011
+      call putbak (c)
+23011 continue
+      goto 23005
+23004 continue
+      if (.not.(t .eq. 40))goto 23013
+      if (.not.(c .ne. 44))goto 23015
+      call baderr (24Hmissing comma in define.)
+23015 continue
+      nlpar = 0
+      i = 1
+23017 if (.not.(nlpar .ge. 0))goto 23019
+      if (.not.(i .gt. defsiz))goto 23020
+      call baderr (20Hdefinition too long.)
+      goto 23021
+23020 continue
+      if (.not.(ngetch (defn (i)) .eq. -1))goto 23022
+      call baderr (20Hmissing right paren.)
+      goto 23023
+23022 continue
+      if (.not.(defn (i) .eq. 40))goto 23024
+      nlpar = nlpar + 1
+      goto 23025
+23024 continue
+      if (.not.(defn (i) .eq. 41))goto 23026
+      nlpar = nlpar - 1
+23026 continue
+23025 continue
+23023 continue
+23021 continue
+23018 i = i + 1
+      goto 23017
+23019 continue
+      goto 23014
+23013 continue
+      call baderr (19Hgetdef is confused.)
+23014 continue
+23005 continue
+      defn (i - 1) = -2
+      return
+      end
+c     logic0  logical_column
diff --git a/unix/boot/spp/rpp/rppfor/gettok.f b/unix/boot/spp/rpp/rppfor/gettok.f
new file mode 100644
index 00000000..ed74b2f7
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/gettok.f
@@ -0,0 +1,104 @@
+      integer function gettok (token, toksiz)
+      integer token (100)
+      integer toksiz
+      common /cdefio/ bp, buf (4096)
+      integer bp
+      integer buf
+      common /cfname/ fcname (30)
+      integer fcname
+      common /cfor/ fordep, forstk (200)
+      integer fordep
+      integer forstk
+      common /cgoto/ xfer
+      integer xfer
+      common /clabel/ label, retlab, memflg, col, logic0
+      integer label
+      integer retlab
+      integer memflg
+      integer col
+      integer logic0
+      common /cline/ dbgout, dbglev, level, linect (5), infile (5), fnam
+     *p, fnames ( 150)
+      integer dbgout
+      integer dbglev
+      integer level
+      integer linect
+      integer infile
+      integer fnamp
+      integer fnames
+      common /cmacro/ cp, ep, evalst (500), deftbl
+      integer cp
+      integer ep
+      integer evalst
+      integer deftbl
+      common /coutln/ outp, outbuf (74)
+      integer outp
+      integer outbuf
+      common /csbuf/ sbp, sbuf(2048), smem(240)
+      integer sbp
+      integer sbuf
+      integer smem
+      common /cswtch/ swtop, swlast, swstak(1000), swvnum, swvlev, swvst
+     *k(10), swinrg
+      integer swtop
+      integer swlast
+      integer swstak
+      integer swvnum
+      integer swvlev
+      integer swvstk
+      integer swinrg
+      common /ckword/ rkwtbl
+      integer rkwtbl
+      common /clname/ fkwtbl, namtbl, gentbl, errtbl, xpptbl
+      integer fkwtbl
+      integer namtbl
+      integer gentbl
+      integer errtbl
+      integer xpptbl
+      common /erchek/ ername, body, esp, errstk(30)
+      integer ername
+      integer body
+      integer esp
+      integer errstk
+      integer mem( 60000)
+      common/cdsmem/mem
+      integer equal
+      integer t, deftok
+      integer ssubr(7)
+      integer sfunc(7)
+      data ssubr(1)/120/,ssubr(2)/36/,ssubr(3)/115/,ssubr(4)/117/,ssubr(
+     *5)/98/,ssubr(6)/114/,ssubr(7)/-2/
+      data sfunc(1)/120/,sfunc(2)/36/,sfunc(3)/102/,sfunc(4)/117/,sfunc(
+     *5)/110/,sfunc(6)/99/,sfunc(7)/-2/
+      gettok = deftok (token, toksiz)
+      if (.not.(gettok .ne. -1))goto 23000
+      if (.not.(gettok .eq.  -166))goto 23002
+      if (.not.(equal (token, sfunc) .eq. 1))goto 23004
+      call skpblk
+      t = deftok (fcname, 30)
+      call pbstr (fcname)
+      if (.not.(t .ne. -9))goto 23006
+      call synerr (22HMissing function name.)
+23006 continue
+      call putbak (32)
+      swvnum = 0
+      swvlev = 0
+      return
+23004 continue
+      if (.not.(equal (token, ssubr) .eq. 1))goto 23008
+      swvnum = 0
+      swvlev = 0
+      return
+23008 continue
+      return
+23009 continue
+23005 continue
+23002 continue
+      return
+23000 continue
+      token (1) = -1
+      token (2) = -2
+      gettok = -1
+      return
+      end
+c     logic0  logical_column
diff --git a/unix/boot/spp/rpp/rppfor/gnbtok.f b/unix/boot/spp/rpp/rppfor/gnbtok.f
new file mode 100644
index 00000000..ac234f7f
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/gnbtok.f
@@ -0,0 +1,73 @@
+      integer function gnbtok (token, toksiz)
+      integer token (100)
+      integer toksiz
+      common /cdefio/ bp, buf (4096)
+      integer bp
+      integer buf
+      common /cfname/ fcname (30)
+      integer fcname
+      common /cfor/ fordep, forstk (200)
+      integer fordep
+      integer forstk
+      common /cgoto/ xfer
+      integer xfer
+      common /clabel/ label, retlab, memflg, col, logic0
+      integer label
+      integer retlab
+      integer memflg
+      integer col
+      integer logic0
+      common /cline/ dbgout, dbglev, level, linect (5), infile (5), fnam
+     *p, fnames ( 150)
+      integer dbgout
+      integer dbglev
+      integer level
+      integer linect
+      integer infile
+      integer fnamp
+      integer fnames
+      common /cmacro/ cp, ep, evalst (500), deftbl
+      integer cp
+      integer ep
+      integer evalst
+      integer deftbl
+      common /coutln/ outp, outbuf (74)
+      integer outp
+      integer outbuf
+      common /csbuf/ sbp, sbuf(2048), smem(240)
+      integer sbp
+      integer sbuf
+      integer smem
+      common /cswtch/ swtop, swlast, swstak(1000), swvnum, swvlev, swvst
+     *k(10), swinrg
+      integer swtop
+      integer swlast
+      integer swstak
+      integer swvnum
+      integer swvlev
+      integer swvstk
+      integer swinrg
+      common /ckword/ rkwtbl
+      integer rkwtbl
+      common /clname/ fkwtbl, namtbl, gentbl, errtbl, xpptbl
+      integer fkwtbl
+      integer namtbl
+      integer gentbl
+      integer errtbl
+      integer xpptbl
+      common /erchek/ ername, body, esp, errstk(30)
+      integer ername
+      integer body
+      integer esp
+      integer errstk
+      integer mem( 60000)
+      common/cdsmem/mem
+      integer gettok
+      call skpblk
+23000 continue
+      gnbtok = gettok (token, toksiz)
+23001 if (.not.(gnbtok .ne. 32))goto 23000
+23002 continue
+      return
+      end
+c     logic0  logical_column
diff --git a/unix/boot/spp/rpp/rppfor/gocode.f b/unix/boot/spp/rpp/rppfor/gocode.f
new file mode 100644
index 00000000..627bc5d9
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/gocode.f
@@ -0,0 +1,83 @@
+      subroutine gocode
+      integer token (100), t
+      integer gnbtok
+      integer ctoi, i
+      common /cdefio/ bp, buf (4096)
+      integer bp
+      integer buf
+      common /cfname/ fcname (30)
+      integer fcname
+      common /cfor/ fordep, forstk (200)
+      integer fordep
+      integer forstk
+      common /cgoto/ xfer
+      integer xfer
+      common /clabel/ label, retlab, memflg, col, logic0
+      integer label
+      integer retlab
+      integer memflg
+      integer col
+      integer logic0
+      common /cline/ dbgout, dbglev, level, linect (5), infile (5), fnam
+     *p, fnames ( 150)
+      integer dbgout
+      integer dbglev
+      integer level
+      integer linect
+      integer infile
+      integer fnamp
+      integer fnames
+      common /cmacro/ cp, ep, evalst (500), deftbl
+      integer cp
+      integer ep
+      integer evalst
+      integer deftbl
+      common /coutln/ outp, outbuf (74)
+      integer outp
+      integer outbuf
+      common /csbuf/ sbp, sbuf(2048), smem(240)
+      integer sbp
+      integer sbuf
+      integer smem
+      common /cswtch/ swtop, swlast, swstak(1000), swvnum, swvlev, swvst
+     *k(10), swinrg
+      integer swtop
+      integer swlast
+      integer swstak
+      integer swvnum
+      integer swvlev
+      integer swvstk
+      integer swinrg
+      common /ckword/ rkwtbl
+      integer rkwtbl
+      common /clname/ fkwtbl, namtbl, gentbl, errtbl, xpptbl
+      integer fkwtbl
+      integer namtbl
+      integer gentbl
+      integer errtbl
+      integer xpptbl
+      common /erchek/ ername, body, esp, errstk(30)
+      integer ername
+      integer body
+      integer esp
+      integer errstk
+      integer mem( 60000)
+      common/cdsmem/mem
+      t = gnbtok (token, 100)
+      if (.not.(t .ne. 48))goto 23000
+      call synerr (23HInvalid label for goto.)
+      goto 23001
+23000 continue
+      call outtab
+      i = 1
+      call ogotos (ctoi(token,i), 0)
+23001 continue
+      xfer = 1
+      t=gnbtok(token,100)
+23002 if (.not.(t .eq. 10))goto 23004
+23003 t=gnbtok(token,100)
+      goto 23002
+23004 continue
+      call pbstr (token)
+      end
+c     logic0  logical_column
diff --git a/unix/boot/spp/rpp/rppfor/gtok.f b/unix/boot/spp/rpp/rppfor/gtok.f
new file mode 100644
index 00000000..5b021e8b
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/gtok.f
@@ -0,0 +1,213 @@
+      integer function gtok (lexstr, toksiz)
+      integer lexstr (100)
+      integer toksiz
+      common /cdefio/ bp, buf (4096)
+      integer bp
+      integer buf
+      common /cfname/ fcname (30)
+      integer fcname
+      common /cfor/ fordep, forstk (200)
+      integer fordep
+      integer forstk
+      common /cgoto/ xfer
+      integer xfer
+      common /clabel/ label, retlab, memflg, col, logic0
+      integer label
+      integer retlab
+      integer memflg
+      integer col
+      integer logic0
+      common /cline/ dbgout, dbglev, level, linect (5), infile (5), fnam
+     *p, fnames ( 150)
+      integer dbgout
+      integer dbglev
+      integer level
+      integer linect
+      integer infile
+      integer fnamp
+      integer fnames
+      common /cmacro/ cp, ep, evalst (500), deftbl
+      integer cp
+      integer ep
+      integer evalst
+      integer deftbl
+      common /coutln/ outp, outbuf (74)
+      integer outp
+      integer outbuf
+      common /csbuf/ sbp, sbuf(2048), smem(240)
+      integer sbp
+      integer sbuf
+      integer smem
+      common /cswtch/ swtop, swlast, swstak(1000), swvnum, swvlev, swvst
+     *k(10), swinrg
+      integer swtop
+      integer swlast
+      integer swstak
+      integer swvnum
+      integer swvlev
+      integer swvstk
+      integer swinrg
+      common /ckword/ rkwtbl
+      integer rkwtbl
+      common /clname/ fkwtbl, namtbl, gentbl, errtbl, xpptbl
+      integer fkwtbl
+      integer namtbl
+      integer gentbl
+      integer errtbl
+      integer xpptbl
+      common /erchek/ ername, body, esp, errstk(30)
+      integer ername
+      integer body
+      integer esp
+      integer errstk
+      integer mem( 60000)
+      common/cdsmem/mem
+      integer c
+      integer ngetch
+      integer i
+      c = ngetch (lexstr (1))
+      if (.not.(c .eq. 32 .or. c .eq. 9))goto 23000
+      lexstr (1) = 32
+23002 if (.not.(c .eq. 32 .or. c .eq. 9))goto 23003
+      c = ngetch (c)
+      goto 23002
+23003 continue
+      if (.not.(c .eq. 35))goto 23004
+23006 if (.not.(ngetch (c) .ne. 10))goto 23007
+      goto 23006
+23007 continue
+23004 continue
+      if (.not.(c .ne. 10))goto 23008
+      call putbak (c)
+      goto 23009
+23008 continue
+      lexstr (1) = 10
+23009 continue
+      lexstr (2) = -2
+      gtok = lexstr (1)
+      return
+23000 continue
+      i = 1
+      if (.not.(((65.le.c.and.c.le.90).or.(97.le.c.and.c.le.122))))goto 
+     *23010
+      gtok = -9
+      if (.not.(c .eq. 120))goto 23012
+      c = ngetch (lexstr(2))
+      if (.not.(c .eq. 36))goto 23014
+      gtok =  -166
+      i = 2
+      goto 23015
+23014 continue
+      call putbak (c)
+23015 continue
+23012 continue
+23016 if (.not.(i .lt. toksiz - 2))goto 23018
+      c = ngetch (lexstr(i+1))
+      if (.not.(.not.((65.le.c.and.c.le.90).or.(97.le.c.and.c.le.122)) .
+     *and. .not.(48.le.c.and.c.le.57) .and. c .ne. 95))goto 23019
+      goto 23018
+23019 continue
+23017 i=i+1
+      goto 23016
+23018 continue
+      call putbak (c)
+      goto 23011
+23010 continue
+      if (.not.((48.le.c.and.c.le.57)))goto 23021
+      i=1
+23023 if (.not.(i .lt. toksiz - 2))goto 23025
+      c = ngetch (lexstr (i + 1))
+      if (.not.(.not.(48.le.c.and.c.le.57)))goto 23026
+      goto 23025
+23026 continue
+23024 i=i+1
+      goto 23023
+23025 continue
+      call putbak (c)
+      gtok = 48
+      goto 23022
+23021 continue
+      if (.not.(c .eq. 91))goto 23028
+      lexstr (1) = 123
+      gtok = 123
+      goto 23029
+23028 continue
+      if (.not.(c .eq. 93))goto 23030
+      lexstr (1) = 125
+      gtok = 125
+      goto 23031
+23030 continue
+      if (.not.(c .eq. 36))goto 23032
+      if (.not.(ngetch (lexstr (2)) .eq. 40))goto 23034
+      i = 2
+      gtok = -69
+      goto 23035
+23034 continue
+      if (.not.(lexstr (2) .eq. 41))goto 23036
+      i = 2
+      gtok = -68
+      goto 23037
+23036 continue
+      call putbak (lexstr (2))
+      gtok = 36
+23037 continue
+23035 continue
+      goto 23033
+23032 continue
+      if (.not.(c .eq. 39 .or. c .eq. 34))goto 23038
+      gtok = c
+      i = 2
+23040 if (.not.(ngetch (lexstr (i)) .ne. lexstr (1)))goto 23042
+      if (.not.(lexstr (i) .eq. 95))goto 23043
+      if (.not.(ngetch (c) .eq. 10))goto 23045
+23047 if (.not.(c .eq. 10 .or. c .eq. 32 .or. c .eq. 9))goto 23048
+      c = ngetch (c)
+      goto 23047
+23048 continue
+      lexstr (i) = c
+      goto 23046
+23045 continue
+      call putbak (c)
+23046 continue
+23043 continue
+      if (.not.(lexstr (i) .eq. 10 .or. i .ge. toksiz - 1))goto 23049
+      call synerr (14Hmissing quote.)
+      lexstr (i) = lexstr (1)
+      call putbak (10)
+      goto 23042
+23049 continue
+23041 i = i + 1
+      goto 23040
+23042 continue
+      goto 23039
+23038 continue
+      if (.not.(c .eq. 35))goto 23051
+23053 if (.not.(ngetch (lexstr (1)) .ne. 10))goto 23054
+      goto 23053
+23054 continue
+      gtok = 10
+      goto 23052
+23051 continue
+      if (.not.(c .eq. 62 .or. c .eq. 60 .or. c .eq. 126 .or. c .eq. 33 
+     *.or. c .eq. 126 .or. c .eq. 94 .or. c .eq. 61 .or. c .eq. 38 .or. 
+     *c .eq. 124))goto 23055
+      call relate (lexstr, i)
+      gtok = c
+      goto 23056
+23055 continue
+      gtok = c
+23056 continue
+23052 continue
+23039 continue
+23033 continue
+23031 continue
+23029 continue
+23022 continue
+23011 continue
+      if (.not.(i .ge. toksiz - 1))goto 23057
+      call synerr (15Htoken too long.)
+23057 continue
+      lexstr (i + 1) = -2
+      return
+      end
+c     logic0  logical_column
diff --git a/unix/boot/spp/rpp/rppfor/ifcode.f b/unix/boot/spp/rpp/rppfor/ifcode.f
new file mode 100644
index 00000000..8fbf5763
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/ifcode.f
@@ -0,0 +1,71 @@
+      subroutine ifcode (lab)
+      integer lab
+      common /cdefio/ bp, buf (4096)
+      integer bp
+      integer buf
+      common /cfname/ fcname (30)
+      integer fcname
+      common /cfor/ fordep, forstk (200)
+      integer fordep
+      integer forstk
+      common /cgoto/ xfer
+      integer xfer
+      common /clabel/ label, retlab, memflg, col, logic0
+      integer label
+      integer retlab
+      integer memflg
+      integer col
+      integer logic0
+      common /cline/ dbgout, dbglev, level, linect (5), infile (5), fnam
+     *p, fnames ( 150)
+      integer dbgout
+      integer dbglev
+      integer level
+      integer linect
+      integer infile
+      integer fnamp
+      integer fnames
+      common /cmacro/ cp, ep, evalst (500), deftbl
+      integer cp
+      integer ep
+      integer evalst
+      integer deftbl
+      common /coutln/ outp, outbuf (74)
+      integer outp
+      integer outbuf
+      common /csbuf/ sbp, sbuf(2048), smem(240)
+      integer sbp
+      integer sbuf
+      integer smem
+      common /cswtch/ swtop, swlast, swstak(1000), swvnum, swvlev, swvst
+     *k(10), swinrg
+      integer swtop
+      integer swlast
+      integer swstak
+      integer swvnum
+      integer swvlev
+      integer swvstk
+      integer swinrg
+      common /ckword/ rkwtbl
+      integer rkwtbl
+      common /clname/ fkwtbl, namtbl, gentbl, errtbl, xpptbl
+      integer fkwtbl
+      integer namtbl
+      integer gentbl
+      integer errtbl
+      integer xpptbl
+      common /erchek/ ername, body, esp, errstk(30)
+      integer ername
+      integer body
+      integer esp
+      integer errstk
+      integer mem( 60000)
+      common/cdsmem/mem
+      integer labgen
+      xfer = 0
+      lab = labgen (2)
+      call ifgo (lab)
+      call indent (1)
+      return
+      end
+c     logic0  logical_column
diff --git a/unix/boot/spp/rpp/rppfor/iferrc.f b/unix/boot/spp/rpp/rppfor/iferrc.f
new file mode 100644
index 00000000..f7abae81
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/iferrc.f
@@ -0,0 +1,168 @@
+      subroutine iferrc (lab, sense)
+      integer lab, sense
+      integer labgen, nlpar
+      integer t, gettok, gnbtok, token(100)
+      common /cdefio/ bp, buf (4096)
+      integer bp
+      integer buf
+      common /cfname/ fcname (30)
+      integer fcname
+      common /cfor/ fordep, forstk (200)
+      integer fordep
+      integer forstk
+      common /cgoto/ xfer
+      integer xfer
+      common /clabel/ label, retlab, memflg, col, logic0
+      integer label
+      integer retlab
+      integer memflg
+      integer col
+      integer logic0
+      common /cline/ dbgout, dbglev, level, linect (5), infile (5), fnam
+     *p, fnames ( 150)
+      integer dbgout
+      integer dbglev
+      integer level
+      integer linect
+      integer infile
+      integer fnamp
+      integer fnames
+      common /cmacro/ cp, ep, evalst (500), deftbl
+      integer cp
+      integer ep
+      integer evalst
+      integer deftbl
+      common /coutln/ outp, outbuf (74)
+      integer outp
+      integer outbuf
+      common /csbuf/ sbp, sbuf(2048), smem(240)
+      integer sbp
+      integer sbuf
+      integer smem
+      common /cswtch/ swtop, swlast, swstak(1000), swvnum, swvlev, swvst
+     *k(10), swinrg
+      integer swtop
+      integer swlast
+      integer swstak
+      integer swvnum
+      integer swvlev
+      integer swvstk
+      integer swinrg
+      common /ckword/ rkwtbl
+      integer rkwtbl
+      common /clname/ fkwtbl, namtbl, gentbl, errtbl, xpptbl
+      integer fkwtbl
+      integer namtbl
+      integer gentbl
+      integer errtbl
+      integer xpptbl
+      common /erchek/ ername, body, esp, errstk(30)
+      integer ername
+      integer body
+      integer esp
+      integer errstk
+      integer mem( 60000)
+      common/cdsmem/mem
+      integer errpsh(12)
+      integer siferr(20)
+      integer sifno0(15)
+      data errpsh(1)/99/,errpsh(2)/97/,errpsh(3)/108/,errpsh(4)/108/,err
+     *psh(5)/32/,errpsh(6)/120/,errpsh(7)/101/,errpsh(8)/114/,errpsh(9)/
+     *112/,errpsh(10)/115/,errpsh(11)/104/,errpsh(12)/-2/
+      data siferr(1)/105/,siferr(2)/102/,siferr(3)/32/,siferr(4)/40/,sif
+     *err(5)/46/,siferr(6)/110/,siferr(7)/111/,siferr(8)/116/,siferr(9)/
+     *46/,siferr(10)/120/,siferr(11)/101/,siferr(12)/114/,siferr(13)/112
+     */,siferr(14)/111/,siferr(15)/112/,siferr(16)/40/,siferr(17)/41/,si
+     *ferr(18)/41/,siferr(19)/32/,siferr(20)/-2/
+      data sifno0(1)/105/,sifno0(2)/102/,sifno0(3)/32/,sifno0(4)/40/,sif
+     *no0(5)/120/,sifno0(6)/101/,sifno0(7)/114/,sifno0(8)/112/,sifno0(9)
+     */111/,sifno0(10)/112/,sifno0(11)/40/,sifno0(12)/41/,sifno0(13)/41/
+     *,sifno0(14)/32/,sifno0(15)/-2/
+      xfer = 0
+      lab = labgen (3)
+      call outtab
+      call outstr (errpsh)
+      call outdon
+      I23000=(gnbtok (token, 100))
+      goto 23000
+23002 continue
+      call outtab
+      goto 23001
+23003 continue
+      call pbstr (token)
+      esp = esp + 1
+      if (.not.(esp .ge. 30))goto 23004
+      call baderr (35HIferr statements nested too deeply.)
+23004 continue
+      errstk(esp) = lab
+      return
+23006 continue
+      call synerr (19HMissing left paren.)
+      return
+23000 continue
+      if (I23000.eq.40)goto 23002
+      if (I23000.eq.123)goto 23003
+      goto 23006
+23001 continue
+      nlpar = 1
+      token(1) = -2
+      esp = esp + 1
+      if (.not.(esp .ge. 30))goto 23007
+      call baderr (35HIferr statements nested too deeply.)
+23007 continue
+      errstk(esp) = 0
+23009 continue
+      call outstr (token)
+      t = gettok (token, 100)
+      if (.not.(t .eq. 59 .or. t .eq. 123 .or. t .eq. 125 .or. t .eq. -1
+     *))goto 23012
+      call pbstr (token)
+      goto 23011
+23012 continue
+      if (.not.(t .eq. 10))goto 23014
+      token (1) = -2
+      goto 23015
+23014 continue
+      if (.not.(t .eq. 40))goto 23016
+      nlpar = nlpar + 1
+      goto 23017
+23016 continue
+      if (.not.(t .eq. 41))goto 23018
+      nlpar = nlpar - 1
+      goto 23019
+23018 continue
+      if (.not.(t .eq. 59))goto 23020
+      call outdon
+      call outtab
+      goto 23021
+23020 continue
+      if (.not.(t .eq. -9))goto 23022
+      call squash (token)
+23022 continue
+23021 continue
+23019 continue
+23017 continue
+23015 continue
+23010 if (.not.(nlpar .le. 0))goto 23009
+23011 continue
+      esp = esp - 1
+      ername = 0
+      if (.not.(nlpar .ne. 0))goto 23024
+      call synerr (33HMissing parenthesis in condition.)
+      goto 23025
+23024 continue
+      call outdon
+23025 continue
+      call outtab
+      if (.not.(sense .eq. 1))goto 23026
+      call outstr (siferr)
+      goto 23027
+23026 continue
+      call outstr (sifno0)
+23027 continue
+      call outgo (lab)
+      call indent (1)
+      return
+      end
+c     sifno0  sifnoerr
+c     logic0  logical_column
diff --git a/unix/boot/spp/rpp/rppfor/ifgo.f b/unix/boot/spp/rpp/rppfor/ifgo.f
new file mode 100644
index 00000000..5f2bb654
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/ifgo.f
@@ -0,0 +1,88 @@
+      subroutine ifgo (lab)
+      integer lab
+      common /cdefio/ bp, buf (4096)
+      integer bp
+      integer buf
+      common /cfname/ fcname (30)
+      integer fcname
+      common /cfor/ fordep, forstk (200)
+      integer fordep
+      integer forstk
+      common /cgoto/ xfer
+      integer xfer
+      common /clabel/ label, retlab, memflg, col, logic0
+      integer label
+      integer retlab
+      integer memflg
+      integer col
+      integer logic0
+      common /cline/ dbgout, dbglev, level, linect (5), infile (5), fnam
+     *p, fnames ( 150)
+      integer dbgout
+      integer dbglev
+      integer level
+      integer linect
+      integer infile
+      integer fnamp
+      integer fnames
+      common /cmacro/ cp, ep, evalst (500), deftbl
+      integer cp
+      integer ep
+      integer evalst
+      integer deftbl
+      common /coutln/ outp, outbuf (74)
+      integer outp
+      integer outbuf
+      common /csbuf/ sbp, sbuf(2048), smem(240)
+      integer sbp
+      integer sbuf
+      integer smem
+      common /cswtch/ swtop, swlast, swstak(1000), swvnum, swvlev, swvst
+     *k(10), swinrg
+      integer swtop
+      integer swlast
+      integer swstak
+      integer swvnum
+      integer swvlev
+      integer swvstk
+      integer swinrg
+      common /ckword/ rkwtbl
+      integer rkwtbl
+      common /clname/ fkwtbl, namtbl, gentbl, errtbl, xpptbl
+      integer fkwtbl
+      integer namtbl
+      integer gentbl
+      integer errtbl
+      integer xpptbl
+      common /erchek/ ername, body, esp, errstk(30)
+      integer ername
+      integer body
+      integer esp
+      integer errstk
+      integer mem( 60000)
+      common/cdsmem/mem
+      integer ifnot(10)
+      integer serrc0(21)
+      data ifnot(1)/105/,ifnot(2)/102/,ifnot(3)/32/,ifnot(4)/40/,ifnot(5
+     *)/46/,ifnot(6)/110/,ifnot(7)/111/,ifnot(8)/116/,ifnot(9)/46/,ifnot
+     *(10)/-2/
+      data serrc0(1)/46/,serrc0(2)/97/,serrc0(3)/110/,serrc0(4)/100/,ser
+     *rc0(5)/46/,serrc0(6)/40/,serrc0(7)/46/,serrc0(8)/110/,serrc0(9)/11
+     *1/,serrc0(10)/116/,serrc0(11)/46/,serrc0(12)/120/,serrc0(13)/101/,
+     *serrc0(14)/114/,serrc0(15)/102/,serrc0(16)/108/,serrc0(17)/103/,se
+     *rrc0(18)/41/,serrc0(19)/41/,serrc0(20)/32/,serrc0(21)/-2/
+      call outtab
+      call outstr (ifnot)
+      call balpar
+      if (.not.(ername .eq. 1))goto 23000
+      call outstr (serrc0)
+      goto 23001
+23000 continue
+      call outch (41)
+      call outch (32)
+23001 continue
+      call outgo (lab)
+      call errgo
+      end
+c     logic0  logical_column
+c     serrc0  serrchk
diff --git a/unix/boot/spp/rpp/rppfor/ifparm.f b/unix/boot/spp/rpp/rppfor/ifparm.f
new file mode 100644
index 00000000..4334a444
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/ifparm.f
@@ -0,0 +1,26 @@
+      integer function ifparm (strng)
+      integer strng (100)
+      integer c
+      external index
+      integer i, index, type
+      c = strng (1)
+      if (.not.(c .eq. -12 .or. c .eq. -13 .or. c .eq. -11 .or. c .eq. -
+     *14 .or. c .eq. -10))goto 23000
+      ifparm = 1
+      goto 23001
+23000 continue
+      ifparm = 0
+      i = 1
+23002 if (.not.(index (strng (i), 36) .gt. 0))goto 23004
+      i = i + index (strng (i), 36)
+      if (.not.(type (strng (i)) .eq. 48))goto 23005
+      if (.not.(type (strng (i + 1)) .ne. 48))goto 23007
+      ifparm = 1
+      goto 23004
+23007 continue
+23005 continue
+23003 goto 23002
+23004 continue
+23001 continue
+      return
+      end
diff --git a/unix/boot/spp/rpp/rppfor/indent.f b/unix/boot/spp/rpp/rppfor/indent.f
new file mode 100644
index 00000000..40b99b9f
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/indent.f
@@ -0,0 +1,68 @@
+      subroutine indent (nleve0)
+      integer nleve0
+      common /cdefio/ bp, buf (4096)
+      integer bp
+      integer buf
+      common /cfname/ fcname (30)
+      integer fcname
+      common /cfor/ fordep, forstk (200)
+      integer fordep
+      integer forstk
+      common /cgoto/ xfer
+      integer xfer
+      common /clabel/ label, retlab, memflg, col, logic0
+      integer label
+      integer retlab
+      integer memflg
+      integer col
+      integer logic0
+      common /cline/ dbgout, dbglev, level, linect (5), infile (5), fnam
+     *p, fnames ( 150)
+      integer dbgout
+      integer dbglev
+      integer level
+      integer linect
+      integer infile
+      integer fnamp
+      integer fnames
+      common /cmacro/ cp, ep, evalst (500), deftbl
+      integer cp
+      integer ep
+      integer evalst
+      integer deftbl
+      common /coutln/ outp, outbuf (74)
+      integer outp
+      integer outbuf
+      common /csbuf/ sbp, sbuf(2048), smem(240)
+      integer sbp
+      integer sbuf
+      integer smem
+      common /cswtch/ swtop, swlast, swstak(1000), swvnum, swvlev, swvst
+     *k(10), swinrg
+      integer swtop
+      integer swlast
+      integer swstak
+      integer swvnum
+      integer swvlev
+      integer swvstk
+      integer swinrg
+      common /ckword/ rkwtbl
+      integer rkwtbl
+      common /clname/ fkwtbl, namtbl, gentbl, errtbl, xpptbl
+      integer fkwtbl
+      integer namtbl
+      integer gentbl
+      integer errtbl
+      integer xpptbl
+      common /erchek/ ername, body, esp, errstk(30)
+      integer ername
+      integer body
+      integer esp
+      integer errstk
+      integer mem( 60000)
+      common/cdsmem/mem
+      logic0 = logic0 + (nleve0 * 3)
+      col = max0(6, min0(30, logic0))
+      end
+c     logic0  logical_column
+c     nleve0  nlevels
diff --git a/unix/boot/spp/rpp/rppfor/initkw.f b/unix/boot/spp/rpp/rppfor/initkw.f
new file mode 100644
index 00000000..c5acfec0
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/initkw.f
@@ -0,0 +1,86 @@
+      subroutine initkw
+      common /cdefio/ bp, buf (4096)
+      integer bp
+      integer buf
+      common /cfname/ fcname (30)
+      integer fcname
+      common /cfor/ fordep, forstk (200)
+      integer fordep
+      integer forstk
+      common /cgoto/ xfer
+      integer xfer
+      common /clabel/ label, retlab, memflg, col, logic0
+      integer label
+      integer retlab
+      integer memflg
+      integer col
+      integer logic0
+      common /cline/ dbgout, dbglev, level, linect (5), infile (5), fnam
+     *p, fnames ( 150)
+      integer dbgout
+      integer dbglev
+      integer level
+      integer linect
+      integer infile
+      integer fnamp
+      integer fnames
+      common /cmacro/ cp, ep, evalst (500), deftbl
+      integer cp
+      integer ep
+      integer evalst
+      integer deftbl
+      common /coutln/ outp, outbuf (74)
+      integer outp
+      integer outbuf
+      common /csbuf/ sbp, sbuf(2048), smem(240)
+      integer sbp
+      integer sbuf
+      integer smem
+      common /cswtch/ swtop, swlast, swstak(1000), swvnum, swvlev, swvst
+     *k(10), swinrg
+      integer swtop
+      integer swlast
+      integer swstak
+      integer swvnum
+      integer swvlev
+      integer swvstk
+      integer swinrg
+      common /ckword/ rkwtbl
+      integer rkwtbl
+      common /clname/ fkwtbl, namtbl, gentbl, errtbl, xpptbl
+      integer fkwtbl
+      integer namtbl
+      integer gentbl
+      integer errtbl
+      integer xpptbl
+      common /erchek/ ername, body, esp, errstk(30)
+      integer ername
+      integer body
+      integer esp
+      integer errstk
+      integer mem( 60000)
+      common/cdsmem/mem
+      integer mktabl
+      call dsinit (60000)
+      deftbl = mktabl (1)
+      call entdkw
+      rkwtbl = mktabl (1)
+      call entrkw
+      fkwtbl = mktabl (0)
+      call entfkw
+      namtbl = mktabl (1)
+      xpptbl = mktabl (1)
+      call entxkw
+      gentbl = mktabl (0)
+      errtbl = 0
+      label = 100
+      smem(1) = -2
+      body = 0
+      dbgout = 0
+      dbglev = 0
+      memflg = 0
+      swinrg = 0
+      col = 6
+      return
+      end
+c     logic0  logical_column
diff --git a/unix/boot/spp/rpp/rppfor/labelc.f b/unix/boot/spp/rpp/rppfor/labelc.f
new file mode 100644
index 00000000..24d88008
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/labelc.f
@@ -0,0 +1,75 @@
+      subroutine labelc (lexstr)
+      integer lexstr (100)
+      common /cdefio/ bp, buf (4096)
+      integer bp
+      integer buf
+      common /cfname/ fcname (30)
+      integer fcname
+      common /cfor/ fordep, forstk (200)
+      integer fordep
+      integer forstk
+      common /cgoto/ xfer
+      integer xfer
+      common /clabel/ label, retlab, memflg, col, logic0
+      integer label
+      integer retlab
+      integer memflg
+      integer col
+      integer logic0
+      common /cline/ dbgout, dbglev, level, linect (5), infile (5), fnam
+     *p, fnames ( 150)
+      integer dbgout
+      integer dbglev
+      integer level
+      integer linect
+      integer infile
+      integer fnamp
+      integer fnames
+      common /cmacro/ cp, ep, evalst (500), deftbl
+      integer cp
+      integer ep
+      integer evalst
+      integer deftbl
+      common /coutln/ outp, outbuf (74)
+      integer outp
+      integer outbuf
+      common /csbuf/ sbp, sbuf(2048), smem(240)
+      integer sbp
+      integer sbuf
+      integer smem
+      common /cswtch/ swtop, swlast, swstak(1000), swvnum, swvlev, swvst
+     *k(10), swinrg
+      integer swtop
+      integer swlast
+      integer swstak
+      integer swvnum
+      integer swvlev
+      integer swvstk
+      integer swinrg
+      common /ckword/ rkwtbl
+      integer rkwtbl
+      common /clname/ fkwtbl, namtbl, gentbl, errtbl, xpptbl
+      integer fkwtbl
+      integer namtbl
+      integer gentbl
+      integer errtbl
+      integer xpptbl
+      common /erchek/ ername, body, esp, errstk(30)
+      integer ername
+      integer body
+      integer esp
+      integer errstk
+      integer mem( 60000)
+      common/cdsmem/mem
+      integer length, l
+      xfer = 0
+      l = length (lexstr)
+      if (.not.(l .ge. 3 .and. l .lt. 4))goto 23000
+      call synerr (53HWarning: statement labels 100 and above are reserv
+     *ed.)
+23000 continue
+      call outstr (lexstr)
+      call outtab
+      return
+      end
+c     logic0  logical_column
diff --git a/unix/boot/spp/rpp/rppfor/labgen.f b/unix/boot/spp/rpp/rppfor/labgen.f
new file mode 100644
index 00000000..ab7538f4
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/labgen.f
@@ -0,0 +1,68 @@
+      integer function labgen (n)
+      integer n
+      common /cdefio/ bp, buf (4096)
+      integer bp
+      integer buf
+      common /cfname/ fcname (30)
+      integer fcname
+      common /cfor/ fordep, forstk (200)
+      integer fordep
+      integer forstk
+      common /cgoto/ xfer
+      integer xfer
+      common /clabel/ label, retlab, memflg, col, logic0
+      integer label
+      integer retlab
+      integer memflg
+      integer col
+      integer logic0
+      common /cline/ dbgout, dbglev, level, linect (5), infile (5), fnam
+     *p, fnames ( 150)
+      integer dbgout
+      integer dbglev
+      integer level
+      integer linect
+      integer infile
+      integer fnamp
+      integer fnames
+      common /cmacro/ cp, ep, evalst (500), deftbl
+      integer cp
+      integer ep
+      integer evalst
+      integer deftbl
+      common /coutln/ outp, outbuf (74)
+      integer outp
+      integer outbuf
+      common /csbuf/ sbp, sbuf(2048), smem(240)
+      integer sbp
+      integer sbuf
+      integer smem
+      common /cswtch/ swtop, swlast, swstak(1000), swvnum, swvlev, swvst
+     *k(10), swinrg
+      integer swtop
+      integer swlast
+      integer swstak
+      integer swvnum
+      integer swvlev
+      integer swvstk
+      integer swinrg
+      common /ckword/ rkwtbl
+      integer rkwtbl
+      common /clname/ fkwtbl, namtbl, gentbl, errtbl, xpptbl
+      integer fkwtbl
+      integer namtbl
+      integer gentbl
+      integer errtbl
+      integer xpptbl
+      common /erchek/ ername, body, esp, errstk(30)
+      integer ername
+      integer body
+      integer esp
+      integer errstk
+      integer mem( 60000)
+      common/cdsmem/mem
+      labgen = label
+      label = label + (n / 10 + 1) * 10
+      return
+      end
+c     logic0  logical_column
diff --git a/unix/boot/spp/rpp/rppfor/lex.f b/unix/boot/spp/rpp/rppfor/lex.f
new file mode 100644
index 00000000..6f2243f4
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/lex.f
@@ -0,0 +1,119 @@
+      integer function lex (lexstr)
+      integer lexstr (100)
+      common /cdefio/ bp, buf (4096)
+      integer bp
+      integer buf
+      common /cfname/ fcname (30)
+      integer fcname
+      common /cfor/ fordep, forstk (200)
+      integer fordep
+      integer forstk
+      common /cgoto/ xfer
+      integer xfer
+      common /clabel/ label, retlab, memflg, col, logic0
+      integer label
+      integer retlab
+      integer memflg
+      integer col
+      integer logic0
+      common /cline/ dbgout, dbglev, level, linect (5), infile (5), fnam
+     *p, fnames ( 150)
+      integer dbgout
+      integer dbglev
+      integer level
+      integer linect
+      integer infile
+      integer fnamp
+      integer fnames
+      common /cmacro/ cp, ep, evalst (500), deftbl
+      integer cp
+      integer ep
+      integer evalst
+      integer deftbl
+      common /coutln/ outp, outbuf (74)
+      integer outp
+      integer outbuf
+      common /csbuf/ sbp, sbuf(2048), smem(240)
+      integer sbp
+      integer sbuf
+      integer smem
+      common /cswtch/ swtop, swlast, swstak(1000), swvnum, swvlev, swvst
+     *k(10), swinrg
+      integer swtop
+      integer swlast
+      integer swstak
+      integer swvnum
+      integer swvlev
+      integer swvstk
+      integer swinrg
+      common /ckword/ rkwtbl
+      integer rkwtbl
+      common /clname/ fkwtbl, namtbl, gentbl, errtbl, xpptbl
+      integer fkwtbl
+      integer namtbl
+      integer gentbl
+      integer errtbl
+      integer xpptbl
+      common /erchek/ ername, body, esp, errstk(30)
+      integer ername
+      integer body
+      integer esp
+      integer errstk
+      integer mem( 60000)
+      common/cdsmem/mem
+      integer gnbtok, t, c
+      integer lookup, n
+      integer sdefa0(8)
+      data sdefa0(1)/100/,sdefa0(2)/101/,sdefa0(3)/102/,sdefa0(4)/97/,sd
+     *efa0(5)/117/,sdefa0(6)/108/,sdefa0(7)/116/,sdefa0(8)/-2/
+      lex = gnbtok (lexstr, 100)
+23000 if (.not.(lex .eq. 10))goto 23002
+23001  lex = gnbtok (lexstr, 100)
+      goto 23000
+23002 continue
+      if (.not.(lex .eq. -1 .or. lex .eq. 59 .or. lex .eq. 123 .or. lex 
+     *.eq. 125))goto 23003
+      return
+23003 continue
+      if (.not.(lex .eq. 48))goto 23005
+      lex = -89
+      goto 23006
+23005 continue
+      if (.not.(lex .eq. 37))goto 23007
+      lex = -85
+      goto 23008
+23007 continue
+      if (.not.(lex .eq.  -166))goto 23009
+      lex = -67
+      goto 23010
+23009 continue
+      if (.not.(lookup (lexstr, lex, rkwtbl) .eq. 1))goto 23011
+      if (.not.(lex .eq. -90))goto 23013
+      n = -1
+23015 continue
+      c = ngetch (c)
+      n = n + 1
+23016 if (.not.(c .ne. 32 .and. c .ne. 9))goto 23015
+23017 continue
+      call putbak (c)
+      t = gnbtok (lexstr, 100)
+      call pbstr (lexstr)
+      if (.not.(n .gt. 0))goto 23018
+      call putbak (32)
+23018 continue
+      call scopy (sdefa0, 1, lexstr, 1)
+      if (.not.(t .ne. 58))goto 23020
+      lex = -80
+23020 continue
+23013 continue
+      goto 23012
+23011 continue
+      lex = -80
+23012 continue
+23010 continue
+23008 continue
+23006 continue
+      return
+      end
+c     logic0  logical_column
+c     sdefa0  sdefault
diff --git a/unix/boot/spp/rpp/rppfor/litral.f b/unix/boot/spp/rpp/rppfor/litral.f
new file mode 100644
index 00000000..25bb6d3f
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/litral.f
@@ -0,0 +1,76 @@
+      subroutine litral
+      common /cdefio/ bp, buf (4096)
+      integer bp
+      integer buf
+      common /cfname/ fcname (30)
+      integer fcname
+      common /cfor/ fordep, forstk (200)
+      integer fordep
+      integer forstk
+      common /cgoto/ xfer
+      integer xfer
+      common /clabel/ label, retlab, memflg, col, logic0
+      integer label
+      integer retlab
+      integer memflg
+      integer col
+      integer logic0
+      common /cline/ dbgout, dbglev, level, linect (5), infile (5), fnam
+     *p, fnames ( 150)
+      integer dbgout
+      integer dbglev
+      integer level
+      integer linect
+      integer infile
+      integer fnamp
+      integer fnames
+      common /cmacro/ cp, ep, evalst (500), deftbl
+      integer cp
+      integer ep
+      integer evalst
+      integer deftbl
+      common /coutln/ outp, outbuf (74)
+      integer outp
+      integer outbuf
+      common /csbuf/ sbp, sbuf(2048), smem(240)
+      integer sbp
+      integer sbuf
+      integer smem
+      common /cswtch/ swtop, swlast, swstak(1000), swvnum, swvlev, swvst
+     *k(10), swinrg
+      integer swtop
+      integer swlast
+      integer swstak
+      integer swvnum
+      integer swvlev
+      integer swvstk
+      integer swinrg
+      common /ckword/ rkwtbl
+      integer rkwtbl
+      common /clname/ fkwtbl, namtbl, gentbl, errtbl, xpptbl
+      integer fkwtbl
+      integer namtbl
+      integer gentbl
+      integer errtbl
+      integer xpptbl
+      common /erchek/ ername, body, esp, errstk(30)
+      integer ername
+      integer body
+      integer esp
+      integer errstk
+      integer mem( 60000)
+      common/cdsmem/mem
+      integer ngetch
+      if (.not.(outp .gt. 0))goto 23000
+      call outdwe
+23000 continue
+      outp = 1
+23002 if (.not.(ngetch (outbuf (outp)) .ne. 10))goto 23004
+23003 outp = outp + 1
+      goto 23002
+23004 continue
+      outp = outp - 1
+      call outdwe
+      return
+      end
+c     logic0  logical_column
diff --git a/unix/boot/spp/rpp/rppfor/lndict.f b/unix/boot/spp/rpp/rppfor/lndict.f
new file mode 100644
index 00000000..c2c4c1c3
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/lndict.f
@@ -0,0 +1,86 @@
+      subroutine lndict
+      integer sym (100), c
+      integer sctabl, length
+      integer posn, locn
+      common /cdefio/ bp, buf (4096)
+      integer bp
+      integer buf
+      common /cfname/ fcname (30)
+      integer fcname
+      common /cfor/ fordep, forstk (200)
+      integer fordep
+      integer forstk
+      common /cgoto/ xfer
+      integer xfer
+      common /clabel/ label, retlab, memflg, col, logic0
+      integer label
+      integer retlab
+      integer memflg
+      integer col
+      integer logic0
+      common /cline/ dbgout, dbglev, level, linect (5), infile (5), fnam
+     *p, fnames ( 150)
+      integer dbgout
+      integer dbglev
+      integer level
+      integer linect
+      integer infile
+      integer fnamp
+      integer fnames
+      common /cmacro/ cp, ep, evalst (500), deftbl
+      integer cp
+      integer ep
+      integer evalst
+      integer deftbl
+      common /coutln/ outp, outbuf (74)
+      integer outp
+      integer outbuf
+      common /csbuf/ sbp, sbuf(2048), smem(240)
+      integer sbp
+      integer sbuf
+      integer smem
+      common /cswtch/ swtop, swlast, swstak(1000), swvnum, swvlev, swvst
+     *k(10), swinrg
+      integer swtop
+      integer swlast
+      integer swstak
+      integer swvnum
+      integer swvlev
+      integer swvstk
+      integer swinrg
+      common /ckword/ rkwtbl
+      integer rkwtbl
+      common /clname/ fkwtbl, namtbl, gentbl, errtbl, xpptbl
+      integer fkwtbl
+      integer namtbl
+      integer gentbl
+      integer errtbl
+      integer xpptbl
+      common /erchek/ ername, body, esp, errstk(30)
+      integer ername
+      integer body
+      integer esp
+      integer errstk
+      integer mem( 60000)
+      common/cdsmem/mem
+      posn = 0
+23000 if (.not.(sctabl (namtbl, sym, locn, posn) .ne. -1))goto 23001
+      if (.not.(length(sym) .gt. 6))goto 23002
+       call outch (99)
+      call outtab
+23004 if (.not.(mem (locn) .ne. -2))goto 23006
+      c = mem (locn)
+      call outch (c)
+23005 locn = locn + 1
+      goto 23004
+23006 continue
+      call outch (32)
+      call outch (32)
+      call outstr (sym)
+      call outdon
+23002 continue
+      goto 23000
+23001 continue
+      return
+      end
+c     logic0  logical_column
diff --git a/unix/boot/spp/rpp/rppfor/ludef.f b/unix/boot/spp/rpp/rppfor/ludef.f
new file mode 100644
index 00000000..3db6c8fe
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/ludef.f
@@ -0,0 +1,84 @@
+      integer function ludef (id, defn, table)
+      integer id (100), defn (100)
+      integer table
+      common /cdefio/ bp, buf (4096)
+      integer bp
+      integer buf
+      common /cfname/ fcname (30)
+      integer fcname
+      common /cfor/ fordep, forstk (200)
+      integer fordep
+      integer forstk
+      common /cgoto/ xfer
+      integer xfer
+      common /clabel/ label, retlab, memflg, col, logic0
+      integer label
+      integer retlab
+      integer memflg
+      integer col
+      integer logic0
+      common /cline/ dbgout, dbglev, level, linect (5), infile (5), fnam
+     *p, fnames ( 150)
+      integer dbgout
+      integer dbglev
+      integer level
+      integer linect
+      integer infile
+      integer fnamp
+      integer fnames
+      common /cmacro/ cp, ep, evalst (500), deftbl
+      integer cp
+      integer ep
+      integer evalst
+      integer deftbl
+      common /coutln/ outp, outbuf (74)
+      integer outp
+      integer outbuf
+      common /csbuf/ sbp, sbuf(2048), smem(240)
+      integer sbp
+      integer sbuf
+      integer smem
+      common /cswtch/ swtop, swlast, swstak(1000), swvnum, swvlev, swvst
+     *k(10), swinrg
+      integer swtop
+      integer swlast
+      integer swstak
+      integer swvnum
+      integer swvlev
+      integer swvstk
+      integer swinrg
+      common /ckword/ rkwtbl
+      integer rkwtbl
+      common /clname/ fkwtbl, namtbl, gentbl, errtbl, xpptbl
+      integer fkwtbl
+      integer namtbl
+      integer gentbl
+      integer errtbl
+      integer xpptbl
+      common /erchek/ ername, body, esp, errstk(30)
+      integer ername
+      integer body
+      integer esp
+      integer errstk
+      integer mem( 60000)
+      common/cdsmem/mem
+      integer i
+      integer lookup
+      integer locn
+      ludef = lookup (id, locn, table)
+      if (.not.(ludef .eq. 1))goto 23000
+      i = 1
+23002 if (.not.(mem (locn) .ne. -2))goto 23004
+      defn (i) = mem (locn)
+      i = i + 1
+23003 locn = locn + 1
+      goto 23002
+23004 continue
+      defn (i) = -2
+      goto 23001
+23000 continue
+      defn (1) = -2
+23001 continue
+      return
+      end
+c     logic0  logical_column
diff --git a/unix/boot/spp/rpp/rppfor/mapid.f b/unix/boot/spp/rpp/rppfor/mapid.f
new file mode 100644
index 00000000..982651ee
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/mapid.f
@@ -0,0 +1,13 @@
+      subroutine mapid (name)
+      integer name(100)
+      integer i
+      i=1
+23000 if (.not.(name(i) .ne. -2))goto 23002
+23001 i=i+1
+      goto 23000
+23002 continue
+      if (.not.(i-1 .gt. 6))goto 23003
+      name(6) = name(i-1)
+      name(6+1) = -2
+23003 continue
+      end
diff --git a/unix/boot/spp/rpp/rppfor/mkpkg.sh b/unix/boot/spp/rpp/rppfor/mkpkg.sh
new file mode 100644
index 00000000..14896773
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/mkpkg.sh
@@ -0,0 +1,22 @@
+# Fortran source for RPP preprocessor.
+
+$F77 -c $HSI_FF	addchr.f allblk.f alldig.f baderr.f balpar.f beginc.f
+$F77 -c $HSI_FF	brknxt.f cascod.f caslab.f declco.f deftok.f doarth.f
+$F77 -c $HSI_FF	docode.f doif.f doincr.f domac.f dostat.f dosub.f
+$F77 -c $HSI_FF	eatup.f elseif.f endcod.f entdef.f entdkw.f entfkw.f
+$F77 -c $HSI_FF	entrkw.f entxkw.f errchk.f errgo.f errorc.f evalr.f
+$F77 -c $HSI_FF	finit.f forcod.f fors.f getdef.f gettok.f gnbtok.f
+$F77 -c $HSI_FF	gocode.f gtok.f ifcode.f iferrc.f ifgo.f ifparm.f
+$F77 -c $HSI_FF	indent.f initkw.f labelc.f labgen.f lex.f litral.f
+$F77 -c $HSI_FF	lndict.f ludef.f mapid.f ngetch.f ogotos.f otherc.f
+$F77 -c $HSI_FF	outch.f outcon.f outdon.f outdwe.f outgo.f outnum.f
+$F77 -c $HSI_FF	outstr.f outtab.f parse.f pbnum.f pbstr.f poicod.f
+$F77 -c $HSI_FF	push.f putbak.f putchr.f puttok.f ratfor.f relate.f
+$F77 -c $HSI_FF	repcod.f retcod.f sdupl.f skpblk.f squash.f strdcl.f
+$F77 -c $HSI_FF	swcode.f swend.f swvar.f synerr.f thenco.f ulstal.f
+$F77 -c $HSI_FF	uniqid.f unstak.f untils.f whilec.f whiles.f
+
+ar rv		librpp.a *.o
+$RANLIB		librpp.a
+mv -f		librpp.a ..
+rm		*.o
diff --git a/unix/boot/spp/rpp/rppfor/ngetch.f b/unix/boot/spp/rpp/rppfor/ngetch.f
new file mode 100644
index 00000000..998e707a
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/ngetch.f
@@ -0,0 +1,94 @@
+      integer function ngetch (c)
+      integer c
+      common /cdefio/ bp, buf (4096)
+      integer bp
+      integer buf
+      common /cfname/ fcname (30)
+      integer fcname
+      common /cfor/ fordep, forstk (200)
+      integer fordep
+      integer forstk
+      common /cgoto/ xfer
+      integer xfer
+      common /clabel/ label, retlab, memflg, col, logic0
+      integer label
+      integer retlab
+      integer memflg
+      integer col
+      integer logic0
+      common /cline/ dbgout, dbglev, level, linect (5), infile (5), fnam
+     *p, fnames ( 150)
+      integer dbgout
+      integer dbglev
+      integer level
+      integer linect
+      integer infile
+      integer fnamp
+      integer fnames
+      common /cmacro/ cp, ep, evalst (500), deftbl
+      integer cp
+      integer ep
+      integer evalst
+      integer deftbl
+      common /coutln/ outp, outbuf (74)
+      integer outp
+      integer outbuf
+      common /csbuf/ sbp, sbuf(2048), smem(240)
+      integer sbp
+      integer sbuf
+      integer smem
+      common /cswtch/ swtop, swlast, swstak(1000), swvnum, swvlev, swvst
+     *k(10), swinrg
+      integer swtop
+      integer swlast
+      integer swstak
+      integer swvnum
+      integer swvlev
+      integer swvstk
+      integer swinrg
+      common /ckword/ rkwtbl
+      integer rkwtbl
+      common /clname/ fkwtbl, namtbl, gentbl, errtbl, xpptbl
+      integer fkwtbl
+      integer namtbl
+      integer gentbl
+      integer errtbl
+      integer xpptbl
+      common /erchek/ ername, body, esp, errstk(30)
+      integer ername
+      integer body
+      integer esp
+      integer errstk
+      integer mem( 60000)
+      common/cdsmem/mem
+      integer getlin, n, i
+      if (.not.(buf (bp) .eq. -2))goto 23000
+      if (.not.(getlin (buf (3192), infile (level)) .eq. -1))goto 23002
+      c = -1
+      goto 23003
+23002 continue
+      c = buf (3192)
+      bp = 3192 + 1
+      if (.not.(c .eq. 35))goto 23004
+      if (.not.(buf(bp) .eq. 33 .and. buf(bp+1) .eq. 35))goto 23006
+      n = 0
+      i=bp+3
+23008 if (.not.(buf(i) .ge. 48 .and. buf(i) .le. 57))goto 23010
+      n = n * 10 + buf(i) - 48
+23009 i=i+1
+      goto 23008
+23010 continue
+      linect (level) = n - 1
+23006 continue
+23004 continue
+      linect (level) = linect (level) + 1
+23003 continue
+      goto 23001
+23000 continue
+      c = buf (bp)
+      bp = bp + 1
+23001 continue
+      ngetch=(c)
+      return
+      end
+c     logic0  logical_column
diff --git a/unix/boot/spp/rpp/rppfor/ogotos.f b/unix/boot/spp/rpp/rppfor/ogotos.f
new file mode 100644
index 00000000..48ce0314
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/ogotos.f
@@ -0,0 +1,78 @@
+      subroutine ogotos (n, error0)
+      integer n, error0
+      common /cdefio/ bp, buf (4096)
+      integer bp
+      integer buf
+      common /cfname/ fcname (30)
+      integer fcname
+      common /cfor/ fordep, forstk (200)
+      integer fordep
+      integer forstk
+      common /cgoto/ xfer
+      integer xfer
+      common /clabel/ label, retlab, memflg, col, logic0
+      integer label
+      integer retlab
+      integer memflg
+      integer col
+      integer logic0
+      common /cline/ dbgout, dbglev, level, linect (5), infile (5), fnam
+     *p, fnames ( 150)
+      integer dbgout
+      integer dbglev
+      integer level
+      integer linect
+      integer infile
+      integer fnamp
+      integer fnames
+      common /cmacro/ cp, ep, evalst (500), deftbl
+      integer cp
+      integer ep
+      integer evalst
+      integer deftbl
+      common /coutln/ outp, outbuf (74)
+      integer outp
+      integer outbuf
+      common /csbuf/ sbp, sbuf(2048), smem(240)
+      integer sbp
+      integer sbuf
+      integer smem
+      common /cswtch/ swtop, swlast, swstak(1000), swvnum, swvlev, swvst
+     *k(10), swinrg
+      integer swtop
+      integer swlast
+      integer swstak
+      integer swvnum
+      integer swvlev
+      integer swvstk
+      integer swinrg
+      common /ckword/ rkwtbl
+      integer rkwtbl
+      common /clname/ fkwtbl, namtbl, gentbl, errtbl, xpptbl
+      integer fkwtbl
+      integer namtbl
+      integer gentbl
+      integer errtbl
+      integer xpptbl
+      common /erchek/ ername, body, esp, errstk(30)
+      integer ername
+      integer body
+      integer esp
+      integer errstk
+      integer mem( 60000)
+      common/cdsmem/mem
+      integer sgoto(6)
+      data sgoto(1)/103/,sgoto(2)/111/,sgoto(3)/116/,sgoto(4)/111/,sgoto
+     *(5)/32/,sgoto(6)/-2/
+      call outtab
+      call outstr (sgoto)
+      call outnum (n)
+      if (.not.(error0 .eq. 1))goto 23000
+      call outdwe
+      goto 23001
+23000 continue
+      call outdon
+23001 continue
+      end
+c     logic0  logical_column
+c     error0  error_check
diff --git a/unix/boot/spp/rpp/rppfor/otherc.f b/unix/boot/spp/rpp/rppfor/otherc.f
new file mode 100644
index 00000000..f745eabb
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/otherc.f
@@ -0,0 +1,75 @@
+      subroutine otherc (lexstr)
+      integer lexstr(100)
+      common /cdefio/ bp, buf (4096)
+      integer bp
+      integer buf
+      common /cfname/ fcname (30)
+      integer fcname
+      common /cfor/ fordep, forstk (200)
+      integer fordep
+      integer forstk
+      common /cgoto/ xfer
+      integer xfer
+      common /clabel/ label, retlab, memflg, col, logic0
+      integer label
+      integer retlab
+      integer memflg
+      integer col
+      integer logic0
+      common /cline/ dbgout, dbglev, level, linect (5), infile (5), fnam
+     *p, fnames ( 150)
+      integer dbgout
+      integer dbglev
+      integer level
+      integer linect
+      integer infile
+      integer fnamp
+      integer fnames
+      common /cmacro/ cp, ep, evalst (500), deftbl
+      integer cp
+      integer ep
+      integer evalst
+      integer deftbl
+      common /coutln/ outp, outbuf (74)
+      integer outp
+      integer outbuf
+      common /csbuf/ sbp, sbuf(2048), smem(240)
+      integer sbp
+      integer sbuf
+      integer smem
+      common /cswtch/ swtop, swlast, swstak(1000), swvnum, swvlev, swvst
+     *k(10), swinrg
+      integer swtop
+      integer swlast
+      integer swstak
+      integer swvnum
+      integer swvlev
+      integer swvstk
+      integer swinrg
+      common /ckword/ rkwtbl
+      integer rkwtbl
+      common /clname/ fkwtbl, namtbl, gentbl, errtbl, xpptbl
+      integer fkwtbl
+      integer namtbl
+      integer gentbl
+      integer errtbl
+      integer xpptbl
+      common /erchek/ ername, body, esp, errstk(30)
+      integer ername
+      integer body
+      integer esp
+      integer errstk
+      integer mem( 60000)
+      common/cdsmem/mem
+      xfer = 0
+      call outtab
+      if (.not.(((65.le.lexstr (1).and.lexstr (1).le.90).or.(97.le.lexst
+     *r (1).and.lexstr (1).le.122))))goto 23000
+      call squash (lexstr)
+23000 continue
+      call outstr (lexstr)
+      call eatup
+      call outdwe
+      return
+      end
+c     logic0  logical_column
diff --git a/unix/boot/spp/rpp/rppfor/outch.f b/unix/boot/spp/rpp/rppfor/outch.f
new file mode 100644
index 00000000..526af517
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/outch.f
@@ -0,0 +1,120 @@
+      subroutine outch (c)
+      integer c, splbuf(8+1)
+      integer i, ip, op, index
+      common /cdefio/ bp, buf (4096)
+      integer bp
+      integer buf
+      common /cfname/ fcname (30)
+      integer fcname
+      common /cfor/ fordep, forstk (200)
+      integer fordep
+      integer forstk
+      common /cgoto/ xfer
+      integer xfer
+      common /clabel/ label, retlab, memflg, col, logic0
+      integer label
+      integer retlab
+      integer memflg
+      integer col
+      integer logic0
+      common /cline/ dbgout, dbglev, level, linect (5), infile (5), fnam
+     *p, fnames ( 150)
+      integer dbgout
+      integer dbglev
+      integer level
+      integer linect
+      integer infile
+      integer fnamp
+      integer fnames
+      common /cmacro/ cp, ep, evalst (500), deftbl
+      integer cp
+      integer ep
+      integer evalst
+      integer deftbl
+      common /coutln/ outp, outbuf (74)
+      integer outp
+      integer outbuf
+      common /csbuf/ sbp, sbuf(2048), smem(240)
+      integer sbp
+      integer sbuf
+      integer smem
+      common /cswtch/ swtop, swlast, swstak(1000), swvnum, swvlev, swvst
+     *k(10), swinrg
+      integer swtop
+      integer swlast
+      integer swstak
+      integer swvnum
+      integer swvlev
+      integer swvstk
+      integer swinrg
+      common /ckword/ rkwtbl
+      integer rkwtbl
+      common /clname/ fkwtbl, namtbl, gentbl, errtbl, xpptbl
+      integer fkwtbl
+      integer namtbl
+      integer gentbl
+      integer errtbl
+      integer xpptbl
+      common /erchek/ ername, body, esp, errstk(30)
+      integer ername
+      integer body
+      integer esp
+      integer errstk
+      integer mem( 60000)
+      common/cdsmem/mem
+      external index
+      integer break0(10)
+      data break0(1)/32/,break0(2)/41/,break0(3)/44/,break0(4)/46/,break
+     *0(5)/43/,break0(6)/45/,break0(7)/42/,break0(8)/47/,break0(9)/40/,b
+     *reak0(10)/-2/
+      if (.not.(outp .ge. 72))goto 23000
+      if (.not.(index (break0, c) .gt. 0))goto 23002
+      ip = outp
+      goto 23003
+23002 continue
+      ip=outp
+23004 if (.not.(ip .ge. 1))goto 23006
+      if (.not.(index (break0, outbuf(ip)) .gt. 0))goto 23007
+      goto 23006
+23007 continue
+23005 ip=ip-1
+      goto 23004
+23006 continue
+23003 continue
+      if (.not.(ip .ne. outp .and. (outp-ip) .lt. 8))goto 23009
+      op = 1
+      i=ip+1
+23011 if (.not.(i .le. outp))goto 23013
+      splbuf(op) = outbuf(i)
+      op = op + 1
+23012 i=i+1
+      goto 23011
+23013 continue
+      splbuf(op) = -2
+      outp = ip
+      goto 23010
+23009 continue
+      splbuf(1) = -2
+23010 continue
+      call outdon
+      op=1
+23014 if (.not.(op .lt. col))goto 23016
+      outbuf(op) = 32
+23015 op=op+1
+      goto 23014
+23016 continue
+      outbuf(6) = 42
+      outp = col
+      ip=1
+23017 if (.not.(splbuf(ip) .ne. -2))goto 23019
+      outp = outp + 1
+      outbuf(outp) = splbuf(ip)
+23018 ip=ip+1
+      goto 23017
+23019 continue
+23000 continue
+      outp = outp + 1
+      outbuf(outp) = c
+      end
+c     logic0  logical_column
+c     break0  break_chars
diff --git a/unix/boot/spp/rpp/rppfor/outcon.f b/unix/boot/spp/rpp/rppfor/outcon.f
new file mode 100644
index 00000000..3c25b6ff
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/outcon.f
@@ -0,0 +1,80 @@
+      subroutine outcon (n)
+      integer n
+      common /cdefio/ bp, buf (4096)
+      integer bp
+      integer buf
+      common /cfname/ fcname (30)
+      integer fcname
+      common /cfor/ fordep, forstk (200)
+      integer fordep
+      integer forstk
+      common /cgoto/ xfer
+      integer xfer
+      common /clabel/ label, retlab, memflg, col, logic0
+      integer label
+      integer retlab
+      integer memflg
+      integer col
+      integer logic0
+      common /cline/ dbgout, dbglev, level, linect (5), infile (5), fnam
+     *p, fnames ( 150)
+      integer dbgout
+      integer dbglev
+      integer level
+      integer linect
+      integer infile
+      integer fnamp
+      integer fnames
+      common /cmacro/ cp, ep, evalst (500), deftbl
+      integer cp
+      integer ep
+      integer evalst
+      integer deftbl
+      common /coutln/ outp, outbuf (74)
+      integer outp
+      integer outbuf
+      common /csbuf/ sbp, sbuf(2048), smem(240)
+      integer sbp
+      integer sbuf
+      integer smem
+      common /cswtch/ swtop, swlast, swstak(1000), swvnum, swvlev, swvst
+     *k(10), swinrg
+      integer swtop
+      integer swlast
+      integer swstak
+      integer swvnum
+      integer swvlev
+      integer swvstk
+      integer swinrg
+      common /ckword/ rkwtbl
+      integer rkwtbl
+      common /clname/ fkwtbl, namtbl, gentbl, errtbl, xpptbl
+      integer fkwtbl
+      integer namtbl
+      integer gentbl
+      integer errtbl
+      integer xpptbl
+      common /erchek/ ername, body, esp, errstk(30)
+      integer ername
+      integer body
+      integer esp
+      integer errstk
+      integer mem( 60000)
+      common/cdsmem/mem
+      integer contin(9)
+      data contin(1)/99/,contin(2)/111/,contin(3)/110/,contin(4)/116/,co
+     *ntin(5)/105/,contin(6)/110/,contin(7)/117/,contin(8)/101/,contin(9
+     *)/-2/
+      xfer = 0
+      if (.not.(n .le. 0 .and. outp .eq. 0))goto 23000
+      return
+23000 continue
+      if (.not.(n .gt. 0))goto 23002
+      call outnum (n)
+23002 continue
+      call outtab
+      call outstr (contin)
+      call outdon
+      return
+      end
+c     logic0  logical_column
diff --git a/unix/boot/spp/rpp/rppfor/outdon.f b/unix/boot/spp/rpp/rppfor/outdon.f
new file mode 100644
index 00000000..d3582ff9
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/outdon.f
@@ -0,0 +1,118 @@
+      subroutine outdon
+      common /cdefio/ bp, buf (4096)
+      integer bp
+      integer buf
+      common /cfname/ fcname (30)
+      integer fcname
+      common /cfor/ fordep, forstk (200)
+      integer fordep
+      integer forstk
+      common /cgoto/ xfer
+      integer xfer
+      common /clabel/ label, retlab, memflg, col, logic0
+      integer label
+      integer retlab
+      integer memflg
+      integer col
+      integer logic0
+      common /cline/ dbgout, dbglev, level, linect (5), infile (5), fnam
+     *p, fnames ( 150)
+      integer dbgout
+      integer dbglev
+      integer level
+      integer linect
+      integer infile
+      integer fnamp
+      integer fnames
+      common /cmacro/ cp, ep, evalst (500), deftbl
+      integer cp
+      integer ep
+      integer evalst
+      integer deftbl
+      common /coutln/ outp, outbuf (74)
+      integer outp
+      integer outbuf
+      common /csbuf/ sbp, sbuf(2048), smem(240)
+      integer sbp
+      integer sbuf
+      integer smem
+      common /cswtch/ swtop, swlast, swstak(1000), swvnum, swvlev, swvst
+     *k(10), swinrg
+      integer swtop
+      integer swlast
+      integer swstak
+      integer swvnum
+      integer swvlev
+      integer swvstk
+      integer swinrg
+      common /ckword/ rkwtbl
+      integer rkwtbl
+      common /clname/ fkwtbl, namtbl, gentbl, errtbl, xpptbl
+      integer fkwtbl
+      integer namtbl
+      integer gentbl
+      integer errtbl
+      integer xpptbl
+      common /erchek/ ername, body, esp, errstk(30)
+      integer ername
+      integer body
+      integer esp
+      integer errstk
+      integer mem( 60000)
+      common/cdsmem/mem
+      integer allblk
+      integer itoc, ip, op, i
+      integer obuf(80)
+      integer sline0(7)
+      data sline0(1)/35/,sline0(2)/108/,sline0(3)/105/,sline0(4)/110/,sl
+     *ine0(5)/101/,sline0(6)/32/,sline0(7)/-2/
+      if (.not.(dbgout .eq. 1))goto 23000
+      if (.not.(body .eq. 1 .or. dbglev .ne. level))goto 23002
+      op = 1
+      ip=1
+23004 if (.not.(sline0(ip) .ne. -2))goto 23006
+      obuf(op) = sline0(ip)
+      op = op + 1
+23005 ip=ip+1
+      goto 23004
+23006 continue
+      op = op + itoc (linect, obuf(op), 80-op+1)
+      obuf(op) = 32
+      op = op + 1
+      obuf(op) = 34
+      op = op + 1
+      i=fnamp-1
+23007 if (.not.(i .ge. 1))goto 23009
+      if (.not.(fnames(i-1) .eq. -2 .or. i .eq. 1))goto 23010
+      ip=i
+23012 if (.not.(fnames(ip) .ne. -2))goto 23014
+      obuf(op) = fnames(ip)
+      op = op + 1
+23013 ip=ip+1
+      goto 23012
+23014 continue
+      goto 23009
+23010 continue
+23008 i=i-1
+      goto 23007
+23009 continue
+      obuf(op) = 34
+      op = op + 1
+      obuf(op) = 10
+      op = op + 1
+      obuf(op) = -2
+      op = op + 1
+      call putlin (obuf, 1)
+      dbglev = level
+23002 continue
+23000 continue
+      outbuf (outp + 1) = 10
+      outbuf (outp + 2) = -2
+      if (.not.(allblk (outbuf) .eq. 0))goto 23015
+      call putlin (outbuf, 1)
+23015 continue
+      outp = 0
+      return
+      end
+c     logic0  logical_column
+c     sline0  s_line
diff --git a/unix/boot/spp/rpp/rppfor/outdwe.f b/unix/boot/spp/rpp/rppfor/outdwe.f
new file mode 100644
index 00000000..6b006269
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/outdwe.f
@@ -0,0 +1,4 @@
+      subroutine outdwe
+      call outdon
+      call errgo
+      end
diff --git a/unix/boot/spp/rpp/rppfor/outgo.f b/unix/boot/spp/rpp/rppfor/outgo.f
new file mode 100644
index 00000000..2f4ff64c
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/outgo.f
@@ -0,0 +1,69 @@
+      subroutine outgo (n)
+      integer n
+      common /cdefio/ bp, buf (4096)
+      integer bp
+      integer buf
+      common /cfname/ fcname (30)
+      integer fcname
+      common /cfor/ fordep, forstk (200)
+      integer fordep
+      integer forstk
+      common /cgoto/ xfer
+      integer xfer
+      common /clabel/ label, retlab, memflg, col, logic0
+      integer label
+      integer retlab
+      integer memflg
+      integer col
+      integer logic0
+      common /cline/ dbgout, dbglev, level, linect (5), infile (5), fnam
+     *p, fnames ( 150)
+      integer dbgout
+      integer dbglev
+      integer level
+      integer linect
+      integer infile
+      integer fnamp
+      integer fnames
+      common /cmacro/ cp, ep, evalst (500), deftbl
+      integer cp
+      integer ep
+      integer evalst
+      integer deftbl
+      common /coutln/ outp, outbuf (74)
+      integer outp
+      integer outbuf
+      common /csbuf/ sbp, sbuf(2048), smem(240)
+      integer sbp
+      integer sbuf
+      integer smem
+      common /cswtch/ swtop, swlast, swstak(1000), swvnum, swvlev, swvst
+     *k(10), swinrg
+      integer swtop
+      integer swlast
+      integer swstak
+      integer swvnum
+      integer swvlev
+      integer swvstk
+      integer swinrg
+      common /ckword/ rkwtbl
+      integer rkwtbl
+      common /clname/ fkwtbl, namtbl, gentbl, errtbl, xpptbl
+      integer fkwtbl
+      integer namtbl
+      integer gentbl
+      integer errtbl
+      integer xpptbl
+      common /erchek/ ername, body, esp, errstk(30)
+      integer ername
+      integer body
+      integer esp
+      integer errstk
+      integer mem( 60000)
+      common/cdsmem/mem
+      if (.not.(xfer .eq. 1))goto 23000
+      return
+23000 continue
+      call ogotos (n, 0)
+      end
+c     logic0  logical_column
diff --git a/unix/boot/spp/rpp/rppfor/outnum.f b/unix/boot/spp/rpp/rppfor/outnum.f
new file mode 100644
index 00000000..8c7e7029
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/outnum.f
@@ -0,0 +1,22 @@
+      subroutine outnum (n)
+      integer n
+      integer chars (20)
+      integer i, m
+      m = iabs (n)
+      i = 0
+23000 continue
+      i = i + 1
+      chars (i) = mod (m, 10) + 48
+      m = m / 10
+23001 if (.not.(m .eq. 0 .or. i .ge. 20))goto 23000
+23002 continue
+      if (.not.(n .lt. 0))goto 23003
+      call outch (45)
+23003 continue
+23005 if (.not.(i .gt. 0))goto 23007
+      call outch (chars (i))
+23006 i = i - 1
+      goto 23005
+23007 continue
+      return
+      end
diff --git a/unix/boot/spp/rpp/rppfor/outstr.f b/unix/boot/spp/rpp/rppfor/outstr.f
new file mode 100644
index 00000000..28230330
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/outstr.f
@@ -0,0 +1,30 @@
+      subroutine outstr (str)
+      integer str (100)
+      integer c
+      integer i, j
+      i = 1
+23000 if (.not.(str (i) .ne. -2))goto 23002
+      c = str (i)
+      if (.not.(c .ne. 39 .and. c .ne. 34))goto 23003
+      call outch (c)
+      goto 23004
+23003 continue
+      i = i + 1
+      j = i
+23005 if (.not.(str (j) .ne. c))goto 23007
+23006 j = j + 1
+      goto 23005
+23007 continue
+      call outnum (j - i)
+      call outch (72)
+23008 if (.not.(i .lt. j))goto 23010
+      call outch (str (i))
+23009 i = i + 1
+      goto 23008
+23010 continue
+23004 continue
+23001 i = i + 1
+      goto 23000
+23002 continue
+      return
+      end
diff --git a/unix/boot/spp/rpp/rppfor/outtab.f b/unix/boot/spp/rpp/rppfor/outtab.f
new file mode 100644
index 00000000..17b0aa8c
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/outtab.f
@@ -0,0 +1,69 @@
+      subroutine outtab
+      common /cdefio/ bp, buf (4096)
+      integer bp
+      integer buf
+      common /cfname/ fcname (30)
+      integer fcname
+      common /cfor/ fordep, forstk (200)
+      integer fordep
+      integer forstk
+      common /cgoto/ xfer
+      integer xfer
+      common /clabel/ label, retlab, memflg, col, logic0
+      integer label
+      integer retlab
+      integer memflg
+      integer col
+      integer logic0
+      common /cline/ dbgout, dbglev, level, linect (5), infile (5), fnam
+     *p, fnames ( 150)
+      integer dbgout
+      integer dbglev
+      integer level
+      integer linect
+      integer infile
+      integer fnamp
+      integer fnames
+      common /cmacro/ cp, ep, evalst (500), deftbl
+      integer cp
+      integer ep
+      integer evalst
+      integer deftbl
+      common /coutln/ outp, outbuf (74)
+      integer outp
+      integer outbuf
+      common /csbuf/ sbp, sbuf(2048), smem(240)
+      integer sbp
+      integer sbuf
+      integer smem
+      common /cswtch/ swtop, swlast, swstak(1000), swvnum, swvlev, swvst
+     *k(10), swinrg
+      integer swtop
+      integer swlast
+      integer swstak
+      integer swvnum
+      integer swvlev
+      integer swvstk
+      integer swinrg
+      common /ckword/ rkwtbl
+      integer rkwtbl
+      common /clname/ fkwtbl, namtbl, gentbl, errtbl, xpptbl
+      integer fkwtbl
+      integer namtbl
+      integer gentbl
+      integer errtbl
+      integer xpptbl
+      common /erchek/ ername, body, esp, errstk(30)
+      integer ername
+      integer body
+      integer esp
+      integer errstk
+      integer mem( 60000)
+      common/cdsmem/mem
+23000 if (.not.(outp .lt. col))goto 23001
+      call outch (32)
+      goto 23000
+23001 continue
+      return
+      end
+c     logic0  logical_column
diff --git a/unix/boot/spp/rpp/rppfor/parse.f b/unix/boot/spp/rpp/rppfor/parse.f
new file mode 100644
index 00000000..5876293a
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/parse.f
@@ -0,0 +1,257 @@
+      subroutine parse
+      common /cdefio/ bp, buf (4096)
+      integer bp
+      integer buf
+      common /cfname/ fcname (30)
+      integer fcname
+      common /cfor/ fordep, forstk (200)
+      integer fordep
+      integer forstk
+      common /cgoto/ xfer
+      integer xfer
+      common /clabel/ label, retlab, memflg, col, logic0
+      integer label
+      integer retlab
+      integer memflg
+      integer col
+      integer logic0
+      common /cline/ dbgout, dbglev, level, linect (5), infile (5), fnam
+     *p, fnames ( 150)
+      integer dbgout
+      integer dbglev
+      integer level
+      integer linect
+      integer infile
+      integer fnamp
+      integer fnames
+      common /cmacro/ cp, ep, evalst (500), deftbl
+      integer cp
+      integer ep
+      integer evalst
+      integer deftbl
+      common /coutln/ outp, outbuf (74)
+      integer outp
+      integer outbuf
+      common /csbuf/ sbp, sbuf(2048), smem(240)
+      integer sbp
+      integer sbuf
+      integer smem
+      common /cswtch/ swtop, swlast, swstak(1000), swvnum, swvlev, swvst
+     *k(10), swinrg
+      integer swtop
+      integer swlast
+      integer swstak
+      integer swvnum
+      integer swvlev
+      integer swvstk
+      integer swinrg
+      common /ckword/ rkwtbl
+      integer rkwtbl
+      common /clname/ fkwtbl, namtbl, gentbl, errtbl, xpptbl
+      integer fkwtbl
+      integer namtbl
+      integer gentbl
+      integer errtbl
+      integer xpptbl
+      common /erchek/ ername, body, esp, errstk(30)
+      integer ername
+      integer body
+      integer esp
+      integer errstk
+      integer mem( 60000)
+      common/cdsmem/mem
+      integer lexstr(100)
+      integer lab, labval(100), lextyp(100), sp, token, i, t
+      integer lex
+      logical pushs0
+      sp = 1
+      lextyp(1) = -1
+      token = lex(lexstr)
+23000 if (.not.(token .ne. -1))goto 23002
+      pushs0 = .false.
+      I23003=(token)
+      goto 23003
+23005 continue
+      call ifcode (lab)
+      pushs0 = .true.
+      goto 23004
+23006 continue
+      call iferrc (lab, 1)
+      pushs0 = .true.
+      goto 23004
+23007 continue
+      call iferrc (lab, 0)
+      pushs0 = .true.
+      goto 23004
+23008 continue
+      call docode (lab)
+      pushs0 = .true.
+      goto 23004
+23009 continue
+      call whilec (lab)
+      pushs0 = .true.
+      goto 23004
+23010 continue
+      call forcod (lab)
+      pushs0 = .true.
+      goto 23004
+23011 continue
+      call repcod (lab)
+      pushs0 = .true.
+      goto 23004
+23012 continue
+      call swcode (lab)
+      pushs0 = .true.
+      goto 23004
+23013 continue
+      i=sp
+23014 if (.not.(i .gt. 0))goto 23016
+      if (.not.(lextyp(i) .eq. -92))goto 23017
+      goto 23016
+23017 continue
+23015 i=i-1
+      goto 23014
+23016 continue
+      if (.not.(i .eq. 0))goto 23019
+      call synerr (24Hillegal case or default.)
+      goto 23020
+23019 continue
+      call cascod (labval (i), token)
+23020 continue
+      goto 23004
+23021 continue
+      call labelc (lexstr)
+      pushs0 = .true.
+      goto 23004
+23022 continue
+      t = lextyp(sp)
+      if (.not.(t .eq. -99 .or. t .eq. -98 .or. t .eq. -97))goto 23023
+      call elseif (labval(sp))
+      goto 23024
+23023 continue
+      call synerr (13HIllegal else.)
+23024 continue
+      t = lex (lexstr)
+      call pbstr (lexstr)
+      if (.not.(t .eq. -99 .or. t .eq. -98 .or. t .eq. -97))goto 23025
+      call indent (-1)
+      token = -72
+23025 continue
+      pushs0 = .true.
+      goto 23004
+23027 continue
+      if (.not.(lextyp(sp) .eq. -98 .or. lextyp(sp) .eq. -97))goto 23028
+      call thenco (lextyp(sp), labval(sp))
+      lab = labval(sp)
+      token = lextyp(sp)
+      sp = sp - 1
+      goto 23029
+23028 continue
+      call synerr (41HIllegal 'then' clause in iferr statement.)
+23029 continue
+      pushs0 = .true.
+      goto 23004
+23030 continue
+      call litral
+      goto 23004
+23031 continue
+      call errchk
+      goto 23004
+23032 continue
+      call beginc
+      goto 23004
+23033 continue
+      call endcod (lexstr)
+      if (.not.(sp .ne. 1))goto 23034
+      call synerr (31HMissing right brace or 'begin'.)
+      sp = 1
+23034 continue
+      goto 23004
+23036 continue
+      if (.not.(token .eq. 123))goto 23037
+      pushs0 = .true.
+      goto 23038
+23037 continue
+      if (.not.(token .eq. -67))goto 23039
+      call declco (lexstr)
+23039 continue
+23038 continue
+      goto 23004
+23003 continue
+      I23003=I23003+100
+      if (I23003.lt.1.or.I23003.gt.18)goto 23036
+      goto (23005,23006,23007,23008,23009,23010,23011,23012,23013,23013,
+     *23021,23036,23022,23027,23030,23031,23032,23033),I23003
+23004 continue
+      if (.not.(pushs0))goto 23041
+      if (.not.(body .eq. 0))goto 23043
+      call synerr (24HMissing 'begin' keyword.)
+      call beginc
+23043 continue
+      sp = sp + 1
+      if (.not.(sp .gt. 100))goto 23045
+      call baderr (25HStack overflow in parser.)
+23045 continue
+      lextyp(sp) = token
+      labval(sp) = lab
+      goto 23042
+23041 continue
+      if (.not.(token .ne. -91 .and. token .ne. -90))goto 23047
+      if (.not.(token .eq. 125))goto 23049
+      token = -74
+23049 continue
+      I23051=(token)
+      goto 23051
+23053 continue
+      call otherc (lexstr)
+      goto 23052
+23054 continue
+      call brknxt (sp, lextyp, labval, token)
+      goto 23052
+23055 continue
+      call retcod
+      goto 23052
+23056 continue
+      call gocode
+      goto 23052
+23057 continue
+      if (.not.(body .eq. 0))goto 23058
+      call strdcl
+      goto 23059
+23058 continue
+      call otherc (lexstr)
+23059 continue
+      goto 23052
+23060 continue
+      if (.not.(lextyp(sp) .eq. 123))goto 23061
+      sp = sp - 1
+      goto 23062
+23061 continue
+      if (.not.(lextyp(sp) .eq. -92))goto 23063
+      call swend (labval(sp))
+      sp = sp - 1
+      goto 23064
+23063 continue
+      call synerr (20HIllegal right brace.)
+23064 continue
+23062 continue
+      goto 23052
+23051 continue
+      I23051=I23051+81
+      if (I23051.lt.1.or.I23051.gt.7)goto 23052
+      goto (23053,23054,23054,23055,23056,23057,23060),I23051
+23052 continue
+      token = lex (lexstr)
+      call pbstr (lexstr)
+      call unstak (sp, lextyp, labval, token)
+23047 continue
+23042 continue
+23001 token = lex(lexstr)
+      goto 23000
+23002 continue
+      if (.not.(sp .ne. 1))goto 23065
+      call synerr (15Hunexpected EOF.)
+23065 continue
+      end
+c     pushs0  push_stack
+c     logic0  logical_column
diff --git a/unix/boot/spp/rpp/rppfor/pbnum.f b/unix/boot/spp/rpp/rppfor/pbnum.f
new file mode 100644
index 00000000..bf477107
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/pbnum.f
@@ -0,0 +1,17 @@
+      subroutine pbnum (n)
+      integer n
+      integer m, num
+      integer mod
+      integer digits(11)
+      data digits(1)/48/,digits(2)/49/,digits(3)/50/,digits(4)/51/,digit
+     *s(5)/52/,digits(6)/53/,digits(7)/54/,digits(8)/55/,digits(9)/56/,d
+     *igits(10)/57/,digits(11)/-2/
+      num = n
+23000 continue
+      m = mod (num, 10)
+      call putbak (digits (m + 1))
+      num = num / 10
+23001 if (.not.(num .eq. 0))goto 23000
+23002 continue
+      return
+      end
diff --git a/unix/boot/spp/rpp/rppfor/pbstr.f b/unix/boot/spp/rpp/rppfor/pbstr.f
new file mode 100644
index 00000000..da3a12a9
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/pbstr.f
@@ -0,0 +1,75 @@
+      subroutine pbstr (s)
+      integer s(100)
+      integer lenstr, i
+      integer length
+      lenstr = length (s)
+      if (.not.(s(1) .eq. 46 .and. s(lenstr) .eq. 46))goto 23000
+      if (.not.(lenstr .eq. 4))goto 23002
+      if (.not.(s(2) .eq. 103))goto 23004
+      if (.not.(s(3) .eq. 116))goto 23006
+      call putbak (62)
+      return
+23006 continue
+      if (.not.(s(3) .eq. 101))goto 23008
+      call putbak (61)
+      call putbak (62)
+      return
+23008 continue
+23007 continue
+      goto 23005
+23004 continue
+      if (.not.(s(2) .eq. 108))goto 23010
+      if (.not.(s(3) .eq. 116))goto 23012
+      call putbak (60)
+      return
+23012 continue
+      if (.not.(s(3) .eq. 101))goto 23014
+      call putbak (61)
+      call putbak (60)
+      return
+23014 continue
+23013 continue
+      goto 23011
+23010 continue
+      if (.not.(s(2) .eq. 101 .and. s(3) .eq. 113))goto 23016
+      call putbak (61)
+      call putbak (61)
+      return
+23016 continue
+      if (.not.(s(2) .eq. 110 .and. s(3) .eq. 101))goto 23018
+      call putbak (61)
+      call putbak (33)
+      return
+23018 continue
+      if (.not.(s(2) .eq. 111 .and. s(3) .eq. 114))goto 23020
+      call putbak (124)
+      return
+23020 continue
+23019 continue
+23017 continue
+23011 continue
+23005 continue
+      goto 23003
+23002 continue
+      if (.not.(lenstr .eq. 5))goto 23022
+      if (.not.(s(2) .eq. 110 .and. s(3) .eq. 111 .and. s(4) .eq. 116))g
+     *oto 23024
+      call putbak (33)
+      return
+23024 continue
+      if (.not.(s(2) .eq. 97 .and. s(3) .eq. 110 .and. s(4) .eq. 100))go
+     *to 23026
+      call putbak (38)
+      return
+23026 continue
+23025 continue
+23022 continue
+23003 continue
+23000 continue
+      i=lenstr
+23028 if (.not.(i .gt. 0))goto 23030
+      call putbak (s(i))
+23029 i=i-1
+      goto 23028
+23030 continue
+      end
diff --git a/unix/boot/spp/rpp/rppfor/poicod.f b/unix/boot/spp/rpp/rppfor/poicod.f
new file mode 100644
index 00000000..834d1644
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/poicod.f
@@ -0,0 +1,172 @@
+      subroutine poicod (decla0)
+      integer decla0
+      common /cdefio/ bp, buf (4096)
+      integer bp
+      integer buf
+      common /cfname/ fcname (30)
+      integer fcname
+      common /cfor/ fordep, forstk (200)
+      integer fordep
+      integer forstk
+      common /cgoto/ xfer
+      integer xfer
+      common /clabel/ label, retlab, memflg, col, logic0
+      integer label
+      integer retlab
+      integer memflg
+      integer col
+      integer logic0
+      common /cline/ dbgout, dbglev, level, linect (5), infile (5), fnam
+     *p, fnames ( 150)
+      integer dbgout
+      integer dbglev
+      integer level
+      integer linect
+      integer infile
+      integer fnamp
+      integer fnames
+      common /cmacro/ cp, ep, evalst (500), deftbl
+      integer cp
+      integer ep
+      integer evalst
+      integer deftbl
+      common /coutln/ outp, outbuf (74)
+      integer outp
+      integer outbuf
+      common /csbuf/ sbp, sbuf(2048), smem(240)
+      integer sbp
+      integer sbuf
+      integer smem
+      common /cswtch/ swtop, swlast, swstak(1000), swvnum, swvlev, swvst
+     *k(10), swinrg
+      integer swtop
+      integer swlast
+      integer swstak
+      integer swvnum
+      integer swvlev
+      integer swvstk
+      integer swinrg
+      common /ckword/ rkwtbl
+      integer rkwtbl
+      common /clname/ fkwtbl, namtbl, gentbl, errtbl, xpptbl
+      integer fkwtbl
+      integer namtbl
+      integer gentbl
+      integer errtbl
+      integer xpptbl
+      common /erchek/ ername, body, esp, errstk(30)
+      integer ername
+      integer body
+      integer esp
+      integer errstk
+      integer mem( 60000)
+      common/cdsmem/mem
+      integer spoin0(9)
+      integer p1(16)
+      integer p2(18)
+      integer p3(18)
+C      integer p4(18)
+C      integer p5(18)
+C      integer p6(25)
+      integer p4(16)
+      integer p5(16)
+      integer p6(13)
+      integer p7(25)
+      integer p8(16)
+      integer p9(61)
+      integer pa(18)
+
+C      data spoin0(1)/105/,spoin0(2)/110/,spoin0(3)/116/,spoin0(4)/101/,s
+C     *poin0(5)/103/,spoin0(6)/101/,spoin0(7)/114/,spoin0(8)/42/,spoin0(9
+C     *)/56/,spoin0(10)/32/,spoin0(11)/-2/
+      data spoin0(1)/105/,spoin0(2)/110/,spoin0(3)/116/,spoin0(4)/101/,s
+     *poin0(5)/103/,spoin0(6)/101/,spoin0(7)/114/,spoin0(8)/32/,spoin0(9
+     *)/-2/
+
+      data p1(1)/108/,p1(2)/111/,p1(3)/103/,p1(4)/105/,p1(5)/99/,p1(6)/9
+     *7/,p1(7)/108/,p1(8)/32/,p1(9)/77/,p1(10)/101/,p1(11)/109/,p1(12)/9
+     *8/,p1(13)/40/,p1(14)/49/,p1(15)/41/,p1(16)/-2/
+      data p2(1)/105/,p2(2)/110/,p2(3)/116/,p2(4)/101/,p2(5)/103/,p2(6)/
+     *101/,p2(7)/114/,p2(8)/42/,p2(9)/50/,p2(10)/32/,p2(11)/77/,p2(12)/1
+     *01/,p2(13)/109/,p2(14)/99/,p2(15)/40/,p2(16)/49/,p2(17)/41/,p2(18)
+     */-2/
+      data p3(1)/105/,p3(2)/110/,p3(3)/116/,p3(4)/101/,p3(5)/103/,p3(6)/
+     *101/,p3(7)/114/,p3(8)/42/,p3(9)/50/,p3(10)/32/,p3(11)/77/,p3(12)/1
+     *01/,p3(13)/109/,p3(14)/115/,p3(15)/40/,p3(16)/49/,p3(17)/41/,p3(18
+     *)/-2/
+
+      data p4(1)/105/,p4(2)/110/,p4(3)/116/,p4(4)/101/,p4(5)/103/,p4(6)/
+     *101/,p4(7)/114/,p4(8)/32/,p4(9)/77/,p4(10)/101/,p4(11)/109/,p4(12)
+     */105/,p4(13)/40/,p4(14)/49/,p4(15)/41/,p4(16)/-2/
+      data p5(1)/105/,p5(2)/110/,p5(3)/116/,p5(4)/101/,p5(5)/103/,p5(6)/
+     *101/,p5(7)/114/,p5(8)/32/,p5(9)/77/,p5(10)/101/,p5(11)/109/,p5(12)
+     */108/,p5(13)/40/,p5(14)/49/,p5(15)/41/,p5(16)/-2/
+
+C      data p4(1)/105/,p4(2)/110/,p4(3)/116/,p4(4)/101/,p4(5)/103/,p4(6)/
+C     *101/,p4(7)/114/,p4(8)/42/,p4(9)/56/,p4(10)/32/,p4(11)/77/,p4(12)/1
+C     *01/,p4(13)/109/,p4(14)/105/,p4(15)/40/,p4(16)/49/,p4(17)/41/,p4(18
+C     *)/-2/
+C      data p5(1)/105/,p5(2)/110/,p5(3)/116/,p5(4)/101/,p5(5)/103/,p5(6)/
+C     *101/,p5(7)/114/,p5(8)/42/,p5(9)/56/,p5(10)/32/,p5(11)/77/,p5(12)/1
+C     *01/,p5(13)/109/,p5(14)/108/,p5(15)/40/,p5(16)/49/,p5(17)/41/,p5(18
+C     *)/-2/
+C      data p6(1)/100/,p6(2)/111/,p6(3)/117/,p6(4)/98/,p6(5)/108/,p6(6)/1
+C     *01/,p6(7)/32/,p6(8)/112/,p6(9)/114/,p6(10)/101/,p6(11)/99/,p6(12)/
+C     *105/,p6(13)/115/,p6(14)/105/,p6(15)/111/,p6(16)/110/,p6(17)/32/,p6
+C     *(18)/77/,p6(19)/101/,p6(20)/109/,p6(21)/114/,p6(22)/40/,p6(23)/49/
+C     *,p6(24)/41/,p6(25)/-2/
+
+      data p6(1)/114/,p6(2)/101/,p6(3)/97/,p6(4)/108/,p6(5)/32/,p6(6)/77
+     */,p6(7)/101/,p6(8)/109/,p6(9)/114/,p6(10)/40/,p6(11)/49/,p6(12)/41
+     */,p6(13)/-2/
+
+      data p7(1)/100/,p7(2)/111/,p7(3)/117/,p7(4)/98/,p7(5)/108/,p7(6)/1
+     *01/,p7(7)/32/,p7(8)/112/,p7(9)/114/,p7(10)/101/,p7(11)/99/,p7(12)/
+     *105/,p7(13)/115/,p7(14)/105/,p7(15)/111/,p7(16)/110/,p7(17)/32/,p7
+     *(18)/77/,p7(19)/101/,p7(20)/109/,p7(21)/100/,p7(22)/40/,p7(23)/49/
+     *,p7(24)/41/,p7(25)/-2/
+      data p8(1)/99/,p8(2)/111/,p8(3)/109/,p8(4)/112/,p8(5)/108/,p8(6)/1
+     *01/,p8(7)/120/,p8(8)/32/,p8(9)/77/,p8(10)/101/,p8(11)/109/,p8(12)/
+     *120/,p8(13)/40/,p8(14)/49/,p8(15)/41/,p8(16)/-2/
+      data p9(1)/101/,p9(2)/113/,p9(3)/117/,p9(4)/105/,p9(5)/118/,p9(6)/
+     *97/,p9(7)/108/,p9(8)/101/,p9(9)/110/,p9(10)/99/,p9(11)/101/,p9(12)
+     */32/,p9(13)/40/,p9(14)/77/,p9(15)/101/,p9(16)/109/,p9(17)/98/,p9(1
+     *8)/44/,p9(19)/32/,p9(20)/77/,p9(21)/101/,p9(22)/109/,p9(23)/99/,p9
+     *(24)/44/,p9(25)/32/,p9(26)/77/,p9(27)/101/,p9(28)/109/,p9(29)/115/
+     *,p9(30)/44/,p9(31)/32/,p9(32)/77/,p9(33)/101/,p9(34)/109/,p9(35)/1
+     *05/,p9(36)/44/,p9(37)/32/,p9(38)/77/,p9(39)/101/,p9(40)/109/,p9(41
+     *)/108/,p9(42)/44/,p9(43)/32/,p9(44)/77/,p9(45)/101/,p9(46)/109/,p9
+     *(47)/114/,p9(48)/44/,p9(49)/32/,p9(50)/77/,p9(51)/101/,p9(52)/109/
+     *,p9(53)/100/,p9(54)/44/,p9(55)/32/,p9(56)/77/,p9(57)/101/,p9(58)/1
+     *09/,p9(59)/120/,p9(60)/41/,p9(61)/-2/
+      data pa(1)/99/,pa(2)/111/,pa(3)/109/,pa(4)/109/,pa(5)/111/,pa(6)/1
+     *10/,pa(7)/32/,pa(8)/47/,pa(9)/77/,pa(10)/101/,pa(11)/109/,pa(12)/4
+     *7/,pa(13)/32/,pa(14)/77/,pa(15)/101/,pa(16)/109/,pa(17)/100/,pa(18
+     *)/-2/
+      if (.not.(memflg .eq. 0))goto 23000
+      call poidec (p1)
+      call poidec (p2)
+      call poidec (p3)
+      call poidec (p4)
+      call poidec (p5)
+      call poidec (p6)
+      call poidec (p7)
+      call poidec (p8)
+      call poidec (p9)
+      call poidec (pa)
+      memflg = 1
+23000 continue
+      if (.not.(decla0 .eq. 1))goto 23002
+      call outtab
+      call outstr (spoin0)
+23002 continue
+      end
+      subroutine poidec (str)
+      integer str
+      call outtab
+      call outstr (str)
+      call outdon
+      end
+c     logic0  logical_column
+c     decla0  declare_variable
+c     spoin0  spointer
diff --git a/unix/boot/spp/rpp/rppfor/push.f b/unix/boot/spp/rpp/rppfor/push.f
new file mode 100644
index 00000000..2329f6c5
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/push.f
@@ -0,0 +1,9 @@
+      integer function push (ep, argstk, ap)
+      integer ap, argstk (100), ep
+      if (.not.(ap .gt. 100))goto 23000
+      call baderr (19Harg stack overflow.)
+23000 continue
+      argstk (ap) = ep
+      push = ap + 1
+      return
+      end
diff --git a/unix/boot/spp/rpp/rppfor/putbak.f b/unix/boot/spp/rpp/rppfor/putbak.f
new file mode 100644
index 00000000..b4252a1e
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/putbak.f
@@ -0,0 +1,73 @@
+      subroutine putbak (c)
+      integer c
+      common /cdefio/ bp, buf (4096)
+      integer bp
+      integer buf
+      common /cfname/ fcname (30)
+      integer fcname
+      common /cfor/ fordep, forstk (200)
+      integer fordep
+      integer forstk
+      common /cgoto/ xfer
+      integer xfer
+      common /clabel/ label, retlab, memflg, col, logic0
+      integer label
+      integer retlab
+      integer memflg
+      integer col
+      integer logic0
+      common /cline/ dbgout, dbglev, level, linect (5), infile (5), fnam
+     *p, fnames ( 150)
+      integer dbgout
+      integer dbglev
+      integer level
+      integer linect
+      integer infile
+      integer fnamp
+      integer fnames
+      common /cmacro/ cp, ep, evalst (500), deftbl
+      integer cp
+      integer ep
+      integer evalst
+      integer deftbl
+      common /coutln/ outp, outbuf (74)
+      integer outp
+      integer outbuf
+      common /csbuf/ sbp, sbuf(2048), smem(240)
+      integer sbp
+      integer sbuf
+      integer smem
+      common /cswtch/ swtop, swlast, swstak(1000), swvnum, swvlev, swvst
+     *k(10), swinrg
+      integer swtop
+      integer swlast
+      integer swstak
+      integer swvnum
+      integer swvlev
+      integer swvstk
+      integer swinrg
+      common /ckword/ rkwtbl
+      integer rkwtbl
+      common /clname/ fkwtbl, namtbl, gentbl, errtbl, xpptbl
+      integer fkwtbl
+      integer namtbl
+      integer gentbl
+      integer errtbl
+      integer xpptbl
+      common /erchek/ ername, body, esp, errstk(30)
+      integer ername
+      integer body
+      integer esp
+      integer errstk
+      integer mem( 60000)
+      common/cdsmem/mem
+      if (.not.(bp .le. 1))goto 23000
+      call baderr (32Htoo many characters pushed back.)
+      goto 23001
+23000 continue
+      bp = bp - 1
+      buf (bp) = c
+23001 continue
+      return
+      end
+c     logic0  logical_column
diff --git a/unix/boot/spp/rpp/rppfor/putchr.f b/unix/boot/spp/rpp/rppfor/putchr.f
new file mode 100644
index 00000000..b502f58a
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/putchr.f
@@ -0,0 +1,71 @@
+      subroutine putchr (c)
+      integer c
+      common /cdefio/ bp, buf (4096)
+      integer bp
+      integer buf
+      common /cfname/ fcname (30)
+      integer fcname
+      common /cfor/ fordep, forstk (200)
+      integer fordep
+      integer forstk
+      common /cgoto/ xfer
+      integer xfer
+      common /clabel/ label, retlab, memflg, col, logic0
+      integer label
+      integer retlab
+      integer memflg
+      integer col
+      integer logic0
+      common /cline/ dbgout, dbglev, level, linect (5), infile (5), fnam
+     *p, fnames ( 150)
+      integer dbgout
+      integer dbglev
+      integer level
+      integer linect
+      integer infile
+      integer fnamp
+      integer fnames
+      common /cmacro/ cp, ep, evalst (500), deftbl
+      integer cp
+      integer ep
+      integer evalst
+      integer deftbl
+      common /coutln/ outp, outbuf (74)
+      integer outp
+      integer outbuf
+      common /csbuf/ sbp, sbuf(2048), smem(240)
+      integer sbp
+      integer sbuf
+      integer smem
+      common /cswtch/ swtop, swlast, swstak(1000), swvnum, swvlev, swvst
+     *k(10), swinrg
+      integer swtop
+      integer swlast
+      integer swstak
+      integer swvnum
+      integer swvlev
+      integer swvstk
+      integer swinrg
+      common /ckword/ rkwtbl
+      integer rkwtbl
+      common /clname/ fkwtbl, namtbl, gentbl, errtbl, xpptbl
+      integer fkwtbl
+      integer namtbl
+      integer gentbl
+      integer errtbl
+      integer xpptbl
+      common /erchek/ ername, body, esp, errstk(30)
+      integer ername
+      integer body
+      integer esp
+      integer errstk
+      integer mem( 60000)
+      common/cdsmem/mem
+      if (.not.(ep .gt. 500))goto 23000
+      call baderr (26Hevaluation stack overflow.)
+23000 continue
+      evalst (ep) = c
+      ep = ep + 1
+      return
+      end
+c     logic0  logical_column
diff --git a/unix/boot/spp/rpp/rppfor/puttok.f b/unix/boot/spp/rpp/rppfor/puttok.f
new file mode 100644
index 00000000..41d4df64
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/puttok.f
@@ -0,0 +1,11 @@
+      subroutine puttok (str)
+      integer str (100)
+      integer i
+      i = 1
+23000 if (.not.(str (i) .ne. -2))goto 23002
+      call putchr (str (i))
+23001 i = i + 1
+      goto 23000
+23002 continue
+      return
+      end
diff --git a/unix/boot/spp/rpp/rppfor/ratfor.f b/unix/boot/spp/rpp/rppfor/ratfor.f
new file mode 100644
index 00000000..7891bd68
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/ratfor.f
@@ -0,0 +1,128 @@
+      subroutine ratfor
+      common /cdefio/ bp, buf (4096)
+      integer bp
+      integer buf
+      common /cfname/ fcname (30)
+      integer fcname
+      common /cfor/ fordep, forstk (200)
+      integer fordep
+      integer forstk
+      common /cgoto/ xfer
+      integer xfer
+      common /clabel/ label, retlab, memflg, col, logic0
+      integer label
+      integer retlab
+      integer memflg
+      integer col
+      integer logic0
+      common /cline/ dbgout, dbglev, level, linect (5), infile (5), fnam
+     *p, fnames ( 150)
+      integer dbgout
+      integer dbglev
+      integer level
+      integer linect
+      integer infile
+      integer fnamp
+      integer fnames
+      common /cmacro/ cp, ep, evalst (500), deftbl
+      integer cp
+      integer ep
+      integer evalst
+      integer deftbl
+      common /coutln/ outp, outbuf (74)
+      integer outp
+      integer outbuf
+      common /csbuf/ sbp, sbuf(2048), smem(240)
+      integer sbp
+      integer sbuf
+      integer smem
+      common /cswtch/ swtop, swlast, swstak(1000), swvnum, swvlev, swvst
+     *k(10), swinrg
+      integer swtop
+      integer swlast
+      integer swstak
+      integer swvnum
+      integer swvlev
+      integer swvstk
+      integer swinrg
+      common /ckword/ rkwtbl
+      integer rkwtbl
+      common /clname/ fkwtbl, namtbl, gentbl, errtbl, xpptbl
+      integer fkwtbl
+      integer namtbl
+      integer gentbl
+      integer errtbl
+      integer xpptbl
+      common /erchek/ ername, body, esp, errstk(30)
+      integer ername
+      integer body
+      integer esp
+      integer errstk
+      integer mem( 60000)
+      common/cdsmem/mem
+      integer i, n
+      integer getarg, rfopen
+      integer arg (30)
+      integer defns(1)
+      data defns(1)/-2/
+      call initkw
+      if (.not.(defns (1) .ne. -2))goto 23000
+      infile (1) = rfopen(defns, 1)
+      if (.not.(infile (1) .eq. -3))goto 23002
+      call remark (37Hcan't open standard definitions file.)
+      goto 23003
+23002 continue
+      call finit
+      call parse
+      call rfclos(infile (1))
+23003 continue
+23000 continue
+      n = 1
+      i=1
+23004 if (.not.(getarg(i,arg,30) .ne. -1))goto 23006
+      n = n + 1
+      call query (37Husage:  ratfor [-g] [files] >outfile.)
+      if (.not.(arg(1) .eq. 45 .and. arg(2) .eq. 103 .and. arg(3) .eq. -
+     *2))goto 23007
+      dbgout = 1
+      goto 23005
+23007 continue
+      if (.not.(arg(1) .eq. 45 .and. arg(2) .eq. -2))goto 23009
+      infile(1) = 0
+      call finit
+      goto 23010
+23009 continue
+      infile(1) = rfopen(arg, 1)
+      if (.not.(infile(1) .eq. -3))goto 23011
+      call cant (arg)
+      goto 23012
+23011 continue
+      call finit
+      call scopy (arg, 1, fnames, 1)
+      fnamp=1
+23013 if (.not.(fnames(fnamp) .ne. -2))goto 23015
+      if (.not.(fnames(fnamp) .eq. 46 .and. fnames(fnamp+1) .eq. 114))go
+     *to 23016
+      fnames(fnamp+1) = 120
+23016 continue
+23014 fnamp=fnamp+1
+      goto 23013
+23015 continue
+23012 continue
+23010 continue
+23008 continue
+      call parse
+      if (.not.(infile (1) .ne. 0))goto 23018
+      call rfclos(infile (1))
+23018 continue
+23005 i=i+1
+      goto 23004
+23006 continue
+      if (.not.(n .eq. 1))goto 23020
+      infile (1) = 0
+      call finit
+      call parse
+23020 continue
+      call lndict
+      end
+c     logic0  logical_column
diff --git a/unix/boot/spp/rpp/rppfor/relate.f b/unix/boot/spp/rpp/rppfor/relate.f
new file mode 100644
index 00000000..36c3e196
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/relate.f
@@ -0,0 +1,66 @@
+      subroutine relate (token, last)
+      integer token (100)
+      integer last
+      integer ngetch
+      integer length
+      if (.not.(ngetch (token (2)) .ne. 61))goto 23000
+      call putbak (token (2))
+      token (3) = 116
+      goto 23001
+23000 continue
+      token (3) = 101
+23001 continue
+      token (4) = 46
+      token (5) = -2
+      token (6) = -2
+      if (.not.(token (1) .eq. 62))goto 23002
+      token (2) = 103
+      goto 23003
+23002 continue
+      if (.not.(token (1) .eq. 60))goto 23004
+      token (2) = 108
+      goto 23005
+23004 continue
+      if (.not.(token (1) .eq. 126 .or. token (1) .eq. 33 .or. token (1)
+     * .eq. 94 .or. token (1) .eq. 126))goto 23006
+      if (.not.(token (2) .ne. 61))goto 23008
+      token (3) = 111
+      token (4) = 116
+      token (5) = 46
+23008 continue
+      token (2) = 110
+      goto 23007
+23006 continue
+      if (.not.(token (1) .eq. 61))goto 23010
+      if (.not.(token (2) .ne. 61))goto 23012
+      token (2) = -2
+      last = 1
+      return
+23012 continue
+      token (2) = 101
+      token (3) = 113
+      goto 23011
+23010 continue
+      if (.not.(token (1) .eq. 38))goto 23014
+      token (2) = 97
+      token (3) = 110
+      token (4) = 100
+      token (5) = 46
+      goto 23015
+23014 continue
+      if (.not.(token (1) .eq. 124))goto 23016
+      token (2) = 111
+      token (3) = 114
+      goto 23017
+23016 continue
+      token (2) = -2
+23017 continue
+23015 continue
+23011 continue
+23007 continue
+23005 continue
+23003 continue
+      token (1) = 46
+      last = length (token)
+      return
+      end
diff --git a/unix/boot/spp/rpp/rppfor/repcod.f b/unix/boot/spp/rpp/rppfor/repcod.f
new file mode 100644
index 00000000..3279d58a
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/repcod.f
@@ -0,0 +1,10 @@
+      subroutine repcod (lab)
+      integer lab
+      integer labgen
+      call outcon (0)
+      lab = labgen (3)
+      call outcon (lab)
+      lab = lab + 1
+      call indent (1)
+      return
+      end
diff --git a/unix/boot/spp/rpp/rppfor/retcod.f b/unix/boot/spp/rpp/rppfor/retcod.f
new file mode 100644
index 00000000..1aa43aee
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/retcod.f
@@ -0,0 +1,88 @@
+      subroutine retcod
+      integer token (100), t
+      integer gnbtok
+      common /cdefio/ bp, buf (4096)
+      integer bp
+      integer buf
+      common /cfname/ fcname (30)
+      integer fcname
+      common /cfor/ fordep, forstk (200)
+      integer fordep
+      integer forstk
+      common /cgoto/ xfer
+      integer xfer
+      common /clabel/ label, retlab, memflg, col, logic0
+      integer label
+      integer retlab
+      integer memflg
+      integer col
+      integer logic0
+      common /cline/ dbgout, dbglev, level, linect (5), infile (5), fnam
+     *p, fnames ( 150)
+      integer dbgout
+      integer dbglev
+      integer level
+      integer linect
+      integer infile
+      integer fnamp
+      integer fnames
+      common /cmacro/ cp, ep, evalst (500), deftbl
+      integer cp
+      integer ep
+      integer evalst
+      integer deftbl
+      common /coutln/ outp, outbuf (74)
+      integer outp
+      integer outbuf
+      common /csbuf/ sbp, sbuf(2048), smem(240)
+      integer sbp
+      integer sbuf
+      integer smem
+      common /cswtch/ swtop, swlast, swstak(1000), swvnum, swvlev, swvst
+     *k(10), swinrg
+      integer swtop
+      integer swlast
+      integer swstak
+      integer swvnum
+      integer swvlev
+      integer swvstk
+      integer swinrg
+      common /ckword/ rkwtbl
+      integer rkwtbl
+      common /clname/ fkwtbl, namtbl, gentbl, errtbl, xpptbl
+      integer fkwtbl
+      integer namtbl
+      integer gentbl
+      integer errtbl
+      integer xpptbl
+      common /erchek/ ername, body, esp, errstk(30)
+      integer ername
+      integer body
+      integer esp
+      integer errstk
+      integer mem( 60000)
+      common/cdsmem/mem
+      t = gnbtok (token, 100)
+      if (.not.(t .ne. 10 .and. t .ne. 59 .and. t .ne. 125))goto 23000
+      call pbstr (token)
+      call outtab
+      call scopy (fcname, 1, token, 1)
+      call squash (token)
+      call outstr (token)
+      call outch (32)
+      call outch (61)
+      call outch (32)
+      call eatup
+      call outdon
+      goto 23001
+23000 continue
+      if (.not.(t .eq. 125))goto 23002
+      call pbstr (token)
+23002 continue
+23001 continue
+      call outtab
+      call ogotos (retlab, 0)
+      xfer = 1
+      return
+      end
+c     logic0  logical_column
diff --git a/unix/boot/spp/rpp/rppfor/sdupl.f b/unix/boot/spp/rpp/rppfor/sdupl.f
new file mode 100644
index 00000000..0d35237a
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/sdupl.f
@@ -0,0 +1,20 @@
+      integer function sdupl (str)
+      integer str (100)
+      integer mem( 60000)
+      common/cdsmem/mem
+      integer i
+      integer length
+      integer j
+      integer dsget
+      j = dsget (length (str) + 1)
+      sdupl = j
+      i = 1
+23000 if (.not.(str (i) .ne. -2))goto 23002
+      mem (j) = str (i)
+      j = j + 1
+23001 i = i + 1
+      goto 23000
+23002 continue
+      mem (j) = -2
+      return
+      end
diff --git a/unix/boot/spp/rpp/rppfor/skpblk.f b/unix/boot/spp/rpp/rppfor/skpblk.f
new file mode 100644
index 00000000..47c2b0aa
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/skpblk.f
@@ -0,0 +1,73 @@
+      subroutine skpblk
+      common /cdefio/ bp, buf (4096)
+      integer bp
+      integer buf
+      common /cfname/ fcname (30)
+      integer fcname
+      common /cfor/ fordep, forstk (200)
+      integer fordep
+      integer forstk
+      common /cgoto/ xfer
+      integer xfer
+      common /clabel/ label, retlab, memflg, col, logic0
+      integer label
+      integer retlab
+      integer memflg
+      integer col
+      integer logic0
+      common /cline/ dbgout, dbglev, level, linect (5), infile (5), fnam
+     *p, fnames ( 150)
+      integer dbgout
+      integer dbglev
+      integer level
+      integer linect
+      integer infile
+      integer fnamp
+      integer fnames
+      common /cmacro/ cp, ep, evalst (500), deftbl
+      integer cp
+      integer ep
+      integer evalst
+      integer deftbl
+      common /coutln/ outp, outbuf (74)
+      integer outp
+      integer outbuf
+      common /csbuf/ sbp, sbuf(2048), smem(240)
+      integer sbp
+      integer sbuf
+      integer smem
+      common /cswtch/ swtop, swlast, swstak(1000), swvnum, swvlev, swvst
+     *k(10), swinrg
+      integer swtop
+      integer swlast
+      integer swstak
+      integer swvnum
+      integer swvlev
+      integer swvstk
+      integer swinrg
+      common /ckword/ rkwtbl
+      integer rkwtbl
+      common /clname/ fkwtbl, namtbl, gentbl, errtbl, xpptbl
+      integer fkwtbl
+      integer namtbl
+      integer gentbl
+      integer errtbl
+      integer xpptbl
+      common /erchek/ ername, body, esp, errstk(30)
+      integer ername
+      integer body
+      integer esp
+      integer errstk
+      integer mem( 60000)
+      common/cdsmem/mem
+      integer c
+      integer ngetch
+      c = ngetch (c)
+23000 if (.not.(c .eq. 32 .or. c .eq. 9))goto 23002
+23001 c = ngetch (c)
+      goto 23000
+23002 continue
+      call putbak (c)
+      return
+      end
+c     logic0  logical_column
diff --git a/unix/boot/spp/rpp/rppfor/squash.f b/unix/boot/spp/rpp/rppfor/squash.f
new file mode 100644
index 00000000..d0e654f0
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/squash.f
@@ -0,0 +1,104 @@
+      subroutine squash (id)
+      integer id(100)
+      integer junk, i, j
+      integer lookup, ludef
+      integer newid(100), recdid(100)
+      common /cdefio/ bp, buf (4096)
+      integer bp
+      integer buf
+      common /cfname/ fcname (30)
+      integer fcname
+      common /cfor/ fordep, forstk (200)
+      integer fordep
+      integer forstk
+      common /cgoto/ xfer
+      integer xfer
+      common /clabel/ label, retlab, memflg, col, logic0
+      integer label
+      integer retlab
+      integer memflg
+      integer col
+      integer logic0
+      common /cline/ dbgout, dbglev, level, linect (5), infile (5), fnam
+     *p, fnames ( 150)
+      integer dbgout
+      integer dbglev
+      integer level
+      integer linect
+      integer infile
+      integer fnamp
+      integer fnames
+      common /cmacro/ cp, ep, evalst (500), deftbl
+      integer cp
+      integer ep
+      integer evalst
+      integer deftbl
+      common /coutln/ outp, outbuf (74)
+      integer outp
+      integer outbuf
+      common /csbuf/ sbp, sbuf(2048), smem(240)
+      integer sbp
+      integer sbuf
+      integer smem
+      common /cswtch/ swtop, swlast, swstak(1000), swvnum, swvlev, swvst
+     *k(10), swinrg
+      integer swtop
+      integer swlast
+      integer swstak
+      integer swvnum
+      integer swvlev
+      integer swvstk
+      integer swinrg
+      common /ckword/ rkwtbl
+      integer rkwtbl
+      common /clname/ fkwtbl, namtbl, gentbl, errtbl, xpptbl
+      integer fkwtbl
+      integer namtbl
+      integer gentbl
+      integer errtbl
+      integer xpptbl
+      common /erchek/ ername, body, esp, errstk(30)
+      integer ername
+      integer body
+      integer esp
+      integer errstk
+      integer mem( 60000)
+      common/cdsmem/mem
+      if (.not.(body .eq. 1 .and. errtbl .ne. 0 .and. ername .eq. 0))got
+     *o 23000
+      if (.not.(lookup (id, junk, errtbl) .eq. 1))goto 23002
+      ername = 1
+23002 continue
+23000 continue
+      j = 1
+      i=1
+23004 if (.not.(id(i) .ne. -2))goto 23006
+      if (.not.(((65.le.id(i).and.id(i).le.90).or.(97.le.id(i).and.id(i)
+     *.le.122)) .or. (48.le.id(i).and.id(i).le.57)))goto 23007
+      newid(j) = id(i)
+      j = j + 1
+23007 continue
+23005 i=i+1
+      goto 23004
+23006 continue
+      newid(j) = -2
+      if (.not.(i-1 .lt. 6 .and. i .eq. j))goto 23009
+      return
+23009 continue
+      if (.not.(lookup (id, junk, fkwtbl) .eq. 1))goto 23011
+      return
+23011 continue
+      if (.not.(ludef (id, recdid, namtbl) .eq. 1))goto 23013
+      call scopy (recdid, 1, id, 1)
+      return
+23013 continue
+      call mapid (newid)
+      if (.not.(lookup (newid, junk, gentbl) .eq. 1))goto 23015
+      call synerr (39HWarning: identifier mapping not unique.)
+      call uniqid (newid)
+23015 continue
+      call entdef (newid, id, gentbl)
+      call entdef (id, newid, namtbl)
+      call scopy (newid, 1, id, 1)
+      end
+c     logic0  logical_column
diff --git a/unix/boot/spp/rpp/rppfor/strdcl.f b/unix/boot/spp/rpp/rppfor/strdcl.f
new file mode 100644
index 00000000..5ebcaeba
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/strdcl.f
@@ -0,0 +1,170 @@
+      subroutine strdcl
+      common /cdefio/ bp, buf (4096)
+      integer bp
+      integer buf
+      common /cfname/ fcname (30)
+      integer fcname
+      common /cfor/ fordep, forstk (200)
+      integer fordep
+      integer forstk
+      common /cgoto/ xfer
+      integer xfer
+      common /clabel/ label, retlab, memflg, col, logic0
+      integer label
+      integer retlab
+      integer memflg
+      integer col
+      integer logic0
+      common /cline/ dbgout, dbglev, level, linect (5), infile (5), fnam
+     *p, fnames ( 150)
+      integer dbgout
+      integer dbglev
+      integer level
+      integer linect
+      integer infile
+      integer fnamp
+      integer fnames
+      common /cmacro/ cp, ep, evalst (500), deftbl
+      integer cp
+      integer ep
+      integer evalst
+      integer deftbl
+      common /coutln/ outp, outbuf (74)
+      integer outp
+      integer outbuf
+      common /csbuf/ sbp, sbuf(2048), smem(240)
+      integer sbp
+      integer sbuf
+      integer smem
+      common /cswtch/ swtop, swlast, swstak(1000), swvnum, swvlev, swvst
+     *k(10), swinrg
+      integer swtop
+      integer swlast
+      integer swstak
+      integer swvnum
+      integer swvlev
+      integer swvstk
+      integer swinrg
+      common /ckword/ rkwtbl
+      integer rkwtbl
+      common /clname/ fkwtbl, namtbl, gentbl, errtbl, xpptbl
+      integer fkwtbl
+      integer namtbl
+      integer gentbl
+      integer errtbl
+      integer xpptbl
+      common /erchek/ ername, body, esp, errstk(30)
+      integer ername
+      integer body
+      integer esp
+      integer errstk
+      integer mem( 60000)
+      common/cdsmem/mem
+      integer t, token (100), dchar (100)
+      integer gnbtok
+      integer i, j, k, n, len
+      integer length, ctoi, lex
+      integer char(11)
+      integer dat(6)
+      integer eoss(3)
+      data char(1)/105/,char(2)/110/,char(3)/116/,char(4)/101/,char(5)/1
+     *03/,char(6)/101/,char(7)/114/,char(8)/42/,char(9)/50/,char(10)/47/
+     *,char(11)/-2/
+      data dat(1)/100/,dat(2)/97/,dat(3)/116/,dat(4)/97/,dat(5)/32/,dat(
+     *6)/-2/
+      data eoss(1)/48/,eoss(2)/47/,eoss(3)/-2/
+      t = gnbtok (token, 100)
+      if (.not.(t .ne. -9))goto 23000
+      call synerr (21Hmissing string token.)
+23000 continue
+      call squash (token)
+      call outtab
+      call pbstr (char)
+23002 continue
+      t = gnbtok (dchar, 100)
+      if (.not.(t .eq. 47))goto 23005
+      goto 23004
+23005 continue
+      call outstr (dchar)
+23003 goto 23002
+23004 continue
+      call outch (32)
+      call outstr (token)
+      call addstr (token, sbuf, sbp, 2048)
+      call addchr (-2, sbuf, sbp, 2048)
+      if (.not.(gnbtok (token, 100) .ne. 40))goto 23007
+      len = length (token) + 1
+      if (.not.(token (1) .eq. 39 .or. token (1) .eq. 34))goto 23009
+      len = len - 2
+23009 continue
+      goto 23008
+23007 continue
+      t = gnbtok (token, 100)
+      i = 1
+      len = ctoi (token, i)
+      if (.not.(token (i) .ne. -2))goto 23011
+      call synerr (20Hinvalid string size.)
+23011 continue
+      if (.not.(gnbtok (token, 100) .ne. 41))goto 23013
+      call synerr (20Hmissing right paren.)
+      goto 23014
+23013 continue
+      t = gnbtok (token, 100)
+23014 continue
+23008 continue
+      call outch (40)
+      call outnum (len)
+      call outch (41)
+      call outdon
+      if (.not.(token (1) .eq. 39 .or. token (1) .eq. 34))goto 23015
+      len = length (token)
+      token (len) = -2
+      call addstr (token (2), sbuf, sbp, 2048)
+      goto 23016
+23015 continue
+      call addstr (token, sbuf, sbp, 2048)
+23016 continue
+      call addchr (-2, sbuf, sbp, 2048)
+      t = lex (token)
+      call pbstr (token)
+      if (.not.(t .ne. -75))goto 23017
+      i = 1
+23019 if (.not.(i .lt. sbp))goto 23021
+      call outtab
+      call outstr (dat)
+      k = 1
+      j = i + length (sbuf (i)) + 1
+23022 continue
+      if (.not.(k .gt. 1))goto 23025
+      call outch (44)
+23025 continue
+      call outstr (sbuf (i))
+      call outch (40)
+      call outnum (k)
+      call outch (41)
+      call outch (47)
+      if (.not.(sbuf (j) .eq. -2))goto 23027
+      goto 23024
+23027 continue
+      n = sbuf (j)
+      call outnum (n)
+      call outch (47)
+      k = k + 1
+23023 j = j + 1
+      goto 23022
+23024 continue
+      call pbstr (eoss)
+23029 continue
+      t = gnbtok (token, 100)
+      call outstr (token)
+23030 if (.not.(t .eq. 47))goto 23029
+23031 continue
+      call outdon
+23020 i = j + 1
+      goto 23019
+23021 continue
+      sbp = 1
+23017 continue
+      return
+      end
+c     logic0  logical_column
diff --git a/unix/boot/spp/rpp/rppfor/swcode.f b/unix/boot/spp/rpp/rppfor/swcode.f
new file mode 100644
index 00000000..22617fdc
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/swcode.f
@@ -0,0 +1,99 @@
+      subroutine swcode (lab)
+      integer lab
+      common /cdefio/ bp, buf (4096)
+      integer bp
+      integer buf
+      common /cfname/ fcname (30)
+      integer fcname
+      common /cfor/ fordep, forstk (200)
+      integer fordep
+      integer forstk
+      common /cgoto/ xfer
+      integer xfer
+      common /clabel/ label, retlab, memflg, col, logic0
+      integer label
+      integer retlab
+      integer memflg
+      integer col
+      integer logic0
+      common /cline/ dbgout, dbglev, level, linect (5), infile (5), fnam
+     *p, fnames ( 150)
+      integer dbgout
+      integer dbglev
+      integer level
+      integer linect
+      integer infile
+      integer fnamp
+      integer fnames
+      common /cmacro/ cp, ep, evalst (500), deftbl
+      integer cp
+      integer ep
+      integer evalst
+      integer deftbl
+      common /coutln/ outp, outbuf (74)
+      integer outp
+      integer outbuf
+      common /csbuf/ sbp, sbuf(2048), smem(240)
+      integer sbp
+      integer sbuf
+      integer smem
+      common /cswtch/ swtop, swlast, swstak(1000), swvnum, swvlev, swvst
+     *k(10), swinrg
+      integer swtop
+      integer swlast
+      integer swstak
+      integer swvnum
+      integer swvlev
+      integer swvstk
+      integer swinrg
+      common /ckword/ rkwtbl
+      integer rkwtbl
+      common /clname/ fkwtbl, namtbl, gentbl, errtbl, xpptbl
+      integer fkwtbl
+      integer namtbl
+      integer gentbl
+      integer errtbl
+      integer xpptbl
+      common /erchek/ ername, body, esp, errstk(30)
+      integer ername
+      integer body
+      integer esp
+      integer errstk
+      integer mem( 60000)
+      common/cdsmem/mem
+      integer tok (100)
+      integer labgen, gnbtok
+      lab = labgen (2)
+      swvnum = swvnum + 1
+      swvlev = swvlev + 1
+      if (.not.(swvlev .gt. 10))goto 23000
+      call baderr (27Hswitches nested too deeply.)
+23000 continue
+      swvstk(swvlev) = swvnum
+      if (.not.(swlast + 3 .gt. 1000))goto 23002
+      call baderr (22Hswitch table overflow.)
+23002 continue
+      swstak (swlast) = swtop
+      swstak (swlast + 1) = 0
+      swstak (swlast + 2) = 0
+      swtop = swlast
+      swlast = swlast + 3
+      xfer = 0
+      call outtab
+      call swvar (swvnum)
+      call outch (61)
+      call balpar
+      call outdwe
+      call outgo (lab)
+      call indent (1)
+      xfer = 1
+23004 if (.not.(gnbtok (tok, 100) .eq. 10))goto 23005
+      goto 23004
+23005 continue
+      if (.not.(tok (1) .ne. 123))goto 23006
+      call synerr (39Hmissing left brace in switch statement.)
+      call pbstr (tok)
+23006 continue
+      return
+      end
+c     logic0  logical_column
diff --git a/unix/boot/spp/rpp/rppfor/swend.f b/unix/boot/spp/rpp/rppfor/swend.f
new file mode 100644
index 00000000..02070f32
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/swend.f
@@ -0,0 +1,187 @@
+      subroutine swend (lab)
+      integer lab
+      common /cdefio/ bp, buf (4096)
+      integer bp
+      integer buf
+      common /cfname/ fcname (30)
+      integer fcname
+      common /cfor/ fordep, forstk (200)
+      integer fordep
+      integer forstk
+      common /cgoto/ xfer
+      integer xfer
+      common /clabel/ label, retlab, memflg, col, logic0
+      integer label
+      integer retlab
+      integer memflg
+      integer col
+      integer logic0
+      common /cline/ dbgout, dbglev, level, linect (5), infile (5), fnam
+     *p, fnames ( 150)
+      integer dbgout
+      integer dbglev
+      integer level
+      integer linect
+      integer infile
+      integer fnamp
+      integer fnames
+      common /cmacro/ cp, ep, evalst (500), deftbl
+      integer cp
+      integer ep
+      integer evalst
+      integer deftbl
+      common /coutln/ outp, outbuf (74)
+      integer outp
+      integer outbuf
+      common /csbuf/ sbp, sbuf(2048), smem(240)
+      integer sbp
+      integer sbuf
+      integer smem
+      common /cswtch/ swtop, swlast, swstak(1000), swvnum, swvlev, swvst
+     *k(10), swinrg
+      integer swtop
+      integer swlast
+      integer swstak
+      integer swvnum
+      integer swvlev
+      integer swvstk
+      integer swinrg
+      common /ckword/ rkwtbl
+      integer rkwtbl
+      common /clname/ fkwtbl, namtbl, gentbl, errtbl, xpptbl
+      integer fkwtbl
+      integer namtbl
+      integer gentbl
+      integer errtbl
+      integer xpptbl
+      common /erchek/ ername, body, esp, errstk(30)
+      integer ername
+      integer body
+      integer esp
+      integer errstk
+      integer mem( 60000)
+      common/cdsmem/mem
+      integer lb, ub, n, i, j, swn
+      integer sif(5)
+      integer slt(10)
+      integer sgt(5)
+      integer sgoto(7)
+      integer seq(5)
+      integer sge(5)
+      integer sle(5)
+      integer sand(6)
+      data sif(1)/105/,sif(2)/102/,sif(3)/32/,sif(4)/40/,sif(5)/-2/
+      data slt(1)/46/,slt(2)/108/,slt(3)/116/,slt(4)/46/,slt(5)/49/,slt(
+     *6)/46/,slt(7)/111/,slt(8)/114/,slt(9)/46/,slt(10)/-2/
+      data sgt(1)/46/,sgt(2)/103/,sgt(3)/116/,sgt(4)/46/,sgt(5)/-2/
+      data sgoto(1)/103/,sgoto(2)/111/,sgoto(3)/116/,sgoto(4)/111/,sgoto
+     *(5)/32/,sgoto(6)/40/,sgoto(7)/-2/
+      data seq(1)/46/,seq(2)/101/,seq(3)/113/,seq(4)/46/,seq(5)/-2/
+      data sge(1)/46/,sge(2)/103/,sge(3)/101/,sge(4)/46/,sge(5)/-2/
+      data sle(1)/46/,sle(2)/108/,sle(3)/101/,sle(4)/46/,sle(5)/-2/
+      data sand(1)/46/,sand(2)/97/,sand(3)/110/,sand(4)/100/,sand(5)/46/
+     *,sand(6)/-2/
+      swn = swvstk(swvlev)
+      swvlev = max0(0, swvlev - 1)
+      lb = swstak (swtop + 3)
+      ub = swstak (swlast - 2)
+      n = swstak (swtop + 1)
+      call outgo (lab + 1)
+      if (.not.(swstak (swtop + 2) .eq. 0))goto 23000
+      swstak (swtop + 2) = lab + 1
+23000 continue
+      xfer = 0
+      call indent (-1)
+      call outcon (lab)
+      call indent (1)
+      if (.not.(n .ge. 3 .and. ub - lb + 1 .lt. 2 * n))goto 23002
+      if (.not.(lb .ne. 1))goto 23004
+      call outtab
+      call swvar (swn)
+      call outch (61)
+      call swvar (swn)
+      if (.not.(lb .lt. 1))goto 23006
+      call outch (43)
+23006 continue
+      call outnum (-lb + 1)
+      call outdon
+23004 continue
+      if (.not.(swinrg .eq. 0))goto 23008
+      call outtab
+      call outstr (sif)
+      call swvar (swn)
+      call outstr (slt)
+      call swvar (swn)
+      call outstr (sgt)
+      call outnum (ub - lb + 1)
+      call outch (41)
+      call outch (32)
+      call outgo (swstak (swtop + 2))
+23008 continue
+      call outtab
+      call outstr (sgoto)
+      j = lb
+      i = swtop + 3
+23010 if (.not.(i .lt. swlast))goto 23012
+23013 if (.not.(j .lt. swstak (i)))goto 23015
+      call outnum (swstak (swtop + 2))
+      call outch (44)
+23014 j = j + 1
+      goto 23013
+23015 continue
+      j = swstak (i + 1) - swstak (i)
+23016 if (.not.(j .ge. 0))goto 23018
+      call outnum (swstak (i + 2))
+23017 j = j - 1
+      goto 23016
+23018 continue
+      j = swstak (i + 1) + 1
+      if (.not.(i .lt. swlast - 3))goto 23019
+      call outch (44)
+23019 continue
+23011 i = i + 3
+      goto 23010
+23012 continue
+      call outch (41)
+      call outch (44)
+      call swvar (swn)
+      call outdon
+      goto 23003
+23002 continue
+      if (.not.(n .gt. 0))goto 23021
+      i = swtop + 3
+23023 if (.not.(i .lt. swlast))goto 23025
+      call outtab
+      call outstr (sif)
+      call swvar (swn)
+      if (.not.(swstak (i) .eq. swstak (i+1)))goto 23026
+      call outstr (seq)
+      call outnum (swstak (i))
+      goto 23027
+23026 continue
+      call outstr (sge)
+      call outnum (swstak (i))
+      call outstr (sand)
+      call swvar (swn)
+      call outstr (sle)
+      call outnum (swstak (i + 1))
+23027 continue
+      call outch (41)
+      call outch (32)
+      call outgo (swstak (i + 2))
+23024 i = i + 3
+      goto 23023
+23025 continue
+      if (.not.(lab + 1 .ne. swstak (swtop + 2)))goto 23028
+      call outgo (swstak (swtop + 2))
+23028 continue
+23021 continue
+23003 continue
+      call indent (-1)
+      call outcon (lab + 1)
+      swlast = swtop
+      swtop = swstak (swtop)
+      swinrg = 0
+      return
+      end
+c     logic0  logical_column
diff --git a/unix/boot/spp/rpp/rppfor/swvar.f b/unix/boot/spp/rpp/rppfor/swvar.f
new file mode 100644
index 00000000..948e43ab
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/swvar.f
@@ -0,0 +1,21 @@
+      subroutine swvar (lab)
+      integer lab, i, labnum, ndigi0
+      call outch (115)
+      call outch (119)
+      labnum = lab
+      ndigi0=0
+23000 if (.not.(labnum .gt. 0))goto 23002
+      ndigi0 = ndigi0 + 1
+23001 labnum=labnum/10
+      goto 23000
+23002 continue
+      i=3
+23003 if (.not.(i .le. 6 - ndigi0))goto 23005
+      call outch (48)
+23004 i=i+1
+      goto 23003
+23005 continue
+      call outnum (lab)
+      return
+      end
+c     ndigi0  ndigits
diff --git a/unix/boot/spp/rpp/rppfor/synerr.f b/unix/boot/spp/rpp/rppfor/synerr.f
new file mode 100644
index 00000000..818171e5
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/synerr.f
@@ -0,0 +1,98 @@
+      subroutine synerr (msg)
+      integer msg
+      common /cdefio/ bp, buf (4096)
+      integer bp
+      integer buf
+      common /cfname/ fcname (30)
+      integer fcname
+      common /cfor/ fordep, forstk (200)
+      integer fordep
+      integer forstk
+      common /cgoto/ xfer
+      integer xfer
+      common /clabel/ label, retlab, memflg, col, logic0
+      integer label
+      integer retlab
+      integer memflg
+      integer col
+      integer logic0
+      common /cline/ dbgout, dbglev, level, linect (5), infile (5), fnam
+     *p, fnames ( 150)
+      integer dbgout
+      integer dbglev
+      integer level
+      integer linect
+      integer infile
+      integer fnamp
+      integer fnames
+      common /cmacro/ cp, ep, evalst (500), deftbl
+      integer cp
+      integer ep
+      integer evalst
+      integer deftbl
+      common /coutln/ outp, outbuf (74)
+      integer outp
+      integer outbuf
+      common /csbuf/ sbp, sbuf(2048), smem(240)
+      integer sbp
+      integer sbuf
+      integer smem
+      common /cswtch/ swtop, swlast, swstak(1000), swvnum, swvlev, swvst
+     *k(10), swinrg
+      integer swtop
+      integer swlast
+      integer swstak
+      integer swvnum
+      integer swvlev
+      integer swvstk
+      integer swinrg
+      common /ckword/ rkwtbl
+      integer rkwtbl
+      common /clname/ fkwtbl, namtbl, gentbl, errtbl, xpptbl
+      integer fkwtbl
+      integer namtbl
+      integer gentbl
+      integer errtbl
+      integer xpptbl
+      common /erchek/ ername, body, esp, errstk(30)
+      integer ername
+      integer body
+      integer esp
+      integer errstk
+      integer mem( 60000)
+      common/cdsmem/mem
+      integer lc (20)
+      integer i, junk
+      integer itoc
+      integer of(5)
+      integer errmsg(100)
+      data of(1)/32/,of(2)/111/,of(3)/102/,of(4)/32/,of(5)/-2/
+      data errmsg(1)/69/,errmsg(2)/114/,errmsg(3)/114/,errmsg(4)/111/,er
+     *rmsg(5)/114/,errmsg(6)/32/,errmsg(7)/111/,errmsg(8)/110/,errmsg(9)
+     */32/,errmsg(10)/108/,errmsg(11)/105/,errmsg(12)/110/,errmsg(13)/10
+     *1/,errmsg(14)/32/,errmsg(15)/-2/
+      call putlin (errmsg, 2)
+      if (.not.(level .ge. 1))goto 23000
+      i = level
+      goto 23001
+23000 continue
+      i = 1
+23001 continue
+      junk = itoc (linect (i), lc, 20)
+      call putlin (lc, 2)
+      i = fnamp - 1
+23002 if (.not.(i .ge. 1))goto 23004
+      if (.not.(fnames (i - 1) .eq. -2 .or. i .eq. 1))goto 23005
+      call putlin (of, 2)
+      call putlin (fnames (i), 2)
+      goto 23004
+23005 continue
+23003 i = i - 1
+      goto 23002
+23004 continue
+      call putch (58, 2)
+      call putch (32, 2)
+      call remark (msg)
+      return
+      end
+c     logic0  logical_column
diff --git a/unix/boot/spp/rpp/rppfor/thenco.f b/unix/boot/spp/rpp/rppfor/thenco.f
new file mode 100644
index 00000000..bb6060d7
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/thenco.f
@@ -0,0 +1,90 @@
+      subroutine thenco (tok, lab)
+      integer lab, tok
+      common /cdefio/ bp, buf (4096)
+      integer bp
+      integer buf
+      common /cfname/ fcname (30)
+      integer fcname
+      common /cfor/ fordep, forstk (200)
+      integer fordep
+      integer forstk
+      common /cgoto/ xfer
+      integer xfer
+      common /clabel/ label, retlab, memflg, col, logic0
+      integer label
+      integer retlab
+      integer memflg
+      integer col
+      integer logic0
+      common /cline/ dbgout, dbglev, level, linect (5), infile (5), fnam
+     *p, fnames ( 150)
+      integer dbgout
+      integer dbglev
+      integer level
+      integer linect
+      integer infile
+      integer fnamp
+      integer fnames
+      common /cmacro/ cp, ep, evalst (500), deftbl
+      integer cp
+      integer ep
+      integer evalst
+      integer deftbl
+      common /coutln/ outp, outbuf (74)
+      integer outp
+      integer outbuf
+      common /csbuf/ sbp, sbuf(2048), smem(240)
+      integer sbp
+      integer sbuf
+      integer smem
+      common /cswtch/ swtop, swlast, swstak(1000), swvnum, swvlev, swvst
+     *k(10), swinrg
+      integer swtop
+      integer swlast
+      integer swstak
+      integer swvnum
+      integer swvlev
+      integer swvstk
+      integer swinrg
+      common /ckword/ rkwtbl
+      integer rkwtbl
+      common /clname/ fkwtbl, namtbl, gentbl, errtbl, xpptbl
+      integer fkwtbl
+      integer namtbl
+      integer gentbl
+      integer errtbl
+      integer xpptbl
+      common /erchek/ ername, body, esp, errstk(30)
+      integer ername
+      integer body
+      integer esp
+      integer errstk
+      integer mem( 60000)
+      common/cdsmem/mem
+      integer siferr(20)
+      integer sifno0(15)
+      data siferr(1)/105/,siferr(2)/102/,siferr(3)/32/,siferr(4)/40/,sif
+     *err(5)/46/,siferr(6)/110/,siferr(7)/111/,siferr(8)/116/,siferr(9)/
+     *46/,siferr(10)/120/,siferr(11)/101/,siferr(12)/114/,siferr(13)/112
+     */,siferr(14)/111/,siferr(15)/112/,siferr(16)/40/,siferr(17)/41/,si
+     *ferr(18)/41/,siferr(19)/32/,siferr(20)/-2/
+      data sifno0(1)/105/,sifno0(2)/102/,sifno0(3)/32/,sifno0(4)/40/,sif
+     *no0(5)/120/,sifno0(6)/101/,sifno0(7)/114/,sifno0(8)/112/,sifno0(9)
+     */111/,sifno0(10)/112/,sifno0(11)/40/,sifno0(12)/41/,sifno0(13)/41/
+     *,sifno0(14)/32/,sifno0(15)/-2/
+      xfer = 0
+      call outnum (lab+2)
+      call outtab
+      if (.not.(tok .eq. -98))goto 23000
+      call outstr (siferr)
+      goto 23001
+23000 continue
+      call outstr (sifno0)
+23001 continue
+      call outgo (lab)
+      esp = esp - 1
+      call indent (1)
+      return
+      end
+c     sifno0  sifnoerr
+c     logic0  logical_column
diff --git a/unix/boot/spp/rpp/rppfor/ulstal.f b/unix/boot/spp/rpp/rppfor/ulstal.f
new file mode 100644
index 00000000..fe59090b
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/ulstal.f
@@ -0,0 +1,69 @@
+      subroutine ulstal (name, defn)
+      integer name (100), defn (100)
+      common /cdefio/ bp, buf (4096)
+      integer bp
+      integer buf
+      common /cfname/ fcname (30)
+      integer fcname
+      common /cfor/ fordep, forstk (200)
+      integer fordep
+      integer forstk
+      common /cgoto/ xfer
+      integer xfer
+      common /clabel/ label, retlab, memflg, col, logic0
+      integer label
+      integer retlab
+      integer memflg
+      integer col
+      integer logic0
+      common /cline/ dbgout, dbglev, level, linect (5), infile (5), fnam
+     *p, fnames ( 150)
+      integer dbgout
+      integer dbglev
+      integer level
+      integer linect
+      integer infile
+      integer fnamp
+      integer fnames
+      common /cmacro/ cp, ep, evalst (500), deftbl
+      integer cp
+      integer ep
+      integer evalst
+      integer deftbl
+      common /coutln/ outp, outbuf (74)
+      integer outp
+      integer outbuf
+      common /csbuf/ sbp, sbuf(2048), smem(240)
+      integer sbp
+      integer sbuf
+      integer smem
+      common /cswtch/ swtop, swlast, swstak(1000), swvnum, swvlev, swvst
+     *k(10), swinrg
+      integer swtop
+      integer swlast
+      integer swstak
+      integer swvnum
+      integer swvlev
+      integer swvstk
+      integer swinrg
+      common /ckword/ rkwtbl
+      integer rkwtbl
+      common /clname/ fkwtbl, namtbl, gentbl, errtbl, xpptbl
+      integer fkwtbl
+      integer namtbl
+      integer gentbl
+      integer errtbl
+      integer xpptbl
+      common /erchek/ ername, body, esp, errstk(30)
+      integer ername
+      integer body
+      integer esp
+      integer errstk
+      integer mem( 60000)
+      common/cdsmem/mem
+      call entdef (name, defn, deftbl)
+      call upper (name)
+      call entdef (name, defn, deftbl)
+      return
+      end
+c     logic0  logical_column
diff --git a/unix/boot/spp/rpp/rppfor/uniqid.f b/unix/boot/spp/rpp/rppfor/uniqid.f
new file mode 100644
index 00000000..d843f0eb
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/uniqid.f
@@ -0,0 +1,116 @@
+      subroutine uniqid (id)
+      integer id (100)
+      integer i, j, junk, idchl
+      external index
+      integer lookup, index, length
+      integer start (6)
+      common /cdefio/ bp, buf (4096)
+      integer bp
+      integer buf
+      common /cfname/ fcname (30)
+      integer fcname
+      common /cfor/ fordep, forstk (200)
+      integer fordep
+      integer forstk
+      common /cgoto/ xfer
+      integer xfer
+      common /clabel/ label, retlab, memflg, col, logic0
+      integer label
+      integer retlab
+      integer memflg
+      integer col
+      integer logic0
+      common /cline/ dbgout, dbglev, level, linect (5), infile (5), fnam
+     *p, fnames ( 150)
+      integer dbgout
+      integer dbglev
+      integer level
+      integer linect
+      integer infile
+      integer fnamp
+      integer fnames
+      common /cmacro/ cp, ep, evalst (500), deftbl
+      integer cp
+      integer ep
+      integer evalst
+      integer deftbl
+      common /coutln/ outp, outbuf (74)
+      integer outp
+      integer outbuf
+      common /csbuf/ sbp, sbuf(2048), smem(240)
+      integer sbp
+      integer sbuf
+      integer smem
+      common /cswtch/ swtop, swlast, swstak(1000), swvnum, swvlev, swvst
+     *k(10), swinrg
+      integer swtop
+      integer swlast
+      integer swstak
+      integer swvnum
+      integer swvlev
+      integer swvstk
+      integer swinrg
+      common /ckword/ rkwtbl
+      integer rkwtbl
+      common /clname/ fkwtbl, namtbl, gentbl, errtbl, xpptbl
+      integer fkwtbl
+      integer namtbl
+      integer gentbl
+      integer errtbl
+      integer xpptbl
+      common /erchek/ ername, body, esp, errstk(30)
+      integer ername
+      integer body
+      integer esp
+      integer errstk
+      integer mem( 60000)
+      common/cdsmem/mem
+      integer idch(37)
+      data idch(1)/48/,idch(2)/49/,idch(3)/50/,idch(4)/51/,idch(5)/52/,i
+     *dch(6)/53/,idch(7)/54/,idch(8)/55/,idch(9)/56/,idch(10)/57/,idch(1
+     *1)/97/,idch(12)/98/,idch(13)/99/,idch(14)/100/,idch(15)/101/,idch(
+     *16)/102/,idch(17)/103/,idch(18)/104/,idch(19)/105/,idch(20)/106/,i
+     *dch(21)/107/,idch(22)/108/,idch(23)/109/,idch(24)/110/,idch(25)/11
+     *1/,idch(26)/112/,idch(27)/113/,idch(28)/114/,idch(29)/115/,idch(30
+     *)/116/,idch(31)/117/,idch(32)/118/,idch(33)/119/,idch(34)/120/,idc
+     *h(35)/121/,idch(36)/122/,idch(37)/-2/
+      i = 1
+23000 if (.not.(id (i) .ne. -2))goto 23002
+23001 i = i + 1
+      goto 23000
+23002 continue
+23003 if (.not.(i .le. 6))goto 23005
+      id (i) = 48
+23004 i = i + 1
+      goto 23003
+23005 continue
+      i = 6 + 1
+      id (i) = -2
+      id (i - 1) = 48
+      if (.not.(lookup (id, junk, gentbl) .eq. 1))goto 23006
+      idchl = length (idch)
+      i = 2
+23008 if (.not.(i .lt. 6))goto 23010
+      start (i) = id (i)
+23009 i = i + 1
+      goto 23008
+23010 continue
+23011 continue
+      i = 6 - 1
+23014 if (.not.(i .gt. 1))goto 23016
+      j = mod (index (idch, id (i)), idchl) + 1
+      id (i) = idch (j)
+      if (.not.(id (i) .ne. start (i)))goto 23017
+      goto 23016
+23017 continue
+23015 i = i - 1
+      goto 23014
+23016 continue
+      if (.not.(i .eq. 1))goto 23019
+      call baderr (30Hcannot make identifier unique.)
+23019 continue
+23012 if (.not.(lookup (id, junk, gentbl) .eq. 0))goto 23011
+23013 continue
+23006 continue
+      end
+c     logic0  logical_column
diff --git a/unix/boot/spp/rpp/rppfor/unstak.f b/unix/boot/spp/rpp/rppfor/unstak.f
new file mode 100644
index 00000000..c602dc06
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/unstak.f
@@ -0,0 +1,58 @@
+      subroutine unstak (sp, lextyp, labval, token)
+      integer labval(100), lextyp(100)
+      integer sp, token, type
+23000 if (.not.(sp .gt. 1))goto 23002
+      type = lextyp(sp)
+      if (.not.((type .eq. -98 .or. type .eq. -97) .and. token .eq. -86)
+     *)goto 23003
+      goto 23002
+23003 continue
+      if (.not.(type .eq. -99 .or. type .eq. -98 .or. type .eq. -97))got
+     *o 23005
+      type = 999
+23005 continue
+      if (.not.(type .eq. 123 .or. type .eq. -92))goto 23007
+      goto 23002
+23007 continue
+      if (.not.(type .eq. 999 .and. token .eq. -87))goto 23009
+      goto 23002
+23009 continue
+      if (.not.(type .eq. 999))goto 23011
+      call indent (-1)
+      call outcon (labval(sp))
+      goto 23012
+23011 continue
+      if (.not.(type .eq. -87 .or. type .eq. -72))goto 23013
+      if (.not.(sp .gt. 2))goto 23015
+      sp = sp - 1
+23015 continue
+      if (.not.(type .ne. -72))goto 23017
+      call indent (-1)
+23017 continue
+      call outcon (labval(sp) + 1)
+      goto 23014
+23013 continue
+      if (.not.(type .eq. -96))goto 23019
+      call dostat (labval(sp))
+      goto 23020
+23019 continue
+      if (.not.(type .eq. -95))goto 23021
+      call whiles (labval(sp))
+      goto 23022
+23021 continue
+      if (.not.(type .eq. -94))goto 23023
+      call fors (labval(sp))
+      goto 23024
+23023 continue
+      if (.not.(type .eq. -93))goto 23025
+      call untils (labval(sp), token)
+23025 continue
+23024 continue
+23022 continue
+23020 continue
+23014 continue
+23012 continue
+23001 sp=sp-1
+      goto 23000
+23002 continue
+      end
diff --git a/unix/boot/spp/rpp/rppfor/untils.f b/unix/boot/spp/rpp/rppfor/untils.f
new file mode 100644
index 00000000..050e25fb
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/untils.f
@@ -0,0 +1,80 @@
+      subroutine untils (lab, token)
+      integer lab, token
+      common /cdefio/ bp, buf (4096)
+      integer bp
+      integer buf
+      common /cfname/ fcname (30)
+      integer fcname
+      common /cfor/ fordep, forstk (200)
+      integer fordep
+      integer forstk
+      common /cgoto/ xfer
+      integer xfer
+      common /clabel/ label, retlab, memflg, col, logic0
+      integer label
+      integer retlab
+      integer memflg
+      integer col
+      integer logic0
+      common /cline/ dbgout, dbglev, level, linect (5), infile (5), fnam
+     *p, fnames ( 150)
+      integer dbgout
+      integer dbglev
+      integer level
+      integer linect
+      integer infile
+      integer fnamp
+      integer fnames
+      common /cmacro/ cp, ep, evalst (500), deftbl
+      integer cp
+      integer ep
+      integer evalst
+      integer deftbl
+      common /coutln/ outp, outbuf (74)
+      integer outp
+      integer outbuf
+      common /csbuf/ sbp, sbuf(2048), smem(240)
+      integer sbp
+      integer sbuf
+      integer smem
+      common /cswtch/ swtop, swlast, swstak(1000), swvnum, swvlev, swvst
+     *k(10), swinrg
+      integer swtop
+      integer swlast
+      integer swstak
+      integer swvnum
+      integer swvlev
+      integer swvstk
+      integer swinrg
+      common /ckword/ rkwtbl
+      integer rkwtbl
+      common /clname/ fkwtbl, namtbl, gentbl, errtbl, xpptbl
+      integer fkwtbl
+      integer namtbl
+      integer gentbl
+      integer errtbl
+      integer xpptbl
+      common /erchek/ ername, body, esp, errstk(30)
+      integer ername
+      integer body
+      integer esp
+      integer errstk
+      integer mem( 60000)
+      common/cdsmem/mem
+      integer ptoken (100)
+      integer junk
+      integer lex
+      xfer = 0
+      call outnum (lab)
+      if (.not.(token .eq. -70))goto 23000
+      junk = lex (ptoken)
+      call ifgo (lab - 1)
+      goto 23001
+23000 continue
+      call outgo (lab - 1)
+23001 continue
+      call indent (-1)
+      call outcon (lab + 1)
+      return
+      end
+c     logic0  logical_column
diff --git a/unix/boot/spp/rpp/rppfor/whilec.f b/unix/boot/spp/rpp/rppfor/whilec.f
new file mode 100644
index 00000000..1f830d00
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/whilec.f
@@ -0,0 +1,72 @@
+      subroutine whilec (lab)
+      integer lab
+      integer labgen
+      common /cdefio/ bp, buf (4096)
+      integer bp
+      integer buf
+      common /cfname/ fcname (30)
+      integer fcname
+      common /cfor/ fordep, forstk (200)
+      integer fordep
+      integer forstk
+      common /cgoto/ xfer
+      integer xfer
+      common /clabel/ label, retlab, memflg, col, logic0
+      integer label
+      integer retlab
+      integer memflg
+      integer col
+      integer logic0
+      common /cline/ dbgout, dbglev, level, linect (5), infile (5), fnam
+     *p, fnames ( 150)
+      integer dbgout
+      integer dbglev
+      integer level
+      integer linect
+      integer infile
+      integer fnamp
+      integer fnames
+      common /cmacro/ cp, ep, evalst (500), deftbl
+      integer cp
+      integer ep
+      integer evalst
+      integer deftbl
+      common /coutln/ outp, outbuf (74)
+      integer outp
+      integer outbuf
+      common /csbuf/ sbp, sbuf(2048), smem(240)
+      integer sbp
+      integer sbuf
+      integer smem
+      common /cswtch/ swtop, swlast, swstak(1000), swvnum, swvlev, swvst
+     *k(10), swinrg
+      integer swtop
+      integer swlast
+      integer swstak
+      integer swvnum
+      integer swvlev
+      integer swvstk
+      integer swinrg
+      common /ckword/ rkwtbl
+      integer rkwtbl
+      common /clname/ fkwtbl, namtbl, gentbl, errtbl, xpptbl
+      integer fkwtbl
+      integer namtbl
+      integer gentbl
+      integer errtbl
+      integer xpptbl
+      common /erchek/ ername, body, esp, errstk(30)
+      integer ername
+      integer body
+      integer esp
+      integer errstk
+      integer mem( 60000)
+      common/cdsmem/mem
+      call outcon (0)
+      lab = labgen (2)
+      call outnum (lab)
+      call ifgo (lab + 1)
+      call indent (1)
+      return
+      end
+c     logic0  logical_column
diff --git a/unix/boot/spp/rpp/rppfor/whiles.f b/unix/boot/spp/rpp/rppfor/whiles.f
new file mode 100644
index 00000000..baa84531
--- /dev/null
+++ b/unix/boot/spp/rpp/rppfor/whiles.f
@@ -0,0 +1,69 @@
+      subroutine whiles (lab)
+      integer lab
+      common /cdefio/ bp, buf (4096)
+      integer bp
+      integer buf
+      common /cfname/ fcname (30)
+      integer fcname
+      common /cfor/ fordep, forstk (200)
+      integer fordep
+      integer forstk
+      common /cgoto/ xfer
+      integer xfer
+      common /clabel/ label, retlab, memflg, col, logic0
+      integer label
+      integer retlab
+      integer memflg
+      integer col
+      integer logic0
+      common /cline/ dbgout, dbglev, level, linect (5), infile (5), fnam
+     *p, fnames ( 150)
+      integer dbgout
+      integer dbglev
+      integer level
+      integer linect
+      integer infile
+      integer fnamp
+      integer fnames
+      common /cmacro/ cp, ep, evalst (500), deftbl
+      integer cp
+      integer ep
+      integer evalst
+      integer deftbl
+      common /coutln/ outp, outbuf (74)
+      integer outp
+      integer outbuf
+      common /csbuf/ sbp, sbuf(2048), smem(240)
+      integer sbp
+      integer sbuf
+      integer smem
+      common /cswtch/ swtop, swlast, swstak(1000), swvnum, swvlev, swvst
+     *k(10), swinrg
+      integer swtop
+      integer swlast
+      integer swstak
+      integer swvnum
+      integer swvlev
+      integer swvstk
+      integer swinrg
+      common /ckword/ rkwtbl
+      integer rkwtbl
+      common /clname/ fkwtbl, namtbl, gentbl, errtbl, xpptbl
+      integer fkwtbl
+      integer namtbl
+      integer gentbl
+      integer errtbl
+      integer xpptbl
+      common /erchek/ ername, body, esp, errstk(30)
+      integer ername
+      integer body
+      integer esp
+      integer errstk
+      integer mem( 60000)
+      common/cdsmem/mem
+      call outgo (lab)
+      call indent (-1)
+      call outcon (lab + 1)
+      return
+      end
+c     logic0  logical_column
diff --git a/unix/boot/spp/rpp/rpprat/Makefile b/unix/boot/spp/rpp/rpprat/Makefile
new file mode 100644
index 00000000..b09289f7
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/Makefile
@@ -0,0 +1,44 @@
+# Ratfor source for the SPP preprocessor.  A TOOLS compatible ratfor compiler
+# is required to compile this.  The original UNIX ratfor compiler may not do
+# the job.
+
+.r.f:
+	/usr/local/bin/ratfor $*.r > $*.f
+
+SRCS=	addchr.r allblk.r alldig.r baderr.r balpar.r beginc.r brknxt.r\
+	cascod.r caslab.r declco.r deftok.r doarth.r docode.r doif.r\
+	doincr.r domac.r dostat.r dosub.r eatup.r elseif.r endcod.r\
+	entdef.r entdkw.r entfkw.r entrkw.r entxkw.r errchk.r errgo.r\
+	errorc.r evalr.r finit.r forcod.r fors.r getdef.r gettok.r\
+	gnbtok.r gocode.r gtok.r ifcode.r iferrc.r ifgo.r ifparm.r\
+	indent.r initkw.r labelc.r labgen.r lex.r litral.r lndict.r\
+	ludef.r mapid.r ngetch.r ogotos.r otherc.r outch.r outcon.r\
+	outdon.r outdwe.r outgo.r outnum.r outstr.r outtab.r parse.r\
+	pbnum.r pbstr.r poicod.r push.r putbak.r putchr.r puttok.r\
+	ratfor.r relate.r repcod.r retcod.r sdupl.r skpblk.r squash.r\
+	strdcl.r swcode.r swend.r swvar.r synerr.r thenco.r ulstal.r\
+	uniqid.r unstak.r untils.r whilec.r whiles.r
+
+FORT=	addchr.f allblk.f alldig.f baderr.f balpar.f beginc.f brknxt.f\
+	cascod.f caslab.f declco.f deftok.f doarth.f docode.f doif.f\
+	doincr.f domac.f dostat.f dosub.f eatup.f elseif.f endcod.f\
+	entdef.f entdkw.f entfkw.f entrkw.f entxkw.f errchk.f errgo.f\
+	errorc.f evalr.f finit.f forcod.f fors.f getdef.f gettok.f\
+	gnbtok.f gocode.f gtok.f ifcode.f iferrc.f ifgo.f ifparm.f\
+	indent.f initkw.f labelc.f labgen.f lex.f litral.f lndict.f\
+	ludef.f mapid.f ngetch.f ogotos.f otherc.f outch.f outcon.f\
+	outdon.f outdwe.f outgo.f outnum.f outstr.f outtab.f parse.f\
+	pbnum.f pbstr.f poicod.f push.f putbak.f putchr.f puttok.f\
+	ratfor.f relate.f repcod.f retcod.f sdupl.f skpblk.f squash.f\
+	strdcl.f swcode.f swend.f swvar.f synerr.f thenco.f ulstal.f\
+	uniqid.f unstak.f untils.f whilec.f whiles.f
+
+# NOTE -- After regenerating the fortran CASLAB.F, comment out the unreachable
+# goto on line 32, generated due to a bug in the ratfor.
+
+fort:	$(SRCS) common defs
+	make fsrc; mv *.f ../rppfor; touch fort
+	(cd ../rppfor; sed -e 's/      goto 23012/c     goto 23012/'\
+	< caslab.f > temp; mv temp caslab.f)
+
+fsrc:	$(FORT)
diff --git a/unix/boot/spp/rpp/rpprat/addchr.r b/unix/boot/spp/rpp/rpprat/addchr.r
new file mode 100644
index 00000000..74695f93
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/addchr.r
@@ -0,0 +1,15 @@
+#-h-  addchr			  254  local   12/01/80  15:53:44
+# addchr - put c in buf (bp) if it fits, increment bp
+   include  defs
+
+   subroutine addchr (c, buf, bp, maxsiz)
+   integer bp, maxsiz
+   character c, buf (ARB)
+
+   if (bp > maxsiz)
+      call baderr ("buffer overflow.")
+   buf (bp) = c
+   bp = bp + 1
+
+   return
+   end
diff --git a/unix/boot/spp/rpp/rpprat/allblk.r b/unix/boot/spp/rpp/rpprat/allblk.r
new file mode 100644
index 00000000..34b83451
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/allblk.r
@@ -0,0 +1,22 @@
+#-h-  allblk			  486  local   12/01/80  15:53:44
+# allblk - determine if line consists of all blanks
+   include  defs
+
+# this routine is called by outdon, and is here to fix
+# a bug which sometimes occurs if two or more includes precede the
+# first line of executable code.  Could not trace down the cause
+
+   integer function allblk (buf)
+   character buf (ARB)
+
+   integer i
+
+   allblk = YES
+   for (i = 1; buf (i) != NEWLINE & buf (i) != EOS; i = i + 1)
+      if (buf (i) != BLANK) {
+	 allblk = NO
+	 break
+	 }
+
+   return
+   end
diff --git a/unix/boot/spp/rpp/rpprat/alldig.r b/unix/boot/spp/rpp/rpprat/alldig.r
new file mode 100644
index 00000000..bac06161
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/alldig.r
@@ -0,0 +1,17 @@
+#-h-  alldig			  306  local   12/01/80  15:53:45
+# alldig - return YES if str is all digits
+   include  defs
+
+   integer function alldig (str)
+   character str (ARB)
+   integer i
+
+   alldig = NO
+   if (str (1) == EOS)
+      return
+   for (i = 1; str (i) != EOS; i = i + 1)
+      if (!IS_DIGIT(str (i)))
+	 return
+   alldig = YES
+   return
+   end
diff --git a/unix/boot/spp/rpp/rpprat/baderr.r b/unix/boot/spp/rpp/rpprat/baderr.r
new file mode 100644
index 00000000..51164a8d
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/baderr.r
@@ -0,0 +1,12 @@
+#-h-  baderr			  144  local   12/01/80  15:53:45
+# baderr --- report fatal error message, then die
+   include  defs
+
+   subroutine baderr (msg)
+
+   character msg (ARB)
+#      character*(*) msg
+
+   call synerr (msg)
+   call endst
+   end
diff --git a/unix/boot/spp/rpp/rpprat/balpar.r b/unix/boot/spp/rpp/rpprat/balpar.r
new file mode 100644
index 00000000..8e0388b8
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/balpar.r
@@ -0,0 +1,40 @@
+#-h-  balpar			  854  local   12/01/80  15:53:46
+# balpar - copy balanced paren string
+   include  defs
+
+   subroutine balpar
+
+   character t, token (MAXTOK)
+   character gettok, gnbtok
+
+   integer nlpar
+
+   if (gnbtok (token, MAXTOK) != LPAREN) {
+      call synerr ("missing left paren.")
+      return
+      }
+   call outstr (token)
+   nlpar = 1
+   repeat {
+      t = gettok (token, MAXTOK)
+      if (t == SEMICOL | t == LBRACE | t == RBRACE | t == EOF) {
+	 call pbstr (token)
+	 break
+	 }
+      if (t == NEWLINE)      # delete newlines
+	 token (1) = EOS
+      else if (t == LPAREN)
+	 nlpar = nlpar + 1
+      else if (t == RPAREN)
+	 nlpar = nlpar - 1
+      if (t == ALPHA)
+	 call squash (token)
+      # else nothing special
+      call outstr (token)
+      } until (nlpar <= 0)
+
+   if (nlpar != 0)
+      call synerr ("missing parenthesis in condition.")
+
+   return
+   end
diff --git a/unix/boot/spp/rpp/rpprat/beginc.r b/unix/boot/spp/rpp/rpprat/beginc.r
new file mode 100644
index 00000000..ceb39e4b
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/beginc.r
@@ -0,0 +1,20 @@
+
+include	defs
+
+# BEGINC -- Code that gets executed when the "begin" statement is encountered,
+# at the beginning of the executable section of a procedure.
+
+
+subroutine beginc
+
+integer	labgen
+include COMMON_BLOCKS
+
+	body = YES				# in body of procedure
+	ername = NO				# errchk name not encountered
+	esp = 0					# error stack pointer
+	label = FIRST_LABEL			# start over with labels
+	retlab = labgen (1)			# label for return stmt
+	logical_column = 6 + INDENT
+	col = logical_column
+end
diff --git a/unix/boot/spp/rpp/rpprat/brknxt.r b/unix/boot/spp/rpp/rpprat/brknxt.r
new file mode 100644
index 00000000..154dc31e
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/brknxt.r
@@ -0,0 +1,45 @@
+#-h-  brknxt			 1077  local   12/01/80  15:53:46
+# brknxt - generate code for break n and next n; n = 1 is default
+   include  defs
+
+   subroutine brknxt (sp, lextyp, labval, token)
+   integer labval (MAXSTACK), lextyp (MAXSTACK), sp, token
+
+   integer i, n
+   integer alldig, ctoi
+
+   character t, ptoken (MAXTOK)
+   character gnbtok
+
+   include COMMON_BLOCKS
+
+   n = 0
+   t = gnbtok (ptoken, MAXTOK)
+   if (alldig (ptoken) == YES) {     # have break n or next n
+      i = 1
+      n = ctoi (ptoken, i) - 1
+      }
+   else if (t != SEMICOL)      # default case
+      call pbstr (ptoken)
+   for (i = sp; i > 0; i = i - 1)
+      if (lextyp (i) == LEXWHILE | lextyp (i) == LEXDO
+	| lextyp (i) == LEXFOR | lextyp (i) == LEXREPEAT) {
+	 if (n > 0) {
+	    n = n - 1
+	    next	     # seek proper level
+	    }
+	 else if (token == LEXBREAK)
+	    call outgo (labval (i) + 1)
+	 else
+	    call outgo (labval (i))
+	 xfer = YES
+	 return
+	 }
+
+   if (token == LEXBREAK)
+      call synerr ("illegal break.")
+   else
+      call synerr ("illegal next.")
+
+   return
+   end
diff --git a/unix/boot/spp/rpp/rpprat/cascod.r b/unix/boot/spp/rpp/rpprat/cascod.r
new file mode 100644
index 00000000..073dc9a4
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/cascod.r
@@ -0,0 +1,71 @@
+#-h-  cascod			 1876  local   12/01/80  15:53:46
+# cascod - generate code for case or default label
+   include  defs
+
+   subroutine cascod (lab, token)
+   integer lab, token
+
+   include COMMON_BLOCKS
+
+   integer t, l, lb, ub, i, j, junk
+   integer caslab, labgen, gnbtok
+
+   character tok (MAXTOK)
+
+   if (swtop <= 0) {
+      call synerr ("illegal case or default.")
+      return
+      }
+   call indent (-1)
+   call outgo (lab + 1) # terminate previous case
+   xfer = YES
+   l = labgen (1)
+   if (token == LEXCASE) { # case n[,n]... : ...
+      while (caslab (lb, t) != EOF) {
+	 ub = lb
+	 if (t == MINUS)
+	    junk = caslab (ub, t)
+	 if (lb > ub) {
+	    call synerr ("illegal range in case label.")
+	    ub = lb
+	    }
+	 if (swlast + 3 > MAXSWITCH)
+	    call baderr ("switch table overflow.")
+	 for (i = swtop + 3; i < swlast; i = i + 3)
+	    if (lb <= swstak (i))
+	       break
+	    else if (lb <= swstak (i+1))
+	       call synerr ("duplicate case label.")
+	 if (i < swlast & ub >= swstak (i))
+	    call synerr ("duplicate case label.")
+	 for (j = swlast; j > i; j = j - 1)   # insert new entry
+	    swstak (j+2) = swstak (j-1)
+	 swstak (i) = lb
+	 swstak (i + 1) = ub
+	 swstak (i + 2) = l
+	 swstak (swtop + 1) = swstak (swtop + 1)  +  1
+	 swlast = swlast + 3
+	 if (t == COLON)
+	    break
+	 else if (t != COMMA)
+	    call synerr ("illegal case syntax.")
+	 }
+      }
+   else {   # default : ...
+      t = gnbtok (tok, MAXTOK)
+      if (swstak (swtop + 2) != 0)
+	 call error ("multiple defaults in switch statement.")
+      else
+	 swstak (swtop + 2) = l
+      }
+
+   if (t == EOF)
+      call synerr ("unexpected EOF.")
+   else if (t != COLON)
+      call error ("missing colon in case or default label.")
+
+   xfer = NO
+   call outcon (l)
+   call indent (1)
+   return
+   end
diff --git a/unix/boot/spp/rpp/rpprat/caslab.r b/unix/boot/spp/rpp/rpprat/caslab.r
new file mode 100644
index 00000000..12d3c0da
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/caslab.r
@@ -0,0 +1,48 @@
+include  defs
+
+# caslab - get one case label
+
+integer function caslab (n, t)
+
+integer n, t
+character tok(MAXTOK)
+integer i, s, lev
+integer gnbtok, ctoi
+
+	t = gnbtok (tok, MAXTOK)
+	while (t == NEWLINE)
+	    t = gnbtok (tok, MAXTOK)
+
+	if (t == EOF)
+	    return (t)
+
+	for (lev=0;  t == LPAREN;  t = gnbtok (tok, MAXTOK))
+	    lev = lev + 1
+
+	if (t == MINUS)
+	    s = -1
+	else
+	    s = +1
+	if (t == MINUS | t == PLUS)
+	    t = gnbtok (tok, MAXTOK)
+
+	if (t != DIGIT)
+	    goto 99
+	else {
+	    i = 1
+	    n = s * ctoi (tok, i)
+	}
+
+	for (t=gnbtok(tok,MAXTOK);  t == RPAREN;  t=gnbtok(tok,MAXTOK))
+	    lev = lev - 1
+	if (lev != 0)
+	    goto 99
+
+	while (t == NEWLINE)
+	    t = gnbtok (tok, MAXTOK)
+
+	return
+
+ 99	call synerr ("Invalid case label.")
+	n = 0
+end
diff --git a/unix/boot/spp/rpp/rpprat/common b/unix/boot/spp/rpp/rpprat/common
new file mode 100644
index 00000000..9685729a
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/common
@@ -0,0 +1,79 @@
+#-h-  common			 2163  local   12/01/80  15:50:08
+# Common blocks used by the Ratfor preprocessor
+#     Place on a file called 'common'
+
+
+ common /cdefio/ bp, buf (BUFSIZE)
+    integer bp	       # next available character; init = 0
+    character buf      # pushed-back characters
+
+ common /cfname/ fcname (MAXNAME)
+   character fcname    # text of current function name
+
+ common /cfor/ fordep, forstk (MAXFORSTK)
+   integer fordep      # current depth of for statements
+   character forstk    # stack of reinit strings
+
+ common /cgoto/ xfer
+   integer xfer        # YES if just made transfer, NO otherwise
+
+ common /clabel/ label, retlab, memflg, col, logical_column
+   integer label       # next label returned by labgen
+   integer retlab      # label for return code at end of procedure
+   integer memflg      # set to YES after Mem common has been declared
+   integer col	       # column where output statement starts
+   integer logical_column	# col = min (maxindent, logical_column)
+
+ common /cline/ dbgout, dbglev, level, linect (NFILES), infile (NFILES),
+   fnamp, fnames (MAXFNAMES)
+   integer dbgout      # YES if debug (-g) output is desired
+   integer dbglev      # current file level for debug output
+   integer level       # level of file inclusion; init = 1
+   integer linect      # line count on input file (level); init = 1
+   integer infile      # file number (level); init infile (1) = STDIN
+   integer fnamp       # next free slot in fnames; init = 2
+   character fnames    # stack of include names; init fnames (1) = EOS
+
+ common /cmacro/ cp, ep, evalst (EVALSIZE), deftbl
+    integer cp	       # current call stack pointer
+    integer ep	       # next free position in evalst
+    character evalst   # evaluation stack
+    pointer deftbl     # symbol table holding macro names
+
+ common /coutln/ outp, outbuf (74)
+   integer outp        # last position filled in outbuf; init = 0
+   character outbuf    # output lines collected here
+
+ common /csbuf/ sbp, sbuf(SBUFSIZE), smem(SZ_SMEM)
+   integer sbp	       # next available character position; init = 1
+   character sbuf      # saved for data statements
+   character smem      # mem declaration
+
+ common /cswtch/ swtop, swlast, swstak(MAXSWITCH), swvnum, swvlev,
+		 swvstk(MAXSWNEST), swinrg
+   integer swtop       # current switch entry; init = 0
+   integer swlast      # next available position; init = 1
+   integer swstak      # switch information
+   integer swvnum      # counter for switch variable names;  init = 0
+   integer swvlev      # level pointer for nesting of switches; init = 0
+   integer swvstk      # stack for the switch variable names
+   integer swinrg      # assert swinrange - disable range checking in next sw.
+
+ common /ckword/ rkwtbl
+   pointer rkwtbl      # symbol table containing Ratfor key words
+
+ common /clname/ fkwtbl, namtbl, gentbl, errtbl, xpptbl
+   pointer fkwtbl      # a list of long Fortran keywords
+   pointer namtbl      # map of long-form names to short-form names
+   pointer gentbl      # list of generated names
+   pointer errtbl      # symbol table of names to be error checked
+   pointer xpptbl      # table of xpp directives
+
+common /erchek/ ername, body, esp, errstk(MAXERRSTK)
+   integer ername      # YES if err checked name encountered
+   integer body	       # YES when between BEGIN .. END block
+   integer esp	       # error stack pointer
+   integer errstk      # error stack (for statement labels)
+
+ DS_DECL(mem, MEMSIZE)
+#-t-  common			 2163  local   12/01/80  15:50:08
diff --git a/unix/boot/spp/rpp/rpprat/declco.r b/unix/boot/spp/rpp/rpprat/declco.r
new file mode 100644
index 00000000..7c669e8c
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/declco.r
@@ -0,0 +1,72 @@
+include	defs
+
+# DECLCO -- Process a declaration (xpp directive).  Look up directive in
+# the symbol table.  If found, output the corresponding Fortran declaration,
+# otherwise output the original string.
+
+subroutine declco (id)
+
+character id(MAXTOK)
+character newid(MAXTOK), tok, tokbl
+integer junk, ludef, equal, gettok
+include COMMON_BLOCKS
+string	xptyp XPOINTER
+string	xpntr "x$pntr"
+string	xfunc "x$func"
+string	xsubr "x$subr"
+ifdef	(IMPNONE,
+string	impnone "implicit none")
+
+	if (ludef (id, newid, xpptbl) == YES) {
+	    if (equal (id, xpntr) == YES) {
+		# Pointer declaration.
+		tokbl = gettok (newid, MAXTOK)
+		if (tokbl == BLANK)
+		    tok = gettok (newid, MAXTOK)
+		else
+		    tok = tokbl
+
+		if (tok == XPP_DIRECTIVE & equal (newid, xfunc) == YES) {
+		    # Pointer function.
+		    call outtab
+		    call outstr (xptyp)
+		    junk = ludef (newid, newid, xpptbl)
+		    call outstr (newid)
+		    call eatup
+		    call outdon
+
+		    ifdef (IMPNONE,
+		    call outtab
+		    call outstr (impnone)
+		    call outdon)
+
+		    call poicod (NO)
+
+		} else {
+		    # Pointer variable.
+		    call pbstr (newid)
+		    call poicod (YES)
+		}
+
+	    } else if (equal (id, xsubr) == YES) {
+		# Subroutine declaration.
+		call outtab
+		call outstr (newid)
+		call eatup
+		call outdon
+
+		ifdef (IMPNONE,
+		call outtab
+		call outstr (impnone)
+		call outdon)
+
+	    } else  {
+		# Some other declaration.
+		call outtab
+		call outstr (newid)
+		call outch (BLANK)
+	    }
+
+	} else
+	    call synerr ("Invalid x$type type declaration.")
+end
diff --git a/unix/boot/spp/rpp/rpprat/defs b/unix/boot/spp/rpp/rpprat/defs
new file mode 100644
index 00000000..bf040c55
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/defs
@@ -0,0 +1,138 @@
+# common definitions for all routines comprising the ratfor preprocessor
+#---------------------------------------------------------------
+# The definition STDEFNS defines the file which contains the
+# standard definitions to be used when preprocessing a file.
+# It is opened and read automatically by the ratfor preprocessor.
+# Set STDEFNS to the name of the file in which the standard
+# definitions reside.  If you don't want the preprocessor to
+# automatically open this file, set STDENFS to "".
+#
+#---------------------------------------------------------------
+#    If you want the preprocessor to output upper case only,
+#    set the following definition:
+#
+#	       define (UPPERC,)
+#
+#---------------------------------------------------------------
+#  Some of the buffer sizes and other symbols might have to be
+#  changed.  Especially check the following:
+#
+#	 MAXDEF 	(number of characters in a definition)
+#	 SBUFSIZE	(nbr string declarations allowed per module)
+#	 MAXSTRTBL	(size of table to buffer string declarations)
+#	 MAXSWITCH	(max stack for switch statement)
+#
+#-----------------------------------------------------------------
+
+
+define (STDEFNS, string defns "")  # standard defns file
+#define (UPPERC,)	   # define if Fortran compiler wants upper case
+#define (IMPNONE,)	   # output IMPLICIT NONE in procedures
+define (NULL,0)
+define (INDENT,3)	   # number of spaces of indentation
+define (MAX_INDENT,30)	   # maximum column for indentation
+define (FIRST_LABEL,100)   # first statement label
+define (SZ_SPOOLBUF,8)	   # for breaking continuation cards
+
+define (RADIX,PERCENT)	   # % indicates alternate radix
+define (TOGGLE,PERCENT)    # toggle for literal lines
+define (ARGFLAG,DOLLAR)
+define (CUTOFF,3)	   # min nbr of cases to generate branch table
+			   # (for switch statement)
+define (DENSITY,2)	   # reciprocal of density necessary for
+			   # branch table
+define (FILLCHAR,DIG0)	   # used in long-name uniquing
+define (MAXIDLENGTH,6)	   # for Fortran 66 and 77
+define (SZ_SMEM,240)	   # memory common declarations string
+
+
+# Lexical items (codes are negative to avoid conflict with character values)
+
+define (LEXBEGIN,-83)
+define (LEXBREAK,-79)
+define (LEXCASE,-91)
+define (LEXDEFAULT,-90)
+define (LEXDIGITS,-89)
+define (LEXDO,-96)
+define (LEXELSE,-87)
+define (LEXEND,-82)
+define (LEXERRCHK,-84)
+define (LEXERROR,-73)
+define (LEXFOR,-94)
+define (LEXIF,-99)
+define (LEXIFELSE,-72)
+define (LEXIFERR,-98)
+define (LEXIFNOERR,-97)
+define (LEXLITERAL,-85)
+define (LEXNEXT,-78)
+define (LEXOTHER,-80)
+define (LEXPOINTER,-88)
+define (LEXRBRACE,-74)
+define (LEXREPEAT,-93)
+define (LEXRETURN,-77)
+define (LEXGOTO,-76)
+define (LEXSTOP,-71)
+define (LEXSTRING,-75)
+define (LEXSWITCH,-92)
+define (LEXTHEN,-86)
+define (LEXUNTIL,-70)
+define (LEXWHILE,-95)
+define (LSTRIPC,-69)
+define (RSTRIPC,-68)
+define (LEXDECL,-67)
+
+define (XPP_DIRECTIVE, -166)
+
+# Built-in macro functions:
+
+define (DEFTYPE,-4)
+define (MACTYPE,-10)
+define (IFTYPE,-11)
+define (INCTYPE,-12)
+define (SUBTYPE,-13)
+define (ARITHTYPE,-14)
+define (IFDEFTYPE,-15)
+define (IFNOTDEFTYPE,-16)
+define (PRAGMATYPE,-17)
+
+
+# Size-limiting definitions:
+
+define (MEMSIZE,60000)	   # space allotted to symbol tables and macro text
+define (BUFSIZE,4096)	   # pushback buffer for ngetch and putbak
+define (PBPOINT,3192)	   # point in buffer where pushback begins
+define (SBUFSIZE,2048)	   # buffer for string statements
+define (MAXDEF,2048)	   # max chars in a defn
+define (MAXFORSTK,200)	   # max space for for reinit clauses
+define (MAXERRSTK,30)	   # max nesting of iferr statements
+define (MAXFNAMES, arith(NFILES,*,FILENAMESIZE))
+define (MAXSTACK,100)	   # max stack depth for parser
+define (MAXSWITCH,1000)    # max stack for switch statement
+define (MAXSWNEST,10)	   # max nesting of switches in a procedure
+define (MAXTOK,100)	   # max chars in a token
+define (NFILES,5)	   # max number of include file nesting
+define (MAXNBRSTR,20)	   #max nbr string declarations per module
+define (CALLSIZE,50)
+define (ARGSIZE,100)
+define (EVALSIZE,500)
+
+
+# Where to find the common blocks:
+
+define(COMMON_BLOCKS,"common")
+
+# Data types, Dynamic Memory common:
+
+define (XPOINTER,"integer ")
+
+
+# The following external names are redefined to avoid name collisions with
+# standard library procedures on some systems.
+
+define	open	rfopen
+define	close	rfclos
+define	flush	rfflus
+define	note	rfnote
+define	seek	rfseek
+define	remove	rfrmov
+define	exit	rexit
diff --git a/unix/boot/spp/rpp/rpprat/deftok.r b/unix/boot/spp/rpp/rpprat/deftok.r
new file mode 100644
index 00000000..af20c35c
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/deftok.r
@@ -0,0 +1,162 @@
+#-h-  deftok			 4116  local   12/01/80  15:53:47
+# deftok - get token; process macro calls and invocations
+   include  defs
+
+# this routine has been disabled to allow defines with parameters to be added
+
+#   character function deftok (token, toksiz)
+#   character gtok
+#   integer toksiz
+#   character defn (MAXDEF), t, token (MAXTOK)
+#   integer ludef
+#   include COMMON_BLOCKS
+#
+#   for (t = gtok (token, toksiz); t!=EOF; t = gtok (token, toksiz)) {
+#      if (t != ALPHA)	 # non-alpha
+#	  break
+#      if (ludef (token, defn, deftbl) == NO)	  # undefined
+#	  break
+#      if (defn (1) == DEFTYPE) {   # get definition
+#	  call getdef (token, toksiz, defn, MAXDEF)
+#	  call entdef (token, defn, deftbl)
+#	  }
+#      else
+#	  call pbstr (defn)   # push replacement onto input
+#      }
+#   deftok = t
+#   if (deftok == ALPHA)   # convert to single case
+#      call fold (token)
+#   return
+#   end
+# deftok - get token; process macro calls and invocations
+
+   character function deftok (token, toksiz)
+   character token (MAXTOK)
+   integer toksiz
+
+   include COMMON_BLOCKS
+
+   character t, c, defn (MAXDEF), mdefn (MAXDEF)
+   character gtok
+   integer equal
+
+   integer ap, argstk (ARGSIZE), callst (CALLSIZE),
+      nlb, plev (CALLSIZE), ifl
+   integer ludef, push, ifparm
+
+   string balp "()"
+   string pswrg "switch_no_range_check"
+
+   cp = 0
+   ap = 1
+   ep = 1
+   for (t = gtok (token, toksiz); t != EOF; t = gtok (token, toksiz)) {
+      if (t == ALPHA)
+	 if (ludef (token, defn, deftbl) == NO) {
+	    if (cp == 0)
+	       break
+	    else
+	       call puttok (token)
+	 } else if (defn (1) == DEFTYPE) {     # process defines directly
+	    call getdef (token, toksiz, defn, MAXDEF)
+	    call entdef (token, defn, deftbl)
+	 } else if (defn (1) == IFDEFTYPE | defn (1) == IFNOTDEFTYPE) {
+	    c = defn (1)
+	    call getdef (token, toksiz, defn, MAXDEF)
+	    ifl = ludef (token, mdefn, deftbl)
+	    if ((ifl == YES & c == IFDEFTYPE) |
+	     (ifl == NO & c == IFNOTDEFTYPE))
+	       call pbstr (defn)
+
+	 } else if (defn(1) == PRAGMATYPE & cp == 0) {   # pragma
+	    if (gtok (defn, MAXDEF) == BLANK) {
+		if (gtok (defn, MAXDEF) == ALPHA) {
+		    if (equal (defn, pswrg) == YES)
+			swinrg = YES
+		    else
+			goto 10
+		} else {
+10		    call pbstr (defn)
+		    call putbak (BLANK)
+		    break
+		}
+	    } else {
+		call pbstr (defn)
+		break
+	    }
+		    
+	 } else {
+	    cp = cp +  1
+	    if (cp > CALLSIZE)
+	       call baderr ("call stack overflow.")
+	    callst (cp) = ap
+	    ap = push (ep, argstk, ap)
+	    call puttok (defn)
+	    call putchr (EOS)
+	    ap = push (ep, argstk, ap)
+	    call puttok (token)
+	    call putchr (EOS)
+	    ap = push (ep, argstk, ap)
+	    t = gtok (token, toksiz)
+	    if (t == BLANK) {		  # allow blanks before arguments
+	       t = gtok (token, toksiz)
+	       call pbstr (token)
+	       if (t != LPAREN)
+		  call putbak (BLANK)
+	       }
+	    else
+	       call pbstr (token)
+	    if (t != LPAREN)
+	       call pbstr (balp)
+	    else if (ifparm (defn) == NO)
+	       call pbstr (balp)
+	    plev (cp) = 0
+	} else if (t == LSTRIPC) {
+	 nlb = 1
+	 repeat {
+	    t = gtok (token, toksiz)
+	    if (t == LSTRIPC)
+	       nlb = nlb + 1
+	    else if (t == RSTRIPC) {
+	       nlb = nlb - 1
+	       if (nlb == 0)
+		  break
+	       }
+	    else if (t == EOF)
+	    call baderr ("EOF in string.")
+	    call puttok (token)
+	    }
+        }
+      else if (cp == 0)
+	 break
+      else if (t == LPAREN) {
+	 if (plev (cp) > 0)
+	    call puttok (token)
+	 plev (cp) = plev (cp) + 1
+	 }
+      else if (t == RPAREN) {
+	 plev (cp) = plev (cp) - 1
+	 if (plev (cp) > 0)
+	    call puttok (token)
+	 else {
+	    call putchr (EOS)
+	    call evalr (argstk, callst (cp), ap - 1)
+	    ap = callst (cp)
+	    ep = argstk (ap)
+	    cp =  cp - 1
+	    }
+	 }
+      else if (t == COMMA & plev (cp) == 1) {
+	 call putchr (EOS)
+	 ap = push (ep, argstk, ap)
+	 }
+      else
+	 call puttok (token)
+      }
+
+   deftok = t
+   if (t == ALPHA)
+      call fold (token)
+
+   return
+   end
diff --git a/unix/boot/spp/rpp/rpprat/doarth.r b/unix/boot/spp/rpp/rpprat/doarth.r
new file mode 100644
index 00000000..2fe633d5
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/doarth.r
@@ -0,0 +1,30 @@
+#-h-  doarth			  636  local   12/01/80  15:53:48
+# doarth - do arithmetic operation
+   include  defs
+
+   subroutine doarth (argstk, i, j)
+   integer argstk (ARGSIZE), i, j
+
+   include COMMON_BLOCKS
+
+   integer k, l
+   integer ctoi
+
+   character op
+
+   k = argstk (i + 2)
+   l = argstk (i + 4)
+   op = evalst (argstk (i + 3))
+   if (op == PLUS)
+      call pbnum (ctoi (evalst, k) + ctoi (evalst, l))
+   else if (op == MINUS)
+      call pbnum (ctoi (evalst, k) - ctoi (evalst, l))
+   else if (op ==  STAR )
+      call pbnum (ctoi (evalst, k) * ctoi (evalst, l))
+   else if (op ==  SLASH )
+      call pbnum (ctoi (evalst, k) / ctoi (evalst, l))
+   else
+      call remark ('arith error')
+
+   return
+   end
diff --git a/unix/boot/spp/rpp/rpprat/docode.r b/unix/boot/spp/rpp/rpprat/docode.r
new file mode 100644
index 00000000..e505f8ee
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/docode.r
@@ -0,0 +1,33 @@
+#-h-  docode			  522  local   12/01/80  15:53:49
+# docode - generate code for beginning of do
+   include  defs
+
+   subroutine docode (lab)
+   integer lab
+
+   integer labgen
+
+   include COMMON_BLOCKS
+
+   character gnbtok
+   character lexstr (MAXTOK)
+
+   string sdo "do"
+
+   xfer = NO
+   call outtab
+   call outstr (sdo)
+   call outch (BLANK)
+   lab = labgen (2)
+   if (gnbtok (lexstr, MAXTOK) == DIGIT) # check for fortran DO
+      call outstr (lexstr)
+   else {
+      call pbstr (lexstr)
+      call outnum (lab)
+      }
+   call outch (BLANK)
+   call eatup
+   call outdwe
+   call indent (1)
+   return
+   end
diff --git a/unix/boot/spp/rpp/rpprat/doif.r b/unix/boot/spp/rpp/rpprat/doif.r
new file mode 100644
index 00000000..51495bd2
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/doif.r
@@ -0,0 +1,25 @@
+#-h-  doif			  458  local   12/01/80  15:53:49
+# doif - select one of two (macro) arguments
+   include  defs
+
+   subroutine doif (argstk, i, j)
+   integer argstk (ARGSIZE), i, j
+
+   include COMMON_BLOCKS
+
+   integer a2, a3, a4, a5
+   integer equal
+
+   if (j - i < 5)
+      return
+   a2 = argstk (i + 2)
+   a3 = argstk (i + 3)
+   a4 = argstk (i + 4)
+   a5 = argstk (i + 5)
+   if (equal (evalst (a2), evalst (a3)) == YES)   # subarrays
+      call pbstr (evalst (a4))
+   else
+      call pbstr (evalst (a5))
+
+   return
+   end
diff --git a/unix/boot/spp/rpp/rpprat/doincr.r b/unix/boot/spp/rpp/rpprat/doincr.r
new file mode 100644
index 00000000..9a8604bf
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/doincr.r
@@ -0,0 +1,17 @@
+#-h-  doincr			  246  local   12/01/80  15:53:49
+# doincr - increment macro argument by 1
+   include  defs
+
+   subroutine doincr (argstk, i, j)
+   integer argstk (ARGSIZE), i, j
+
+   include COMMON_BLOCKS
+
+   integer k
+   integer ctoi
+
+   k = argstk (i + 2)
+   call pbnum (ctoi (evalst, k) + 1)
+
+   return
+   end
diff --git a/unix/boot/spp/rpp/rpprat/domac.r b/unix/boot/spp/rpp/rpprat/domac.r
new file mode 100644
index 00000000..fe4c1c62
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/domac.r
@@ -0,0 +1,18 @@
+#-h-  domac			  326  local   12/01/80  15:53:49
+# domac - install macro definition in table
+   include  defs
+
+   subroutine domac (argstk, i, j)
+   integer argstk (ARGSIZE), i, j
+
+   include COMMON_BLOCKS
+
+   integer a2, a3
+
+   if (j - i > 2) {
+      a2 = argstk (i + 2)
+      a3 = argstk (i + 3)
+      call entdef (evalst (a2), evalst (a3), deftbl)	 # subarrays
+      }
+   return
+   end
diff --git a/unix/boot/spp/rpp/rpprat/dostat.r b/unix/boot/spp/rpp/rpprat/dostat.r
new file mode 100644
index 00000000..4a934bad
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/dostat.r
@@ -0,0 +1,13 @@
+#-h-  dostat			  156  local   12/01/80  15:53:50
+# dostat - generate code for end of do statement
+   include  defs
+
+   subroutine dostat (lab)
+
+   integer lab
+
+   call indent (-1)
+   call outcon (lab)
+   call outcon (lab + 1)
+   return
+   end
diff --git a/unix/boot/spp/rpp/rpprat/dosub.r b/unix/boot/spp/rpp/rpprat/dosub.r
new file mode 100644
index 00000000..611bdbaf
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/dosub.r
@@ -0,0 +1,31 @@
+#-h-  dosub			  709  local   12/01/80  15:53:50
+# dosub - select macro substring
+   include  defs
+
+   subroutine dosub (argstk, i, j)
+   integer argstk (ARGSIZE), i, j
+
+   include COMMON_BLOCKS
+
+   integer ap, fc, k, nc
+   integer ctoi, length
+
+   if (j - i < 3)
+      return
+   if (j - i < 4)
+      nc = MAXTOK
+   else {
+      k = argstk (i + 4)
+      nc = ctoi (evalst, k)	 # number of characters
+      }
+   k = argstk (i + 3)	      # origin
+   ap = argstk (i + 2)	       # target string
+   fc = ap + ctoi (evalst, k) - 1   # first char of substring
+   if (fc >= ap & fc < ap + length (evalst (ap))) {   # subarrays
+      k = fc + min (nc, length (evalst (fc))) - 1
+       for ( ; k >= fc; k = k - 1)
+	  call putbak (evalst (k))
+       }
+
+    return
+    end
diff --git a/unix/boot/spp/rpp/rpprat/eatup.r b/unix/boot/spp/rpp/rpprat/eatup.r
new file mode 100644
index 00000000..df001caf
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/eatup.r
@@ -0,0 +1,69 @@
+#-h-  eatup			 1137  local   12/01/80  15:53:50
+# eatup - process rest of statement; interpret continuations
+   include  defs
+
+   subroutine eatup
+
+   character ptoken (MAXTOK), t, token (MAXTOK)
+   character gettok
+   integer nlpar, equal
+   include COMMON_BLOCKS
+   string serror "error"
+
+   nlpar = 0
+   token(1) = EOS
+
+   repeat {
+       call outstr (token)
+       t = gettok (token, MAXTOK)
+   } until (t != BLANK & t != TAB)
+
+   if (t == ALPHA) {				# is it a "call error" stmt?
+      if (equal (token, serror) == YES) {
+	 # call errorc (token)
+	 # return
+
+	 # ERROR statement is now simply error checked like any other
+	 # external procedure, so that it may be used the same way.
+	 ername = YES
+	 }
+      }
+   goto 10
+
+   repeat {
+      t = gettok (token, MAXTOK)
+10    if (t == SEMICOL | t == NEWLINE)
+	 break
+      if (t == RBRACE | t == LBRACE) {
+	 call pbstr (token)
+	 break
+	 }
+      if (t == EOF) {
+	 call synerr ("unexpected EOF.")
+	 call pbstr (token)
+	 break
+	 }
+      if (t == COMMA | t == PLUS | t == MINUS | t == STAR |
+      (t == SLASH & body == YES) |
+       t == LPAREN | t == AND | t == BAR | t == BANG | t == TILDE |
+       t == NOT | t == CARET | t == EQUALS | t == UNDERLINE) {
+	 while (gettok (ptoken, MAXTOK) == NEWLINE)
+	    ;
+	 call pbstr (ptoken)
+	 if (t == UNDERLINE)
+	    token (1) = EOS
+	 }
+      if (t == LPAREN)
+	 nlpar = nlpar + 1
+      else if (t == RPAREN)
+	 nlpar = nlpar - 1
+      if (t == ALPHA)
+	 call squash (token)
+      call outstr (token)
+      } until (nlpar < 0)
+
+   if (nlpar != 0)
+      call synerr ("unbalanced parentheses.")
+
+   return
+   end
diff --git a/unix/boot/spp/rpp/rpprat/elseif.r b/unix/boot/spp/rpp/rpprat/elseif.r
new file mode 100644
index 00000000..88b1355d
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/elseif.r
@@ -0,0 +1,13 @@
+#-h-  elseif			  155  local   12/01/80  15:53:51
+# elseif - generate code for end of if before else
+   include  defs
+
+   subroutine elseif (lab)
+   integer lab
+
+   call outgo (lab+1)
+   call indent (-1)
+   call outcon (lab)
+   call indent (1)
+   return
+   end
diff --git a/unix/boot/spp/rpp/rpprat/endcod.r b/unix/boot/spp/rpp/rpprat/endcod.r
new file mode 100644
index 00000000..f94636f8
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/endcod.r
@@ -0,0 +1,36 @@
+include defs
+
+# ENDCOD -- Code thats gets executed when the END statement is encountered,
+# terminating a procedure.
+
+subroutine endcod (endstr)
+
+character endstr(1)
+include COMMON_BLOCKS
+string	sepro "call zzepro"
+string	sret "return"
+
+	if (esp != 0)
+	    call synerr ("Unmatched 'iferr' or 'then' keyword.")
+	esp = 0					# error stack pointer
+	body = NO
+	ername = NO
+	if (errtbl != NULL)
+	    call rmtabl (errtbl)
+	errtbl = NULL
+	memflg = NO				# reinit mem decl flag
+
+	if (retlab != NULL)
+	    call outnum (retlab)
+	call outtab
+	call outstr (sepro)
+	call outdon
+	call outtab
+	call outstr (sret)
+	call outdon
+
+	col = 6
+	call outtab
+	call outstr (endstr)
+	call outdon
+end
diff --git a/unix/boot/spp/rpp/rpprat/entdef.r b/unix/boot/spp/rpp/rpprat/entdef.r
new file mode 100644
index 00000000..e9c447ff
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/entdef.r
@@ -0,0 +1,19 @@
+#-h-  entdef			  387  local   12/01/80  15:53:51
+# entdef - enter a new symbol definition, discarding any old one
+   include  defs
+
+   subroutine entdef (name, defn, table)
+   character name (MAXTOK), defn (ARB)
+   pointer table
+
+   integer lookup
+
+   pointer text
+   pointer sdupl
+
+   if (lookup (name, text, table) == YES)
+      call dsfree (text)   # this is how to do UNDEFINE, by the way
+   call enter (name, sdupl (defn), table)
+
+   return
+   end
diff --git a/unix/boot/spp/rpp/rpprat/entdkw.r b/unix/boot/spp/rpp/rpprat/entdkw.r
new file mode 100644
index 00000000..6b061075
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/entdkw.r
@@ -0,0 +1,41 @@
+#-h-  entdkw			  975  local   12/01/80  15:54:05
+# entdkw --- install macro processor keywords
+   include  defs
+
+   subroutine entdkw
+
+   character deft(2), prag(2) #, inct(2), subt(2), ift(2), art(2),
+      # ifdft(2), ifndt(2), mact(2)
+
+   string defnam "define"
+   string prgnam "pragma"
+#  string macnam "mdefine"
+#  string incnam "incr"
+#  string subnam "substr"
+#  string ifnam "ifelse"
+#  string arnam "arith"
+#  string ifdfnm "ifdef"
+#  string ifndnm "ifnotdef"
+
+   data deft (1), deft (2) /DEFTYPE, EOS/
+   data prag (1), prag (2) /PRAGMATYPE, EOS/
+#  data mact (1), mact (2) /MACTYPE, EOS/
+#  data inct (1), inct (2) /INCTYPE, EOS/
+#  data subt (1), subt (2) /SUBTYPE, EOS/
+#  data ift (1), ift (2) /IFTYPE, EOS/
+#  data art (1), art (2) /ARITHTYPE, EOS/
+#  data ifdft (1), ifdft (2) /IFDEFTYPE, EOS/
+#  data ifndt (1), ifndt (2) /IFNOTDEFTYPE, EOS/
+
+   call ulstal (defnam, deft)
+   call ulstal (prgnam, prag)
+#  call ulstal (macnam, mact)
+#  call ulstal (incnam, inct)
+#  call ulstal (subnam, subt)
+#  call ulstal (ifnam, ift)
+#  call ulstal (arnam, art)
+#  call ulstal (ifdfnm, ifdft)
+#  call ulstal (ifndnm, ifndt)
+
+return
+end
diff --git a/unix/boot/spp/rpp/rpprat/entfkw.r b/unix/boot/spp/rpp/rpprat/entfkw.r
new file mode 100644
index 00000000..43174502
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/entfkw.r
@@ -0,0 +1,14 @@
+include  defs
+
+# entfkw - place Fortran keywords in symbol table.
+# Place in the following table any long (> 6 characters)
+# keyword that is used by your Fortran compiler:
+
+
+subroutine entfkw
+
+include COMMON_BLOCKS
+string sequiv "equivalence"
+
+	call enter (sequiv, 0, fkwtbl)
+end
diff --git a/unix/boot/spp/rpp/rpprat/entrkw.r b/unix/boot/spp/rpp/rpprat/entrkw.r
new file mode 100644
index 00000000..ec86b9e0
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/entrkw.r
@@ -0,0 +1,56 @@
+#-h-  entrkw			 1003  local   12/01/80  15:54:06
+# entrkw --- install Ratfor keywords in symbol table
+   include  defs
+
+   subroutine entrkw
+
+   include COMMON_BLOCKS
+
+   string sif "if"
+   string selse "else"
+   string swhile "while"
+   string sdo "do"
+   string sbreak "break"
+   string snext "next"
+   string sfor "for"
+   string srept "repeat"
+   string suntil "until"
+   string sret "return"
+   string sstr "string"
+   string sswtch "switch"
+   string scase "case"
+   string sdeflt "default"
+   string send "end"
+   string serrchk "errchk"
+   string siferr "iferr"
+   string sifnoerr "ifnoerr"
+   string sthen "then"
+   string sbegin "begin"
+   string spoint "pointer"
+   string sgoto "goto"
+
+   call enter (sif, LEXIF, rkwtbl)
+   call enter (selse, LEXELSE, rkwtbl)
+   call enter (swhile, LEXWHILE, rkwtbl)
+   call enter (sdo, LEXDO, rkwtbl)
+   call enter (sbreak, LEXBREAK, rkwtbl)
+   call enter (snext, LEXNEXT, rkwtbl)
+   call enter (sfor, LEXFOR, rkwtbl)
+   call enter (srept, LEXREPEAT, rkwtbl)
+   call enter (suntil, LEXUNTIL, rkwtbl)
+   call enter (sret, LEXRETURN, rkwtbl)
+   call enter (sstr, LEXSTRING, rkwtbl)
+   call enter (sswtch, LEXSWITCH, rkwtbl)
+   call enter (scase, LEXCASE, rkwtbl)
+   call enter (sdeflt, LEXDEFAULT, rkwtbl)
+   call enter (send, LEXEND, rkwtbl)
+   call enter (serrchk, LEXERRCHK, rkwtbl)
+   call enter (siferr, LEXIFERR, rkwtbl)
+   call enter (sifnoerr, LEXIFNOERR, rkwtbl)
+   call enter (sthen, LEXTHEN, rkwtbl)
+   call enter (sbegin, LEXBEGIN, rkwtbl)
+   call enter (spoint, LEXPOINTER, rkwtbl)
+   call enter (sgoto, LEXGOTO, rkwtbl)
+
+   return
+   end
diff --git a/unix/boot/spp/rpp/rpprat/entxkw.r b/unix/boot/spp/rpp/rpprat/entxkw.r
new file mode 100644
index 00000000..d2ec81b2
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/entxkw.r
@@ -0,0 +1,51 @@
+
+include defs
+
+# ENTXKW -- Enter all XPP directives in the symbol table.
+
+subroutine entxkw
+
+include	COMMON_BLOCKS
+
+string	sbool	"x$bool"
+string	schar	"x$char"
+string	sshort	"x$short"
+string	sint	"x$int"
+string	slong	"x$long"
+string	sreal	"x$real"
+string	sdble	"x$dble"
+string	scplx	"x$cplx"
+string	spntr	"x$pntr"
+string	sfchr	"x$fchr"
+string	sfunc	"x$func"
+string	ssubr	"x$subr"
+string	sextn	"x$extn"
+
+string dbool	"logical"
+string dchar	"integer*2"
+string dshort	"integer*2"
+string dint	"integer"
+string dlong	"integer"
+string dpntr	"integer"
+string dreal	"real"
+string ddble	"double precision"
+string dcplx	"complex"
+string dfchr	"character"
+string dfunc	"function"
+string dsubr	"subroutine"
+string dextn	"external"
+
+	call entdef (sbool,  dbool,  xpptbl)
+	call entdef (schar,  dchar,  xpptbl)
+	call entdef (sshort, dshort, xpptbl)
+	call entdef (sint,   dint,   xpptbl)
+	call entdef (slong,  dlong,  xpptbl)
+	call entdef (spntr,  dpntr,  xpptbl)
+	call entdef (sreal,  dreal,  xpptbl)
+	call entdef (sdble,  ddble,  xpptbl)
+	call entdef (scplx,  dcplx,  xpptbl)
+	call entdef (sfchr,  dfchr,  xpptbl)
+	call entdef (sfunc,  dfunc,  xpptbl)
+	call entdef (ssubr,  dsubr,  xpptbl)
+	call entdef (sextn,  dextn,  xpptbl)
+end
diff --git a/unix/boot/spp/rpp/rpprat/errchk.r b/unix/boot/spp/rpp/rpprat/errchk.r
new file mode 100644
index 00000000..4b948936
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/errchk.r
@@ -0,0 +1,42 @@
+include defs
+
+# ERRCHK -- Code called to process an ERRCHK declaration.
+
+subroutine errchk
+
+character tok, last_tok, gnbtok, token(MAXTOK)
+integer	ntok
+pointer	mktabl
+include	COMMON_BLOCKS
+string	serrcom1 "logical xerflg, xerpad(84)"
+string	serrcom2 "common /xercom/ xerflg, xerpad"
+
+	ntok = 0
+	tok = 0
+
+	repeat {
+	    last_tok = tok
+	    tok = gnbtok (token, MAXTOK)
+
+	    switch (tok) {
+	    case ALPHA:
+		if (errtbl == NULL) {
+		    errtbl = mktabl(0)			# make empty table
+		    call outtab				# declare err flag
+		    call outstr (serrcom1)
+		    call outdon
+		    call outtab				# declare err common
+		    call outstr (serrcom2)
+		    call outdon
+		}
+		call enter (token, 0, errtbl)		# enter keyw in table
+	    case COMMA:
+		# no action, but required by syntax
+	    case NEWLINE:
+		if (last_tok != COMMA)
+		    break
+	    default:
+		call synerr ("Syntax error in ERRCHK declaration.")
+	    }
+	}
+end
diff --git a/unix/boot/spp/rpp/rpprat/errgo.r b/unix/boot/spp/rpp/rpprat/errgo.r
new file mode 100644
index 00000000..81aa582c
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/errgo.r
@@ -0,0 +1,29 @@
+include defs
+
+# ERRGO -- Ouput error checking code.
+
+subroutine errgo
+
+include COMMON_BLOCKS
+string	serrchk "if (xerflg) "
+
+	# In the processing of the last line, was an indentifier encountered
+	# for which error checking is required (named in errchk declaration)?
+
+	if (ername == YES) {
+	    call outtab
+	    if (esp > 0) {				# in iferr ... stmt?
+		# Omit goto if goto statement label number is zero.  This
+		# happens in "iferr (...)" statements.
+		if (errstk(esp) > 0) {
+		    call outstr (serrchk)
+		    call ogotos (errstk(esp)+2, NO)	# "goto lab"
+		}
+	    } else {
+		call outstr (serrchk)
+		call ogotos (retlab, NO)
+		call outdon
+	    }
+	    ername = NO
+	}
+end
diff --git a/unix/boot/spp/rpp/rpprat/errorc.r b/unix/boot/spp/rpp/rpprat/errorc.r
new file mode 100644
index 00000000..f0fa6a2f
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/errorc.r
@@ -0,0 +1,20 @@
+
+include defs
+
+# ERRORC -- Process an error statement.  "call error" already processed.
+
+
+subroutine errorc (str)
+
+character str(1)
+include COMMON_BLOCKS
+
+	xfer = YES
+	call outstr (str)
+	call balpar			# output "(errcod, errmsg)"
+	ername = NO			# just to be safe
+	call outdon
+	call outtab
+	call ogotos (retlab, NO)	# always return after error statement
+	call outdon
+end
diff --git a/unix/boot/spp/rpp/rpprat/evalr.r b/unix/boot/spp/rpp/rpprat/evalr.r
new file mode 100644
index 00000000..3752bcd4
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/evalr.r
@@ -0,0 +1,56 @@
+#-h-  evalr			 1126  local   12/01/80  15:54:06
+# evalr - expand args i through j: evaluate builtin or push back defn
+   include  defs
+
+   subroutine evalr (argstk, i, j)
+   integer argstk (ARGSIZE), i, j
+
+   include COMMON_BLOCKS
+
+   integer argno, k, m, n, t, td, in_string, delim
+   external index
+   integer index, length
+
+   string digits '0123456789'
+
+   t = argstk (i)
+   td = evalst (t)
+   if (td == MACTYPE)
+      call domac (argstk, i, j)
+   else if (td == INCTYPE)
+      call doincr (argstk, i, j)
+   else if (td == SUBTYPE)
+      call dosub (argstk, i, j)
+   else if (td == IFTYPE)
+      call doif (argstk, i, j)
+   else if (td == ARITHTYPE)
+      call doarth (argstk, i, j)
+   else {
+      in_string = NO
+      for (k = t + length (evalst (t)) - 1; k > t; k = k - 1)
+	 if (evalst(k) == SQUOTE | evalst(k) == DQUOTE) {
+	    if (in_string == NO) {
+		delim = evalst(k)
+		in_string = YES
+		}
+	    else
+		in_string = NO
+	    call putbak (evalst(k))
+	    }
+	 # Don't expand $arg if in a string.
+	 else if (evalst(k-1) != ARGFLAG | in_string == YES)
+	    call putbak (evalst (k))
+	 else {
+	    argno = index (digits, evalst (k))	-  1
+	    if (argno >= 0 & argno < j - i) {
+	       n = i + argno + 1
+	       m = argstk (n)
+	       call pbstr (evalst (m))
+	       }
+	    k = k - 1	# skip over $
+	    }
+      if (k == t)	  # do last character
+	 call putbak (evalst (k))
+      }
+   return
+   end
diff --git a/unix/boot/spp/rpp/rpprat/finit.r b/unix/boot/spp/rpp/rpprat/finit.r
new file mode 100644
index 00000000..8ca1ecf5
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/finit.r
@@ -0,0 +1,24 @@
+#-h-  finit			  432  local   12/01/80  15:54:07
+# finit - initialize for each input file
+   include  defs
+
+   subroutine finit
+
+   include COMMON_BLOCKS
+
+   outp = 0  # output character pointer
+   level = 1  # file control
+   linect (1) = 0
+   sbp	= 1
+   fnamp = 2
+   fnames (1) = EOS
+   bp = PBPOINT
+   buf (bp) = EOS    # to force a read on next call to 'ngetch'
+   fordep = 0  # for stack
+   fcname (1) = EOS # current function name
+   swtop = 0  # switch stack
+   swlast = 1
+   swvnum = 0
+   swvlev = 0
+   return
+   end
diff --git a/unix/boot/spp/rpp/rpprat/forcod.r b/unix/boot/spp/rpp/rpprat/forcod.r
new file mode 100644
index 00000000..9d389f5e
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/forcod.r
@@ -0,0 +1,101 @@
+#-h-  forcod			 2259  local   12/01/80  15:54:07
+# forcod - beginning of for statement
+   include  defs
+
+   subroutine forcod (lab)
+   integer lab
+
+   include COMMON_BLOCKS
+
+   character t, token (MAXTOK)
+   character gettok, gnbtok
+
+   integer i, j, nlpar
+   integer length, labgen
+
+   string ifnot "if (.not."
+   string serrchk ".and.(.not.xerflg))) "
+
+   lab = labgen (3)
+   call outcon (0)
+   if (gnbtok (token, MAXTOK) != LPAREN) {
+      call synerr ("missing left paren.")
+      return
+      }
+   if (gnbtok (token, MAXTOK) != SEMICOL) {   # real init clause
+      call pbstr (token)
+      call outtab
+      call eatup
+      call outdwe
+      }
+   if (gnbtok (token, MAXTOK) == SEMICOL)   # empty condition
+      call outcon (lab)
+   else {   # non-empty condition
+      call pbstr (token)
+      call outnum (lab)
+      call outtab
+      call outstr (ifnot)
+      call outch (LPAREN)
+      nlpar = 0
+      while (nlpar >= 0) {
+	 t = gettok (token, MAXTOK)
+	 if (t == SEMICOL)
+	    break
+	 if (t == LPAREN)
+	    nlpar = nlpar + 1
+	 else if (t == RPAREN)
+	    nlpar = nlpar - 1
+	 if (t == EOF) {
+	    call pbstr (token)
+	    return
+	    }
+	 if (t == ALPHA)
+	    call squash (token)
+	 if (t != NEWLINE & t != UNDERLINE)
+	    call outstr (token)
+	 }
+
+      # name encountered for which error checking is required?
+      if (ername == YES)
+	 call outstr (serrchk)
+      else {
+	  call outch (RPAREN)
+	  call outch (RPAREN)
+	  call outch (BLANK)
+	  }
+      call outgo (lab+2)			# error checking below (errgo)
+      if (nlpar < 0)
+	 call synerr ("invalid for clause.")
+      }
+   fordep = fordep + 1	 # stack reinit clause
+   j = 1
+   for (i = 1; i < fordep; i = i + 1)	# find end
+      j = j + length (forstk (j)) + 1
+   forstk (j) = EOS   # null, in case no reinit
+   nlpar = 0
+   t = gnbtok (token, MAXTOK)
+   call pbstr (token)
+   while (nlpar >= 0) {
+      t = gettok (token, MAXTOK)
+      if (t == LPAREN)
+	 nlpar = nlpar + 1
+      else if (t == RPAREN)
+	 nlpar = nlpar - 1
+      if (t == EOF) {
+	 call pbstr (token)
+	 break
+	 }
+      if (nlpar >= 0 & t != NEWLINE & t != UNDERLINE) {
+	 if (t == ALPHA)
+	    call squash (token)
+	 if (j + length (token) >= MAXFORSTK)
+	    call baderr ("for clause too long.")
+	 call scopy (token, 1, forstk, j)
+	 j = j + length (token)
+	 }
+      }
+   lab = lab + 1   # label for next's
+   call indent (1)
+   call errgo
+   return
+   end
diff --git a/unix/boot/spp/rpp/rpprat/fors.r b/unix/boot/spp/rpp/rpprat/fors.r
new file mode 100644
index 00000000..5d3692ea
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/fors.r
@@ -0,0 +1,29 @@
+#-h-  fors			  458  local   12/01/80  15:54:08
+# fors - process end of for statement
+   include  defs
+
+   subroutine fors (lab)
+   integer lab
+
+   include COMMON_BLOCKS
+
+   integer i, j
+   integer length
+
+   xfer = NO
+   call outnum (lab)
+   j = 1
+   for (i = 1; i < fordep; i = i + 1)
+      j = j + length (forstk (j)) + 1
+   if (length (forstk (j)) > 0) {
+      call outtab
+      call outstr (forstk (j))
+      call outdon
+      }
+   call outgo (lab - 1)
+   call indent (-1)
+   call outcon (lab + 1)
+   fordep = fordep - 1
+   ername = NO
+   return
+   end
diff --git a/unix/boot/spp/rpp/rpprat/fort b/unix/boot/spp/rpp/rpprat/fort
new file mode 100644
index 00000000..e69de29b
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/fort
diff --git a/unix/boot/spp/rpp/rpprat/getdef.r b/unix/boot/spp/rpp/rpprat/getdef.r
new file mode 100644
index 00000000..be97b439
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/getdef.r
@@ -0,0 +1,62 @@
+#-h-  getdef			 1634  local   12/01/80  15:54:08
+# getdef (for no arguments) - get name and definition
+   include  defs
+
+   subroutine getdef (token, toksiz, defn, defsiz)
+   character token (MAXTOK), defn (MAXDEF)
+   integer toksiz, defsiz
+
+   include COMMON_BLOCKS
+
+   character c, t, ptoken (MAXTOK)
+   character gtok, ngetch
+
+   integer i, nlpar
+
+   call skpblk
+   c = gtok (ptoken, MAXTOK)
+   if (c == LPAREN)
+      t = LPAREN	     # define (name, defn)
+   else {
+      t = BLANK 	     # define name defn
+      call pbstr (ptoken)
+      }
+   call skpblk
+   if (gtok (token, toksiz) != ALPHA)
+      call baderr ("non-alphanumeric name.")
+   call skpblk
+   c = gtok (ptoken, MAXTOK)
+   if (t == BLANK) {	     # define name defn
+      call pbstr (ptoken)
+      i = 1
+      repeat {
+	 c = ngetch (c)
+	 if (i > defsiz)
+	    call baderr ("definition too long.")
+	 defn (i) = c
+	 i = i + 1
+	 } until (c == SHARP | c == NEWLINE | c == EOF)
+      if (c == SHARP)
+	 call putbak (c)
+      }
+   else if (t == LPAREN) {   # define (name, defn)
+      if (c != COMMA)
+	 call baderr ("missing comma in define.")
+      # else got (name,
+      nlpar = 0
+      for (i = 1; nlpar >= 0; i = i + 1)
+	 if (i > defsiz)
+	    call baderr ("definition too long.")
+	 else if (ngetch (defn (i)) == EOF)
+	    call baderr ("missing right paren.")
+	 else if (defn (i) == LPAREN)
+	    nlpar = nlpar + 1
+	 else if (defn (i) == RPAREN)
+	    nlpar = nlpar - 1
+	 # else normal character in defn (i)
+      }
+   else
+      call baderr ("getdef is confused.")
+   defn (i - 1) = EOS
+   return
+   end
diff --git a/unix/boot/spp/rpp/rpprat/gettok.r b/unix/boot/spp/rpp/rpprat/gettok.r
new file mode 100644
index 00000000..8ae855db
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/gettok.r
@@ -0,0 +1,90 @@
+#-h-  gettok			 2076  local   12/01/80  15:54:09
+# gettok - get token. handles file inclusion and line numbers
+   include  defs
+
+character function gettok (token, toksiz)
+
+character token (MAXTOK)
+integer toksiz
+include COMMON_BLOCKS
+integer equal
+character t, deftok
+#character name(MAXNAME), t
+#integer i, len, open, length
+
+string ssubr "x$subr"
+string sfunc "x$func"
+#string incl "include"
+
+#  for (;  level > 0;  level = level - 1) {
+
+	gettok = deftok (token, toksiz)
+	if (gettok != EOF) {
+	    if (gettok == XPP_DIRECTIVE) {
+	        if (equal (token, sfunc) == YES) {
+		    call skpblk
+		    t = deftok (fcname, MAXNAME)
+		    call pbstr (fcname)
+		    if (t != ALPHA)
+		        call synerr ("Missing function name.")
+		    call putbak (BLANK)
+		    swvnum = 0
+		    swvlev = 0
+		    return
+	        } else if (equal (token, ssubr) == YES) {
+		    swvnum = 0
+		    swvlev = 0
+		    return
+	        } else
+		    return
+	     }
+	     return
+	}
+
+	token (1) = EOF
+	token (2) = EOS
+	gettok = EOF
+	return
+end
+
+
+# -- Includes are now processed elsewhere
+
+#	 else if (equal (token, incl) == NO)
+#	    return
+#
+#	 # process 'include' statements:
+#	 call skpblk
+#	 t = deftok (name, MAXNAME)
+#	 if (t == SQUOTE | t == DQUOTE) {
+#	    len = length (name) - 1
+#	    for (i = 1; i < len; i = i + 1)
+#	       name (i) = name (i + 1)
+#	    name (i) = EOS
+#	    }
+#	 i = length (name) + 1
+#	 if (level >= NFILES)
+#	    call synerr ("includes nested too deeply.")
+#	 else {
+#	    infile (level + 1) = open (name, READ)
+#	    linect (level + 1) = 0
+#	    if (infile (level + 1) == ERR)
+#	       call synerr ("can't open include.")
+#	    else {
+#	       level = level + 1
+#	       if (fnamp + i <= MAXFNAMES) {
+#		  call scopy (name, 1, fnames, fnamp)
+#		  fnamp = fnamp + i    # push file name stack
+#		  }
+#	       }
+#	    }
+#	 }
+#      if (level > 1) {	    # close include file pop file name stack
+#	 call close (infile (level))
+#	 for (fnamp = fnamp - 1; fnamp > 1; fnamp = fnamp - 1)
+#	    if (fnames (fnamp - 1) == EOS)
+#	       break
+#	 }
+
+#    }
+
diff --git a/unix/boot/spp/rpp/rpprat/gnbtok.r b/unix/boot/spp/rpp/rpprat/gnbtok.r
new file mode 100644
index 00000000..448a1aad
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/gnbtok.r
@@ -0,0 +1,19 @@
+#-h-  gnbtok			  237  local   12/01/80  15:54:09
+# gnbtok - get nonblank token
+   include  defs
+
+   character function gnbtok (token, toksiz)
+   character token (MAXTOK)
+   integer toksiz
+
+   include COMMON_BLOCKS
+
+   character gettok
+
+   call skpblk
+   repeat {
+      gnbtok = gettok (token, toksiz)
+   } until (gnbtok != BLANK)
+
+   return
+   end
diff --git a/unix/boot/spp/rpp/rpprat/gocode.r b/unix/boot/spp/rpp/rpprat/gocode.r
new file mode 100644
index 00000000..26e201c4
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/gocode.r
@@ -0,0 +1,25 @@
+include  defs
+
+# GOCODE - generate code for goto statement
+
+subroutine gocode
+
+character token (MAXTOK), t
+character gnbtok
+integer	ctoi, i
+include	COMMON_BLOCKS
+
+	t = gnbtok (token, MAXTOK)
+	if (t != DIGIT)
+	    call synerr ("Invalid label for goto.")
+	else {
+	    call outtab
+	    i = 1
+	    call ogotos (ctoi(token,i), NO)
+	}
+	xfer = YES
+
+	for (t=gnbtok(token,MAXTOK);  t == NEWLINE;  t=gnbtok(token,MAXTOK))
+	    ;
+	call pbstr (token)
+end
diff --git a/unix/boot/spp/rpp/rpprat/gtok.r b/unix/boot/spp/rpp/rpprat/gtok.r
new file mode 100644
index 00000000..4cdb3d72
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/gtok.r
@@ -0,0 +1,161 @@
+include  defs
+
+# gtok - get token for Ratfor
+
+   character function gtok (lexstr, toksiz)
+   character lexstr (MAXTOK)
+   integer toksiz
+
+   include COMMON_BLOCKS
+
+   character c
+   character ngetch
+
+   integer i
+#  external index
+#  integer index
+
+#  string digits "0123456789abcdefghijklmnopqrstuvwxyz"
+
+   c = ngetch (lexstr (1))
+
+   if (c == BLANK | c == TAB) {
+      lexstr (1) = BLANK
+      while (c == BLANK | c == TAB)    # compress many blanks to one
+	 c = ngetch (c)
+      if (c == SHARP)
+	 while (ngetch (c) != NEWLINE)	 # strip comments
+	    ;
+      if (c != NEWLINE)
+	 call putbak (c)
+      else
+	 lexstr (1) = NEWLINE
+      lexstr (2) = EOS
+      gtok = lexstr (1)
+      return
+      }
+
+   i = 1
+   if (IS_LETTER(c)) {				# alpha
+      gtok = ALPHA
+      if (c == LETX) {				# "x$cccc" directive?
+	 c = ngetch (lexstr(2))
+	 if (c == DOLLAR) {
+	    gtok = XPP_DIRECTIVE
+	    i = 2
+	    }
+	 else
+	    call putbak (c)
+	 }
+
+      for (;  i < toksiz - 2;  i=i+1) {
+	 c = ngetch (lexstr(i+1))
+	 if (!IS_LETTER(c) & !IS_DIGIT(c) & c != UNDERLINE)
+	    break
+	 }
+      call putbak (c)
+
+	} else if (IS_DIGIT(c)) {   # digits
+	    for (i=1;  i < toksiz - 2;  i=i+1) {
+		c = ngetch (lexstr (i + 1))
+		if (!IS_DIGIT(c))
+		    break
+	    }
+	    call putbak (c)
+	    gtok = DIGIT
+	}
+
+# The following is not needed since XPP does base conversion, and this caused
+# fixed point overflow on a Data General machine.
+#
+#      b = c - DIG0 # in case alternate base number
+#      for (i = 1; i < toksiz - 2; i = i + 1) {
+#	 c = ngetch (lexstr (i + 1))
+#	 if (!IS_DIGIT(c))
+#	    break
+#	 b = 10 * b + (c - DIG0)
+#	 }
+#      if (c == RADIX & b >= 2 & b <= 36) {   #n%ddd...
+#	 n = 0
+#	 repeat {
+#	    d = index (digits, clower (ngetch (c))) - 1
+#	    if (d < 0)
+#	       break
+#	    n = b * n + d
+#	    }
+#	 call putbak (c)
+#	 i = itoc (n, lexstr, toksiz)
+#	 }
+#      else
+#	 call putbak (c)
+#      gtok = DIGIT
+#      }
+
+   else if (c == LBRACK) {   # allow [ for {
+      lexstr (1) = LBRACE
+      gtok = LBRACE
+      }
+
+   else if (c == RBRACK) {   # allow ] for }
+      lexstr (1) = RBRACE
+      gtok = RBRACE
+      }
+
+   else if (c == DOLLAR) {    # $( and $) now used by macro processor
+      if (ngetch (lexstr (2)) == LPAREN) {
+	 i = 2
+	 gtok = LSTRIPC
+	 }
+      else if (lexstr (2) == RPAREN) {
+	 i = 2
+	 gtok = RSTRIPC
+	 }
+      else {
+	 call putbak (lexstr (2))
+	 gtok = DOLLAR
+	 }
+      }
+
+   else if (c == SQUOTE | c == DQUOTE) {
+      gtok = c
+      for (i = 2; ngetch (lexstr (i)) != lexstr (1); i = i + 1) {
+	 if (lexstr (i) == UNDERLINE)
+	    if (ngetch (c) == NEWLINE) {
+	       while (c == NEWLINE | c == BLANK | c == TAB)
+		  c = ngetch (c)
+	       lexstr (i) = c
+	       }
+	    else
+	       call putbak (c)
+	 if (lexstr (i) == NEWLINE | i >= toksiz - 1) {
+	    call synerr ("missing quote.")
+	    lexstr (i) = lexstr (1)
+	    call putbak (NEWLINE)
+	    break
+	    }
+	 }
+      }
+
+   else if (c == SHARP) {   # strip comments
+      while (ngetch (lexstr (1)) != NEWLINE)
+	 ;
+      gtok = NEWLINE
+      }
+
+   else if (c == GREATER | c == LESS | c == NOT | c == BANG |
+    c == TILDE | c == CARET | c == EQUALS | c == AND | c == OR) {
+      call relate (lexstr, i)
+      gtok = c
+      }
+
+   else
+      gtok = c
+
+   if (i >= toksiz - 1)
+      call synerr ("token too long.")
+   lexstr (i + 1) = EOS
+
+   # Note:  line number accounting is now done in 'ngetch'
+
+   return
+   end
diff --git a/unix/boot/spp/rpp/rpprat/ifcode.r b/unix/boot/spp/rpp/rpprat/ifcode.r
new file mode 100644
index 00000000..81855321
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/ifcode.r
@@ -0,0 +1,17 @@
+#-h-  ifcode			  198  local   12/01/80  15:54:10
+# ifcode - generate initial code for if
+   include  defs
+
+   subroutine ifcode (lab)
+   integer lab
+
+   include COMMON_BLOCKS
+
+   integer labgen
+
+   xfer = NO
+   lab = labgen (2)
+   call ifgo (lab)
+   call indent (1)
+   return
+   end
diff --git a/unix/boot/spp/rpp/rpprat/iferrc.r b/unix/boot/spp/rpp/rpprat/iferrc.r
new file mode 100644
index 00000000..4fd77154
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/iferrc.r
@@ -0,0 +1,85 @@
+include  defs
+
+# IFERRC - Generate initial code for an IFERR statement.  Used to provide
+# error recovery for a statement or compound statement.
+
+subroutine iferrc (lab, sense)	
+
+integer lab, sense
+integer labgen, nlpar
+character t, gettok, gnbtok, token(MAXTOK)
+include COMMON_BLOCKS
+string	errpsh "call xerpsh"
+string	siferr "if (.not.xerpop()) "
+string	sifnoerr "if (xerpop()) "
+
+	xfer = NO
+	lab = labgen (3)
+
+	call outtab					# "call errpsh"
+	call outstr (errpsh)
+	call outdon
+
+	switch (gnbtok (token, MAXTOK)) {		# "iferr (" or "iferr {"
+	case LPAREN:
+	    call outtab
+	case LBRACE:
+	    call pbstr (token)
+	    esp = esp + 1
+	    if (esp >= MAXERRSTK)			# not likely
+		call baderr ("Iferr statements nested too deeply.")
+	    errstk(esp) = lab
+	    return
+	default:
+	    call synerr ("Missing left paren.")
+	    return
+	}
+
+	nlpar = 1					# process "iferr (.."
+	token(1) = EOS
+
+	# Push handler on error stack temporarily so that "iferr (call error.."
+	# can be handled properly.
+	esp = esp + 1
+	if (esp >= MAXERRSTK)				# not likely
+	    call baderr ("Iferr statements nested too deeply.")
+	errstk(esp) = 0
+	
+	repeat {					# output the statement
+	    call outstr (token)
+	    t = gettok (token, MAXTOK)
+	    if (t == SEMICOL | t == LBRACE | t == RBRACE | t == EOF) {
+		call pbstr (token)
+		break
+	    }
+	    if (t == NEWLINE)      			# delete newlines
+		token (1) = EOS
+	    else if (t == LPAREN)
+		nlpar = nlpar + 1
+	    else if (t == RPAREN)
+		nlpar = nlpar - 1
+	    else if (t == SEMICOL) {
+		call outdon
+		call outtab
+	    } else if (t == ALPHA)
+		call squash (token)
+	    # else nothing special
+	} until (nlpar <= 0)
+	
+	esp = esp - 1
+	ername = NO					# ignore errchk
+	if (nlpar != 0)
+	    call synerr ("Missing parenthesis in condition.")
+	else
+	    call outdon
+	
+	call outtab					# "if (errpop())"
+	if (sense == 1)
+	    call outstr (siferr)
+	else
+	    call outstr (sifnoerr)
+	call outgo (lab)				# "... goto lab"
+
+	call indent (1)
+	return
+end
diff --git a/unix/boot/spp/rpp/rpprat/ifgo.r b/unix/boot/spp/rpp/rpprat/ifgo.r
new file mode 100644
index 00000000..da0e6647
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/ifgo.r
@@ -0,0 +1,23 @@
+include  defs
+
+# IFGO - generate "if (.not.(...)) goto lab"
+
+subroutine ifgo (lab)
+
+integer lab
+include COMMON_BLOCKS
+string ifnot "if (.not."
+string serrchk ".and.(.not.xerflg)) "
+
+	call outtab			# get to column 7
+	call outstr (ifnot)		# " if (.not. "
+	call balpar			# collect and output condition
+	if (ername == YES)		# add error checking?
+	    call outstr (serrchk)
+	else {
+	    call outch (RPAREN)		# " ) "
+	    call outch (BLANK)
+	}
+	call outgo (lab)		# " goto lab "
+	call errgo
+end
diff --git a/unix/boot/spp/rpp/rpprat/ifparm.r b/unix/boot/spp/rpp/rpprat/ifparm.r
new file mode 100644
index 00000000..b2b5f706
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/ifparm.r
@@ -0,0 +1,31 @@
+#-h-  ifparm			  689  local   12/01/80  15:54:11
+# ifparm - determines if the defined symbol has arguments in its
+   include  defs
+# definition.  This effects how the macro is expanded.
+
+   integer function ifparm (strng)
+   character strng (ARB)
+
+   character c
+
+   external index
+   integer i, index, type
+
+   c = strng (1)
+   if (c == INCTYPE | c == SUBTYPE | c == IFTYPE | c == ARITHTYPE |
+    c == MACTYPE)
+      ifparm = YES
+   else {
+      ifparm = NO
+      for (i = 1; index (strng (i), ARGFLAG) > 0; ) {
+	 i = i + index (strng (i), ARGFLAG) # i points at char after ARGFLAG
+	 if (type (strng (i)) == DIGIT)
+	 andif (type (strng (i + 1)) != DIGIT) {
+	    ifparm = YES
+	    break
+	    }
+	 }
+      }
+
+   return
+   end
diff --git a/unix/boot/spp/rpp/rpprat/indent.r b/unix/boot/spp/rpp/rpprat/indent.r
new file mode 100644
index 00000000..e119c773
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/indent.r
@@ -0,0 +1,12 @@
+include defs
+
+# INDENT -- Indent the output listing.
+
+subroutine indent (nlevels)
+
+integer	nlevels
+include COMMON_BLOCKS
+
+	logical_column = logical_column + (nlevels * INDENT)
+	col = max(6, min(MAX_INDENT, logical_column))
+end
diff --git a/unix/boot/spp/rpp/rpprat/initkw.r b/unix/boot/spp/rpp/rpprat/initkw.r
new file mode 100644
index 00000000..c03bf2f2
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/initkw.r
@@ -0,0 +1,34 @@
+#-h-  initkw			  549  local   12/01/80  15:54:11
+# initkw - initialize tables and important global variables
+   include  defs
+
+   subroutine initkw
+
+   include COMMON_BLOCKS
+
+   pointer mktabl
+
+   call dsinit (MEMSIZE)
+   deftbl = mktabl (1)	   # symbol table for definitions
+   call entdkw
+   rkwtbl = mktabl (1)	   # symbol table for Ratfor key words
+   call entrkw
+   fkwtbl = mktabl (0)	   # symbol table for Fortran key words
+   call entfkw
+   namtbl = mktabl (1)	   # symbol table for long identifiers
+   xpptbl = mktabl (1)	   # symbol table for xpp directives
+   call entxkw
+   gentbl = mktabl (0)	   # symbol table for generated identifiers
+   errtbl = NULL	   # table of names to be error checked
+
+   label = FIRST_LABEL	   # starting statement label
+   smem(1) = EOS	   # haven't read in "mem.com" file yet
+   body = NO		   # not in procedure body to start
+   dbgout = NO		   # disable debug output by default
+   dbglev = 0		   # file level if debug enabled
+   memflg = NO		   # haven't declared mem common yet
+   swinrg = NO		   # default range checking for switches
+   col = 6
+
+   return
+   end
diff --git a/unix/boot/spp/rpp/rpprat/labelc.r b/unix/boot/spp/rpp/rpprat/labelc.r
new file mode 100644
index 00000000..86421d9b
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/labelc.r
@@ -0,0 +1,19 @@
+#-h-  labelc			  404  local   12/01/80  15:54:12
+# labelc - output statement number
+   include  defs
+
+   subroutine labelc (lexstr)
+   character lexstr (ARB)
+
+   include COMMON_BLOCKS
+
+   integer length, l
+
+   xfer = NO   # can't suppress goto's now
+   l = length (lexstr)
+   if (l >= 3 & l < 4)		# possible conflict with pp-generated labels
+       call synerr ("Warning: statement labels 100 and above are reserved.")
+   call outstr (lexstr)
+   call outtab
+   return
+   end
diff --git a/unix/boot/spp/rpp/rpprat/labgen.r b/unix/boot/spp/rpp/rpprat/labgen.r
new file mode 100644
index 00000000..f110e963
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/labgen.r
@@ -0,0 +1,13 @@
+#-h-  labgen			  189  local   12/01/80  15:54:12
+# labgen - generate  n	consecutive labels, return first one
+   include  defs
+
+   integer function labgen (n)
+   integer n
+
+   include COMMON_BLOCKS
+
+   labgen = label
+   label = label + (n / 10 + 1) * 10
+   return
+   end
diff --git a/unix/boot/spp/rpp/rpprat/lex.r b/unix/boot/spp/rpp/rpprat/lex.r
new file mode 100644
index 00000000..bc8f7a27
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/lex.r
@@ -0,0 +1,49 @@
+#-h-  lex			  543  local   12/01/80  15:54:12
+# lex - return lexical type of token
+   include  defs
+
+   integer function lex (lexstr)
+   character lexstr (MAXTOK)
+
+   include COMMON_BLOCKS
+
+   character gnbtok, t, c
+
+   integer lookup, n
+   string sdefault "default"
+
+   for (lex = gnbtok (lexstr, MAXTOK);  lex == NEWLINE;
+        lex = gnbtok (lexstr, MAXTOK))
+      ;
+
+   if (lex == EOF | lex == SEMICOL | lex == LBRACE | lex == RBRACE)
+      return
+   if (lex == DIGIT)
+      lex = LEXDIGITS
+   else if (lex == TOGGLE)
+      lex = LEXLITERAL
+   else if (lex == XPP_DIRECTIVE)
+      lex = LEXDECL
+   else if (lookup (lexstr, lex, rkwtbl) == YES) {
+      if (lex == LEXDEFAULT) {				# "default:"
+	 n = -1
+	 repeat {
+	    c = ngetch (c)
+	    n = n + 1
+	 } until (c != BLANK & c != TAB)
+	 call putbak (c)
+
+	 t = gnbtok (lexstr, MAXTOK)
+	 call pbstr (lexstr)
+	 if (n > 0)
+	    call putbak (BLANK)
+	 call scopy (sdefault, 1, lexstr, 1)
+	 if (t != COLON)
+	    lex = LEXOTHER
+	 }
+      }
+   else
+      lex = LEXOTHER
+
+   return
+   end
diff --git a/unix/boot/spp/rpp/rpprat/litral.r b/unix/boot/spp/rpp/rpprat/litral.r
new file mode 100644
index 00000000..e9106559
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/litral.r
@@ -0,0 +1,20 @@
+#-h-  litral			  316  local   12/01/80  15:54:13
+# litral - process literal Fortran line
+   include  defs
+
+   subroutine litral
+
+   include COMMON_BLOCKS
+
+   character ngetch
+
+   # Finish off any left-over characters
+   if (outp > 0)
+      call outdwe
+
+   for (outp = 1; ngetch (outbuf (outp)) != NEWLINE; outp = outp + 1)
+      ;
+   outp = outp - 1
+   call outdwe
+   return
+   end
diff --git a/unix/boot/spp/rpp/rpprat/lndict.r b/unix/boot/spp/rpp/rpprat/lndict.r
new file mode 100644
index 00000000..42cf8d6a
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/lndict.r
@@ -0,0 +1,30 @@
+#-h-  lndict			  678  local   12/01/80  15:54:13
+# lndict - output long-name dictionary as a debugging aid
+   include  defs
+
+subroutine lndict
+
+character sym (MAXTOK), c
+ifdef (UPPERC, character cupper)
+integer sctabl, length
+pointer posn, locn
+include COMMON_BLOCKS
+
+   posn = 0
+   while (sctabl (namtbl, sym, locn, posn) != EOF)
+      if (length(sym) > MAXIDLENGTH) {
+	  ifdef (UPPERC, call outch (BIGC))
+	  ifnotdef (UPPERC, call outch (LETC))
+	  call outtab
+	  for (; mem (locn) != EOS; locn = locn + 1) {
+	     c = mem (locn) # kluge for people with LOGICAL*1 characters
+	     ifdef (UPPERC, c = cupper (c))
+	     call outch (c)
+	  }
+	  call outch (BLANK)
+	  call outch (BLANK)
+	  call outstr (sym)
+	  call outdon
+      }
+   return
+end
diff --git a/unix/boot/spp/rpp/rpprat/ludef.r b/unix/boot/spp/rpp/rpprat/ludef.r
new file mode 100644
index 00000000..45876968
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/ludef.r
@@ -0,0 +1,29 @@
+#-h-  ludef			  495  local   12/01/80  15:54:29
+# ludef --- look up a defined identifier, return its definition
+   include  defs
+
+   integer function ludef (id, defn, table)
+   character id (ARB), defn (ARB)
+   pointer table
+
+   include COMMON_BLOCKS
+
+   integer i
+   integer lookup
+
+   pointer locn
+
+   ludef = lookup (id, locn, table)
+   if (ludef == YES) {
+      i = 1
+      for (; mem (locn) != EOS; locn = locn + 1) {
+	 defn (i) = mem (locn)
+	 i = i + 1
+	 }
+      defn (i) = EOS
+      }
+   else
+      defn (1) = EOS
+
+   return
+   end
diff --git a/unix/boot/spp/rpp/rpprat/mapid.r b/unix/boot/spp/rpp/rpprat/mapid.r
new file mode 100644
index 00000000..106a9335
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/mapid.r
@@ -0,0 +1,19 @@
+
+include defs
+
+# MAPID -- Map a long identifier.  The new identifier is formed by
+# concatenating the first MAXIDLENGTH-1 characters and the last character.
+
+
+subroutine mapid (name)
+
+character name(MAXTOK)
+integer	i
+
+	for (i=1;  name(i) != EOS;  i=i+1)
+	    ;
+	if (i-1 > MAXIDLENGTH) {
+	    name(MAXIDLENGTH) = name(i-1)
+	    name(MAXIDLENGTH+1) = EOS
+	}
+end
diff --git a/unix/boot/spp/rpp/rpprat/ngetch.r b/unix/boot/spp/rpp/rpprat/ngetch.r
new file mode 100644
index 00000000..26dce4de
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/ngetch.r
@@ -0,0 +1,34 @@
+#-h-  ngetch			  442  local   12/01/80  15:54:30
+# ngetch - get a (possibly pushed back) character
+   include  defs
+
+   character function ngetch (c)
+   character c
+
+   include COMMON_BLOCKS
+
+   integer getlin, n, i
+
+   if (buf (bp) == EOS)
+      if (getlin (buf (PBPOINT), infile (level)) == EOF)
+	 c = EOF
+      else {
+	 c = buf (PBPOINT)
+	 bp = PBPOINT + 1
+	 if (c == SHARP) {		#check for "#!# nn" directive
+	    if (buf(bp) == BANG & buf(bp+1) == SHARP) {
+	       n = 0
+	       for (i=bp+3;  buf(i) >= DIG0 & buf(i) <= DIG9;  i=i+1)
+		  n = n * 10 + buf(i) - DIG0
+	       linect (level) = n - 1
+	       }
+	    }
+	 linect (level) = linect (level) + 1
+	 }
+   else {
+      c = buf (bp)
+      bp = bp + 1
+      }
+
+   return (c)
+   end
diff --git a/unix/boot/spp/rpp/rpprat/ogotos.r b/unix/boot/spp/rpp/rpprat/ogotos.r
new file mode 100644
index 00000000..e20e7df0
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/ogotos.r
@@ -0,0 +1,20 @@
+
+include  defs
+
+# OGOTOS - Output "goto	n", unconditionally.
+
+
+subroutine ogotos (n, error_check)
+
+integer n, error_check
+include COMMON_BLOCKS
+string sgoto "goto "
+
+	call outtab
+	call outstr (sgoto)
+	call outnum (n)
+	if (error_check == YES)
+	    call outdwe
+	else
+	    call outdon
+end
diff --git a/unix/boot/spp/rpp/rpprat/otherc.r b/unix/boot/spp/rpp/rpprat/otherc.r
new file mode 100644
index 00000000..9a8451b8
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/otherc.r
@@ -0,0 +1,18 @@
+#-h-  otherc			  284  local   12/01/80  15:54:30
+# otherc - output ordinary Fortran statement
+   include  defs
+
+   subroutine otherc (lexstr)
+   character lexstr(ARB)
+
+   include COMMON_BLOCKS
+
+   xfer = NO
+   call outtab
+   if (IS_LETTER(lexstr (1)))
+      call squash (lexstr)
+   call outstr (lexstr)
+   call eatup
+   call outdwe
+   return
+   end
diff --git a/unix/boot/spp/rpp/rpprat/outch.r b/unix/boot/spp/rpp/rpprat/outch.r
new file mode 100644
index 00000000..f7dfa99e
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/outch.r
@@ -0,0 +1,51 @@
+include  defs
+
+# outch - put one character into output buffer
+
+subroutine outch (c)
+
+character c, splbuf(SZ_SPOOLBUF+1)
+integer i, ip, op, index
+include COMMON_BLOCKS
+external index
+string	break_chars " ),.+-*/("
+
+	# Process a continuation card.  Try to break the card at a whitespace
+	# division, operator, or punctuation mark.
+
+	if (outp >= 72) {
+	    if (index (break_chars, c) > 0)		# find break point
+		ip = outp
+	    else {
+		for (ip=outp;  ip >= 1;  ip=ip-1) {
+		    if (index (break_chars, outbuf(ip)) > 0)
+			break
+		}
+	    }
+
+	    if (ip != outp & (outp-ip) < SZ_SPOOLBUF) {
+		op = 1
+		for (i=ip+1;  i <= outp;  i=i+1) {	# save chars
+		    splbuf(op) = outbuf(i)
+		    op = op + 1
+		}
+		splbuf(op) = EOS
+		outp = ip
+	    } else
+		splbuf(1) = EOS
+
+	    call outdon
+	    
+	    for (op=1;  op < col;  op=op+1)
+		outbuf(op) = BLANK
+	    outbuf(6) = STAR
+	    outp = col
+	    for (ip=1;  splbuf(ip) != EOS;  ip=ip+1) {
+		outp = outp + 1
+		outbuf(outp) = splbuf(ip)
+	    }
+	}
+
+	outp = outp + 1				# output character
+	outbuf(outp) = c
+end
diff --git a/unix/boot/spp/rpp/rpprat/outcon.r b/unix/boot/spp/rpp/rpprat/outcon.r
new file mode 100644
index 00000000..90d5e636
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/outcon.r
@@ -0,0 +1,21 @@
+#-h-  outcon			  332  local   12/01/80  15:54:31
+# outcon - output "n   continue"
+   include  defs
+
+   subroutine outcon (n)
+   integer n
+
+   include COMMON_BLOCKS
+
+   string contin "continue"
+
+   xfer = NO
+   if (n <= 0 & outp == 0)
+      return		# don't need unlabeled continues
+   if (n > 0)
+      call outnum (n)
+   call outtab
+   call outstr (contin)
+   call outdon
+   return
+   end
diff --git a/unix/boot/spp/rpp/rpprat/outdon.r b/unix/boot/spp/rpp/rpprat/outdon.r
new file mode 100644
index 00000000..5ea969bb
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/outdon.r
@@ -0,0 +1,58 @@
+#-h-  outdon			  257  local   12/01/80  15:54:31
+# outdon - finish off an output line
+    include  defs
+
+    subroutine outdon
+
+    include COMMON_BLOCKS
+
+    integer allblk
+    integer itoc, ip, op, i
+    character obuf(80)
+    string s_line "#line "
+
+    # If dbgout is enabled output the "#line" statement.
+    if (dbgout == YES) {
+	if (body == YES | dbglev != level) {
+	    op = 1
+	    for (ip=1;  s_line(ip) != EOS;  ip=ip+1) {
+		obuf(op) = s_line(ip)
+		op = op + 1
+	    }
+
+	    op = op + itoc (linect, obuf(op), 80-op+1)
+	    obuf(op) = BLANK
+	    op = op + 1
+	    obuf(op) = DQUOTE
+	    op = op + 1
+
+	    for (i=fnamp-1;  i >= 1;  i=i-1)
+		if (fnames(i-1) == EOS | i == 1) {	 # print file name
+		    for (ip=i;  fnames(ip) != EOS;  ip=ip+1) {
+			obuf(op) = fnames(ip)
+			op = op + 1
+		    }
+		    break
+		}
+
+	    obuf(op) = DQUOTE
+	    op = op + 1
+	    obuf(op) = NEWLINE
+	    op = op + 1
+	    obuf(op) = EOS
+	    op = op + 1
+
+	    call putlin (obuf, STDOUT)
+	    dbglev = level
+	}
+    }
+
+    # Output the program statement.
+    outbuf (outp + 1) = NEWLINE
+    outbuf (outp + 2) = EOS
+    if (allblk (outbuf) == NO)
+	call putlin (outbuf, STDOUT)
+    outp = 0
+
+    return
+    end
diff --git a/unix/boot/spp/rpp/rpprat/outdwe.r b/unix/boot/spp/rpp/rpprat/outdwe.r
new file mode 100644
index 00000000..d6ef22ce
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/outdwe.r
@@ -0,0 +1,13 @@
+
+include defs
+
+# OUTDWE -- (outdon with error checking).
+# Called by code generation routines to output a line of code,
+# possibly followed by an error checking instruction.
+
+
+subroutine outdwe
+
+	call outdon
+	call errgo
+end
diff --git a/unix/boot/spp/rpp/rpprat/outgo.r b/unix/boot/spp/rpp/rpprat/outgo.r
new file mode 100644
index 00000000..d4f54faa
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/outgo.r
@@ -0,0 +1,13 @@
+#-h-  outgo			  239  local   12/01/80  15:54:31
+# outgo - output "goto	n"
+   include  defs
+
+subroutine outgo (n)
+
+integer n
+include COMMON_BLOCKS
+
+       if (xfer == YES)
+	   return
+       call ogotos (n, NO)
+end
diff --git a/unix/boot/spp/rpp/rpprat/outnum.r b/unix/boot/spp/rpp/rpprat/outnum.r
new file mode 100644
index 00000000..5286971e
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/outnum.r
@@ -0,0 +1,24 @@
+#-h-  outnum			  381  local   12/01/80  15:54:32
+# outnum - output decimal number
+   include  defs
+
+   subroutine outnum (n)
+   integer n
+
+   character chars (MAXCHARS)
+
+   integer i, m
+
+   m = iabs (n)
+   i = 0
+   repeat {
+      i = i + 1
+      chars (i) = mod (m, 10) + DIG0
+      m = m / 10
+      } until (m == 0 | i >= MAXCHARS)
+   if (n < 0)
+      call outch (MINUS)
+   for ( ; i > 0; i = i - 1)
+      call outch (chars (i))
+   return
+   end
diff --git a/unix/boot/spp/rpp/rpprat/outstr.r b/unix/boot/spp/rpp/rpprat/outstr.r
new file mode 100644
index 00000000..248bb39c
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/outstr.r
@@ -0,0 +1,33 @@
+#-h-  outstr			  687  local   12/01/80  15:54:32
+# outstr - output string; handles quoted literals
+   include  defs
+
+   subroutine outstr (str)
+   character str (ARB)
+
+   character c
+   ifdef (UPPERC, character cupper)
+
+   integer i, j
+
+   for (i = 1; str (i) != EOS; i = i + 1) {
+      c = str (i)
+      if (c != SQUOTE & c != DQUOTE) {
+			 # produce upper case fortran, if desired
+	 ifdef (UPPERC,
+	    c = cupper (c)
+	    )
+	 call outch (c)
+	 }
+      else {
+	 i = i + 1
+	 for (j = i; str (j) != c; j = j + 1)	# find end
+	    ;
+	 call outnum (j - i)
+	 call outch (BIGH)
+	 for ( ; i < j; i = i + 1)
+	    call outch (str (i))
+	 }
+      }
+   return
+   end
diff --git a/unix/boot/spp/rpp/rpprat/outtab.r b/unix/boot/spp/rpp/rpprat/outtab.r
new file mode 100644
index 00000000..94f38c69
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/outtab.r
@@ -0,0 +1,12 @@
+#-h-  outtab			  140  local   12/01/80  15:54:32
+# outtab - get past column 6
+   include  defs
+
+   subroutine outtab
+
+   include COMMON_BLOCKS
+
+   while (outp < col)
+      call outch (BLANK)
+   return
+   end
diff --git a/unix/boot/spp/rpp/rpprat/parse.r b/unix/boot/spp/rpp/rpprat/parse.r
new file mode 100644
index 00000000..676ee759
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/parse.r
@@ -0,0 +1,144 @@
+include  defs
+
+# PARSE - parse Ratfor source program
+
+subroutine parse
+
+include COMMON_BLOCKS
+character lexstr(MAXTOK)
+integer lab, labval(MAXSTACK), lextyp(MAXSTACK), sp, token, i, t
+integer lex
+logical	push_stack
+
+	sp = 1
+	lextyp(1) = EOF
+
+	for (token = lex(lexstr);  token != EOF;  token = lex(lexstr)) {
+	    push_stack = .false.
+
+	    switch (token) {
+	    case LEXIF:
+		call ifcode (lab)
+		push_stack = .true.
+	    case LEXIFERR:
+		call iferrc (lab, 1)
+		push_stack = .true.
+	    case LEXIFNOERR:
+		call iferrc (lab, 0)
+		push_stack = .true.
+	    case LEXDO:
+		call docode (lab)
+		push_stack = .true.
+	    case LEXWHILE:
+		call whilec (lab)
+		push_stack = .true.
+	    case LEXFOR:
+		call forcod (lab)
+		push_stack = .true.
+	    case LEXREPEAT:
+		call repcod (lab)
+		push_stack = .true.
+	    case LEXSWITCH:
+		call swcode (lab)
+		push_stack = .true.
+	    case LEXCASE, LEXDEFAULT:
+		for (i=sp;  i > 0;  i=i-1)	# find for most recent switch
+		    if (lextyp(i) == LEXSWITCH)
+		       break
+		if (i == 0)
+		    call synerr ("illegal case or default.")
+		else
+		    call cascod (labval (i), token)
+	    case LEXDIGITS:
+		call labelc (lexstr)
+		push_stack = .true.
+	    case LEXELSE:
+		t = lextyp(sp)
+		if (t == LEXIF | t == LEXIFERR | t == LEXIFNOERR)
+		    call elseif (labval(sp))
+		else
+		    call synerr ("Illegal else.")
+
+		t = lex (lexstr)			# check for "else if"
+		call pbstr (lexstr)
+		if (t == LEXIF | t == LEXIFERR | t == LEXIFNOERR) {
+		    call indent (-1)			# cancel out indent +1
+		    token = LEXIFELSE			# prevent -indent at end
+		}
+		push_stack = .true.
+	    case LEXTHEN:
+		if (lextyp(sp) == LEXIFERR | lextyp(sp) == LEXIFNOERR) {
+		    call thenco (lextyp(sp), labval(sp))
+		    lab = labval(sp)
+		    token = lextyp(sp)
+		    sp = sp - 1			# cancel out subsequent push
+		} else
+		    call synerr ("Illegal 'then' clause in iferr statement.")
+		push_stack = .true.
+	    case LEXLITERAL:
+		call litral
+	    case LEXERRCHK:
+		call errchk
+	    case LEXBEGIN:
+		call beginc
+	    case LEXEND:
+		call endcod (lexstr)
+		if (sp != 1) {
+		    call synerr ("Missing right brace or 'begin'.")
+		    sp = 1
+		}
+	    default:
+		if (token == LBRACE)
+		    push_stack = .true.
+		else if (token == LEXDECL)
+		    call declco (lexstr)
+	    }
+
+	    if (push_stack) {
+		if (body == NO) {
+		    call synerr ("Missing 'begin' keyword.")
+		    call beginc
+		}
+		sp = sp + 1				# beginning of statement
+		if (sp > MAXSTACK)
+		    call baderr ("Stack overflow in parser.")
+		lextyp(sp) = token			# stack type and value
+		labval(sp) = lab
+
+	    } else if (token != LEXCASE & token != LEXDEFAULT) {
+		if (token == RBRACE)
+		    token = LEXRBRACE
+
+		switch (token) {
+		case LEXOTHER:
+		    call otherc (lexstr)
+		case LEXBREAK, LEXNEXT:
+		    call brknxt (sp, lextyp, labval, token)
+		case LEXRETURN:
+		    call retcod
+		case LEXGOTO:
+		    call gocode
+		case LEXSTRING:
+		    if (body == NO)
+			call strdcl
+		    else
+			call otherc (lexstr)
+		case LEXRBRACE:
+		    if (lextyp(sp) == LBRACE)
+			sp = sp - 1
+		    else if (lextyp(sp) == LEXSWITCH) {
+			call swend (labval(sp))
+			sp = sp - 1
+		    } else
+		       call synerr ("Illegal right brace.")
+		}
+
+		token = lex (lexstr)	   		# peek at next token
+		call pbstr (lexstr)
+		call unstak (sp, lextyp, labval, token)
+	    }
+	}
+
+	if (sp != 1)
+	    call synerr ("unexpected EOF.")
+end
diff --git a/unix/boot/spp/rpp/rpprat/pbnum.r b/unix/boot/spp/rpp/rpprat/pbnum.r
new file mode 100644
index 00000000..e77b5db6
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/pbnum.r
@@ -0,0 +1,20 @@
+#-h-  pbnum			  304  local   12/01/80  15:54:33
+# pbnum - convert number to string, push back on input
+   include  defs
+
+   subroutine pbnum (n)
+   integer n
+
+   integer m, num
+   integer mod
+
+   string digits '0123456789'
+
+   num = n
+   repeat {
+      m = mod (num, 10)
+      call putbak (digits (m + 1))
+      num = num / 10
+      } until (num == 0)
+   return
+   end
diff --git a/unix/boot/spp/rpp/rpprat/pbstr.r b/unix/boot/spp/rpp/rpprat/pbstr.r
new file mode 100644
index 00000000..9c2234de
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/pbstr.r
@@ -0,0 +1,69 @@
+include  defs
+
+# PBSTR -- Push string back onto input.
+
+subroutine pbstr (s)
+
+character s(ARB)			# string to be pushed back.
+integer lenstr, i
+integer length
+
+#begin
+	lenstr = length (s)
+	
+	# We are called to push back tokens returned by GTOK, which converts
+	# the ratfor relational operators >, >=, &, etc. into their Fortran
+	# equivalents .gt., .ge., .and., and so on.  This conversion must be
+	# reversed in the push back to prevent macro expansion from operating
+	# on the strings "gt", "ge, "and", etc.  This is a stupid way to
+	# handle this but this ratfor code (which was free) is a hopeless mess
+	# already anyhow.
+
+	if (s(1) == PERIOD & s(lenstr) == PERIOD)
+	    if (lenstr == 4) {
+		if (s(2) == LETG) {
+		    if (s(3) == LETT) {			# .gt.
+			call putbak (GREATER)
+			return
+		    } else if (s(3) == LETE) {		# .ge.
+			# Note chars are pushed back in
+			# reverse order.
+			call putbak (EQUALS)
+			call putbak (GREATER)
+			return
+		    }
+		} else if (s(2) == LETL) {
+		    if (s(3) == LETT) {			# .lt.
+			call putbak (LESS)
+			return
+		    } else if (s(3) == LETE) {		# .le.
+			call putbak (EQUALS)
+			call putbak (LESS)
+			return
+		    }
+		} else if (s(2) == LETE & s(3) == LETQ) {
+		    call putbak (EQUALS)		# .eq.
+		    call putbak (EQUALS)
+		    return
+		} else if (s(2) == LETN & s(3) == LETE) {
+		    call putbak (EQUALS)		# .ne.
+		    call putbak (BANG)
+		    return
+		} else if (s(2) == LETO & s(3) == LETR) {
+		    call putbak (OR)			# .or.
+		    return
+		}
+	    } else if (lenstr == 5) {
+		if (s(2) == LETN & s(3) == LETO & s(4) == LETT) {
+		    call putbak (BANG)			# .not.
+		    return
+		} else if (s(2) == LETA & s(3) == LETN & s(4) == LETD) {
+		    call putbak (AND)			# .and.
+		    return
+		}
+	    }
+
+	# Push back an arbitrary string.
+	for (i=lenstr;  i > 0;  i=i-1)
+	    call putbak (s(i))
+end
diff --git a/unix/boot/spp/rpp/rpprat/poicod.r b/unix/boot/spp/rpp/rpprat/poicod.r
new file mode 100644
index 00000000..7b31bf80
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/poicod.r
@@ -0,0 +1,56 @@
+include defs
+
+# POICOD -- Called to process a declaration of type "pointer".
+
+subroutine poicod (declare_variable)
+
+integer	declare_variable
+include COMMON_BLOCKS
+string	spointer XPOINTER
+
+# Fortran declarations for the MEM common.
+string	p1	"logical Memb(1)"
+string	p2	"integer*2 Memc(1)"
+string	p3	"integer*2 Mems(1)"
+string	p4	"integer Memi(1)"
+string	p5	"integer Meml(1)"
+string	p6	"real Memr(1)"
+string	p7	"double precision Memd(1)"
+string	p8	"complex Memx(1)"
+string	p9	"equivalence (Memb, Memc, Mems, Memi, Meml, Memr, Memd, Memx)"
+string	pa	"common /Mem/ Memd"
+
+	# Output declarations only once per procedure declarations section.
+	# The flag memflg is cleared when processing of a procedure begins.
+
+	if (memflg == NO) {
+	    call poidec (p1)
+	    call poidec (p2)
+	    call poidec (p3)
+	    call poidec (p4)
+	    call poidec (p5)
+	    call poidec (p6)
+	    call poidec (p7)
+	    call poidec (p8)
+	    call poidec (p9)
+	    call poidec (pa)
+	    memflg = YES
+	}
+
+	if (declare_variable == YES) {
+	    call outtab
+	    call outstr (spointer)
+	}
+end
+
+
+# POIDEC -- Output a poicod declaration statement.
+
+subroutine poidec (str)
+
+character str
+
+	call outtab
+	call outstr (str)
+	call outdon
+end
diff --git a/unix/boot/spp/rpp/rpprat/push.r b/unix/boot/spp/rpp/rpprat/push.r
new file mode 100644
index 00000000..7d0c3374
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/push.r
@@ -0,0 +1,13 @@
+#-h-  push			  249  local   12/01/80  15:54:34
+# push - push ep onto argstk, return new pointer ap
+   include  defs
+
+   integer function push (ep, argstk, ap)
+   integer ap, argstk (ARGSIZE), ep
+
+   if (ap > ARGSIZE)
+      call baderr ('arg stack overflow.')
+   argstk (ap) = ep
+   push = ap + 1
+   return
+   end
diff --git a/unix/boot/spp/rpp/rpprat/putbak.r b/unix/boot/spp/rpp/rpprat/putbak.r
new file mode 100644
index 00000000..b88a3f11
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/putbak.r
@@ -0,0 +1,18 @@
+#-h-  putbak			  254  local   12/01/80  15:54:34
+# putbak - push character back onto input
+   include  defs
+
+   subroutine putbak (c)
+   character c
+
+   include COMMON_BLOCKS
+
+   if (bp <= 1)
+      call baderr ("too many characters pushed back.")
+   else {
+      bp = bp - 1
+      buf (bp) = c
+      }
+
+   return
+   end
diff --git a/unix/boot/spp/rpp/rpprat/putchr.r b/unix/boot/spp/rpp/rpprat/putchr.r
new file mode 100644
index 00000000..b39eeadf
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/putchr.r
@@ -0,0 +1,15 @@
+#-h-  putchr			  233  local   12/01/80  15:54:34
+# putchr - put single char into eval stack
+   include  defs
+
+   subroutine putchr (c)
+   character c
+
+   include COMMON_BLOCKS
+
+   if (ep > EVALSIZE)
+      call baderr ('evaluation stack overflow.')
+   evalst (ep) = c
+   ep = ep + 1
+   return
+   end
diff --git a/unix/boot/spp/rpp/rpprat/puttok.r b/unix/boot/spp/rpp/rpprat/puttok.r
new file mode 100644
index 00000000..2cdcf6d2
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/puttok.r
@@ -0,0 +1,13 @@
+#-h-  puttok			  198  local   12/01/80  15:54:34
+# puttok-put token into eval stack
+   include  defs
+
+    subroutine puttok (str)
+    character str (MAXTOK)
+
+    integer i
+
+    for (i = 1; str (i) != EOS; i = i + 1)
+       call putchr (str (i))
+    return
+    end
diff --git a/unix/boot/spp/rpp/rpprat/ratfor.r b/unix/boot/spp/rpp/rpprat/ratfor.r
new file mode 100644
index 00000000..f2f847fd
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/ratfor.r
@@ -0,0 +1,70 @@
+#-h-  ratfor			 4496  local   12/01/80  15:53:43
+# Ratfor preprocessor
+   include  defs
+
+   subroutine ratfor
+
+#   DRIVER(ratfor)   Not used; RPP has a C main.
+
+   include COMMON_BLOCKS
+
+   integer i, n
+   integer getarg, open
+
+   character arg (FILENAMESIZE)
+
+   STDEFNS 	# define standard definitions file
+
+   call initkw	# initialize variables
+
+   # Read file containing standard definitions
+   # If this isn't desired, define (STDEFNS,"")
+
+   if (defns (1) != EOS) {
+      infile (1) = open (defns, READ)
+      if (infile (1) == ERR)
+	 call remark ("can't open standard definitions file.")
+      else {
+	 call finit
+	 call parse
+	 call close (infile (1))
+      }
+   }
+
+   n = 1
+   for (i=1;  getarg(i,arg,FILENAMESIZE) != EOF;  i=i+1) {
+      n = n + 1
+      call query ("usage:  ratfor [-g] [files] >outfile.")
+      if (arg(1) == MINUS & arg(2) == LETG & arg(3) == EOS) {
+	 dbgout = YES
+	 next
+      } else if (arg(1) == MINUS & arg(2) == EOS) {
+	 infile(1) = STDIN
+         call finit
+      } else {
+	 infile(1) = open (arg, READ)
+	 if (infile(1) == ERR) {
+	    call cant (arg)
+	 } else {			#save file name for error messages
+            call finit
+	    call scopy (arg, 1, fnames, 1)
+	    for (fnamp=1;  fnames(fnamp) != EOS;  fnamp=fnamp+1)
+		if (fnames(fnamp) == PERIOD & fnames(fnamp+1) == LETR)
+		    fnames(fnamp+1) = LETX
+	 }
+      }
+      call parse
+      if (infile (1) != STDIN)
+	 call close (infile (1))
+   }
+
+   if (n == 1) {   # no files given on command line, use STDIN
+      infile (1) = STDIN
+      call finit
+      call parse
+   }
+
+   call lndict
+
+#   DRETURN
+   end
diff --git a/unix/boot/spp/rpp/rpprat/relate.r b/unix/boot/spp/rpp/rpprat/relate.r
new file mode 100644
index 00000000..50a04025
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/relate.r
@@ -0,0 +1,59 @@
+#-h-  relate			 1276  local   12/01/80  15:54:35
+# relate - convert relational shorthands into long form
+   include  defs
+
+   subroutine relate (token, last)
+   character token (ARB)
+   integer last
+
+   character ngetch
+
+   integer length
+
+   if (ngetch (token (2)) != EQUALS) {
+      call putbak (token (2))
+      token (3) = LETT
+      }
+   else
+      token (3) = LETE
+   token (4) = PERIOD
+   token (5) = EOS
+   token (6) = EOS # for .not. and .and.
+   if (token (1) == GREATER)
+      token (2) = LETG
+   else if (token (1) == LESS)
+      token (2) = LETL
+   else if (token (1) == NOT | token (1) == BANG |
+	    token (1) == CARET | token (1) == TILDE) {
+      if (token (2) != EQUALS) {
+	 token (3) = LETO
+	 token (4) = LETT
+	 token (5) = PERIOD
+	 }
+      token (2) = LETN
+      }
+   else if (token (1) == EQUALS) {
+      if (token (2) != EQUALS) {
+	 token (2) = EOS
+	 last = 1
+	 return
+	 }
+      token (2) = LETE
+      token (3) = LETQ
+      }
+   else if (token (1) == AND) {
+      token (2) = LETA
+      token (3) = LETN
+      token (4) = LETD
+      token (5) = PERIOD
+      }
+   else if (token (1) == OR) {
+      token (2) = LETO
+      token (3) = LETR
+      }
+   else   # can't happen
+      token (2) = EOS
+   token (1) = PERIOD
+   last = length (token)
+   return
+   end
diff --git a/unix/boot/spp/rpp/rpprat/repcod.r b/unix/boot/spp/rpp/rpprat/repcod.r
new file mode 100644
index 00000000..e2fd40aa
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/repcod.r
@@ -0,0 +1,16 @@
+#-h-  repcod			  262  local   12/01/80  15:54:35
+# repcod - generate code for beginning of repeat
+   include  defs
+
+   subroutine repcod (lab)
+   integer lab
+
+   integer labgen
+
+   call outcon (0)   # in case there was a label
+   lab = labgen (3)
+   call outcon (lab)
+   lab = lab + 1   # label to go on next's
+   call indent (1)
+   return
+   end
diff --git a/unix/boot/spp/rpp/rpprat/retcod.r b/unix/boot/spp/rpp/rpprat/retcod.r
new file mode 100644
index 00000000..3490016d
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/retcod.r
@@ -0,0 +1,30 @@
+#-h-  retcod			  580  local   12/01/80  15:54:35
+# retcod - generate code for return
+   include  defs
+
+   subroutine retcod
+
+   character token (MAXTOK), t
+   character gnbtok
+   include COMMON_BLOCKS
+
+   t = gnbtok (token, MAXTOK)
+   if (t != NEWLINE & t != SEMICOL & t != RBRACE) {
+      call pbstr (token)
+      call outtab
+      call scopy (fcname, 1, token, 1)
+      call squash (token)
+      call outstr (token)
+      call outch (BLANK)
+      call outch (EQUALS)
+      call outch (BLANK)
+      call eatup
+      call outdon
+      }
+   else if (t == RBRACE)
+      call pbstr (token)
+   call outtab
+   call ogotos (retlab, NO)
+   xfer = YES
+   return
+   end
diff --git a/unix/boot/spp/rpp/rpprat/sdupl.r b/unix/boot/spp/rpp/rpprat/sdupl.r
new file mode 100644
index 00000000..968bfebd
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/sdupl.r
@@ -0,0 +1,25 @@
+#-h-  sdupl			  374  local   12/01/80  15:55:03
+# sdupl --- duplicate a string in dynamic storage space
+   include  defs
+
+   pointer function sdupl (str)
+   character str (ARB)
+
+   DS_DECL(mem, MEMSIZE)
+
+   integer i
+   integer length
+
+   pointer j
+   pointer dsget
+
+   j = dsget (length (str) + 1)
+   sdupl = j
+   for (i = 1; str (i) != EOS; i = i + 1) {
+      mem (j) = str (i)
+      j = j + 1
+      }
+   mem (j) = EOS
+
+   return
+   end
diff --git a/unix/boot/spp/rpp/rpprat/skpblk.r b/unix/boot/spp/rpp/rpprat/skpblk.r
new file mode 100644
index 00000000..3badc3e9
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/skpblk.r
@@ -0,0 +1,17 @@
+#-h-  skpblk			  247  local   12/01/80  15:55:04
+# skpblk - skip blanks and tabs in current input file
+   include  defs
+
+   subroutine skpblk
+
+   include COMMON_BLOCKS
+
+   character c
+   character ngetch
+
+   for (c = ngetch (c); c == BLANK | c == TAB; c = ngetch (c))
+      ;
+
+   call putbak (c)
+   return
+   end
diff --git a/unix/boot/spp/rpp/rpprat/squash.r b/unix/boot/spp/rpp/rpprat/squash.r
new file mode 100644
index 00000000..9990fe1a
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/squash.r
@@ -0,0 +1,53 @@
+include  defs
+
+# SQUASH - convert a long or special identifier into a Fortran variable
+
+subroutine squash (id)
+
+character id(MAXTOK)
+integer junk, i, j
+integer lookup, ludef
+character newid(MAXTOK), recdid(MAXTOK)
+include COMMON_BLOCKS
+
+	# identify names for which error checking is to be performed
+	if (body == YES & errtbl != NULL & ername == NO)
+	    if (lookup (id, junk, errtbl) == YES)
+		ername = YES
+
+	j = 1
+	for (i=1;  id(i) != EOS;  i=i+1)		# copy, delete '_'
+	    if (IS_LETTER(id(i)) | IS_DIGIT(id(i))) {
+		newid(j) = id(i)
+	        j = j + 1
+	    }
+	newid(j) = EOS
+
+	# done if ordinary (short) Fortran variable
+	if (i-1 < MAXIDLENGTH & i == j)
+	    return
+
+# Otherwise, the identifier (1) is longer than Fortran allows,
+# (2) contains special characters (_ or .), or (3) is the maximum
+# length permitted by the Fortran compiler.  The first two cases
+# obviously call for name conversion; the last case may require conversion
+# to avoid accidental conflicts with automatically generated names.
+
+	if (lookup (id, junk, fkwtbl) == YES)	# Fortran key word?
+	    return				# (must be treated as reserved)
+
+	if (ludef (id, recdid, namtbl) == YES) {   # have we seen this before?
+	    call scopy (recdid, 1, id, 1)
+	    return
+	}
+		
+	call mapid (newid)			# try standard mapping
+	if (lookup (newid, junk, gentbl) == YES) {
+	    call synerr ("Warning: identifier mapping not unique.")
+	    call uniqid (newid)
+	}
+	call entdef (newid, id, gentbl)
+
+	call entdef (id, newid, namtbl)		# record it for posterity
+	call scopy (newid, 1, id, 1)		# substitute it for the old one
+end
diff --git a/unix/boot/spp/rpp/rpprat/strdcl.r b/unix/boot/spp/rpp/rpprat/strdcl.r
new file mode 100644
index 00000000..03b04afc
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/strdcl.r
@@ -0,0 +1,96 @@
+#-h-  strdcl			 2575  local   12/01/80  15:55:05
+# strdcl - generate code for string declaration
+   include  defs
+
+   subroutine strdcl
+
+   include COMMON_BLOCKS
+
+   character t, token (MAXTOK), dchar (MAXTOK)
+   character gnbtok
+
+   integer i, j, k, n, len
+   integer length, ctoi, lex
+
+   string char "integer*2/"
+   string dat  "data "
+   string eoss "0/"
+
+   t = gnbtok (token, MAXTOK)
+   if (t != ALPHA)
+      call synerr ("missing string token.")
+   call squash (token)
+   call outtab
+   call pbstr (char) # use defined meaning of "character"
+   repeat {
+      t = gnbtok (dchar, MAXTOK)
+      if (t == SLASH)
+	 break
+      call outstr (dchar)
+      }
+   call outch (BLANK)  # separator in declaration
+   call outstr (token)
+   call addstr (token, sbuf, sbp, SBUFSIZE)  # save for later
+   call addchr (EOS, sbuf, sbp, SBUFSIZE)
+   if (gnbtok (token, MAXTOK) != LPAREN) {  # make size same as initial value
+      len = length (token) + 1
+      if (token (1) == SQUOTE | token (1) == DQUOTE)
+	 len = len - 2
+      }
+   else { # form is string name (size) init
+      t = gnbtok (token, MAXTOK)
+      i = 1
+      len = ctoi (token, i)
+      if (token (i) != EOS)
+	 call synerr ("invalid string size.")
+      if (gnbtok (token, MAXTOK) != RPAREN)
+	 call synerr ("missing right paren.")
+      else
+	 t = gnbtok (token, MAXTOK)
+      }
+   call outch (LPAREN)
+   call outnum (len)
+   call outch (RPAREN)
+   call outdon
+   if (token (1) == SQUOTE | token (1) == DQUOTE) {
+      len = length (token)
+      token (len) = EOS
+      call addstr (token (2), sbuf, sbp, SBUFSIZE)
+      }
+   else
+      call addstr (token, sbuf, sbp, SBUFSIZE)
+   call addchr (EOS, sbuf, sbp, SBUFSIZE)
+   t = lex (token)   # peek at next token
+   call pbstr (token)
+   if (t != LEXSTRING) {   # dump accumulated data statements
+      for (i = 1; i < sbp; i = j + 1) {
+	 call outtab
+	 call outstr (dat)
+	 k = 1
+	 for (j = i + length (sbuf (i)) + 1; ; j = j + 1) {
+	    if (k > 1)
+	       call outch (COMMA)
+	    call outstr (sbuf (i))
+	    call outch (LPAREN)
+	    call outnum (k)
+	    call outch (RPAREN)
+	    call outch (SLASH)
+	    if (sbuf (j) == EOS)
+	       break
+	    n = sbuf (j)
+	    call outnum (n)
+	    call outch (SLASH)
+	    k = k + 1
+	    }
+	 call pbstr (eoss) # use defined meaning of EOS
+	 repeat {
+	    t = gnbtok (token, MAXTOK)
+	    call outstr (token)
+	    } until (t == SLASH)
+	 call outdon
+	 }
+      sbp = 1
+      }
+
+   return
+   end
diff --git a/unix/boot/spp/rpp/rpprat/swcode.r b/unix/boot/spp/rpp/rpprat/swcode.r
new file mode 100644
index 00000000..348f8de3
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/swcode.r
@@ -0,0 +1,44 @@
+#-h-  swcode			  746  local   12/01/80  15:55:06
+# swcode - generate code for beginning of switch statement
+   include  defs
+
+   subroutine swcode (lab)
+   integer lab
+
+   include COMMON_BLOCKS
+
+   character tok (MAXTOK)
+
+   integer labgen, gnbtok
+
+   lab = labgen (2)
+   swvnum = swvnum + 1
+   swvlev = swvlev + 1
+   if (swvlev > MAXSWNEST)
+      call baderr ("switches nested too deeply.")
+   swvstk(swvlev) = swvnum
+
+   if (swlast + 3 > MAXSWITCH)
+      call baderr ("switch table overflow.")
+   swstak (swlast) = swtop
+   swstak (swlast + 1) = 0
+   swstak (swlast + 2) = 0
+   swtop = swlast
+   swlast = swlast + 3
+   xfer = NO
+   call outtab	# Innn=(e)
+   call swvar (swvnum)
+   call outch (EQUALS)
+   call balpar
+   call outdwe
+   call outgo (lab) # goto L
+   call indent (1)
+   xfer = YES
+   while (gnbtok (tok, MAXTOK) == NEWLINE)
+      ;
+   if (tok (1) != LBRACE) {
+      call synerr ("missing left brace in switch statement.")
+      call pbstr (tok)
+      }
+   return
+   end
diff --git a/unix/boot/spp/rpp/rpprat/swend.r b/unix/boot/spp/rpp/rpprat/swend.r
new file mode 100644
index 00000000..86088ddd
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/swend.r
@@ -0,0 +1,106 @@
+#-h-  swend			 2714  local   12/01/80  15:55:07
+# swend - finish off switch statement; generate dispatch code
+   include  defs
+
+   subroutine swend (lab)
+   integer lab
+
+   include COMMON_BLOCKS
+
+   integer lb, ub, n, i, j, swn
+
+   string sif "if ("
+   string slt ".lt.1.or."
+   string sgt ".gt."
+   string sgoto "goto ("
+   string seq ".eq."
+   string sge ".ge."
+   string sle ".le."
+   string sand ".and."
+
+   swn = swvstk(swvlev)		#get switch variable number, SWnnnn
+   swvlev = max(0, swvlev - 1)
+
+   lb = swstak (swtop + 3)
+   ub = swstak (swlast - 2)
+   n = swstak (swtop + 1)
+   call outgo (lab + 1) # terminate last case
+   if (swstak (swtop + 2) == 0)
+      swstak (swtop + 2) = lab + 1  # default default label
+   xfer = NO
+   call indent (-1)
+   call outcon (lab)  # L   continue
+   call indent (1)
+   if (n >= CUTOFF & ub - lb + 1 < DENSITY * n) { # output branch table
+      if (lb != 1) {  # L  Innn=Innn-lb+1
+	 call outtab
+	 call swvar (swn)
+	 call outch (EQUALS)
+	 call swvar (swn)
+	 if (lb < 1)
+	    call outch (PLUS)
+	 call outnum (-lb + 1)
+	 call outdon
+	 }
+      if (swinrg == NO) {
+	  call outtab  #  if (Innn.lt.1.or.Innn.gt.ub-lb+1)goto default
+	  call outstr (sif)
+	  call swvar (swn)
+	  call outstr (slt)
+	  call swvar (swn)
+	  call outstr (sgt)
+	  call outnum (ub - lb + 1)
+	  call outch (RPAREN)
+	  call outch (BLANK)
+	  call outgo (swstak (swtop + 2))
+      }
+      call outtab  #  goto (....),Innn
+      call outstr (sgoto)
+      j = lb
+      for (i = swtop + 3; i < swlast; i = i + 3) {
+	 for ( ; j < swstak (i); j = j + 1) { # fill in vacancies
+	    call outnum (swstak (swtop + 2))
+	    call outch (COMMA)
+	    }
+	 for (j = swstak (i + 1) - swstak (i); j >= 0; j = j - 1)
+	    call outnum (swstak (i + 2)) # fill in range
+	 j = swstak (i + 1) + 1
+	 if (i < swlast - 3)
+	    call outch (COMMA)
+	 }
+      call outch (RPAREN)
+      call outch (COMMA)
+      call swvar (swn)
+      call outdon
+      }
+   else if (n > 0) {  # output linear search form
+      for (i = swtop + 3; i < swlast; i = i + 3) {
+	 call outtab  # if (Innn
+	 call outstr (sif)
+	 call swvar (swn)
+	 if (swstak (i) == swstak (i+1)) {
+	    call outstr (seq) #   .eq....
+	    call outnum (swstak (i))
+	    }
+	 else {
+	    call outstr (sge) #   .ge.lb.and.Innn.le.ub
+	    call outnum (swstak (i))
+	    call outstr (sand)
+	    call swvar (swn)
+	    call outstr (sle)
+	    call outnum (swstak (i + 1))
+	    }
+	 call outch (RPAREN) #	  ) goto ...
+	 call outch (BLANK)
+	 call outgo (swstak (i + 2))
+	 }
+      if (lab + 1 != swstak (swtop + 2))
+	 call outgo (swstak (swtop + 2))
+      }
+   call indent (-1)
+   call outcon (lab + 1)   # L+1  continue
+   swlast = swtop # pop switch stack
+   swtop = swstak (swtop)
+   swinrg = NO
+   return
+   end
diff --git a/unix/boot/spp/rpp/rpprat/swvar.r b/unix/boot/spp/rpp/rpprat/swvar.r
new file mode 100644
index 00000000..df8da344
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/swvar.r
@@ -0,0 +1,22 @@
+#-h-  swvar			  157  local   12/01/80  15:55:08
+# swvar - output switch variable SWnnnn, where nnnn = lab
+# (modified aug82 dct to permit declaration of switch variable)
+
+   include  defs
+
+   subroutine swvar (lab)
+   integer lab, i, labnum, ndigits
+
+   ifnotdef (UPPERC, call outch (LETS))
+   ifdef    (UPPERC, call outch (BIGS))
+   ifnotdef (UPPERC, call outch (LETW))
+   ifdef    (UPPERC, call outch (BIGW))
+
+   labnum = lab
+   for (ndigits=0;  labnum > 0;  labnum=labnum/10)
+    	ndigits = ndigits + 1
+   for (i=3;  i <= 6 - ndigits;  i=i+1)
+	call outch (DIG0)
+   call outnum (lab)
+   return
+   end
diff --git a/unix/boot/spp/rpp/rpprat/synerr.r b/unix/boot/spp/rpp/rpprat/synerr.r
new file mode 100644
index 00000000..80bee91b
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/synerr.r
@@ -0,0 +1,37 @@
+#-h-  synerr			  703  local   12/01/80  15:55:08
+# synerr --- report non-fatal error
+   include  defs
+
+   subroutine synerr (msg)
+
+   character msg
+#      character*(*) msg
+
+   include COMMON_BLOCKS
+   character lc (MAXCHARS)
+
+   integer i, junk
+   integer itoc
+
+   string of " of "
+   string errmsg "Error on line "
+
+   call putlin (errmsg, ERROUT)
+   if (level >= 1)
+      i = level
+   else
+      i = 1 # for EOF errors
+   junk = itoc (linect (i), lc, MAXCHARS)
+   call putlin (lc, ERROUT)
+   for (i = fnamp - 1; i >= 1; i = i - 1)
+      if (fnames (i - 1) == EOS | i == 1) {  # print file name
+	 call putlin (of, ERROUT)
+	 call putlin (fnames (i), ERROUT)
+	 break
+	 }
+
+   call putch (COLON, ERROUT)
+   call putch (BLANK, ERROUT)
+   call remark (msg)
+   return
+   end
diff --git a/unix/boot/spp/rpp/rpprat/thenco.r b/unix/boot/spp/rpp/rpprat/thenco.r
new file mode 100644
index 00000000..1b4a812e
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/thenco.r
@@ -0,0 +1,25 @@
+
+include  defs
+
+# THENCO -- Generate code for the "then" part of a compound IFERR statement.
+
+
+subroutine thenco (tok, lab)
+
+integer lab, tok
+include COMMON_BLOCKS
+string	siferr "if (.not.xerpop()) "
+string	sifnoerr "if (xerpop()) "
+
+	xfer = NO
+	call outnum (lab+2)
+	call outtab
+	if (tok == LEXIFERR)
+	    call outstr (siferr)
+	else
+	    call outstr (sifnoerr)
+	call outgo (lab)
+	esp = esp - 1				# pop error stack
+	call indent (1)
+	return
+end
diff --git a/unix/boot/spp/rpp/rpprat/ulstal.r b/unix/boot/spp/rpp/rpprat/ulstal.r
new file mode 100644
index 00000000..bff4e19e
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/ulstal.r
@@ -0,0 +1,15 @@
+#-h-  ulstal			  268  local   12/01/80  15:55:09
+# ulstal - install lower and upper case versions of symbol
+   include  defs
+
+   subroutine ulstal (name, defn)
+   character name (ARB), defn (ARB)
+
+   include COMMON_BLOCKS
+
+   call entdef (name, defn, deftbl)
+   call upper (name)
+   call entdef (name, defn, deftbl)
+
+   return
+   end
diff --git a/unix/boot/spp/rpp/rpprat/uniqid.r b/unix/boot/spp/rpp/rpprat/uniqid.r
new file mode 100644
index 00000000..6187fa86
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/uniqid.r
@@ -0,0 +1,49 @@
+#-h-  uniqid			 1825  local   12/01/80  15:55:09
+# uniqid - convert an identifier to one never before seen
+   include  defs
+
+subroutine uniqid (id)
+
+character id (MAXTOK)
+integer i, j, junk, idchl
+external index
+integer lookup, index, length
+character start (MAXIDLENGTH)
+include COMMON_BLOCKS
+string idch "0123456789abcdefghijklmnopqrstuvwxyz" # legal id characters
+
+   # Pad the identifer out to length 6 with FILLCHARs:
+   for (i = 1; id (i) != EOS; i = i + 1)
+      ;
+   for (; i <= MAXIDLENGTH; i = i + 1)
+      id (i) = FILLCHAR
+   i = MAXIDLENGTH + 1
+   id (i) = EOS
+   id (i - 1) = FILLCHAR
+
+   # Look it up in the table of generated names.  If it's not there,
+   #  it's unique.  If it is there, it has been generated previously;
+   #  modify it and try again.	Assume this procedure always succeeds,
+   #  since to fail implies there are very, very many identifiers in
+   #  the symbol table.
+   #  Note that we must preserve the first and last characters of the
+   #  id, so as not to disturb implicit typing and to provide a flag
+   #  to catch potentially conflicting user-defined identifiers without
+   #  a lookup.
+
+   if (lookup (id, junk, gentbl) == YES) {   # (not very likely)
+      idchl = length (idch)
+      for (i = 2; i < MAXIDLENGTH; i = i + 1)
+	 start (i) = id (i)
+      repeat {	  # until we get a unique id
+	 for (i = MAXIDLENGTH - 1; i > 1; i = i - 1) {
+	    j = mod (index (idch, id (i)), idchl) + 1
+	    id (i) = idch (j)
+	    if (id (i) != start (i))
+	       break
+	    }
+	 if (i == 1)
+	    call baderr ("cannot make identifier unique.")
+	 } until (lookup (id, junk, gentbl) == NO)
+      }
+end
diff --git a/unix/boot/spp/rpp/rpprat/unstak.r b/unix/boot/spp/rpp/rpprat/unstak.r
new file mode 100644
index 00000000..ec8a6eef
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/unstak.r
@@ -0,0 +1,42 @@
+include  defs
+
+# unstak - unstack at end of statement
+
+define	IFSTMT		999
+
+
+subroutine unstak (sp, lextyp, labval, token)
+
+integer	labval(MAXSTACK), lextyp(MAXSTACK)
+integer	sp, token, type
+
+	for (;  sp > 1;  sp=sp-1) {
+	    type = lextyp(sp)
+	    if ((type == LEXIFERR | type == LEXIFNOERR) & token == LEXTHEN)
+		break
+	    if (type == LEXIF | type == LEXIFERR | type == LEXIFNOERR)
+		type = IFSTMT
+	    if (type == LBRACE | type == LEXSWITCH)
+		break
+	    if (type == IFSTMT & token == LEXELSE)
+		break
+
+	    if (type == IFSTMT) {
+		call indent (-1)
+		call outcon (labval(sp))
+	    } else if (type == LEXELSE | type == LEXIFELSE) {
+		if (sp > 2)
+		    sp = sp - 1
+		if (type != LEXIFELSE)
+		    call indent (-1)
+		call outcon (labval(sp) + 1)
+	    } else if (type == LEXDO)
+		call dostat (labval(sp))
+	    else if (type == LEXWHILE)
+		call whiles (labval(sp))
+	    else if (type == LEXFOR)
+		call fors (labval(sp))
+	    else if (type == LEXREPEAT)
+		call untils (labval(sp), token)
+	}
+end
diff --git a/unix/boot/spp/rpp/rpprat/untils.r b/unix/boot/spp/rpp/rpprat/untils.r
new file mode 100644
index 00000000..b784fab5
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/untils.r
@@ -0,0 +1,26 @@
+#-h-  untils			  397  local   12/01/80  15:55:11
+# untils - generate code for until or end of repeat
+   include  defs
+
+   subroutine untils (lab, token)
+   integer lab, token
+
+   include COMMON_BLOCKS
+
+   character ptoken (MAXTOK)
+
+   integer junk
+   integer lex
+
+   xfer = NO
+   call outnum (lab)
+   if (token == LEXUNTIL) {
+      junk = lex (ptoken)
+      call ifgo (lab - 1)
+      }
+   else
+      call outgo (lab - 1)
+   call indent (-1)
+   call outcon (lab + 1)
+   return
+   end
diff --git a/unix/boot/spp/rpp/rpprat/whilec.r b/unix/boot/spp/rpp/rpprat/whilec.r
new file mode 100644
index 00000000..5dc0fd01
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/whilec.r
@@ -0,0 +1,17 @@
+#-h-  whilec			  262  local   12/01/80  15:55:11
+# whilec - generate code for beginning of while
+   include  defs
+
+   subroutine whilec (lab)
+
+   integer lab
+   integer labgen
+   include COMMON_BLOCKS
+
+   call outcon (0)    # unlabeled continue, in case there was a label
+   lab = labgen (2)
+   call outnum (lab)
+   call ifgo (lab + 1)
+   call indent (1)
+   return
+   end
diff --git a/unix/boot/spp/rpp/rpprat/whiles.r b/unix/boot/spp/rpp/rpprat/whiles.r
new file mode 100644
index 00000000..af5679fa
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/whiles.r
@@ -0,0 +1,14 @@
+#-h-  whiles			  148  local   12/01/80  15:55:12
+# whiles - generate code for end of while
+   include  defs
+
+   subroutine whiles (lab)
+
+   integer lab
+   include COMMON_BLOCKS
+
+   call outgo (lab)
+   call indent (-1)
+   call outcon (lab + 1)
+   return
+   end
diff --git a/unix/boot/spp/rpp/test.r b/unix/boot/spp/rpp/test.r
new file mode 100644
index 00000000..7bafd871
--- /dev/null
+++ b/unix/boot/spp/rpp/test.r
@@ -0,0 +1,212 @@
+
+
+
+
+define	ARB		999999999
+define	ERR		-1
+define	EOF		-2
+define	BOF		-3
+define	EOT		-4
+define	BOFL		BOF
+define	EOFL		EOF
+define	EOS		0
+define	NO		0
+define	YES		1
+define	OK		0
+define	NULL		0
+
+
+define	READ_ONLY	1		
+define	READ_WRITE	2
+define	WRITE_ONLY	3
+define	APPEND		4
+define	NEW_FILE	5
+define	TEMP_FILE	6
+define	NEW_COPY	7
+define	NEW_IMAGE	5		
+define	NEW_STRUCT	5
+define	NEW_TAPE	5
+define	TEXT_FILE	11		
+define	BINARY_FILE	12
+define	DIRECTORY_FILE	13
+define	STATIC_FILE	14
+define	SPOOL_FILE	(-2)
+define	RANDOM		1		
+define	SEQUENTIAL	2
+define	CLIN		1		
+define	CLOUT		2		
+define	STDIN		3		
+define	STDOUT		4
+define	STDERR		5
+define	STDGRAPH	6
+define	STDIMAGE	7
+define	STDPLOT		8
+
+
+
+define	SZ_BOOL		2		
+define	SZ_CHAR		1
+define	SZ_SHORT	1
+define	SZ_INT		2
+define	SZ_LONG		2
+define	SZ_REAL		2
+define	SZ_DOUBLE	4
+define	SZ_COMPLEX	4
+define	SZ_POINTER	2
+define	SZ_STRUCT	2
+define	SZ_USHORT	1
+define	SZ_FNAME	255		
+define	SZ_PATHNAME	511		
+define	SZ_LINE		1023		
+define	SZ_COMMAND	2047		
+
+define  SZ_MII_SHORT    1		
+define  SZ_MII_LONG     2
+define  SZ_MII_REAL     2
+define  SZ_MII_DOUBLE   4
+define  SZ_MII_INT      SZ_MII_LONG
+
+define	SZ_INT32	2		
+define	SZ_LONG32	2
+define	SZ_STRUCT32	2
+
+define	TY_BOOL		1		
+define	TY_CHAR		2
+define	TY_SHORT	3
+define	TY_INT		4
+define	TY_LONG		5
+define	TY_REAL		6
+define	TY_DOUBLE	7
+define	TY_COMPLEX	8
+define	TY_POINTER	9
+define	TY_STRUCT	10		
+define	TY_USHORT	11		
+define	TY_UBYTE	12		
+
+
+define	INDEFS		(-32767)
+define	INDEFL		(-2147483647)
+define	INDEFI		INDEFL
+define	INDEFR		1.6e38
+define	INDEFD		1.6d308
+define	INDEFX		(INDEF,INDEF)
+define	INDEF		INDEFR
+
+define	IS_INDEFS	(($1)==INDEFS)
+define	IS_INDEFL	(($1)==INDEFL)
+define	IS_INDEFI	(($1)==INDEFI)
+define	IS_INDEFR	(($1)==INDEFR)
+define	IS_INDEFD	(($1)==INDEFD)
+define	IS_INDEFX	(real($1)==INDEFR)
+define	IS_INDEF	(($1)==INDEFR)
+
+
+define	P2C	((($1)-1)*2+1)
+define	P2S	((($1)-1)*2+1)
+define	P2L	($1)
+define	P2R	($1)
+define	P2D	((($1)-1)/2+1)
+define	P2X	((($1)-1)/2+1)
+
+define	P2P	($1)			
+
+
+
+
+
+
+
+
+
+
+
+
+define	access	xfaccs
+define	calloc	xcallc
+define	close	xfcloe
+define	delete	xfdele
+define	error	xerror
+define	flush	xffluh
+define	getc	xfgetc
+define	getchar	xfgetr
+define	malloc	xmallc
+define	mfree	xmfree
+define	mktemp	xmktep
+define	note	xfnote
+define	open	xfopen
+define	poll	xfpoll
+define	printf	xprinf
+define	putc	xfputc
+define	putchar	xfputr
+define	qsort	xqsort
+define	read	xfread
+define	realloc	xrealc
+define	seek	xfseek
+define	sizeof	xsizef
+define	strcat	xstrct
+define	strcmp	xstrcp
+define	strcpy	xstrcy
+define	strlen	xstrln
+define	ungetc	xfungc
+define	write	xfwrie
+define  fatal   xfatal
+define  fchdir  xfchdr
+define  fscan   xfscan
+define  getopt  xgtopt
+define  getpid  xgtpid
+define  getuid  xgtuid
+define  rename  xfrnam
+define  reset   xreset
+define  scan    xxscan
+
+
+
+
+
+
+define	IS_UPPER	($1>=65&$1<=90)
+define	IS_LOWER	($1>=97&$1<=122)
+define	IS_DIGIT	($1>=48&$1<=57)
+define	IS_PRINT	($1>=32&$1<127)
+define	IS_CNTRL	($1>0&$1<32)
+define	IS_ASCII	($1>0&$1<=127)
+define	IS_ALPHA	(IS_UPPER($1)|IS_LOWER($1))
+define	IS_ALNUM	(IS_ALPHA($1)|IS_DIGIT($1))
+define	IS_WHITE	($1==32|$1==9)
+define	TO_UPPER	($1+65-97)
+define	TO_LOWER	($1+97-65)
+define	TO_INTEG	($1-48)
+define	TO_DIGIT	($1+48)
+
+#!# 2
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ 
+x$subr t_hello ()
+
+x$short	ST0001(14)
+save
+x$int	iyy
+data	(ST0001(iyy),iyy= 1, 8)	/104,101,108,108,111, 44, 32,119/
+data	(ST0001(iyy),iyy= 9,14)	/111,114,108,100, 10, 0/
+begin
+#!# 10
+
+	call printf (ST0001)
+end
+
+
diff --git a/unix/boot/spp/rpp/x b/unix/boot/spp/rpp/x
new file mode 100644
index 00000000..007b82a6
--- /dev/null
+++ b/unix/boot/spp/rpp/x
@@ -0,0 +1,18 @@
+
+
+x$subr t_foo ()
+x$int	i
+x$long	l
+x$pntr	p
+x$pntr	p2
+
+save
+begin
+#!# 7
+
+	i = 1
+	l = 1
+	p = 1
+end
+
+
diff --git a/unix/boot/spp/test.x b/unix/boot/spp/test.x
new file mode 100644
index 00000000..1c1d6c71
--- /dev/null
+++ b/unix/boot/spp/test.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+
+# Test program.
+
+task	hello = t_hello
+
+procedure t_hello()
+
+begin
+	call printf ("hello, world\n")
+end
diff --git a/unix/boot/spp/xc.c b/unix/boot/spp/xc.c
new file mode 100644
index 00000000..73079c58
--- /dev/null
+++ b/unix/boot/spp/xc.c
@@ -0,0 +1,1970 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#include <stdio.h>
+#include <ctype.h>
+#include <signal.h>
+#include <errno.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <sys/wait.h>
+#include <dirent.h>
+#include <string.h>
+#include <stdlib.h>
+#include "xpp.h"
+#include "../bootProto.h"
+
+#define	NOKNET
+#define	import_kernel
+#define	import_knames
+#include <iraf.h>
+
+#if defined(LINUX) || defined(BSD)
+# ifdef SOLARIS
+#  undef SOLARIS
+# endif
+#endif
+
+/*
+ * XC -- Main entry point of the XC compiler front-end used by the IRAF
+ * system.
+ */
+
+#define VERSION		"IRAFNET XC V2.4 Jan 21 2010"
+
+#define	ERR		(-1)
+#define	EOS		'\0'
+#define	YES		1
+#define	NO		0
+#define	MAXFLAG		64			/* maximum option flags */
+#define MAXFILE		1024			/* maximum files on cmdline */
+#define	SZ_CMDBUF	4096			/* maximum command buffer */
+#define	SZ_BUFFER	4096			/* library names, flags */
+#define	SZ_LIBBUF	4096			/* full library names */
+#define	SZ_FNAME	255
+#define	SZ_PATHNAME	511
+#define	SZ_PKGENV	256
+#define DEF_PKGENV	"iraf"
+
+#ifdef MACOSX
+#define	CCOMP		"cc"			/* C compiler (also .s etc.) */
+#define	LINKER		"cc"			/* Linking utility */
+#else
+#define	CCOMP		"gcc"			/* C compiler (also .s etc.) */
+#define	LINKER		"gcc"			/* Linking utility */
+#endif
+#define	F77COMP		"f77"			/* Fortran compiler */
+#define	DEBUGFLAG	'g'			/* host flag for -x */
+#define	USEF2C		1			/* use Fortran to C trans. */
+
+#define	LIBCINCLUDES	"hlib$libc/"		/* IRAF LIBC include dir */
+#define	LOCALBINDIR	"/usr/local/bin/"	/* standard local BIN */
+#define	SYSBINDIR	"/usr/bin/"		/* special system BIN */
+
+#define	XPP		"xpp.e"
+#define	RPP		"rpp.e"
+#define	EDSYM		"edsym.e"
+#define	SHIMAGE		"S.e"
+#define LIBMAIN		"libmain.o"
+#define SHARELIB	"libshare.a"
+#define IRAFLIB1	"libex.a"
+#define IRAFLIB2	"libsys.a"
+#define IRAFLIB3	"libvops.a"
+#define IRAFLIB4	"libos.a"
+#define IRAFLIB5	"libVO.a"
+#define IRAFLIB6	"libcfitsio.a"
+
+#ifdef LINUX
+char *fortlib[] = { "-lf2c",			/*  0  (host progs) */
+		    "-lf2c",			/*  1  */
+		    "-lm",			/*  2  */
+#ifndef LINUXPPC
+#ifndef LINUX64
+		    "",				/*  3  -lcompat */
+#endif
+#else
+		    "-lg2c",			/*  3  */
+#endif
+		    "-lpthread",		/*  4  */
+		    "-lm",			/*  5  */
+		    "-lrt",			/*  6  */
+		    "",				/*  7  */
+		    "",				/*  8  */
+		    "",				/*  9  */
+		    0};				/* EOF */
+
+char *opt_flags[] = { "-O",			/*  0  */
+		    0};				/* EOF */
+int  nopt_flags	   = 1;				/* No. optimizer flags */
+
+#else
+#ifdef BSD
+char *fortlib[] = { "-lf2c",			/*  0  (host progs) */
+		    "-lf2c",			/*  1  */
+		    "-lm",			/*  2  */
+		    "-lcompat",			/*  3  */
+		    "",				/*  4  */
+		    "",				/*  5  */
+		    "",				/*  6  */
+		    "",				/*  7  */
+		    "",				/*  8  */
+		    "",				/*  9  */
+		    0};				/* EOF */
+
+char *opt_flags[] = { "-O",			/*  0  */
+		    0};				/* EOF */
+int  nopt_flags	   = 1;				/* No. optimizer flags */
+
+#else
+#ifdef MACOSX
+char *fortlib[] = { "-lf2c",			/*  0  (host progs) */
+		    "-lf2c",			/*  1  */
+		    "-lm",			/*  2  */
+		    "-lcurl",			/*  3  */
+		    "",				/*  4  */
+		    "",				/*  5  */
+		    "",				/*  6  */
+		    "",				/*  7  */
+		    "",				/*  8  */
+		    "",				/*  9  */
+		    0};				/* EOF */
+
+char *opt_flags[] = { "-O3",			/*  0  */
+		    0};				/* EOF */
+
+/* As of Dec2007 there remains an unexplained optimizer bug in
+** the system which has the effect of disabling FPE handling on
+** Mac Intel/PPC systems.  For the moment, we'll disable the optimization
+** until this is better understood or fixed in future GCC versions.
+*/
+int  nopt_flags	   = 0;				/* No. optimizer flags */
+
+#else
+#ifdef SOLARIS
+char *fortlib[] = { "-lf2c",			/*  0  (host progs) */
+		    "-lf2c",			/*  1  */
+		    "-lm",			/*  2  */
+		    "-lsocket",			/*  3  */
+		    "-lnsl",			/*  4  */
+		    "-lintl",			/*  5  */
+		    "-ldl",			/*  6  */
+		    "-lelf",			/*  7  */
+		    "",				/*  8  */
+		    "",				/*  9  */
+		    0};				/* EOF */
+
+char *opt_flags[] = { "-O",			/*  0  */
+		    0};				/* EOF */
+int  nopt_flags	   = 1;				/* No. optimizer flags */
+
+#else
+#ifdef CYGWIN
+char *fortlib[] = { "-lf2c",			/*  0  (host progs) */
+		    "-lf2c",			/*  1  */
+		    "-lm",			/*  2  */
+		    "-lcompat",			/*  3  */
+		    "",				/*  4  */
+		    "",				/*  5  */
+		    "",				/*  6  */
+		    "",				/*  7  */
+		    "",				/*  8  */
+		    "",				/*  9  */
+		    0};				/* EOF */
+
+char *opt_flags[] = { "-O",			/*  0  */
+		    0};				/* EOF */
+int  nopt_flags	   = 1;				/* No. optimizer flags */
+
+#else
+char *fortlib[] = { "-lU77",			/*  0  (host progs) */
+		    "-lm",			/*  1  */
+		    "-lF77",			/*  2  */
+		    "-lI77",			/*  3  */
+		    "-lm",			/*  4  */
+		    "",				/*  5  */
+		    "",				/*  6  */
+		    "",				/*  7  */
+		    "",				/*  8  */
+		    "",				/*  9  */
+		    0};				/* EOF */
+
+char *opt_flags[] = { "-O",			/*  0  */
+		    0};				/* EOF */
+int  nopt_flags	   = 1;				/* No. optimizer flags */
+
+#endif
+#endif
+#endif
+#endif
+#endif
+
+#ifdef BSD
+#define	F_STATIC	"-static"
+#define	F_SHARED	"-shared"
+#else
+#ifdef MACOSX
+#define	F_STATIC	"-static"
+#define	F_SHARED	"-shared"
+#else
+#ifdef LINUX
+#define	F_STATIC	"-Wl,-Bstatic"
+#define	F_SHARED	"-Wl,-Bdynamic"
+#else
+#ifdef SOLARIS
+#define	F_STATIC	"-Wl,-Bstatic"
+#define	F_SHARED	"-Wl,-Bdynamic"
+#endif
+#endif
+#endif
+#endif
+
+#define isxfile(str)	(getextn(str) == 'x')
+#define isffile(str)	(getextn(str) == 'f')
+#define iscfile(str)	(getextn(str) == 'c')
+#define issfile(str)	(getextn(str) == 's')
+#define isefile(str)	(getextn(str) == 'e')
+#define isafile(str)	(getextn(str) == 'a')
+#define isofile(str)	(getextn(str) == 'o')
+#define ispfile(str)	(getextn(str) == 'P')	/* func prototypes	*/
+
+
+#ifdef SOLARIS
+#ifdef X86
+int	usesharelib = NO;
+int	noedsym = YES;
+#else
+int	usesharelib = YES;
+int	noedsym = NO;
+#endif
+
+#else
+#ifdef SHLIB
+int	usesharelib = YES;
+int	noedsym = NO;
+#else
+int	usesharelib = NO;
+int	noedsym = YES;
+#endif
+#endif
+
+int	stripexe 	= NO;
+int	notvsym 	= NO;
+int	noshsym 	= NO;
+int	errflag 	= NO;
+int	objflags 	= NO;
+int	keepfort 	= NO;
+int	mkobject 	= YES;
+int	mktask 		= YES;
+int	optimize 	= YES;
+int	cflagseen 	= NO;
+int	nfileargs 	= 0;
+int	link_static 	= NO;
+int	link_nfs 	= NO;
+int	debug 		= NO;
+int	dbgout 		= NO;
+int	hostprog 	= NO;
+int	voslibs 	= YES;
+int	nolibc 		= NO;
+int	usef2c 		= YES;
+int	useg95 		= NO;
+int	userincs	= NO;
+#ifdef LINUXPPC
+int	useg2c 		= YES;
+#else
+int	useg2c 		= NO;
+#endif
+int	host_c_main 	= NO;
+
+char	ccomp[SZ_FNAME] 	= CCOMP;
+char	f77comp[SZ_FNAME] 	= F77COMP;
+char	linker[SZ_FNAME] 	= LINKER;
+char	f2cpath[SZ_FNAME] 	= "/usr/bin/f2c";
+char	g77path[SZ_FNAME] 	= "/usr/bin/g77";
+
+char	outfile[SZ_FNAME] = "";
+char	tempfile[SZ_FNAME] = "";
+char	*lflags[MAXFLAG+1];
+char	*lfiles[MAXFILE+1];			/* all files		*/
+char	*hlibs[MAXFILE+1];			/* host libraries	*/
+char	*lxfiles[MAXFILE+1];			/* .x files		*/
+char	*lffiles[MAXFILE+1];			/* .f files		*/
+char	buffer[SZ_BUFFER+1];
+char	libbuf[SZ_LIBBUF+1];
+char	*bp = buffer;
+char	*libp = libbuf;
+char	*pkgenv = NULL;
+char	*pkglibs = NULL;
+char	v_pkgenv[SZ_PKGENV+1];
+int	nflags, nfiles, nhlibs, nxfiles, nffiles;
+long	sig_int, sig_quit, sig_hup, sig_term;
+char	*shellname = "/bin/sh";
+int	foreigndefs = NO;
+char	*foreign_defsfile = "";
+char	*irafarch = "";				/* IRAFARCH string */
+char	floatoption[32] = "";			/* f77 arch flag, if any */
+int	pid;
+
+
+/**
+ *  External procedure declarations.
+ */
+extern 	void ZZSTRT (void);
+extern 	void ZZSTOP (void);
+
+/**
+ *  Local procedure declarations.
+ */
+static char *mkfname (char *i_fname);
+static int   addflags (char *flag, char *arglist[], int *p_nargs);
+static char *iraflib (char *libref);
+static void  printargs (char *cmd, char *arglist[], int nargs);
+static void  xtof (char *file);
+static int   getextn (char *fname);
+static void  chdot (char *fname, char dotchar);
+
+static int   run (char *task, char *argv[]);
+static int   sys (char *cmd);
+
+static void  done (int k);
+static void  enbint (SIGFUNC handler);
+static void  interrupt (void);
+static int   await (int waitpid);
+static void  rmfiles (void);
+
+static void  fatalstr (char *s1, char *s2);
+static void  fatal (char *s);
+
+static int   isv13 (void);
+static char *findexe (char *prog, char *dir);
+
+
+
+
+/**
+ *  MAIN -- Execution begins here.  Interpret command line arguments and
+ *  pass commands to UNIX to execute the various passes, i.e.:
+ *
+ *	xpp		SPP to modified-ratfor
+ *	rpp		modified-ratfor to Fortran
+ *	f77		UNIX fortran compiler
+ *	cc		compile other sources, link if desired
+ *
+ *  The Fortran source is left behind if the -F flag is given.  The IRAF root
+ *  directory must either be given on the command line as "-r pathname" or in
+ *  the environment as the variable "irafdir".
+ */
+int
+main (int argc, char *argv[])
+{
+	int	i, j, nargs, ncomp;
+	char	*arglist[MAXFILE+MAXFLAG+10];
+	char	*arg, *ip, *s;
+	int	status, noperands;
+
+	/* Initialization. */
+	ZZSTRT();
+	isv13();
+
+#if defined(LINUX) || defined(BSD) || defined(X86) || defined(MACOSX)
+	if (os_sysfile ("f77.sh", f77comp, SZ_FNAME) < 0) {
+	    strcpy (f77comp, "f77");
+	    usef2c = 0;
+	} else
+	    usef2c = 1;
+	if (os_sysfile ("f2c.e", tempfile, SZ_FNAME) > 0)
+	    strcpy (f2cpath, tempfile);
+#else
+	strcpy (f77comp, "f77");
+#endif
+
+	nflags = nfiles = nhlibs = nxfiles = nffiles = 0;
+
+	sig_int  = (long) signal (SIGINT,  SIG_IGN) & 01;
+	sig_quit = (long) signal (SIGQUIT, SIG_IGN) & 01;
+	sig_hup  = (long) signal (SIGHUP,  SIG_IGN) & 01;
+	sig_term = (long) signal (SIGTERM, SIG_IGN) & 01;
+
+	enbint ((SIGFUNC)interrupt);
+	pid = getpid();
+
+	/* Load any XC related environment definitions.
+	 */
+	if ((s = os_getenv ("XC-CC")) || (s = os_getenv ("XC_CC")))
+	    strcpy (ccomp, s);
+	if ((s = os_getenv ("XC-F77")) || (s = os_getenv ("XC_F77"))) {
+	    strcpy (f77comp, s);
+	    usef2c = (strncmp (f77comp, "f77", 3) == 0 ? 1 : 0);
+	    useg95 = (strncmp (f77comp, "g95", 3) == 0 ? 1 : 0);
+	}
+	if ((s = os_getenv ("XC-LINKER")) || (s = os_getenv ("XC_LINKER")))
+	    strcpy (linker, s);
+
+
+
+        /* Always load the default IRAF package environment. */
+	loadpkgenv (DEF_PKGENV);
+
+	/* Count the number of file arguments.  Load the environment for
+	 * any packages named on the command line.
+	 */
+	pkgenv = NULL;
+	v_pkgenv[0] = EOS;
+	for (i=1, nfileargs=0;  argv[i] != NULL;  i++)
+	    if (argv[i][0] != '-')
+		nfileargs++;
+	    else if (strcmp (argv[i], "-p") == 0 && argv[i+1]) {
+		loadpkgenv (argv[++i]);
+		strcat (v_pkgenv, v_pkgenv[0] ? " -p " : "-p ");
+		strcat (v_pkgenv, argv[i]);
+		pkgenv = v_pkgenv;
+	    }
+
+	/* If no package environment was specified see if the user has
+	 * specified a default package in their user environment.
+	 */
+	if (!pkgenv) {
+	    char *s, u_pkgenv[SZ_PKGENV+1];
+	    char *pkgname, *ip;
+
+	    if ((s = os_getenv ("PKGENV"))) {
+		strcpy (ip = u_pkgenv, s);
+		while (*ip) {
+		    while (isspace(*ip))
+			ip++;
+		    pkgname = ip;
+		    while (*ip && !isspace(*ip))
+			ip++;
+		    if (*ip)
+			*ip++ = EOS;
+
+		    if (pkgname[0]) {
+			loadpkgenv (pkgname);
+			strcat (v_pkgenv, v_pkgenv[0] ? " -p " : "-p ");
+			strcat (v_pkgenv, pkgname);
+			pkgenv = v_pkgenv;
+		    }
+		}
+	    }
+	}
+
+	/* Process command line options, make file lists.
+	 * Convert ".x" files to ".f".
+	 */
+	for (i=1;  (arg = argv[i]) != NULL;  i++) {
+	    if (arg[0] == '-') {
+		switch (arg[1]) {
+                case '/':
+                    /* Pass flag on without further interpretation.
+                     *     "-/foo"    ->  "-foo"
+                     *     "-//foo"   ->  "foo"
+                     */
+                    lflags[nflags] = bp;
+                    ip = &arg[2];
+                    if (*ip == '/')
+                        ip++;
+                    else
+                        *bp++ = '-';
+
+                    while ((*bp++ = *ip++))
+                        ;
+
+                    if (nflags++ >= MAXFLAG)
+                        fatal ("Too many compiler options");
+                    break;
+
+		case 'D':
+		    /* Pass a -D<define> flag on to the host compiler.
+		     */
+		    lflags[nflags] = bp;
+		    for (ip = &arg[0];  (*bp++ = *ip++);  )
+			;
+		    if (bp - buffer >= SZ_BUFFER)
+			fatal ("Out of buffer space for options");
+		    if (nflags++ >= MAXFLAG)
+			fatal ("Too many compiler options");
+		    break;
+
+		case 'I':
+		    /* Pass a -I<include-dir> flag on to the host compiler.
+		     * A special case is "-Inolibc" which disables automatic
+		     * inclusion of the IRAF LIBC includes (hlib$libc).
+		     */
+		    if (strcmp (&arg[2], "nolibc") == 0)
+			nolibc++;
+		    else {
+			lflags[nflags] = bp;
+			*bp++ = arg[0];
+			*bp++ = arg[1];
+			strcpy (bp, vfn2osfn (&arg[2], 0));
+			bp += strlen (bp) + 1;
+
+			if (bp - buffer >= SZ_BUFFER)
+			    fatal ("Out of buffer space for options");
+			if (nflags++ >= MAXFLAG)
+			    fatal ("Too many compiler options");
+		    }
+		    break;
+
+		case 'l':
+		case 'L':
+		    /* Library file (-llib) or library directory (-Ldir)
+		     * reference.
+		     */
+		    if ((lfiles[nfiles] = iraflib (arg)) == NULL) {
+			hlibs[nhlibs] = arg;
+		        nhlibs++;
+		    } else
+			nfiles++;
+		    if (nfiles > MAXFILE || nhlibs > MAXFILE)
+			fatal ("Too many files");
+
+		    objflags = YES;
+		    mkobject = YES;
+		    mktask = YES;
+		    break;
+
+		case 'o':
+		    /* Set output file name.
+		     */
+		    if ((arg = argv[++i]) == NULL)
+			i--;
+		    else
+			strcpy (outfile, arg);
+		    mkobject = YES;
+		    mktask = YES;
+		    objflags = YES;
+		    break;
+
+		case 'p':
+		    /* Ignore since the -p args were already processed above.
+		     */
+		    i++;
+		    break;
+
+		case 'r':
+		    /* Not used anymore */
+		    if ((arg = argv[++i]) == EOS)
+			i--;
+		    break;
+
+		case 'h':
+		    /* Host program: do not link in IRAF main or search
+		     * standard IRAF libraries unless explicitly referenced
+		     * on command line.
+		     */
+		    voslibs = 0;
+		    /* fall through */
+
+		case 'H':
+		    /* Link a host program, but include the VOS libraries.
+		     */
+		    hostprog++;
+		    noedsym++;
+		    nolibc++;
+		    break;
+
+		case 'G':
+		    /* Force a program to link w/ libg2c.a instead of libf2c.a
+		     */
+		    useg2c++;
+		    break;
+
+		case 'A':
+		    /* Force arch-specific include files.
+		     */
+		    userincs++;
+		    break;
+
+		case 'C':
+		    /* Link a host program which has a C main.  We may need
+		     * to tweak the command line as a special case here since
+		     * we normally assume Fortran sources.  This is currently
+		     * only needed for host C programs under LinuxPPC.
+		     */
+		    host_c_main++;
+		    break;
+
+		case 'V':
+		    /* Print XC version identification.
+		     */
+		    fprintf (stderr, "%s\n", VERSION);
+		    fflush (stderr);
+		    break;
+
+		default:
+		    if (strcmp (&arg[1], "Nh") == 0) {
+			if ((arg = argv[++i]) == EOS)
+			    i--;
+			else {
+			    foreigndefs++;
+			    foreign_defsfile = arg;
+			    continue;
+			}
+		    }
+
+		    lflags[nflags] = bp;
+		    *bp++ = '-';
+
+		    /* Process list of flags without arguments, e.g. "-xyz"
+		     * which is the same as "-x -y -z".
+		     */
+		    for (ip = &arg[1];  *ip != EOS;  ip++)
+			if (*ip == 'c') {
+			    mkobject = YES;
+			    mktask = NO;
+			    objflags = YES;
+			    cflagseen = YES;
+
+			} else if (*ip == 'd') {
+			    debug++;
+			} else if (*ip == 'q') {
+			    optimize = NO;
+			} else if (*ip == 'O') {
+			    optimize = YES;
+
+			} else if (*ip == 'F' || *ip == 'f') {
+			    keepfort = YES;
+			    if (objflags == NO) {
+				mkobject = NO;
+				mktask = NO;
+			    }
+			} else if (*ip == 'x') {
+			    dbgout++;
+			    optimize = NO;
+			    *bp++ = DEBUGFLAG;
+			    if (bp - buffer >= SZ_BUFFER)
+				fatal ("Out of buffer space for options");
+			} else if (*ip == 'z') {
+			    usesharelib = NO;
+			} else if (*ip == 'e') {
+			    noedsym = YES;
+			} else if (*ip == 't') {
+			    notvsym = YES;
+			} else if (*ip == 'T') {
+			    noshsym = YES;
+			} else if (*ip == 's') {
+			    stripexe = YES;
+			    goto passflag;
+			} else if (*ip == 'N') {
+			    /* "NFS" link option.  Generate the output temp
+			     * file in /tmp during the link, then move it to
+			     * the output directory in one operation when done.
+			     * For cases such as linking in an NFS-mounted
+			     * directory, where all the NFS i/o may slow the
+			     * link down excessively.
+			     */
+			    link_nfs = YES;
+			} else {
+passflag:		    mkobject = YES;
+			    if (!cflagseen)
+				mktask = YES;
+			    *bp++ = *ip;
+			    if (bp - buffer >= SZ_BUFFER)
+				fatal ("Out of buffer space for options");
+		        }
+
+		    if (bp - lflags[nflags] <= 1) {
+			lflags[nflags] = NULL;
+			bp--;
+		    } else {
+			*bp++ = EOS;
+			if (nflags++ >= MAXFLAG)
+			    fatal ("Too many compiler options");
+		    }
+		}
+
+	    } else {
+		char	*ip, *op, *last_dot;
+
+		/* Get default name for output executable file, if not given
+		 * as arg.  The default extension is ".e".
+		 */
+		if (outfile[0] == EOS) {
+		    last_dot = NULL;
+		    for (ip=arg, op=outfile;  (*op = *ip++) != EOS;  op++)
+			if (*op == '.')
+			    last_dot = op;
+		    if (last_dot != NULL)
+			*last_dot = EOS;
+		    strcat (outfile, ".e");
+		}
+
+		/* Munge filename if file is a library. */
+		if (isafile(arg) && (s = iraflib(arg)))
+		    arg = s;
+
+		if (access (arg,0) == -1) {
+		    fprintf (stderr, "Warning: file `%s' not found\n", arg);
+		    fflush (stderr);
+		} else {
+		    lfiles[nfiles++] = arg;
+		    if (nfiles > MAXFILE)
+			fatal ("Too many files");
+
+		    if (isxfile (arg)) {
+			xtof (arg);
+			if (errflag & (XPP_BADXFILE | XPP_COMPERR)) {
+			    nfiles--;
+			    errflag &= ~(XPP_BADXFILE | XPP_COMPERR);
+			}
+		    } else if (isffile (arg)) {
+			lffiles[nffiles++] = arg;
+			if (nffiles > MAXFILE)
+			    fatal ("too many files");
+		    } else if (isefile (arg))
+			fatal ("no .e files permitted in file list");
+		}
+	    }
+	}
+	
+	if (!mkobject) {
+	    if (debug) {
+		fprintf (stderr, "quit, fortran only\n");
+		fflush (stderr);
+	    }
+	    ZZSTOP();
+	    exit (errflag);
+	}
+
+	/* Add -I<include-dir> to lflags for each directory in the pkglibs
+	 * package library list.  pkglibs is a comma delimited list of VFN
+	 * directory names formed by loading the core system and layered
+	 * package environments.
+	 */
+	if ((pkglibs = os_getenv ("pkglibs"))) {
+	    char *ip, *op, *vp, fname[SZ_FNAME];
+
+	    for (ip=pkglibs;  *ip;  ) {
+		while (*ip && (isspace(*ip) || *ip == ','))
+		    ip++;
+		for (op=fname;  *ip && !(isspace (*ip) || *ip == ',');  )
+		    *op++ = *ip++;
+		*op++ = EOS;
+		if (*fname == EOS)
+		    break;
+
+		/* Omit the LIBC includes if -Inolibc was specified. */
+		if (! (nolibc && strcmp (fname, LIBCINCLUDES) == 0)) {
+		    lflags[nflags] = bp;
+		    *bp++ = '-';
+		    *bp++ = 'I';
+		    for (vp=vfn2osfn(fname,0);  (*bp++ = *vp++);  )
+			;
+		    if (*(bp-2) == '/') {
+			--bp;
+			*(bp-1) = EOS;
+		    }
+
+		    if (bp - buffer >= SZ_BUFFER)
+			fatal ("Out of buffer space for options");
+		    if (nflags++ >= MAXFLAG)
+			fatal ("Too many compiler options");
+		}
+
+		while (*ip && (isspace(*ip) || *ip == ','))
+		    ip++;
+	    }
+	}
+
+	/* Now check for any alternative compiler definitions or commandline
+	 * flags which will affect out link line.  Some systems like LinuxPPC
+	 * will require use of -lg2c even though we can continue to use the
+	 * hlib$f77.sh the fortran compiler script on that system.
+	 */
+	if (useg2c || strncmp (f77comp, "g77", 3) == 0) {
+	    fortlib[0] = fortlib[1] = "-lg2c";
+	}
+
+
+#ifdef sun
+	/* Determine if any special architecture dependent compilation flags
+	 * are needed.  For the Sun V1.3 compiler, since FLOAT_OPTION is no
+	 * longer supported, we look for IRAFARCH and generate the -f68881
+	 * or -ffpa compiler switches automatically if we are compiling on a
+	 * Sun-3 and no -/f* has already been specified on the command line.
+	 */
+	if (!floatoption[0] && (irafarch = os_getenv("IRAFARCH")))
+	    if (irafarch[0] == 'f')
+		sprintf (floatoption, "-%s", irafarch);
+#endif
+	/* Compile all F77 source files with F77 to produce object code.
+	 * This compilation is separate from that used for the '.x' files,
+	 * because we do not want to use the UNIX "-u" flag (requires that
+	 * everything be declared) for raw Fortran files.
+	 */
+	nargs = 0;
+	arglist[nargs++] = f77comp;
+	arglist[nargs++] = "-c";
+	if (usef2c == YES) {
+	    arglist[nargs++] = "-f2c";
+	    arglist[nargs++] = f2cpath;
+	}
+
+#ifdef MACOSX
+	if (useg95 == 0) {
+	    if ((irafarch = os_getenv("IRAFARCH"))) {
+	        if (strcmp (irafarch, "macosx") == 0) {
+		    /*
+	            arglist[nargs++] = "-arch";
+	    	    arglist[nargs++] = "ppc";
+		    */
+	            arglist[nargs++] = "-arch";
+	    	    arglist[nargs++] = "i386";
+	    	    arglist[nargs++] = "-m32";
+	    	    arglist[nargs++] = "-mmacosx-version-min=10.4";
+	        } else if (strcmp (irafarch, "macintel") == 0) {
+	            arglist[nargs++] = "-arch";
+	    	    arglist[nargs++] = "x86_64";
+	    	    arglist[nargs++] = "-m64";
+		}
+	    }
+	}
+#endif
+#if (defined(LINUX) && !defined(MACH64))
+	arglist[nargs++] = "-m32";
+#endif
+#if (defined(BSD))
+	arglist[nargs++] = "-m32";
+#endif
+
+#ifdef LINUXAOUT
+	arglist[nargs++] = "-b";
+	arglist[nargs++] = "i486-linuxaout";
+#endif
+#ifdef sun
+	if (floatoption[0])
+	    arglist[nargs++] = floatoption;
+#endif
+        if (optimize) {
+	    for (i=0;  i < nopt_flags;  i++)
+	        arglist[nargs++] = opt_flags[i];
+	}
+
+	/* Add the user-defined flags last so they can override the 
+	 * hardwired options.
+	 */
+	if ((s = os_getenv("XC-FFLAGS")) || (s = os_getenv("XC_FFLAGS")))
+	    addflags (s, arglist, &nargs);
+
+	for (i=0;  i < nflags;  i++)
+	    arglist[nargs++] = lflags[i];
+	
+	for (i=0;  i < nffiles;  i++)
+	    arglist[nargs++] = lffiles[i];
+	arglist[nargs] = NULL;
+
+	if (i > 0) {
+	    if (debug)
+		printargs (f77comp, arglist, nargs);
+	    status = run (f77comp, arglist);
+#ifdef LINUX
+	/* This kludge is to work around a bug in the F2C based F77 script
+	 * on Linux, which returns an exit status of 4 when successfully
+	 * compiling a Fortran file.
+	 */
+	if (status == 4)
+	    status = 0;
+#endif
+	    errflag += status;
+	}
+
+
+	/* Compile the remaining Fortran source files with F77 to produce
+	 * object code.
+	 */
+	nargs = 0;
+	arglist[nargs++] = f77comp;
+	arglist[nargs++] = "-c";
+	arglist[nargs++] = "-u";
+	arglist[nargs++] = "-x";
+	if (usef2c == YES) {
+	    arglist[nargs++] = "-f2c";
+	    arglist[nargs++] = f2cpath;
+	}
+
+#ifdef MACOSX
+	if (useg95 == 0) {
+	    if ((irafarch = os_getenv("IRAFARCH"))) {
+                if (strcmp (irafarch, "macosx") == 0) {
+		    /*
+                    arglist[nargs++] = "-arch";
+                    arglist[nargs++] = "ppc";
+		    */
+                    arglist[nargs++] = "-arch";
+                    arglist[nargs++] = "i386";
+                    arglist[nargs++] = "-m32";
+	    	    arglist[nargs++] = "-mmacosx-version-min=10.4";
+                } else if (strcmp (irafarch, "macintel") == 0) {
+                    arglist[nargs++] = "-arch";
+                    arglist[nargs++] = "x86_64";
+                    arglist[nargs++] = "-m64";
+                }
+
+	    }
+	}
+#endif
+#if (defined(LINUX) && !defined(MACH64))
+	arglist[nargs++] = "-m32";
+#endif
+#if (defined(BSD))
+	arglist[nargs++] = "-m32";
+#endif
+
+#ifdef LINUXAOUT
+        arglist[nargs++] = "-b";
+	arglist[nargs++] = "i486-linuxaout";
+#endif
+#ifdef sun
+	if (floatoption[0])
+	    arglist[nargs++] = floatoption;
+#endif
+        if (optimize) {
+	    for (i=0;  i < nopt_flags;  i++)
+	       arglist[nargs++] = opt_flags[i];
+	}
+
+	/* Add the user-defined flags last so they can override the 
+	 * hardwired options.
+	 */
+	if ((s = os_getenv("XC-FFLAGS")) || (s = os_getenv("XC_FFLAGS")))
+	    addflags (s, arglist, &nargs);
+
+	for (i=0;  i < nflags;  i++)
+	    arglist[nargs++] = lflags[i];
+	
+	/* Make list of files to be compiled.  Do not include F77 files,
+	 * as they were already compiled above.
+	 */
+	for (i=0, noperands=0;  i < nfiles;  i++) {
+	    for (j=0;  j < nffiles && lffiles[j] != lfiles[i];  j++)
+		;
+	    if (j >= nffiles && isffile (lfiles[i])) {
+		arglist[nargs++] = lfiles[i];
+		noperands++;
+	    }
+	}
+	arglist[nargs] = NULL;
+
+	if (noperands > 0) {
+	    if (debug)
+		printargs (f77comp, arglist, nargs);
+	    status = run (f77comp, arglist);
+#ifdef LINUX
+	    /* This kludge is to work around a bug in the F2C based F77 script
+	     * on Linux, which returns an exit status of 4 when successfully
+	     * compiling a Fortran file.
+	     */
+	    if (status == 4)
+		status = 0;
+#endif
+	    errflag += status;
+	}
+
+
+	/* Compile the remaining non-Fortran source files with CC to produce
+	 * object code.
+	 */
+	nargs = 0;
+	arglist[nargs++] = ccomp;
+	arglist[nargs++] = "-c";
+
+#ifdef MACH64
+	arglist[nargs++] = "-DMACH64";		/* needed for zmain.c */
+#endif
+#ifdef LINUX64
+	arglist[nargs++] = "-DLINUX64";		/* needed for zmain.c */
+#endif
+#if (defined(LINUX) && !defined(MACH64))
+	arglist[nargs++] = "-m32";
+#endif
+#ifdef LINUX
+	arglist[nargs++] = "-DLINUX";
+#ifdef REDHAT
+	arglist[nargs++] = "-DREDHAT";
+#endif
+#ifdef LINUXPPC
+	arglist[nargs++] = "-DLINUXPPC";
+#endif
+	arglist[nargs++] = "-DPOSIX";
+	arglist[nargs++] = "-DSYSV";
+#endif
+
+#ifdef BSD
+	arglist[nargs++] = "-m32";
+	arglist[nargs++] = "-DBSD";
+#endif
+
+#ifdef MACOSX
+	arglist[nargs++] = "-DMACOSX";
+	if (useg95 == 0) {
+	    if ((irafarch = os_getenv("IRAFARCH"))) {
+                if (strcmp (irafarch, "macosx") == 0) {
+		    /*
+                    arglist[nargs++] = "-arch";
+                    arglist[nargs++] = "ppc";
+		    */
+                    arglist[nargs++] = "-arch";
+                    arglist[nargs++] = "i386";
+                    arglist[nargs++] = "-m32";
+	    	    arglist[nargs++] = "-mmacosx-version-min=10.4";
+                } else if (strcmp (irafarch, "macintel") == 0) {
+                    arglist[nargs++] = "-arch";
+                    arglist[nargs++] = "x86_64";
+                    arglist[nargs++] = "-m64";
+                }
+
+	    }
+	}
+#endif
+
+#ifdef SOLARIS
+	arglist[nargs++] = "-DSOLARIS";
+#ifdef X86
+	arglist[nargs++] = "-DX86";
+#endif
+	arglist[nargs++] = "-DPOSIX";
+	arglist[nargs++] = "-DSYSV";
+#endif
+
+#ifdef LINUXAOUT
+        arglist[nargs++] = "-b";
+	arglist[nargs++] = "i486-linuxaout";
+#endif
+
+#ifdef sun
+	if (floatoption[0])
+	    arglist[nargs++] = floatoption;
+#endif
+	if (optimize) {
+	    for (i=0;  i < nopt_flags;  i++)
+	        arglist[nargs++] = opt_flags[i];
+	}
+
+	/* Add the user-defined flags last so they can override the 
+	 * hardwired options.
+	 */
+	if ((s = os_getenv("XC-CFLAGS")) || (s = os_getenv("XC_CFLAGS")))
+	    addflags (s, arglist, &nargs);
+
+	for (i=0;  i < nflags;  i++)
+	    arglist[nargs++] = lflags[i];
+	
+	/* Make list of files to be compiled.  Only C and assembler files
+	 * are included.
+	 */
+	for (i=0, noperands=0;  i < nfiles;  i++) {
+	    if (iscfile (lfiles[i]) || issfile (lfiles[i])) {
+		arglist[nargs++] = lfiles[i];
+		noperands++;
+	    }
+	}
+	arglist[nargs] = NULL;
+
+	if (noperands > 0) {
+	    if (debug)
+		printargs (ccomp, arglist, nargs);
+	    errflag += run (ccomp, arglist);
+	}
+
+
+	/* If "-c" (compile only), or there was a compiler error, do not
+	 * proceed with the link.
+	 */
+	if (!mktask || cflagseen || errflag)
+	    done (errflag);
+
+
+	/* Link the object files and libraries to produce the "-o" task.
+	 */
+	nargs = 0;
+	arglist[nargs++] = linker;
+	if ((s = os_getenv("XC-LFLAGS")) || (s = os_getenv("XC_LFLAGS")))
+	    addflags (s, arglist, &nargs);
+
+#ifdef MACOSX
+	if (useg95 == 0 && (irafarch = os_getenv("IRAFARCH"))) {
+            if (strcmp (irafarch, "macosx") == 0) {
+		/*
+                arglist[nargs++] = "-arch";
+                arglist[nargs++] = "ppc";
+		*/
+                arglist[nargs++] = "-arch";
+                arglist[nargs++] = "i386";
+                arglist[nargs++] = "-m32";
+	    	arglist[nargs++] = "-mmacosx-version-min=10.4";
+            } else if (strcmp (irafarch, "macintel") == 0) {
+                arglist[nargs++] = "-arch";
+                arglist[nargs++] = "x86_64";
+                arglist[nargs++] = "-m64";
+            }
+	}
+#endif
+
+#ifdef SOLARIS
+	arglist[nargs++] = "-Wl,-t";
+#endif
+#if (defined(LINUX) && !defined(MACH64))
+	arglist[nargs++] = "-Wl,--defsym,mem_=0";
+#endif
+#if (defined(LINUX) && !defined(MACH64))
+	arglist[nargs++] = "-m32";
+#endif
+#if (defined(BSD))
+	arglist[nargs++] = "-m32";
+	arglist[nargs++] = "-L/usr/lib32";
+	arglist[nargs++] = "-B/usr/lib32";
+#endif
+#ifdef NEED_GCC_SPECS
+	{   char gcc_specs[SZ_PATHNAME];
+	    static char cmd[SZ_CMDBUF];
+
+	    if (os_sysfile ("gcc-specs", gcc_specs, SZ_PATHNAME) < 0)
+		arglist[nargs++] = "/iraf/iraf/unix/bin/gcc-specs";
+	    sprintf (cmd, "-specs=%s", gcc_specs);
+	    arglist[nargs++] = cmd;
+	}
+#endif
+#ifdef LINUXAOUT
+        arglist[nargs++] = "-b";
+	arglist[nargs++] = "i486-linuxaout";
+#endif
+	arglist[nargs++] = "-o";
+
+	if (link_nfs) {
+	    sprintf (tempfile, "/tmp/T_%s.XXXXXX", outfile);
+#ifdef LINUX
+	    mkstemp (tempfile);
+#else
+	    mktemp (tempfile);
+#endif
+	} else
+	    sprintf (tempfile, "T_%s", outfile);
+	arglist[nargs++] = tempfile;
+
+	ncomp = 0;
+	for (i=0;  i < nfiles;  i++)
+	    if (*(ip = lfiles[i]) != '-') {
+		while (*ip++ != EOS)
+		    ;
+		while (*--ip != '.' && ip >= lfiles[i])
+		    ;
+		if (*ip == '.')
+		    switch (ip[1]) {
+		    case 'f':
+		    case 'r':
+		    case 'c':
+		    case 's':
+		    case 'e':
+			ip[1] = 'o';
+			ncomp++;
+		    }
+	    }
+
+	/* Link options. */
+	link_static = 0;
+	for (i=0;  i < nflags;  i++) {
+	    arglist[nargs++] = lflags[i];
+	    if (strcmp (lflags[i], F_STATIC) == 0)
+		link_static = 1;
+	    else if (strcmp (lflags[i], F_SHARED) == 0)
+		link_static = 0;
+	}
+
+#ifdef sun
+	/* Need to pass -f<float> to CC for the C libraries. */
+	if (floatoption[0])
+	    arglist[nargs++] = floatoption;
+
+	/* If we are using the V1.3 Sun Fortran compiler, the V1.3 "f77"
+	 * should be a symbolic link pointing to the BIN directory for the
+	 * new compiler.  Construct the path to this directory and put it
+	 * out as a -Ldir flag on the link line to ensure that the library
+	 * is searched for linking.
+	 */
+	if (isv13()) {
+	    char    libpath[SZ_PATHNAME];
+	    char    dir[SZ_PATHNAME], *path;
+	    char    *pp, *ip, *op, *s;
+	    int     n;
+
+	    path = findexe ("f77", dir);
+
+	    strcpy (libpath, "-L");
+	    strcpy (libpath+2, dir);
+	    for (op=libpath;  *op;  op++)
+		;
+	    if ((n = readlink (path, op, 128)) > 0) {
+		op[n] = EOS;
+
+		for (ip=op;  *ip;  ip++)
+		    if (*ip == '/')
+			op = ip;
+		*op = EOS;
+
+		/* Search, e.g., /usr/lang/SC0.0/ffpa first if Sun-3. */
+		if (floatoption[0]) {
+		    s = floatoption + 1;
+		    *op = '/';
+		    strcpy (op+1, s);
+		    strcpy (libp, libpath);
+		    libp += strlen (pp = libp) + 1;
+		    arglist[nargs++] = pp;
+		}
+
+		/* Search /usr/lang/SC0.0 (or whatever). */
+		*op = EOS;
+		strcpy (libp, libpath);
+		libp += strlen (pp = libp) + 1;
+		arglist[nargs++] = pp;
+	    }
+	}
+#endif
+
+	/* File to link. */
+	for (i=0;  i < nfiles;  i++)
+	    arglist[nargs++] = lfiles[i];
+
+	/* Libraries to link against.
+	 */
+	if (hostprog) {
+#ifdef LINUXPPC
+	    /* LinuxPPC (YellowDog anyway) requires this library to resolve
+	     * the MAIN__ generated by the fortran program statement into
+	     * the 'main'.
+	     */
+	    if (host_c_main == 0)
+	        arglist[nargs++] = "-lfrtbegin";
+#else
+	    if (!isv13())
+		arglist[nargs++] = mkfname (fortlib[0]);
+#endif
+	} else
+	    arglist[nargs++] = mkfname (LIBMAIN);
+
+	if (voslibs) {
+	    if (usesharelib) {
+		arglist[nargs++] = mkfname (SHARELIB);
+		arglist[nargs++] = mkfname (IRAFLIB4);
+		arglist[nargs++] = mkfname (IRAFLIB5);
+		arglist[nargs++] = mkfname (IRAFLIB6);
+	    } else {
+		arglist[nargs++] = mkfname (IRAFLIB1);
+		arglist[nargs++] = mkfname (IRAFLIB2);
+		arglist[nargs++] = mkfname (IRAFLIB3);
+		arglist[nargs++] = mkfname (IRAFLIB4);
+		arglist[nargs++] = mkfname (IRAFLIB5);
+		arglist[nargs++] = mkfname (IRAFLIB6);
+	    }
+	}
+
+	/* Host libraries, searched after iraf libraries. */
+	for (i=0;  i < nhlibs;  i++)
+	    arglist[nargs++] = hlibs[i];
+
+	/* The remaining system libraries depend upon which version of
+	 * the SunOS compiler we are using.  The V1.3 compilers use only
+	 * -lF77 and -lm.
+	 */
+	if (isv13()) {
+	    addflags (fortlib[2], arglist, &nargs);
+	    addflags (fortlib[4], arglist, &nargs);
+	} else {
+	    addflags (fortlib[1], arglist, &nargs);
+	    addflags (fortlib[2], arglist, &nargs);
+	    addflags (fortlib[3], arglist, &nargs);
+	    addflags (fortlib[4], arglist, &nargs);
+	    addflags (fortlib[5], arglist, &nargs);
+	    addflags (fortlib[6], arglist, &nargs);
+	    addflags (fortlib[7], arglist, &nargs);
+	    addflags (fortlib[8], arglist, &nargs);
+	    addflags (fortlib[9], arglist, &nargs);
+	}
+	arglist[nargs] = NULL;
+
+	if (ncomp) {
+	    fprintf (stderr, "link:\n");
+	    fflush (stderr);
+	}
+	if (debug)
+	    printargs (linker, arglist, nargs);
+
+	/* If the link is successful, replace the old executable with the
+	 * new one.  Do not delete the bad executable if the link fails,
+	 * as we might want to examine its symbol table.
+	 */
+	if ((status = run (linker, arglist)) == 0) {
+	    unlink (outfile);
+
+	    if (link_nfs) {
+		char command[1024];
+		sprintf (command, "/bin/cp -f %s %s", tempfile, outfile);
+		if (debug)
+		    printargs (command, NULL, 0);
+		status = sys (command);
+	    } else
+		link (tempfile, outfile);
+
+	    /* Force the mode of the file. */
+	    chmod (outfile, 0755);
+
+	    unlink (tempfile);
+	}
+	errflag += status;
+
+	/* If we are linking against the iraf shared library and symbol editing
+	 * has not been disabled, edit the symbol table of the new executable
+	 * to provide symbols within the shared image.
+	 */
+	if (usesharelib && !noedsym && !stripexe) {
+	    char    shlib[SZ_PATHNAME+1];
+	    char    edsym[SZ_PATHNAME+1];
+	    char    command[SZ_CMDBUF];
+
+	    /* The os_sysfile(SHIMAGE) below assumes the existence of a file
+	     * entry "S.e" in the directory containing the real shared image
+	     * "S<n>.e".  We can't easily look directly for S<n>.e because
+	     * the process symbol table and image has to be examined to
+	     * determine the shared image version number.
+	     */
+	    if (os_sysfile (SHIMAGE, shlib, SZ_PATHNAME) > 0) {
+		if (os_sysfile (EDSYM, edsym, SZ_PATHNAME) > 0) {
+		    sprintf (command, "%s %s %s", edsym, outfile, shlib);
+		    if (noshsym)
+			strcat (command, " -T");
+		    else if (notvsym)
+			strcat (command, " -t");
+		    status = sys (command);
+		}
+	    }
+	}
+	errflag += status;
+	done (errflag);
+
+	return (0);
+}
+
+
+/* MKFNAME -- Make the UNIX pathname of an IRAF library file.  Use os_sysfile
+ * the get the vfn of the library file, so that we do not have to know what
+ * system directory the library file is in.
+ */
+static char *
+mkfname (char *i_fname)
+{
+	char fname[SZ_PATHNAME+1];
+	char *oname;
+
+	/* Library referenced as -lXXX */
+	if (strncmp (i_fname, "-l", 2) == 0) {
+	    sprintf (fname, "lib%s.a", &i_fname[2]);
+	    if ((oname = iraflib (fname)))
+		return (oname);
+	    else
+		return (i_fname);
+	}
+
+	/* Must be a library filename or pathname */
+	strcpy (fname, i_fname);
+	if ((oname = iraflib (fname)))
+	    strcpy (libp, oname);
+	else
+	    strcpy (libp, fname);
+
+	oname = libp;
+	libp += strlen (libp) + 1;
+
+	return (oname);
+}
+
+
+/* ADDFLAGS -- Add one or more flags to an argument list.  Ignore null flags,
+ * separate multiple flags on whitespace.
+ */
+static int
+addflags (char *flag, char *arglist[], int *p_nargs)
+{
+	register int i, len, nargs = *p_nargs;
+	char *fp, *fs, lflag[SZ_FNAME];
+
+	if (flag && *flag) {
+
+	    for (fp = flag; *fp; ) {
+		while (*fp && isspace(*fp)) 		/* skip leading space */
+		    fp++;
+		for (i=0; *fp && !isspace(*fp); ) 	/* collect flag       */
+		    lflag[i++] = *fp++;
+		lflag[i] = '\0';
+		len = strlen (lflag);
+		strcpy ((fs = malloc(len+1)), lflag);
+
+	        if (strcmp (lflag, F_STATIC) == 0) {
+		    link_static = 1;
+	        } else if (strcmp (lflag, F_SHARED) == 0) {
+		    link_static = 0;
+#if defined(LINUX) || defined(BSD) || defined(X86) || defined(MACOSX)
+	        } else if ((strcmp (lflag, "-lf2c") == 0) || 
+	    	    (strcmp (lflag, "-lcompat") == 0)) {
+		        /* Use the IRAF version of libf2c.a or libcompat.a,
+		         * not the host version which may or may not be present.
+		         */
+		        arglist[nargs++] = mkfname (lflag);
+		        *p_nargs = nargs;
+		        return (1);
+	        }
+#endif
+#ifdef SOLARIS
+	        else if (strcmp (lflag, "-ldl") == 0) {
+		    /* This beastie has to be linked dynamic on Solaris, but
+		     * we don't want to have to know this everywhere so we do
+		     * it automatically there.
+		     */
+		    if (link_static)
+		        arglist[nargs++] = F_SHARED;
+		    arglist[nargs++] = fs;
+		    if (link_static)
+		        arglist[nargs++] = F_STATIC;
+		    *p_nargs = nargs;
+		    return (1);
+	        }
+#endif
+	        arglist[nargs++] = fs;
+	    }
+
+	    *p_nargs = nargs;
+	    return (1);
+	}
+
+	return (0);
+}
+
+
+/* IRAFLIB -- Determine if "libname" is an IRAF library.  If so return
+ * the pathname of the library, else return NULL.
+ */
+static char *
+iraflib (char *libref)
+{
+	register char *ip, *op;
+	char savename[SZ_PATHNAME+1];
+	char libname[SZ_PATHNAME+1];
+	char fname[SZ_PATHNAME+1];
+	char path[SZ_PATHNAME+1];
+	int foundit, dbg = dbgout;
+	char *absname;
+
+	strcpy (savename, libref);
+
+	/* If dbgout is enabled try the debug library first, but fall back
+	 * to the normal library if thie debug library is not found.
+	 */
+again:
+	if (strncmp (libref, "-l", 2) == 0) { 
+	    sprintf (libname, "lib%s.a", libref+2);
+	    libref = libname;
+	    goto again;
+	} else
+	    strcpy (libname, libref);
+
+	/* Position IP to EOS. */
+	for (ip=libref;  *ip;  ip++)
+	    ;
+
+	if (!(*(ip-2) == '.' && *(ip-1) == 'a')) {
+	    /* Not a library file, leave it alone.
+	     */
+	    strcpy (fname, libref);
+
+	} else {
+	    /* Normalize the library file name, "libXXX[_p].a".
+	     */
+	    for (ip=libref, op=fname;  (*op = *ip);  op++, ip++)
+		;
+	    if ((*(op-2) == '.' && *(op-1) == 'a')) {
+		*(op-2) = '\0';
+		op -= 2;
+	    } else
+		op -= 1;
+
+	    if (dbg && !(*(op-2) == '_' && *(op-1) == 'p')) {
+		*op++ = '_';
+		*op++ = 'p';
+	    }
+	    *op++ = '.';
+	    *op++ = 'a';
+	    *op++ = '\0';
+	}
+
+	foundit = 0;
+	if (access (fname, 0) == 0) {
+	    strcpy (path, fname);
+	    foundit++;
+	} else {
+	    if (os_sysfile (fname, path, SZ_PATHNAME) > 0)
+		foundit++;
+	}
+
+	if (foundit) {
+	    strcpy (absname=bp, vfn2osfn (path, 0));
+	    bp += strlen (absname) + 1;
+	    if (bp - buffer >= SZ_BUFFER)
+		fatal ("Out of space for library names");
+	    if (debug > 1)
+		fprintf (stderr, "iraflib: %s -> %s\n", savename, absname);
+	    return (absname);
+	} else if (dbg) {
+	    dbg = 0;
+	    goto again;
+	} else {
+	    if (debug > 1)
+		fprintf (stderr, "iraflib: %s -> %s\n", savename, savename);
+	    return (NULL);
+	}
+}
+
+
+/* PRINTARGS -- Echo a UNIX command on the standard error output.
+ */
+static void
+printargs (char *cmd, char *arglist[], int nargs)
+{
+	int	i;
+
+	fputs (cmd, stderr);
+	for (i=1;  i < nargs;  i++)
+	    fprintf (stderr, " %s", arglist[i]);
+	putc ('\n', stderr);
+	fflush (stderr);
+}
+
+
+/* XTOF -- Convert a ".x" file into a ".f" file, i.e., call up the preprocessor
+ * to translate an SPP file into Fortran.
+ */
+static void
+xtof (char *file)
+{
+	static  char xpp_path[SZ_PATHNAME+1], rpp_path[SZ_PATHNAME+1];
+	char	cmdbuf[SZ_CMDBUF], fname[SZ_FNAME];
+#if defined(LINUX64) || defined(MACH64)
+	char    iraf_h[SZ_PATHNAME];
+#endif
+
+
+	lxfiles[nxfiles++] = file;
+	if (nxfiles > MAXFILE)
+	    fatal ("too many files");
+
+	if (nfileargs > 1 || mkobject) {
+	    fprintf (stderr, "%s:\n", file);
+	    fflush (stderr);
+	}
+
+	if (!xpp_path[0])
+	    if (os_sysfile (XPP, xpp_path, SZ_PATHNAME) <= 0)
+		strcpy (xpp_path, XPP);
+
+	if (userincs) {
+	    if (pkgenv)
+	        sprintf (cmdbuf, "%s %s -A -R %s", xpp_path, pkgenv, file);
+	    else
+	        sprintf (cmdbuf, "%s -A -R %s", xpp_path, file);
+	} else {
+	    if (pkgenv)
+	        sprintf (cmdbuf, "%s %s -R %s", xpp_path, pkgenv, file);
+	    else
+	        sprintf (cmdbuf, "%s -R %s", xpp_path, file);
+	}
+
+
+	/* Include a custom 64-bit iraf.h file.
+	 */
+#if defined(LINUX64) || defined(MACH64)
+	memset (iraf_h, 0, SZ_PATHNAME);
+
+	if (os_sysfile ("iraf.h", iraf_h, SZ_PATHNAME) <= 0)
+	    strcpy (iraf_h, "iraf.h");
+	strcat (cmdbuf, " -h ");
+	strcat (cmdbuf, iraf_h);
+#else
+	if (foreigndefs) {
+	    strcat (cmdbuf, " -h ");
+	    strcat (cmdbuf, foreign_defsfile);
+	}
+#endif
+
+	errflag |= sys (cmdbuf);
+	chdot (file, 'r');
+
+	strcpy (fname, file);
+	chdot (fname, 'f');
+
+	if (!rpp_path[0])
+	    if (os_sysfile (RPP, rpp_path, SZ_PATHNAME) <= 0)
+		strcpy (rpp_path, RPP);
+	sprintf (cmdbuf, "%s %s%s >%s",
+	    rpp_path, dbgout ? "-g " : "", file, fname);
+	if (!(errflag & XPP_BADXFILE))
+	    errflag |= sys (cmdbuf);
+
+	unlink (file);			/* remove ".r" file */
+	chdot (file, 'f');		/* change name to ".f" */
+}
+
+
+/* GETEXTN -- Get a one letter extension from a file name (BPS 07.23.96)
+ */
+static int
+getextn (char *fname)
+{
+	register char *ip, *dot;
+        int ch;
+
+	for (ip=fname, dot=NULL;  *ip != EOS;  ip++)
+	    if (*ip == '.')
+		dot = ip;
+
+	if (dot == NULL || *(dot+2) != EOS) {
+	    ch = EOS;
+	} else {
+	    ch = *(dot+1);
+	}
+
+	return (ch);
+}
+	
+
+/* CHDOT -- Change the filename extension, i.e., the single character
+ * following the "." at the end of the filename, to the indicated character.
+ */
+static void
+chdot (char *fname, char dotchar)
+{
+	char	*p;
+
+	p = fname;
+	while (*p++ != EOS)
+	    ;
+	while (*--p != '.' && p >= fname)
+	    ;
+	*(p+1) = dotchar;
+}
+
+
+/* RUN -- Send a command to UNIX and return the execution status to our
+ * caller at the completion of the command.
+ */
+static int
+run (char *task, char *argv[])
+{
+	int	waitpid;
+	pid_t	fork();
+	char	path[SZ_PATHNAME];
+
+	if ((waitpid = fork()) == 0) {
+	    enbint (SIG_DFL);
+
+	    execvp (task, argv);	/* use user PATH for search */
+	    strcpy (path, SYSBINDIR);
+	    strcat (path, task);
+	    execv  (path, argv);	/* look in SYSBINDIR */
+	    strcpy (path, LOCALBINDIR);
+	    strcat (path, task);
+	    execv  (path, argv);	/* look in LOCALBINDIR */
+
+	    fatalstr ("Cannot execute %s", task);
+	}
+
+	return (await (waitpid));
+}
+
+
+/*
+ * Task execution and interrupt handling routines,
+ * taken with minor modifications the F77 driver.
+ */
+
+
+/* SYS -- Execute a general UNIX command passed as a string.  The command may
+ * contain i/o redirection metacharacters.  The full path of the command to
+ * be executed should be given (and always is in the case of XC).
+ */
+static int
+sys (char *cmd)
+{
+	register char *ip;
+	char	*argv[256];
+	char	*inname, *outname;
+	int	append;
+	int	waitpid;
+	int	argc;
+
+	if (debug) {
+	    fprintf (stderr, "debug: %s\n", cmd);
+	    fflush (stderr);
+	}
+
+	inname  = NULL;
+	outname = NULL;
+	append = NO;
+	argc = 0;
+
+	/* Parse command string into argv array, inname, and outname.
+	 */
+	ip = cmd;
+	while (isspace (*ip))
+	    ++ip;
+	while (*ip) {
+	    if (*ip == '<')
+		inname = ip+1;
+	    else if (*ip == '>') {
+		if (ip[1] == '>') {
+		    append = YES;
+		    outname = ip+2;
+		} else {
+		    append = NO;
+		    outname = ip+1;
+		}
+	    } else
+		argv[argc++] = ip;
+	    while ( !isspace (*ip) && *ip != '\0' )
+		++ip;
+	    if (*ip) {
+		*ip++ = '\0';
+		while (isspace (*ip))
+		    ++ip;
+	    }
+	}
+
+	if (argc <= 0)				/* no command */
+	    return (-1);
+	argv[argc] = 0;
+
+	/* Execute the command. */
+	if ((waitpid = fork()) == 0) {
+	    if (inname)
+		freopen (inname, "r", stdin);
+	    if (outname)
+		freopen (outname, (append ? "a" : "w"), stdout);
+	    enbint (SIG_DFL);
+
+	    execv (argv[0], argv);
+	    fatalstr ("Cannot execute %s", argv[0]);
+	}
+
+	return (await (waitpid));
+}
+
+
+/* DONE -- Called at process shutdown to cleanup.  Primary action is to delete
+ * the intermediate Fortran files, unless the -F flag was given on the command
+ * line.
+ */
+static void
+done (int k)
+{
+	static	int recurs = NO;
+
+	if (recurs == NO) {
+	    recurs = YES;
+	    if (!keepfort)
+	        rmfiles();
+	}
+
+	ZZSTOP();
+	exit (k);
+}
+
+
+/* ENBINT -- Post an exception handler function to be executed if any sort
+ * of interrupt occurs.
+ */
+static void
+enbint (SIGFUNC handler)
+{
+	if (sig_int == 0)
+	    signal (SIGINT, handler);
+	if (sig_quit == 0)
+	    signal (SIGQUIT, handler);
+	if (sig_hup == 0)
+	    signal (SIGHUP, handler);
+	if (sig_term == 0)
+	    signal (SIGTERM, handler);
+}
+
+
+/* INTERRUPT -- Exception handler, called if an interrupt is received
+ * during compilation.
+ */
+static void
+interrupt (void)
+{
+	done (2);
+}
+
+
+/* AWAIT -- Wait for an asynchronous child process to terminate.
+ */
+static int
+await (int waitpid)
+{
+	int	w, status;
+
+	enbint (SIG_IGN);
+	while ((w = wait (&status)) != waitpid)
+	    if (w == -1)
+		fatal ("bad wait code");
+	enbint ((SIGFUNC)interrupt);
+	if (status & 0377) {
+	    if (status != SIGINT) {
+		fprintf (stderr, "Termination code %d", status);
+		fflush (stderr);
+	    }
+	    done (2);
+	}
+	return (status>>8);
+}
+
+
+/* RMFILES -- Delete all of the ".f" intermediate Fortran files.
+ */
+static void
+rmfiles (void)
+{
+	int	i;
+
+	for (i=0;  i < nxfiles;  i++) {
+	    chdot (lxfiles[i], 'f');
+	    unlink (lxfiles[i]);
+	}
+}
+
+
+/* FATALSTR -- Fatal error with an sprintf format and one string argument.
+ */
+static void
+fatalstr (char *s1, char *s2)
+{
+	char	out[SZ_CMDBUF];
+
+	sprintf (out, s1, s2);
+	fatal (out);
+}
+
+
+/* FATAL -- A fatal error has occurred.  Print error message and terminate
+ * process execution.
+ */
+static void
+fatal (char *s)
+{
+	fprintf (stderr, "Fatal compiler error: %s\n", s);
+	fflush (stderr);
+	done (1);
+}
+
+
+/* ISV13 -- Test if we are using the version 1.3 Sun Fortran compiler.
+ * There is no simple, reliable way to do this.  The heuristic used is
+ * to first locate the "f77" we will use, then see if there is a file
+ * named "f77-1.3*" in the same directory.
+ */
+static int
+isv13 (void)
+{
+	static	int v13 = -1;
+	struct	dirent *dp;
+	char	dir[SZ_PATHNAME];
+	char	*name;
+	DIR	*dirp;
+
+return (0);
+#ifdef SOLARIS
+	return (v13 = 0);
+#else
+
+	if (v13 != -1)
+	    return (v13);
+
+	if (findexe ("f77", dir) && (dirp = opendir(dir)) != NULL) {
+	    while ((dp = readdir(dirp))) {
+		/* Actually, we don't want to be too picky about the
+		 * version number of this won't work for future versions,
+		 * so just match up to the version number.
+		 */
+		name = dp->d_name;
+		if (!strncmp (name, "f77-1.3", 4) && isdigit(name[4])) {
+		    closedir (dirp);
+		    return (v13 = 1);
+		}
+	    }
+	    closedir (dirp);
+	}
+
+	return (v13 = 0);
+#endif
+}
+
+
+/* FINDEXE -- Search for the named file and return the path if found, else
+ * NULL.  If "dir" is non-NULL the directory in which the file resides is
+ * returned in the string buffer pointed to.  The user's PATH is searched,
+ * followed by SYSBINDIR, then LOCALBINDIR.
+ */
+static char *
+findexe (
+    char  *prog,		/* file to search for */
+    char  *dir			/* pointer to output string buf, or NULL */
+)
+{
+	register char *ip, *op;
+	static	char path[SZ_PATHNAME];
+	char	dirpath[SZ_PATHNAME];
+	char	*dp = dir ? dir : dirpath;
+	char	*pathp;
+
+	/* Look for the program in the directories in the user's path.
+	 */
+	ip = pathp = os_getenv ("PATH");
+	while (*ip) {
+	    for (op=dp;  *ip && (*op = *ip++) != ':';  op++)
+		;
+	    *op++ = '/';
+	    *op++ = EOS;
+	    strcpy (path, dp);
+	    strcat (path, prog);
+	    if (access (path, 0) != -1)
+		return (path);
+	}
+
+	/* Look in SYSBINDIR. */
+	strcpy (dp, SYSBINDIR);
+	strcpy (path, dp);
+	strcat (path, prog);
+
+	if (access (path, 0) != -1) {
+	    static  char envpath[8192];
+	    char    *oldpath;
+
+	    /* Add SYSBINDIR to the user's path.  This is required to
+	     * use the V1.3 compiler.  Note that this code should only be
+	     * executed once, since the next time findexe is called the
+	     * SYSBINDIR directory will be in the default path, above.
+	     */
+	    if ((oldpath = pathp)) {
+		sprintf (envpath, "PATH=%s:%s", SYSBINDIR, oldpath);
+		putenv (envpath);
+	    }
+
+	    return (path);
+	}
+
+	/* Look in LOCALBINDIR. */
+	strcpy (dp, LOCALBINDIR);
+	strcpy (path, dp);
+	strcat (path, prog);
+	if (access (path, 0) != -1)
+	    return (path);
+
+	/* Not found. */
+	return (NULL);
+}
diff --git a/unix/boot/spp/xc.hlp b/unix/boot/spp/xc.hlp
new file mode 100644
index 00000000..0e941b82
--- /dev/null
+++ b/unix/boot/spp/xc.hlp
@@ -0,0 +1,197 @@
+.help xc Oct89 softools
+.ih
+NAME
+xc -- portable IRAF compile/link utility
+.ih
+USAGE
+xc [flags] files
+.ih
+FLAGS
+.ls 10 -a
+To support VMS link options file.  Next file is taken to be the VMS name
+of a link options file.  This is primarily for using long lists of files
+or libraries and not for actual VMS Linker options, since XC adds continuation
+characters where it believes it is appropriate.
+.le
+.ls 10 -C
+Tells fortran to do array bound and other checking.
+By default no checking is done.  From DCL fortran usually
+does array and overflow checking which is not used here.
+.le
+.ls 10 -c
+Tells \fIxc\fR not to link, i.e., not to create an executable.
+.le
+.ls 10 -d
+Causes debug messages to be printed during execution.
+.le
+.ls 10 -F, -f
+Do not delete the Fortran translation of an SPP source file.
+.le
+.ls 10 -g
+Generates debugging information and (for VMS), links in the debugger.
+.le
+.ls 10 -h
+Causes the executable to be linked as a host program, i.e., without the
+IRAF main and without searching the IRAF libraries, unless explicitly
+referenced on the command line.  Used to compile and link host (e.g., Fortran)
+programs which may or may not reference the IRAF libraries.
+.le
+.ls 10 -i2
+Tells fortran to use I*2 by default.
+.le
+.ls 10 -i4
+Tells fortran to use I*4 by default.
+.le
+.ls 10 -l\fIlib\fR
+This tells the linker which libraries besides the standard
+ones to include.  These must be either on the current
+directory, or in an IRAF system library (lib$ or hlib$).
+The library specification must be immediately after the option as in
+"-lxtools".  No other option may follow the 'l' option in the same
+argument as in -lxtoolsO.	
+.le
+.ls 10 -L
+Creates a list file. VMS specific.
+.le
+.ls 10 -M, -m
+Tells the linker to create a link map.
+.le
+.ls 10 -n
+Not really supported under VMS since "normal" users
+cannot install images.  In Unix this is just a link
+option to make a shareable image.
+.le
+.ls 10 -N
+Same as -z for VMS.
+.le
+.ls 10 -Nh [filename]
+This tells xpp that the foreign definitions in the
+file specified should be used in preference to
+standard include files.	
+.le
+.ls 10 -o
+This flag redirects the output of the compile if used in
+conjunction with -c option or specifies where the executable
+or object is to be placed.  If not given the first file
+name is used to obtain the name for the executable or
+object.
+.le
+.ls 10 -O
+Optimize object code produced; this is now the default, but this switch
+is still provided for backwards compatibility.
+.le
+.ls 10 -p pkgname
+Load the package environment for the named external package, e.g.,
+"xc -c -p noao file.x".  If the same package is always specified
+the environment variable or logical name PKGENV may be defined at the
+host level to accomplish the same thing.  The package name \fImust\fR
+be specified when doing software development in an external or layered
+package.
+.le
+.ls 10 -P
+Check portability.  This should be used all of the time in IRAF,
+but the VMS C compiler forces the use of non-standard
+constructs in some cases.  Also <stdio.h> and <ctype.h> get
+complaints for the above reason.  This may be used and probably
+should when working with Fortran due to Dec non-standard
+extension.
+.le
+.ls 10 -q
+Disable optimization.  Opposite of -O.  Object code will be optimized
+by default.
+.le
+.ls 10 -s
+Strips all symbols and debugging information.
+.le
+.ls 10 -S
+Same as -s for VMS.
+.le
+.ls 10 -v
+Verbose mode.  Causes messages to be printed during execution telling
+what the \fIxc\fR program is doing.
+.le
+.ls 10 -w
+Suppress warnings.				
+.le
+.ls 10 -X, -x
+Compile and link for debugging.  In VMS/IRAF, links in the VMS debugger
+and symbols.
+.le
+.ls 10 -z
+Create a non-shareable image (default).
+.le
+.ih
+DESCRIPTION
+XC is a machine independent utility for compiling and linking IRAF
+tasks or files.  The XC utility may also be used to compile and/or link
+non-IRAF files and tasks.  The VMS version of XC supports all of the
+important flags except -D which VMS C doesn't support in any way.
+It can be used to generate fortran from xpp or ratfor code, to compile any
+number of files, and then link them if desired.  XC accepts and maps IRAF
+virtual filenames, but since it is a standalone bootstrap utility the
+environment is not passed, hence logical directories cannot be used.
+
+The following extensions are supported by the VMS version of xc:
+.x, .r, .f, .ftn, .for, .c, .mar, .s, .o, .obj, .a, .olb, .e, .exe.
+It is suggested that everyone stick with the iraf virtual file name extensions.
+These are : .x, .r, .f, .c, .s, .o, .a, .e. The mapping of these to their
+VMS counterparts is:
+
+.ks
+.nf
+     .x -> .x    SPP code
+     .r -> .r    Ratfor code
+     .f -> .for  Fortran code
+     .c -> .c    C code
+     .s -> .mar  Macro assembler code
+     .o -> .obj  Object module
+     .a -> .olb  Library file
+     .e -> .exe  Executable Image
+.fi
+.ke
+
+
+XC is available both in the CL, via the foreign task interface, and as
+a standalone DCL callable task.  Usage is equivalent in either case.  Upper
+case flags must be quoted to be recognized (the upper case flags will be
+done away with at some point).
+.ih
+EXAMPLES
+Any upper case flags in the following examples must be doubly quoted in
+the CL, singly quoted in VMS, to make it to XC without VMS mapping
+everything to one case.  Omit the "-x" flag on a UNIX system.
+
+1. Compile and link the source file "mytask.x" to produce the executable
+"mytask.e".
+
+	cl> xc mytask.x
+
+2. Translate the file "file.x" into Fortran.
+
+	cl> xc -f file.x
+
+3. Compile but do not link "mytask.x" and the support file "util.x".
+
+	cl> xc -c file.x util.x
+
+4. Now link these for debugging.
+
+	cl> xc -x file.o util.o
+
+5. Link the same files without the VMS debug stuff, but link in the library
+-ldeboor (the DeBoor spline routines) as well.
+
+	cl> xc file.o util.o -ldeboor
+
+XC is often combined with \fImkpkg\fR to automatically maintain large packages
+or libraries.
+.ih
+BUGS
+The -S flag should generate assembler
+output but does not presently do so in the VMS version.  All case sensitive
+switches should be done away with in both the UNIX and VMS versions of the
+utility.
+.ih
+SEE ALSO
+mkpkg, generic
+.endhelp
diff --git a/unix/boot/spp/xpp.h b/unix/boot/spp/xpp.h
new file mode 100644
index 00000000..c240bf6a
--- /dev/null
+++ b/unix/boot/spp/xpp.h
@@ -0,0 +1,12 @@
+/*  XPP error codes.
+ */
+#define	XPP_COMPERR	101		/* compiler error */
+#define	XPP_BADXFILE	102		/* cannot open .x file */
+#define	XPP_SYNTAX	104		/* language error */
+
+
+/* String type codes.
+ */
+#define	STR_INLINE	0
+#define	STR_DEFINE	1
+#define	STR_DECL	2
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
diff --git a/unix/boot/vmcached/README b/unix/boot/vmcached/README
new file mode 100644
index 00000000..6844153c
--- /dev/null
+++ b/unix/boot/vmcached/README
@@ -0,0 +1,17 @@
+VMCACHED -- VMcache daemon.
+
+The VMcache daemon is a Unix server which manages a file cache in virtual
+memory.  This is used to optimize virtual memory usage, allowing files to
+be cached in memory so that they can be shared or accessed without going
+to disk.  It is also possible to conditionally access files via "direct
+i/o", bypassing system virtual memory and transferring the data directly
+from disk to or from process memory.
+
+NOTE: as of Dec 2001, the Vmcache library and vmcached have been updated
+to provide the capabilites described above.  The daemon runs, and was used
+to develop the VM client interface, which is currently functional, tested,
+and installed in os$zfiobf.c.  The new version of the VMcache library
+however, has not yet been fully tested and should not be used.
+
+Since this code is still under development it is not part of the normal
+IRAF build (hence no mkpkg or mkpkg.sh).
diff --git a/unix/boot/vmcached/notes b/unix/boot/vmcached/notes
new file mode 100644
index 00000000..f5da300b
--- /dev/null
+++ b/unix/boot/vmcached/notes
@@ -0,0 +1,364 @@
+Virtual Memory Caching Scheme
+Mon Oct 25 1999 - Thu Jan 20 2000
+
+
+OVERVIEW [now somewhat dated]
+
+Most modern Unix systems implement ordinary file i/o by mapping files into
+host memory, faulting the file pages into memory, and copying data to and
+from process memory and the cached file pages.  This has the effect of
+caching recently read file data in memory.  This scheme replaces the old
+Unix buffer cache, with the advantage that there is no builtin limit on
+the size of the cache.  The global file cache is shared by both data files
+and the file pages of executing programs, and will grow until all physical
+memory is in use.
+
+The advantage of the virtual memory file system (VMFS) is that it makes
+maximal use of system memory for caching file data.  If a relatively static
+set of data is repeatedly accessed it will remain in the system file cache,
+speeding access and minimizing i/o and page faulting.  The disadvantage
+is the same thing: VMFS makes maximal use of system memory for caching
+file data.  Programs which do heavy file i/o, reading a large amount of
+data, fault in a great deal of file data pages which may only be accessed
+once.  Once the free list is exhausted the system page daemon runs to
+reclaim old file pages for reuse.  The system pages heavily and becomes
+inefficient.
+
+The goal of the file caching scheme presented here is to continue to cache
+file data in the global system file cache, but control how data is cached to
+minimize use of the pageout daemon which runs when memory is exhausted.  This
+scheme makes use of the ** existing operating system kernel facilities **
+to cache the file data and use the cached data for general file access.
+The trick is to try to control how data is loaded into the cache, and when
+it is removed from the cache, so that cache space is reused efficiently
+without invoking the system pageout daemon.  Since data is cached by the
+system the cache benefits all programs which access the cached file data,
+without requiring that the programs explicitly use any cache facilities
+such as a custom library.
+
+
+HOW IT WORKS
+
+
+INTERFACE
+
+
+	      vm = vm_initcache (initstr)
+		  vm_closecache (vm)
+
+		   vm_cachefile (vm, fname, flags)
+		     vm_cachefd (vm, fd, flags)
+		 vm_uncachefile (vm, fname)
+		   vm_uncachefd (vm, fd)
+
+		 vm_cacheregion (vm, fd, offset, nbytes, flags)
+	       vm_uncacheregion (vm, fd, offset, nbytes)
+		vm_reservespace (vm, nbytes)
+		        vm_sync (vm, fd)
+
+
+vm_cacheregion (vm, fd, offset, nbytes, flags)
+
+    check whether the indicated region is mapped (vm descriptor)
+    if not, free space from the tail of the cache; map new region
+    request that mapped region be faulted into memory (madvise)
+    move referenced file to head of cache
+
+    redundant requests are harmless, but will reload any missing pages,
+    and cause the file to again be moved to the head of the cache list
+
+    may need to scan the cache periodically to make adjustments for
+    files that have changed in size, or been deleted, while still in
+    the cache
+
+    cached regions may optionally be locked into memory until freed
+
+    the cache controller may function either as a library within a process,
+    or as a cache controller server process shared by multiple processes
+
+
+vm_uncacheregion (vm, fd, offset, nbytes)
+
+    check whether the indicated region is mapped
+    if so, unmap the pages
+    if no more pages remain mapped, remove file from cache list
+
+
+vm_reservespace (vm, nbytes)
+
+    unmap file segments from tail of list until the requested space
+    (plus some extra space) is available for reuse
+
+
+data structures
+
+    caching mechanism is file-oriented
+    linked list of mapped regions (each from a file)
+	for each region keep track of file descriptor, offset, size
+    linked list of file descriptors
+	for each file keep track of file size, mtime,
+	type of mapping (full,region) and so on
+
+    some dynamic things such as the size of a file or wether pages are memory
+    resident can only be determined by querying the system at runtime
+
+
+
+Solaris VM Interface
+
+	     madvise (addr, len, advice)
+		mmap (addr, len, prot, flags, fildes, off)
+	      munmap (addr, len)
+	       mlock (addr, len)
+	     munlock (addr, len)
+	     memcntl (addr, len, cmd, arg, attr, mask)
+	        mctl (addr, len, function, arg)
+	     mincore (addr, len, *vec)
+	       msync (addr, len, flags)
+
+    Notes
+	Madvise can be used to request that a range of pages be faulted
+	into memory (WILL_NEED), or freed from memory (DONT_NEED)
+
+	Mctl can be used to invalidate page mappings in a region
+
+	Mincore can be used to determine if pages in a given address range
+	are resident in memory
+
+
+
+VMCACHED -- December 2001
+------------------------------
+
+Added VMcache daemon and IRAF interface to same
+Design notes follow
+
+
+Various Cache Control Algorithms
+
+    1.	No Cache
+
+	No VMcache daemon.  Clients use their builtin default i/o mechanism,
+	e.g., either normal or direct i/o depending upon the file size.
+
+    2.	Manually or externally controlled cache
+
+	Files are cached only when directed.  Clients connect to the cache
+	daemon to see if files are in the cache and if so use normal VM i/o
+	to access data in the cache.  If the file is not cached the client
+	uses its default i/o mechanism, e.g., direct i/o.
+
+    3.	LRU Cache
+
+	A client file access causes the accessed file to be cached.  Normal
+	VM i/o is used for file i/o.  As new files are cached the space
+	used by the least recently used files is reclaimed.  Accessing a
+	file moves it to the head of the cache, if it is still in the cache.
+	Otherwise it is reloaded.
+
+    4.	Adaptive Priority Cache
+
+	This is like the LRU cache, but the cache keeps statistics on files
+	whether or not they have aged out of the cache, and raises the 
+	cache priority or lifetime of files that are more frequently
+	accessed.  Files that are only accessed once tend to pass quickly
+	through the cache, or may not even be cached until the second
+	access.  Files that are repeatedly accessed have a higher priority
+	and will tend to stay in the cache.
+
+The caching mechanism and algorithm used are independent of the client
+programs, hence can be easily tuned or replaced with a different algorithm.
+
+Factors determining if a file is cached:
+
+	user-assigned priority (0=nocache; 1-N=cache priority)
+	number of references
+	time since last access (degrades nref)
+	amount of available memory (cutoff point)
+
+Cache priority
+
+	priority = userpri * max(0,
+	    (nref-refbase - ((time - last_access) / tock)) )
+
+Tunable parameters
+
+	userpri		User defined file priority.  Files with a higher
+			priority stay in the cache longer.  A zero priority
+			prevents a file from being cached.
+
+	refbase         The number of file references has to exceed refbase
+			before the file will be cached.  For example, if
+			refbase=0 the file will be cacheable on the first
+			reference.  If refbase=1 a file will only become
+			cacheable if accessed two or more times.  Refbase
+			can be used to exclude files from the cache that
+			are only referenced once and hence are not worth
+			caching.
+
+	tock            While the number of accesses increases the cache
+			priority of a file, the time interval since the
+			last access likewise decreases the cache priority
+			of the file.  A time interval of "tock" seconds
+			will cancel out one file reference.  In effect,
+			tock=N means that a file reference increases the
+			cache priority of a file for N seconds.  A
+			frequently referenced file will be relatively
+			unaffected by tock, but tock will cause
+			infrequently referenced files to age out of the
+			cache within a few tocks.
+
+Cache Management
+
+    Manual cache control
+
+	Explicitly caching or refreshing a file always maps the file into
+	memory and moves it to the head of the cache.
+
+    File access
+
+	Accessing a file (vm_accessfile) allows cache optimization to
+	occur.  The file nref and access time are updated and the priority
+	of the current file and all files (to a certain depth in the cache
+	list) are recomputed.  If a whole-file level access is being
+	performed the file size is examined to see if it has changed and
+	if the file has gotten larger a new segment is created.  The
+	segment descriptor is then unlinked and relinked in the cache in
+	cache priority order.  If the segment is above the VM cutoff it
+	is loaded into the cache: lower priority segments are freed as
+	necessary, and if the file is an existing file it is marked
+	WILL_NEED to queue the file data to be read into memory.
+
+	If the file is a new file it must already have been created
+	externally to be managed under VMcache.  The file size at access
+	time will determine the size of the file entry in the cache.  Some
+	systems (BSD, Sun) allow a mmap to extend beyond the end of a
+	file, but others (Linux) do not.  To reserve space for a large
+	file where the ultimate size of the file is known in advance, one
+	can write a byte where the last byte of the file will be (as with
+	zfaloc in IRAF) before caching the file, and the entire memory
+	space will be reserved in advance.  If a file is cached and later
+	extended, re-accessing the file will automatically cache the new
+	segment of the file (see above).
+
+    Data structures
+
+	Segment descriptors
+	List of segments linked in memory allocation order
+	    first N segments are cached (whatever will fit)
+	    remainder are maintained in list, but are not cached
+	    manually cached/refreshed segments go to head of list
+	    accessed files are inserted in list based on priority
+	List of segments belonging to the same file
+	    a file can be stored in the cache in multiple segments
+
+	File hash table
+	    provides fast lookup of an individual file
+	    hash dev+ino to segment
+	    segment points to next segment if collision occurs
+	    only initial/root file segment is indexed
+
+    Cache management
+
+	Relinking of the main list occurs only in certain circumstances
+	    when a segment is manually cached/uncached/refreshed
+		referenced segment moves to head of list
+		new segment is always cached
+	    when a file or segment is accessed
+		priority of each element is computed and segment is
+		placed in priority order (only referenced segment is moved)
+		caching/uncaching may occur due to new VM cutoff
+	    when a new segment is added
+	    when an old segment is deleted
+	Residency in memory is determined by link order
+	    priority normally determines memory residency
+	    but manual caching will override (for a time)
+
+
+File Driver Issues
+
+    Image kernels
+
+	Currently only OIF uses the SF driver.  FXF, STF, and QPF (FMIO)
+	all use the BF driver.  Some or all could be changed to use SF
+	if it is made compatible with BF, otherwrise the VM hooks need
+	to go into the BF driver.  Since potentially any large file can
+	be cached, putting the VM support into BF is a reasonable option.
+
+	The FITS kernel is a problem currently as it violates device
+	block size restrictions, using a block size of 2880.
+
+	It is always a good idea to use falloc to pre-allocate storage for
+	a large imagefile when the size is known in advance.  This permits
+	the VM system to reserve VM space for a new image before data is
+	written to the file.
+
+    Direct I/O
+
+	Direct i/o is possible only if transfers are aligned on device
+	blocks and are an integral number of blocks in length.
+
+	Direct i/o flushes any VM buffered data for the file.  If a file
+	is mapped into memory this is not possible, hence direct i/o is
+	disabled for a file while it is mapped into memory.
+
+	This decision is made at read/write time, hence cannot be
+	determined reliably when a file is opened.
+
+    FITS Kernel
+
+	Until the block size issues can be addressed, direct i/o cannot
+	be used for FITS images.  Some VM cache control is still possible
+	however.  Options include:
+
+	o   Always cache a .fits image: either set vmcached to cache a file
+	    on the first access, or adjust the cache parameters based on
+	    the file type.  Use a higher priority for explicitly cached
+	    files (e.g. Mosaic readouts), so that running a sequence of
+	    normal i/o images through the cache does not flush the high
+	    priority images.
+
+	o   Writing to new files which have not been pre-allocated is
+	    problematic as a large amount of data can be written, causing
+	    paging.  One way to deal with this is to use large transfers
+	    (IMIO will already do this), and to issue a reservespace
+	    directive on each file write at EOF, to free up VM space as
+	    needed.  The next access directive would cause the new
+	    portion of the image to be mapped into the cache.
+
+	    A possible problem with this is that the new file may initially
+	    be too small to reach the cache threshold.  Space could be
+	    reserved in any case, waiting for the next access to cache
+	    the file; the cache daemon could always cache new files of a
+	    certain type; or the file could be cached when it reaches the
+	    cache threshold.
+
+    Kernel File Driver
+
+	A environment variable will be used in the OS driver to define a
+	cache threshold or to disable use of VMcache entirely.  We need
+	to be able to specify these two things separately.  If a cache
+	threshold is set, files smaller than this size will not result in
+	a query to the cache daemon.  If there is no cache threshold but
+	VMcache is enabled, the cache daemon will decide whether the file
+	is too small to be cached.  It should also be possible to force
+	the use of direct i/o if the file is larger than a certain size.
+
+	Kernel file driver parameters:
+
+	    enable	boolean
+
+	    vmcache	Use vmcache only if the file size equals or exceeds
+			the specified threshold.
+
+	    directio    If the file size equals or exceeds the specified
+			threshold use direct i/o to access the file.  If
+			direct i/o is enabled in this fashion then vmcache
+			is not used (otherwise vmcache decides whether to
+			use direct i/o for a file).
+
+	    port	Socket number to be used.
+
+	    VMPORT=8797
+	    VMCLIENT=enable,threshold=10m,directio=10m
+
diff --git a/unix/boot/vmcached/vmcache.c b/unix/boot/vmcached/vmcache.c
new file mode 100644
index 00000000..a072951f
--- /dev/null
+++ b/unix/boot/vmcached/vmcache.c
@@ -0,0 +1,1566 @@
+#include <stdio.h>
+#include <unistd.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <sys/mman.h>
+#include <ctype.h>
+#include <fcntl.h>
+#include "vmcache.h"
+
+#ifdef sun
+#ifndef MS_SYNC
+#define MS_SYNC 0  /* SunOS */
+#else
+#include <sys/systeminfo.h>
+#endif
+#endif
+
+/*
+ * Virtual Memory Cache Controller
+ *
+ * The VM cache controller manages a region of physical memory in the host
+ * computer.  Entire files or file segments are loaded into the cache (into
+ * memory).  Space to store such files is made available by the cache
+ * controller by freeing the least recently used file segments.  This explicit
+ * freeing of space immediately before it is reused for new data prevents
+ * (in most cases) the kernel reclaim page daemon from running, causing cached
+ * data to remain in memory until freed, and preventing the flow of data
+ * through the cache from causing the system to page heavily and steal pages
+ * away from the region of memory outside the cache.
+ *
+ *	      vm = vm_initcache (vm|NULL, initstr)
+ *		      vm_status (vm, outbuf, maxch, flags)
+ *		  vm_closecache (vm)
+ *
+ *		      vm_access (vm, fname, mode, flags)
+ *		    vm_statfile (vm, fname, flags)
+ * 	         vm_setpriority (vm, fname, priority)
+ *		   vm_cachefile (vm, fname, flags)
+ *		 vm_uncachefile (vm, fname, flags)
+ *		 vm_refreshfile (vm, fname, flags)
+ *		     vm_cachefd (vm, fd, acmode, flags)
+ *		   vm_uncachefd (vm, fd, flags)
+ *		   vm_refreshfd (vm, fd, flags)
+ *
+ *		vm_reservespace (vm, nbytes)
+ * 	  addr = vm_cacheregion (vm, fname, fd, offset, nbytes, acmode, flags)
+ *	       vm_uncacheregion (vm, fd, offset, nbytes, flags)
+ * 	       vm_refreshregion (vm, fd, offset, nbytes)
+ *
+ *		        vm_sync (vm, fd, offset, nbytes, flags)
+ *		       vm_msync (vm, addr, nbytes, flags)
+ *
+ * Before the VM cache is used it should be initialized with vm_initcache.
+ * The string "initstr" may be used to set the size of the cache, enable
+ * or disable it (e.g. for performance tests), and set other options.
+ * A summary of the VMcache configuration and contents can be generated
+ * with vm_status.
+ *
+ * Files or file segments are loaded into the cache with routines such as
+ * vm_cachefile and vm_cacheregion.  Normally, cached files or file segments
+ * are reused on a least-recently-used basis.  A file can be locked in the
+ * cache by setting the VM_LOCKFILE flag when the file is cached.  This is
+ * automatic for vm_cacheregion since the address at which the file is
+ * mapped is returned to the caller and hence the file is assumed to be in
+ * use.  When a file or region which is locked in the cache is no longer
+ * needed one of the "uncache" routines should be called to make the space
+ * used by the cached file data available for reuse.  Note that "uncaching"
+ * a file or file segment does not immediately remove the data from the
+ * cache.  Any "uncached" data normally remains in the cache until the
+ * space it uses is needed to load other data.
+ *
+ * VMcache is a library which is compiled into a process.  This can be
+ * incorportated into a server process to manage the VM cache for a
+ * group of cooperating processes running on the same computer.  The
+ * vmcached program (VMcache daemon) is one such program.
+ */
+
+
+#define	DEF_CACHESIZE	"50%"
+#define	DEF_PHYSPAGES	32768
+#define READAHEAD	32768
+#define	DEF_PRIORITY	1
+#define	DEF_REFBASE	1
+#define	DEF_TOCK	600
+#define	SZ_HASHTBL	16384
+#define	SZ_NAME		64
+#define	SZ_VALSTR	64
+#define SZ_PATHNAME	1024
+#define	SZ_LINE		4096
+
+/* Solaris and FreeBSD have a madvise() system call. */
+#define HAVE_MADVISE	1
+
+/* Linux provides a madvise call, but it is not implemented and produces
+ * a linker warning message.  The madvise call will always fail, but this
+ * is harmless (it just means that the cache fails to control paging and
+ * everything operates "normally".
+ */
+#ifdef linux
+#undef  HAVE_MADVISE
+#define MADV_WILLNEED   3               /* will need these pages */
+#define MADV_DONTNEED   4               /* don't need these page */
+#endif
+
+#define	isfile(sp,st)	(sp->device == st.st_dev && sp->inode == st.st_ino)
+
+
+/* Segment descriptor. */
+struct segment {
+	struct segment *next;
+	struct segment *prev;
+	struct segment *nexthash;
+	int priority;
+	int userpri;
+	int refcnt;
+	int nrefs;
+	time_t atime;
+	time_t ptime;
+	void *addr;
+	int fd;
+	int acmode;
+	unsigned long inode;
+	unsigned long device;
+	unsigned long offset;
+	unsigned long nbytes;
+	char *fname;
+}; typedef struct segment Segment;
+
+/* Main VMcache descriptor. */
+struct vmcache {
+	Segment *segment_head, *last_mapped, *segment_tail;
+	int cache_initialized;
+	int cache_enabled;
+	int cachelen;
+	unsigned long cacheused;
+	unsigned long cachesize;
+	unsigned long physmem;
+	int lockpages;
+	int pagesize;
+	int defuserpri;
+	int refbase;
+	int tock;
+}; typedef struct vmcache VMcache;
+
+static debug = 0;
+static VMcache vmcache;
+static Segment *hashtbl[SZ_HASHTBL];
+
+static int primes[] = {
+	101,103,107,109,113,127,131,137,139,
+	149,151,157,163,167,173,179,181,191,
+};
+
+static vm_readahead();
+static vm_uncache();
+static Segment *vm_locate();
+static int vm_cachepriority();
+static int hashint();
+
+
+/* VM_INITCACHE -- Initialize the VM cache.  A pointer to the cache 
+ * descriptor is returned as the function value, or NULL if the cache cannot
+ * be initialized.  The argument VM may point to an existing cache which
+ * is to be reinitialized, or may be NULL if the cache is being initialized
+ * for the first time.
+ *
+ * The INITSTR argument is used to control all init-time cache options.
+ * INITSTR is a sequence of keyword=value substrings.  The recognized options
+ * are as follows:
+ *
+ *	cachesize	total cache size
+ *	lockpages	lock pages in memory
+ *	enable		enable the cache
+ *	debug		turn on debug messages
+ *	defpri		default file priority
+ *	refbase		number of file references before file is cached
+ *	tock		interval (seconds) at which file references degrade
+ *	
+ * Other options may be added in the future.
+ *
+ * Keywords which take a size type value (e.g. cachesize) permit values
+ * such as "x" (size in bytes), "x%" (X percent of physical memory), "xK"
+ * (X kilobytes), or "xM" (X megabytes).  The "x%" notation may not work
+ * correctly on all systems as it is not always easy to determine the total
+ * physical memory.
+ *
+ * If the cache is initialized with "enable=no" then all the cache routines
+ * will still be called, the cache controller will be disabled.
+ */
+void *
+vm_initcache (vm, initstr)
+register VMcache *vm;
+char *initstr;
+{
+	register char *ip, *op;
+	char keyword[SZ_NAME], valstr[SZ_NAME];
+	char cachesize[SZ_VALSTR], *modchar;
+	int percent, enable = 1, lockpages = 0;
+	int defuserpri, refbase, tock;
+	unsigned long physpages;
+
+	if (debug)
+	    fprintf (stderr, "vm_initcache (0x%x, \"%s\")\n", vm, initstr);
+
+	strcpy (cachesize, DEF_CACHESIZE);
+	defuserpri = DEF_PRIORITY;
+	refbase = DEF_REFBASE;
+	tock = DEF_TOCK;
+
+	/* Scan the initialization string.  Initstr may be NULL or the empty
+	 * string, if only the defaults are desired.
+	 */
+	for (ip=initstr;  ip && *ip;  ) {
+	    /* Advance to the next keyword=value pair. */
+	    while (*ip && (isspace(*ip) || *ip == ','))
+		ip++;
+
+	    /* Extract the keyword. */
+	    for (op=keyword;  *ip && isalnum(*ip);  )
+		*op++ = *ip++;
+	    *op = '\0';
+
+	    while (*ip && (isspace(*ip) || *ip == '='))
+		ip++;
+
+	    /* Extract the value string. */
+	    for (op=valstr;  *ip && (isalnum(*ip) || *ip == '%');  )
+		*op++ = *ip++;
+	    *op = '\0';
+
+	    if (strcmp (keyword, "cachesize") == 0) {
+		strcpy (cachesize, valstr);
+	    } else if (strcmp (keyword, "defpri") == 0) {
+		defuserpri = atoi (valstr);
+	    } else if (strcmp (keyword, "refbase") == 0) {
+		refbase = atoi (valstr);
+	    } else if (strcmp (keyword, "tock") == 0) {
+		tock = atoi (valstr);
+	    } else if (strcmp (keyword, "lockpages") == 0) {
+		int ch = valstr[0];
+		lockpages = (ch == 'y' || ch == 'Y');
+	    } else if (strcmp (keyword, "enable") == 0) {
+		int ch = valstr[0];
+		enable = (ch == 'y' || ch == 'Y');
+	    } else if (strcmp (keyword, "debug") == 0) {
+		int ch = valstr[0];
+		debug = (ch == 'y' || ch == 'Y');
+	    }
+	}
+
+	/* The VM cache needs to be global for a given host, so we just
+	 * use a statically allocated cache descriptor here.  In the most
+	 * general case the whole VMcache interface needs to be split into
+	 * a client-server configuration, with the cache server managing
+	 * virtual memory for a collection of processes.
+	 */
+	if (!vm)
+	    vm = &vmcache;
+
+	/* Shut down the old cache if already enabled. */
+	vm_closecache (vm);
+
+	/* There is no good way to guess the total physical memory if this
+	 * is not available from the system.  But in such a case the user
+	 * can just set the value of the cachesize explicitly in the initstr.
+	 */
+#ifdef _SC_PHYS_PAGES
+	physpages = sysconf (_SC_PHYS_PAGES);
+	if (debug) {
+	    fprintf (stderr, "total physical memory %d (%dm)\n",
+		physpages * getpagesize(),
+		physpages * getpagesize() / (1024 * 1024));
+	}
+#else
+	physpages = DEF_PHYSPAGES;
+#endif
+
+	vm->cachelen = 0;
+	vm->cacheused = 0;
+	vm->cache_enabled = enable;
+	vm->cache_initialized = 1;
+	vm->segment_head = NULL;
+	vm->segment_tail = NULL;
+	vm->pagesize = getpagesize();
+	vm->physmem = physpages * vm->pagesize;
+	vm->lockpages = lockpages;
+	vm->defuserpri = defuserpri;
+	vm->refbase = refbase;
+	vm->tock = tock;
+
+	vm->cachesize = percent = strtol (cachesize, &modchar, 10);
+	if (modchar == cachesize)
+	    vm->cachesize = physpages / 2 * vm->pagesize;
+	else if (*modchar == '%')
+	    vm->cachesize = physpages * percent / 100 * vm->pagesize;
+	else if (*modchar == 'k' || *modchar == 'K')
+	    vm->cachesize *= 1024;
+	else if (*modchar == 'm' || *modchar == 'M')
+	    vm->cachesize *= (1024 * 1024);
+	else if (*modchar == 'g' || *modchar == 'G')
+	    vm->cachesize *= (1024 * 1024 * 1024);
+
+	return ((void *)vm);
+}
+
+
+/* VM_CLOSECACHE -- Forcibly shutdown a cache if it is already open.
+ * All segments are freed and returned to the system.  An attempt is made
+ * to close any open files (this is the only case where the VM cache code
+ * closes files opened by the caller).
+ */
+vm_closecache (vm)
+register VMcache *vm;
+{
+	register Segment *sp;
+	struct stat st;
+
+	if (debug)
+	    fprintf (stderr, "vm_closecache (0x%x)\n", vm);
+	if (!vm->cache_initialized)
+	    return;
+
+	/* Free successive segments at the head of the cache list until the
+	 * list is empty.
+	 */
+	while (sp = vm->segment_head) {
+	    vm_uncache (vm, sp, VM_DESTROYREGION | VM_CANCELREFCNT);
+
+	    /* Since we are closing the cache attempt to forcibly close the
+	     * associated file descriptor if it refers to an open file.
+	     * Make sure that FD refers to the correct file.
+	     */
+	    if (fstat (sp->fd, &st) == 0)
+		if (isfile(sp,st))
+		    close (sp->fd);
+	}
+
+	vm->cache_initialized = 0;
+}
+
+
+/* VM_ACCESS -- Access the named file and determine if it is in the cache.
+ * Accessing a file via vm_access may cause the file to be loaded into the
+ * cache, depending upon the cache tuning parameters and per-file statistics
+ * such as the number of past references to the file and how recently they
+ * occurred.  A return value of -1 indicates that the named file does not
+ * exist or could not be physically accessed.  A value of zero indicates
+ * that the file is not cached (is not being managed by the cache).  A value
+ * of 1 indicates that the file is being managed by the cache.  Accessing
+ * a file updates the reference count and time of last access of the file.
+ * and increases the probability that it will be cached in memory.
+ *
+ * Applications which use VMcache should call vm_access whenever a file is
+ * opened or otherwise accessed so that VMcache can keep statistics on file
+ * accesses and optimize use of the cache.  If vm_access returns 1 the client
+ * should use normal i/o to access the file (normal VM-based file i/o or 
+ * mmap).  If vm_access returns 0 VMcache has determined that the file is
+ * not worth caching in memory, and some form of direct i/o (bypassing
+ * system virtual memory) should be used to access the file.
+ *
+ * The file must exist at the time that vm_access is called.  If the file
+ * already exists and has changed size (e.g., data was appended to the file
+ * since the last access) then vm_access will add or remove VM segments to
+ * adjust to the new size of the file.  If a new file is being created and
+ * it is desired to reserve VM space for the file, two approaches are
+ * possible: 1) use seek,write to write a byte where the EOF of the new
+ * file will be when all data has been written, so that vm_access will 
+ * reserve space for the new file pages; 2) access the short or zero-length
+ * file, explicitly reserve unallocated VM space with vm_reservespace,
+ * and rely upon vm_access to adjust to the new file size the next time
+ * the file is accessed.  Option 1) is the best technique for reserving VM
+ * space for large new files which may subsequently be shared by other
+ * applications.
+ */
+vm_access (vm, fname, mode, flags)
+register VMcache *vm;
+char *fname, *mode;
+int flags;
+{
+	register Segment *sp, *xp;
+	Segment *first=NULL, *last=NULL;
+	unsigned long offset, x0, x1, vm_offset, vm_nbytes;
+	int spaceused, map, n, status=0, fd;
+	struct stat st;
+
+	if (debug)
+	    fprintf (stderr, "vm_access (0x%x, \"%s\", 0%o)\n",
+		vm, fname, flags);
+	if (!vm->cache_enabled)
+	    return (0);
+
+	if ((fd = open (fname, O_RDONLY)) < 0)
+	    return (-1);
+	if (fstat (fd, &st) < 0) {
+abort:	    close (fd);
+	    return (-1);
+	}
+
+	/* Align offset,nbytes to map the full file. */
+	x0 = offset = 0;
+	x0 = (x0 - (x0 % vm->pagesize));
+	x1 = offset + st.st_size - 1;
+	x1 = (x1 - (x1 % vm->pagesize)) + vm->pagesize - 1;
+	vm_offset = x0;
+	vm_nbytes = x1 - x0 + 1;
+
+again:
+	/* See if the file is already in the cache list. */
+	first = last = vm_locate (vm, st.st_ino, st.st_dev);
+	for (sp = first;  sp;  sp = sp->nexthash)
+	    if (isfile(sp,st))
+		last = sp;
+
+	/* If the file is already in the cache check whether it has changed
+	 * size and adjust the segment descriptors until they agree with the
+	 * current file size before we proceed further.
+	 */
+	if (last) {
+	    if (vm_nbytes < (last->offset + last->nbytes)) {
+		/* If the file has gotten smaller uncache the last segment
+		 * and start over.  Repeat until the last segment includes EOF.
+		 */
+		vm_uncache (vm, last, VM_DESTROYREGION|VM_CANCELREFCNT);
+		goto again;
+
+	    } else if (vm_nbytes > (last->offset + last->nbytes)) {
+		/* If the file has gotten larger cache the new data as a new
+		 * file segment.
+		 */
+		unsigned long offset, nbytes;
+		void *addr;
+
+		offset = last->offset + last->nbytes;
+		nbytes = vm_nbytes - offset;
+		addr = vm_cacheregion (vm, fname, fd,
+		    offset, nbytes, last->acmode, VM_DONTMAP);
+		if (!addr)
+		    goto abort;
+		goto again;
+	    }
+	    /* else fall through */
+	} else {
+	    /* File is not currently in the cache.  Create a new segment
+	     * encompassing the entire file, but don't map it in yet.
+	     */
+	    void *addr;
+	    addr = vm_cacheregion (vm, fname, fd,
+		vm_offset, vm_nbytes, VM_READONLY, VM_DONTMAP);
+	    if (!addr)
+		goto abort;
+	    goto again;
+	}
+
+	/*
+	 * If we get here we have one or more file segments in the cache.
+	 * The segments may or may not be mapped and they can be anywhere
+	 * in the cache list.  We need to compute the new priority for the
+	 * file, relocate the segments in the cache, determine whether or
+	 * not the file will be mapped, and adjust the contents of the 
+	 * cache accordingly.
+	 */
+
+	/* Update the priority of the current file and give all cached file
+	 * segments the same reference attributes, since we treating the
+	 * entire file as a whole here.
+	 */
+	first = vm_locate (vm, st.st_ino, st.st_dev);
+	first->nrefs++;
+	first->atime = time(0);
+	first->priority = vm_cachepriority (vm, first);
+
+	for (sp = first;  sp;  sp = sp->nexthash)
+	    if (isfile(sp,st)) {
+		sp->nrefs = first->nrefs;
+		sp->atime = first->atime;
+		sp->priority = first->priority;
+	    }
+
+	/* Recompute the priorities of all other segments in the head or
+	 * "active" area of the cache list.
+	 */
+	for (sp = vm->segment_head, n=0;  sp;  sp = sp->next, n++) {
+	    if (!isfile(sp,st))
+		sp->priority = vm_cachepriority (vm, sp);
+	    if (sp == vm->last_mapped)
+		break;
+	}
+	for (sp = vm->last_mapped->next;  --n >= 0 && sp;  sp = sp->next)
+	    if (!isfile(sp,st))
+		sp->priority = vm_cachepriority (vm, sp);
+
+	/* Scan the cache list and determine where in priority order to place
+	 * the accessed segment.  Since manually cached segments are always
+	 * placed at the head of the list there is no guarantee that the cache
+	 * list will be in strict priority order, but this doesn't matter.
+	 */
+	for (xp = vm->segment_head;  xp;  xp = xp->next)
+	    if (first->priority >= xp->priority)
+		break;
+
+	/* Relink each segment of the accessed file in just before the lower
+	 * priority segment pointed to by XP.  This collects all the file
+	 * segments in allocation order within the list.
+	 */
+	for (sp=first;  sp;  sp = sp->nexthash)
+	    if (isfile(sp,st)) {
+		/* Unlink segment SP. */
+		if (sp->next)
+		    sp->next->prev = sp->prev;
+		else
+		    vm->segment_tail = sp->prev;
+
+		if (sp->prev)
+		    sp->prev->next = sp->next;
+		else
+		    vm->segment_head = sp->next;
+
+		/* Link segment SP in just before XP. */
+		sp->next = xp;
+		if (xp) {
+		    sp->prev = xp->prev;
+		    sp->prev->next = sp;
+		} else {
+		    /* XP is NULL; SP will be the new segment_tail. */
+		    sp->prev = vm->segment_tail;
+		    vm->segment_tail = sp;
+		}
+
+		/* If XP is at the list head SP replaces it at the head. */
+		if (vm->segment_head == xp)
+		    vm->segment_head = sp;
+	    }
+
+	/* Scan the new cache list to see if the accessed file is in the
+	 * allocated portion of the list.
+	 */
+	for (sp = vm->segment_head, spaceused=map=0;  sp;  sp = sp->next) {
+	    if (sp == first) {
+		map = (spaceused + vm_nbytes <= vm->cachesize);
+		break;
+	    } else if (sp->addr && !isfile(sp,st)) {
+		spaceused += sp->nbytes;
+		if (spaceused >= vm->cachesize)
+		    break;
+	    }
+	}
+
+	/* Map the file if it lies above the cutoff point. */
+	if (map) {
+	    /* Free sufficient memory pages for the new region.  If space
+	     * is already allocated to this file don't free it unnecessarily.
+	     */
+	    for (sp = first, n=vm_nbytes;  sp;  sp = sp->nexthash)
+		if (isfile(sp,st) && sp->addr)
+		    n -= sp->nbytes;
+
+	    if (n > 0)
+		vm_reservespace (vm, n);
+
+	    /* Map the accessed file segments. */
+	    for (sp = first, n=vm_nbytes;  sp;  sp = sp->nexthash) {
+		if (!isfile(sp,st))
+		    continue;
+
+		if (!sp->addr) {
+		    void *addr;
+
+		    addr = mmap (NULL, (size_t)sp->nbytes,
+			sp->acmode, MAP_SHARED, fd, (off_t)sp->offset);
+		    if (!addr) {
+			map = 0;
+			break;
+		    }
+
+		    /* Lock segment in memory if indicated. */
+		    if (vm->lockpages && vm->cache_enabled)
+			mlock (addr, (size_t) sp->nbytes);
+
+		    vm->cacheused += sp->nbytes;
+		    sp->addr = addr;
+		}
+
+		/* Preload the accessed file segment. */
+		vm_readahead (vm, sp->addr, sp->nbytes);
+	    }
+
+	    status = 1;
+	}
+
+	close (fd);
+	return (status);
+}
+
+
+/* VM_STATFILE -- Determine if the named file is in the cache.  A return
+ * value of -1 indicates that the named file does not exist or could not
+ * be accessed.  A value of zero indicates that the file is not cached.
+ * A value of 1 or more indicates the number of file segments in the cache.
+ */
+vm_statfile (vm, fname)
+register VMcache *vm;
+char *fname;
+{
+	register Segment *sp;
+	struct stat st;
+	int status=0;
+
+	if (debug)
+	    fprintf (stderr, "vm_statfile (0x%x, \"%s\")\n", vm, fname);
+	if (!vm->cache_enabled)
+	    return (0);
+
+	if (stat (fname, &st) < 0)
+	    return (-1);
+
+	for (sp = vm_locate(vm,st.st_ino,st.st_dev);  sp;  sp = sp->nexthash)
+	    if (isfile(sp,st))
+		status++;
+
+	return (status);
+}
+
+
+/* VM_SETPRIORITY -- Set the user-defined priority of a file already in the
+ * cache list from a prior access or cache call.  If the file priority is
+ * zero it will never be cached in memory.  A priority of 1 is neutral;
+ * higher values increase the cache priority of the file.
+ */
+vm_setpriority (vm, fname, priority)
+register VMcache *vm;
+char *fname;
+int priority;
+{
+	register Segment *sp;
+	struct stat st;
+	int status=0;
+
+	if (priority < 0)
+	    priority = 0;
+
+	if (debug)
+	    fprintf (stderr, "vm_setpriority (0x%x, \"%s\", %d)\n",
+		vm, fname, priority);
+	if (!vm->cache_enabled)
+	    return (0);
+
+	if (stat (fname, &st) < 0)
+	    return (-1);
+
+	for (sp = vm_locate(vm,st.st_ino,st.st_dev);  sp;  sp = sp->nexthash)
+	    if (isfile(sp,st))
+		sp->userpri = priority;
+
+	return (status);
+}
+
+
+/* VM_CACHEFILE -- Cache an entire named file in the VM cache.
+ */
+vm_cachefile (vm, fname, flags)
+register VMcache *vm;
+char *fname;
+int flags;
+{
+	struct stat st;
+	int fd;
+
+	if (debug)
+	    fprintf (stderr, "vm_cachefile (0x%x, \"%s\", 0%o)\n",
+		vm, fname, flags);
+	if (!vm->cache_enabled)
+	    return (0);
+
+	if ((fd = open (fname, O_RDONLY)) < 0)
+	    return (-1);
+	if (fstat (fd, &st) < 0)
+	    return (-1);
+
+	if (!vm_cacheregion (vm, fname, fd, 0L, st.st_size, VM_READONLY, 0)) {
+	    close (fd);
+	    return (-1);
+	}
+
+	close (fd);
+	if (!(flags & VM_LOCKFILE))
+	    vm_uncachefile (vm, fname, 0);
+
+	return (0);
+}
+
+
+/* VM_CACHEFD -- Cache an already open file in the VM cache.
+ */
+vm_cachefd (vm, fd, acmode, flags)
+register VMcache *vm;
+int acmode;
+int flags;
+{
+	struct stat st;
+
+	if (debug)
+	    fprintf (stderr, "vm_cachefd (0x%x, %d, 0%o, 0%o)\n",
+		vm, fd, acmode, flags);
+	if (!vm->cache_enabled)
+	    return (0);
+
+	if (fstat (fd, &st) < 0)
+	    return (-1);
+
+	if (!vm_cacheregion (vm, NULL, fd, 0L, st.st_size, acmode, flags))
+	    return (-1);
+
+	if (!(flags & VM_LOCKFILE))
+	    vm_uncachefd (vm, fd, 0);
+
+	return (0);
+}
+
+
+/* VM_UNCACHEFILE -- Identify a cached file as ready for reuse.  The file
+ * remains in the cache, but its space is available for reuse on a least
+ * recently used basis.  If it is desired to immediately free the space used
+ * by cached file immediately the VM_DESTROYREGION flag may be set in FLAGS.
+ */
+vm_uncachefile (vm, fname, flags)
+register VMcache *vm;
+char *fname;
+int flags;
+{
+	register Segment *sp;
+	struct stat st;
+	int status = 0;
+
+	if (debug)
+	    fprintf (stderr, "vm_uncachefile (0x%x, \"%s\", 0%o)\n",
+		vm, fname, flags);
+	if (!vm->cache_enabled)
+	    return (0);
+
+	if (stat (fname, &st) < 0)
+	    return (-1);
+
+	for (sp = vm_locate(vm,st.st_ino,st.st_dev);  sp;  sp = sp->nexthash) {
+	    if (!isfile(sp,st))
+		continue;
+	    if (vm_uncache (vm, sp, flags) < 0)
+		status = -1;
+	}
+
+	return (status);
+}
+
+
+/* VM_UNCACHEFD -- Uncache an entire file identified by its file descriptor.
+ * The file remains in the cache, but its space is available for reuse on a
+ * least recently used basis.  If it is desired to immediately free the space
+ * used by cached file immediately the VM_DESTROYREGION flag may be set in
+ * FLAGS.
+ */
+vm_uncachefd (vm, fd, flags)
+register VMcache *vm;
+int fd;
+int flags;
+{
+	register Segment *sp;
+	struct stat st;
+	int status = 0;
+
+	if (debug)
+	    fprintf (stderr, "vm_uncachefd (0x%x, %d, 0%o)\n",
+		vm, fd, flags);
+	if (!vm->cache_enabled)
+	    return (0);
+
+	if (fstat (fd, &st) < 0)
+	    return (-1);
+
+	for (sp = vm_locate(vm,st.st_ino,st.st_dev);  sp;  sp = sp->nexthash) {
+	    if (!isfile(sp,st))
+		continue;
+	    if (vm_uncache (vm, sp, flags) < 0)
+		status = -1;
+	}
+
+	return (status);
+}
+
+
+/* VM_REFRESHFILE -- Refresh an entire named file in the VM cache.
+ * If the file is not in the cache nothing is done and -1 is returned.
+ * If the file is cached it is refreshed, i.e., moved to the head of
+ * the cache, reloading any pages not already present in memory.
+ */
+vm_refreshfile (vm, fname, flags)
+register VMcache *vm;
+char *fname;
+int flags;
+{
+	struct stat st;
+	int fd;
+
+	if (debug)
+	    fprintf (stderr, "vm_refreshfile (0x%x, \"%s\", 0%o)\n",
+		vm, fname, flags);
+	if (!vm->cache_enabled)
+	    return (0);
+
+	if ((fd = open (fname, O_RDONLY)) < 0)
+	    return (-1);
+	if (fstat (fd, &st) < 0)
+	    return (-1);
+
+	if (!vm_refreshregion (vm, fd, 0L, st.st_size)) {
+	    close (fd);
+	    return (-1);
+	}
+
+	close (fd);
+	return (0);
+}
+
+
+/* VM_REFRESHFD -- Refresh an already open file in the VM cache.
+ */
+vm_refreshfd (vm, fd, flags)
+register VMcache *vm;
+int fd;
+int flags;
+{
+	struct stat st;
+
+	if (debug)
+	    fprintf (stderr, "vm_refreshfd (0x%x, %d, 0%o)\n",
+		vm, fd, flags);
+	if (!vm->cache_enabled)
+	    return (0);
+
+	if (fstat (fd, &st) < 0)
+	    return (-1);
+
+	if (!vm_refreshregion (vm, fd, 0L, st.st_size))
+	    return (-1);
+
+	return (0);
+}
+
+
+/* VM_CACHEREGION -- Cache a region or segment of a file.  File segments are
+ * removed from the tail of the LRU cache list until sufficient space is 
+ * available for the new segment.  The new file segment is then mapped and a
+ * request is issued to asynchronously read in the file data.  The virtual
+ * memory address of the cached and mapped region is returned.
+ *
+ * File segments may be redundantly cached in which case the existing
+ * mapping is refreshed and the segment is moved to the head of the cache.
+ * Each cache operation increments the reference count of the region and
+ * a matching uncache is required to eventually return the reference count
+ * to zero allowing the space to be reused.  vm_refreshregion can be called
+ * instead of cacheregion if all that is desired is to refresh the mapping
+ * and move the cached region to the head of the cache.  A single file may
+ * be cached as multiple segments but the segments must be page aligned
+ * and must not overlap.  The virtual memory addresses of independent segments
+ * may not be contiguous in virtual memory even though the corresponding
+ * file regions are.  If a new segment overlaps an existing segment it must
+ * fall within the existing segment as the size of a segment cannot be changed
+ * once it is created.  If a file is expected to grow in size after it is
+ * cached, the size of the cached region must be at least as large as the
+ * expected size of the file.
+ *
+ * vm_cacheregion can (should) be used instead of MMAP to map files into
+ * memory, if the files will be managed by the VM cache controller.  Otherwise
+ * the same file may be mapped twice by the same process, which may use
+ * extra virtual memory.  Only files can be mapped using vm_cacheregion, and
+ * all mappings are for shared data.
+ *
+ * If the cache is disabled vm_cacheregion will still map file segments into
+ * memory, and vm_uncacheregion will unmap them when the reference count goes
+ * to zero (regardless of whether the VM_DESTROYREGION flag is set if the
+ * cache is disabled).
+ *
+ * If write access to a segment is desired the file referenced by FD must
+ * have already been opened with write permission.
+ */
+void *
+vm_cacheregion (vm, fname, fd, offset, nbytes, acmode, flags)
+register VMcache *vm;
+char *fname;
+int fd;
+unsigned long offset;
+unsigned long nbytes;
+int acmode, flags;
+{
+	register Segment *sp, *xp;
+	unsigned long x0, x1, vm_offset, vm_nbytes;
+	struct stat st;
+	int mode;
+	void *addr;
+
+	if (debug)
+	    fprintf (stderr,
+		"vm_cacheregion (0x%x, \"%s\", %d, %d, %d, 0%o, 0%o)\n",
+		vm, fname, fd, offset, nbytes, acmode, flags);
+	if (fstat (fd, &st) < 0)
+	    return (NULL);
+
+	/* Align offset,nbytes to fill the referenced memory pages.
+	 */
+	x0 = offset;
+	x0 = (x0 - (x0 % vm->pagesize));
+
+	x1 = offset + nbytes - 1;
+	x1 = (x1 - (x1 % vm->pagesize)) + vm->pagesize - 1;
+
+	vm_offset = x0;
+	vm_nbytes = x1 - x0 + 1;
+
+	/* Is this a reference to an already cached segment?
+	 */
+	for (sp = vm_locate(vm,st.st_ino,st.st_dev);  sp;  sp = sp->nexthash) {
+	    if (!isfile(sp,st))
+		continue;
+
+	    if (x0 >= sp->offset && x0 < (sp->offset + sp->nbytes))
+		if (x1 >= sp->offset && x1 < (sp->offset + sp->nbytes)) {
+		    /* New segment lies entirely within an existing one. */
+		    vm_offset = sp->offset;
+		    vm_nbytes = sp->nbytes;
+		    goto refresh;
+		} else {
+		    /* New segment extends an existing one. */
+		    return (NULL);
+		}
+	}
+
+	mode = PROT_READ;
+	if (acmode == VM_READWRITE)
+	    mode |= PROT_WRITE;
+
+	if (flags & VM_DONTMAP)
+	    addr = NULL;
+	else {
+	    /* Free sufficient memory pages for the new region.  */
+	    vm_reservespace (vm, vm_nbytes);
+
+	    /* Map the new segment, reusing the VM pages freed above. */
+	    addr = mmap (NULL,
+		(size_t)vm_nbytes, mode, MAP_SHARED, fd, (off_t)vm_offset);
+	    if (!addr)
+		return (NULL);
+
+	    /* Lock segment in memory if indicated. */
+	    if (vm->lockpages && vm->cache_enabled)
+		mlock (addr, (size_t) vm_nbytes);
+
+	    vm->cacheused += vm_nbytes;
+	}
+
+	/* Get a segment descriptor for the new segment. */
+	if (!(sp = (Segment *) calloc (1, sizeof(Segment)))) {
+	    if (addr)
+		munmap (addr, vm_nbytes);
+	    return (NULL);
+	}
+
+	vm->cachelen++;
+	sp->fd = fd;
+	sp->acmode = acmode;
+	sp->inode = st.st_ino;
+	sp->device = st.st_dev;
+	sp->offset = vm_offset;
+	sp->nbytes = vm_nbytes;
+	sp->addr = addr;
+	sp->ptime = time(0);
+	sp->userpri = vm->defuserpri;
+	if (fname) {
+	    sp->fname = (char *) malloc (strlen(fname)+1);
+	    strcpy (sp->fname, fname);
+	}
+
+	/* Set up the new segment at the head of the cache. */
+	sp->next = vm->segment_head;
+	sp->prev = NULL;
+	if (vm->segment_head)
+	    vm->segment_head->prev = sp;
+	vm->segment_head = sp;
+
+	/* If there is nothing at the tail of the cache yet this element
+	 * becomes the tail of the cache list.
+	 */
+	if (!vm->segment_tail)
+	    vm->segment_tail = sp;
+	if (!vm->last_mapped)
+	    vm->last_mapped = sp;
+
+	/* Add the segment to the global file hash table.
+	 */
+	if (xp = vm_locate(vm,st.st_dev,st.st_ino)) {
+	    /* The file is already in the hash table.  Add the new segment
+	     * to the tail of the file segment list.
+	     */
+	    while (xp->nexthash)
+		xp = xp->nexthash;
+	    xp->nexthash = sp;
+
+	} else {
+	    /* Add initial file segment to hash table. */
+	    int hashval;
+
+	    hashval = hashint (SZ_HASHTBL, (int)st.st_dev, (int)st.st_ino);
+	    if (xp = hashtbl[hashval]) {
+		while (xp->nexthash)
+		    xp = xp->nexthash;
+		xp->nexthash = sp;
+	    } else
+		hashtbl[hashval] = sp;
+	}
+
+refresh:
+	/* Move a new or existing segment to the head of the cache and
+	 * increment the reference count.  Refresh the segment pages if
+	 * indicated.
+	 */
+	if (vm->segment_head != sp) {
+	    /* Unlink the list element. */
+	    if (sp->next)
+		sp->next->prev = sp->prev;
+	    if (sp->prev)
+		sp->prev->next = sp->next;
+
+	    /* Link current segment at head of cache. */
+	    sp->next = vm->segment_head;
+	    sp->prev = NULL;
+	    if (vm->segment_head)
+		vm->segment_head->prev = sp;
+	    vm->segment_head = sp;
+
+	    if (!vm->segment_tail)
+		vm->segment_tail = sp;
+	}
+
+	/* Preload the referenced segment if indicated. */
+	if (vm->cache_enabled && !(flags & VM_DONTMAP))
+	    vm_readahead (vm, addr, vm_nbytes);
+
+	sp->refcnt++;
+	sp->nrefs++;
+	sp->atime = time(0);
+	sp->priority = vm_cachepriority (vm, sp);
+
+	return ((void *)((char *)addr + (offset - vm_offset)));
+}
+
+
+/* VM_UNCACHEREGION -- Called after a vm_cacheregion to indicate that the
+ * cached region is available for reuse.  For every call to vm_cacheregion
+ * there must be a corresponding call to vm_uncacheregion before the space
+ * used by the region can be reused.  Uncaching a region does not immediately
+ * free the space used by the region, it merely decrements a reference 
+ * count so that the region can later be freed and reused if its space is
+ * needed.  The region remains in the cache and can be immediately reclaimed
+ * by a subequent vm_cacheregion.  If it is known that the space will not
+ * be reused, it can be freed immediately by setting the VM_DESTROYREGION
+ * flag in FLAGS.
+ */
+vm_uncacheregion (vm, fd, offset, nbytes, flags)
+register VMcache *vm;
+int fd;
+unsigned long offset;
+unsigned long nbytes;
+int flags;
+{
+	register Segment *sp;
+	unsigned long x0, x1, vm_offset, vm_nbytes;
+	struct stat st;
+	int mode;
+
+	if (debug)
+	    fprintf (stderr, "vm_uncacheregion (0x%x, %d, %d, %d, 0%o)\n",
+		vm, fd, offset, nbytes, flags);
+
+	/* Map offset,nbytes to a range of memory pages.
+	 */
+	x0 = offset;
+	x0 = (x0 - (x0 % vm->pagesize));
+
+	x1 = offset + nbytes - 1;
+	x1 = (x1 - (x1 % vm->pagesize)) + vm->pagesize - 1;
+
+	vm_offset = x0;
+	vm_nbytes = x1 - x0 + 1;
+
+	if (fstat (fd, &st) < 0)
+	    return (-1);
+
+	/* Locate the referenced segment.  */
+	for (sp = vm_locate(vm,st.st_ino,st.st_dev);  sp;  sp = sp->nexthash)
+	    if (isfile(sp,st) && (sp->offset == vm_offset))
+		break;
+	if (!sp)
+	    return (-1);   /* not found */
+
+	return (vm_uncache (vm, sp, flags));
+}
+
+
+/* VM_REFRESHREGION -- Refresh an already cached file region.  The region is
+ * moved to the head of the cache and preloading of any non-memory resident
+ * pages is initiated.
+ */
+vm_refreshregion (vm, fd, offset, nbytes)
+register VMcache *vm;
+int fd;
+unsigned long offset;
+unsigned long nbytes;
+{
+	register Segment *sp;
+	unsigned long x0, x1, vm_offset, vm_nbytes;
+	struct stat st;
+	int mode;
+	void *addr;
+
+	if (debug)
+	    fprintf (stderr, "vm_refreshregion (0x%x, %d, %d, %d)\n",
+		vm, fd, offset, nbytes);
+
+	if (!vm->cache_enabled)
+	    return (0);
+
+	/* Map offset,nbytes to a range of memory pages.
+	 */
+	x0 = offset;
+	x0 = (x0 - (x0 % vm->pagesize));
+
+	x1 = offset + nbytes - 1;
+	x1 = (x1 - (x1 % vm->pagesize)) + vm->pagesize - 1;
+
+	vm_offset = x0;
+	vm_nbytes = x1 - x0 + 1;
+
+	if (fstat (fd, &st) < 0)
+	    return (-1);
+
+	/* Locate the referenced segment.  */
+	for (sp = vm_locate(vm,st.st_ino,st.st_dev);  sp;  sp = sp->nexthash)
+	    if (isfile(sp,st) && (sp->offset == vm_offset))
+		break;
+	if (!sp)
+	    return (-1);   /* not found */
+
+	/* Relink the segment at the head of the cache.
+	 */
+	if (vm->last_mapped == sp && sp->prev)
+	    vm->last_mapped = sp->prev;
+
+	if (vm->segment_head != sp) {
+	    /* Unlink the list element. */
+	    if (sp->next)
+		sp->next->prev = sp->prev;
+	    if (sp->prev)
+		sp->prev->next = sp->next;
+
+	    /* Link current segment at head of cache. */
+	    sp->next = vm->segment_head;
+	    sp->prev = NULL;
+	    if (vm->segment_head)
+		vm->segment_head->prev = sp;
+	    vm->segment_head = sp;
+	}
+
+	sp->nrefs++;
+	sp->atime = time(0);
+	sp->priority = vm_cachepriority (vm, sp);
+
+	/* Preload any missing pages from the referenced segment. */
+	madvise (addr, vm_nbytes, MADV_WILLNEED);
+
+	return (0);
+}
+
+
+/* VM_UNCACHE -- Internal routine to free a cache segment.
+ */
+static
+vm_uncache (vm, sp, flags)
+register VMcache *vm;
+register Segment *sp;
+int flags;
+{
+	register Segment *xp;
+	Segment *first, *last;
+	int hashval, status=0, mode;
+
+	if (debug)
+	    fprintf (stderr, "vm_uncache (0x%x, 0x%x, 0%o)\n", vm, sp, flags);
+
+	/* Decrement the reference count.  Setting VM_CANCELREFCNT (as in
+	 * closecache) causes any references to be ignored.
+	 */
+	if (--sp->refcnt < 0 || (flags & VM_CANCELREFCNT))
+	    sp->refcnt = 0;
+
+	/* If the reference count is zero and the VM_DESTROYREGION flag is
+	 * set, try to free up the pages immediately, otherwise merely
+	 * decrement the reference count so that it can be reused if it is
+	 * referenced before the space it uses is reclaimed by another cache
+	 * load.
+	 */
+	if (!sp->refcnt && ((flags & VM_DESTROYREGION) || !vm->cache_enabled)) {
+	    if (vm->cache_enabled)
+		madvise (sp->addr, sp->nbytes, MADV_DONTNEED);
+	    if (munmap (sp->addr, sp->nbytes) < 0)
+		status = -1;
+	    vm->cacheused -= sp->nbytes;
+
+	    /* Remove the segment from the file hash table. */
+	    first = vm_locate (vm, sp->device, sp->inode);
+	    hashval = hashint (SZ_HASHTBL, sp->device, sp->inode);
+
+	    for (xp=first, last=NULL;  xp;  last=xp, xp=xp->nexthash)
+		if (xp == sp) {
+		    if (last)
+			last->nexthash = sp->nexthash;
+		    if (hashtbl[hashval] == sp)
+			hashtbl[hashval] = sp->nexthash;
+		    break;
+		}
+
+	    /* Update last_mapped if it points to this segment. */
+	    if (vm->last_mapped == sp && sp->prev)
+		vm->last_mapped = sp->prev;
+
+	    /* Unlink and free the segment descriptor. */
+	    if (sp->next)
+		sp->next->prev = sp->prev;
+	    if (sp->prev)
+		sp->prev->next = sp->next;
+	    if (vm->segment_head == sp)
+		vm->segment_head = sp->next;
+	    if (vm->segment_tail == sp)
+		vm->segment_tail = sp->prev;
+
+	    if (sp->fname)
+		free (sp->fname);
+	    free ((void *)sp);
+	    vm->cachelen--;
+	}
+
+	return (status);
+}
+
+
+/* VM_RESERVESPACE -- Free space in the cache, e.g. to create space to cache
+ * a new file or file segment.  File segments are freed at the tail of the
+ * cache list until the requested space is available.  Only segments which 
+ * have a reference count of zero are freed.  We do not actually remove
+ * segments from the cache here, we just free any mapped pages.
+ */
+vm_reservespace (vm, nbytes)
+register VMcache *vm;
+unsigned long nbytes;
+{
+	register Segment *sp;
+	unsigned long freespace = vm->cachesize - vm->cacheused;
+	int locked_segment_seen = 0;
+
+	if (debug)
+	    fprintf (stderr, "vm_reservespace (0x%x, %d)\n", vm, nbytes);
+
+	if (!vm->cache_enabled)
+	    return (0);
+
+	for (sp = vm->last_mapped;  sp;  sp = sp->prev) {
+	    freespace = vm->cachesize - vm->cacheused;
+	    if (freespace > nbytes)
+		break;
+
+	    if (sp->refcnt) {
+		locked_segment_seen++;
+		continue;
+	    } else if (!sp->addr)
+		continue;
+
+	    if (debug)
+		fprintf (stderr, "vm_reservespace: free %d bytes at 0x%x\n",
+		    sp->nbytes, sp->addr);
+
+	    madvise (sp->addr, sp->nbytes, MADV_DONTNEED);
+	    munmap (sp->addr, sp->nbytes);
+	    vm->cacheused -= sp->nbytes;
+	    sp->addr = NULL;
+
+	    if (sp == vm->last_mapped && !locked_segment_seen)
+		vm->last_mapped = sp->prev;
+	}
+
+	return ((freespace >= nbytes) ? 0 : -1);
+}
+
+
+/* VM_STATUS -- Return a description of the status and contents of the VM
+ * cache.  The output is written to the supplied text buffer.
+ */
+vm_status (vm, outbuf, maxch, flags)
+register VMcache *vm;
+char *outbuf;
+int maxch, flags;
+{
+	register Segment *sp;
+	register char *op = outbuf;
+	char buf[SZ_LINE];
+	int seg, nseg;
+
+	sprintf (buf, "initialized %d\n", vm->cache_initialized);
+	strcpy (op, buf);  op += strlen (buf);
+
+	sprintf (buf, "enabled %d\n", vm->cache_enabled);
+	strcpy (op, buf);  op += strlen (buf);
+
+	sprintf (buf, "lockpages %d\n", vm->lockpages);
+	strcpy (op, buf);  op += strlen (buf);
+
+	sprintf (buf, "physmem %d\n", vm->physmem);
+	strcpy (op, buf);  op += strlen (buf);
+
+	sprintf (buf, "cachesize %d\n", vm->cachesize);
+	strcpy (op, buf);  op += strlen (buf);
+
+	sprintf (buf, "cacheused %d\n", vm->cacheused);
+	strcpy (op, buf);  op += strlen (buf);
+
+	sprintf (buf, "pagesize %d\n", vm->pagesize);
+	strcpy (op, buf);  op += strlen (buf);
+
+	for (nseg=0, sp = vm->segment_head;  sp;  sp = sp->next)
+	    nseg++;
+	sprintf (buf, "nsegments %d\n", nseg);
+	strcpy (op, buf);  op += strlen (buf);
+
+	for (seg=0, sp = vm->segment_head;  sp;  sp = sp->next, seg++) {
+	    sprintf (buf, "segment %d inode %d device %d ",
+		seg, sp->inode, sp->device);
+	    sprintf (buf+strlen(buf), "offset %d nbytes %d refcnt %d %s\n",
+		sp->offset, sp->nbytes, sp->refcnt,
+		sp->fname ? sp->fname : "[done]");
+	    if (op-outbuf+strlen(buf) >= maxch)
+		break;
+	    strcpy (op, buf);  op += strlen (buf);
+	}
+
+	return (op - outbuf);
+}
+
+
+/* VM_LOCATE -- Internal routine to locate the initial segment of a cached
+ * file given its device and inode.  NULL is returned if the referenced file
+ * has no segments in the cache.
+ */
+static Segment *
+vm_locate (vm, device, inode)
+VMcache *vm;
+register dev_t device;
+register ino_t inode;
+{
+	register Segment *sp;
+	int hashval;
+
+	hashval = hashint (SZ_HASHTBL, device, inode);
+	for (sp = hashtbl[hashval];  sp;  sp = sp->nexthash)
+	    if (sp->device == device && sp->inode == inode)
+		return (sp);
+
+	return (NULL);
+}
+
+
+/* HASHINT -- Hash a pair of integer values.  An integer hash value in the
+ * range 0-nthreads is returned.
+ */
+static int
+hashint (nthreads, w1, w2)
+int nthreads;
+register int w1, w2;
+{
+	unsigned int h1, h2;
+	register int i=0;
+
+	h1 = (((w1 >> 16) * primes[i++]) ^ (w1 * primes[i++]));
+	h2 = (((w2 >> 16) * primes[i++]) ^ (w2 * primes[i++]));
+
+	return ((h1 ^ h2) % nthreads);
+}
+
+
+/* VM_CACHEPRIORITY -- Compute the cache priority of a file segment.  Various
+ * heuristics are possible for computing the cache priority of a segment.
+ * The one used here assigns a priority which scales with a user defined
+ * per-file priority, and which is a function of the number of recent
+ * references to the file.  The USERPRI, REFBASE, and TOCK parameters can
+ * be used (possibly in combination with manual cache control commands) to
+ * tune the algorithm for the expected file activity.
+ */
+static int
+vm_cachepriority (vm, sp)
+register VMcache *vm;
+register Segment *sp;
+{
+	register int priority = 0;
+	time_t curtime = time(NULL);
+
+	/* A user-specified priority of zero overrides. */
+	if (sp->userpri <= 0)
+	    return (0);
+
+	/* Compute the cache priority for the segment. */
+	priority = (sp->nrefs - vm->refbase) -
+	    ((curtime - sp->atime) / vm->tock);
+	if (priority < 0)
+	    priority = 0;
+	priority *= sp->userpri;
+
+	/* Degrade nrefs every tock seconds if the file is not being
+	 * accessed.
+	 */
+	if (sp->atime > sp->ptime)
+	    sp->ptime = sp->atime;
+	else if ((curtime - sp->ptime) > vm->tock) {
+	    sp->nrefs -= ((curtime - sp->ptime) / vm->tock);
+	    if (sp->nrefs < 0)
+		sp->nrefs = 0;
+	    sp->ptime = curtime;
+	}
+
+	return (priority);
+}
+
+
+/* VM_SYNC -- Sync (update on disk) any pages of virtual memory mapped to
+ * the given region of the given file.  If nbytes=0, any mapped regions of
+ * the given file are synced.  If the VM_ASYNC flag is set the sync operation
+ * will be performed asynchronously and vm_sync will return immediately,
+ * otherwise vm_sync waits for the synchronization operation to complete.
+ */
+vm_sync (vm, fd, offset, nbytes, flags)
+register VMcache *vm;
+int fd;
+unsigned long offset;
+unsigned long nbytes;
+int flags;
+{
+	register Segment *sp;
+	unsigned long x0, x1, vm_offset, vm_nbytes;
+	int syncflag, status = 0;
+	struct stat st;
+
+	if (debug)
+	    fprintf (stderr, "vm_sync (0x%x, %d, %d, %d, 0%o)\n",
+		vm, fd, offset, nbytes, flags);
+	if (!vm->cache_enabled)
+	    return (0);
+
+	/* Map offset,nbytes to a range of memory pages.
+	 */
+	x0 = offset;
+	x0 = (x0 - (x0 % vm->pagesize));
+
+	x1 = offset + nbytes - 1;
+	x1 = (x1 - (x1 % vm->pagesize)) + vm->pagesize - 1;
+
+	vm_offset = x0;
+	vm_nbytes = x1 - x0 + 1;
+
+#ifdef sun
+#ifdef _SYS_SYSTEMINFO_H
+	/* This is a mess.  The values of MS_SYNC,MS_ASYNC changed between
+	 * Solaris 2.6 and 2.7.  This code assumes that the system is
+	 * being built on a Solaris 2.7 or greater system, but the wired-in
+	 * values below allow the executable to be run on earlier versions.
+	 */
+	{
+	    char buf[SZ_NAME];   /* e.g. "5.7" */
+
+	    sysinfo (SI_RELEASE, buf, SZ_NAME);
+	    if (buf[0] >= '5' && buf[2] >= '7')
+		syncflag = (flags & VM_ASYNC) ? MS_ASYNC : MS_SYNC;
+	    else
+		syncflag = (flags & VM_ASYNC) ? 0x1 : 0x0;
+	}
+#else
+	syncflag = (flags & VM_ASYNC) ? MS_ASYNC : MS_SYNC;
+#endif
+#else
+	syncflag = (flags & VM_ASYNC) ? MS_ASYNC : MS_SYNC;
+#endif
+
+	if (fstat (fd, &st) < 0)
+	    return (-1);
+
+	/* Locate the referenced segment.  */
+	for (sp = vm->segment_head;  sp;  sp = sp->next) {
+	    if (!isfile(sp,st))
+		continue;
+
+	    if (!nbytes || sp->offset == vm_offset)
+		if (msync (sp->addr, sp->nbytes, syncflag))
+		    status = -1;
+	}
+
+	return (status);
+}
+
+
+/* VM_MSYNC -- Sync the given region of virtual memory.  This routine does
+ * not require that the caller know the file to which the memory is mapped.
+ * If the VM_ASYNC flag is set the sync operation will be performed
+ * asynchronously and vm_sync will return immediately, therwise vm_sync waits
+ * for the synchronization operation to complete.
+ */
+vm_msync (vm, addr, nbytes, flags)
+register VMcache *vm;
+void *addr;
+unsigned long nbytes;
+int flags;
+{
+	register Segment *sp;
+	unsigned long addr1, addr2;
+	int syncflag;
+
+	if (debug)
+	    fprintf (stderr, "vm_msync (0x%x, 0x%x, %d, 0%o)\n",
+		vm, addr, nbytes, flags);
+
+	/* Align the given address region to the page boundaries.
+	 */
+	addr1 = ((long)addr - ((long)addr % vm->pagesize));
+	addr2 = (long)addr + nbytes - 1;
+	addr2 = (addr2 - (addr2 % vm->pagesize)) + vm->pagesize - 1;
+	syncflag = (flags & VM_ASYNC) ? MS_ASYNC : MS_SYNC;
+
+	return (msync ((void *)addr1, addr2 - addr1 + 1, syncflag));
+}
+
+
+/* VM_READAHEAD -- Internal routine used to request that a segment of file
+ * data be preloaded.
+ */
+static
+vm_readahead (vm, addr, nbytes)
+register VMcache *vm;
+void *addr;
+unsigned long nbytes;
+{
+	register int n, nb;
+	int chunk = READAHEAD * vm->pagesize;
+	unsigned long buf = (unsigned long) addr;
+
+	/* Break large reads into chunks of READAHEAD memory pages.  This
+	 * increases the chance that file access and computation can overlap
+	 * the readahead i/o.
+	 */
+	for (n=0;  n < nbytes;  n += chunk) {
+	    nb = nbytes - n;
+	    if (nb > chunk)
+		nb = chunk;
+	    madvise ((void *)(buf + n), nb, MADV_WILLNEED);
+	}
+}
diff --git a/unix/boot/vmcached/vmcache.h b/unix/boot/vmcached/vmcache.h
new file mode 100644
index 00000000..3304b8dd
--- /dev/null
+++ b/unix/boot/vmcached/vmcache.h
@@ -0,0 +1,19 @@
+/*
+ * VMCACHE.H -- Public definitions for the VMcache interface.
+ */
+
+#define DEF_VMSOCK      	8677
+#define ENV_VMSOCK		"VMPORT"
+
+#define	VM_READONLY		0001
+#define	VM_READWRITE		0002
+#define	VM_WRITEONLY		0004
+#define	VM_ASYNC		0010
+#define	VM_SYNC			0020
+#define	VM_LOCKFILE		0040
+#define	VM_DESTROYREGION	0100
+#define	VM_CANCELREFCNT		0200
+#define	VM_DONTMAP		0400
+
+void	*vm_initcache();
+void	*vm_cacheregion();
diff --git a/unix/boot/vmcached/vmcached.c b/unix/boot/vmcached/vmcached.c
new file mode 100644
index 00000000..5acccdea
--- /dev/null
+++ b/unix/boot/vmcached/vmcached.c
@@ -0,0 +1,568 @@
+#include <stdio.h>
+#include <sys/types.h>
+#include <sys/time.h>
+#include <unistd.h>
+#include <ctype.h>
+#include "vmcache.h"
+
+#define NOKNET
+#define	import_spp
+#define	import_knames
+#include <iraf.h>
+
+/*
+ * VMCACHED -- VMcache daemon.
+ *
+ * The VMcache daemon controls a virtual memory cache for optimizing file
+ * storage in virtual memory on a single host computer.  Clients can connect
+ * to the daemon to request that files be cached or uncached, query whether
+ * a file is cached, modify cache parameters, or query the status of the
+ * cache.
+ */
+
+#define	MAX_CLIENTS	256
+#define MAX_ARGS	32
+#define SZ_STATBUF	8192
+#define SZ_CMDBUF	8192
+#define	SZ_NAME		32
+#define DEF_CACHESIZE   "50%"
+#define DEF_PHYSPAGES   32768
+#define DEF_PRIORITY    1
+#define DEF_REFBASE     1
+#define DEF_TOCK        600
+
+
+/* Client connection. */
+struct client {
+	int fd;
+	FILE *out;
+	char name[SZ_NAME+1];
+}; typedef struct client Client;
+
+Client client[MAX_CLIENTS];
+int nclients;
+int maxclients;
+int debug;
+int running;
+extern char *getenv();
+void *vm;
+
+
+/* MAIN -- VMCACHED main program.
+ */
+main (argc, argv)
+int argc;
+char **argv;
+{
+	char *argp, *op, *cachesize;
+	int socket, lockpages, defpri, refbase, tock;
+	int c_argc, fd, status, acmode, server, i;
+	char *c_argv[MAX_ARGS];
+	char initstr[SZ_FNAME];
+	char osfn[SZ_FNAME];
+	fd_set readfds;
+
+	cachesize = DEF_CACHESIZE;
+	socket = DEF_VMSOCK;
+	defpri = DEF_PRIORITY;
+	refbase = DEF_REFBASE;
+	tock = DEF_TOCK;
+	lockpages = 0;
+
+	/* The socket to be used can be set in the environment. */
+	if (argp = getenv (ENV_VMSOCK))
+	    socket = atoi (argp);
+
+	/* Parse argument list. */
+	for (i=1;  i < argc, argp = argv[i];  i++) {
+	    if (argname (argp, "-k", "-port")) {
+		argp = (argv[++i]);
+		socket = atoi (argp);
+	    } else if (argname (argp, "-s", "-cachesize")) {
+		argp = (argv[++i]);
+		cachesize = argp;
+	    } else if (argname (argp, "-p", "-defpri")) {
+		argp = (argv[++i]);
+		defpri = atoi (argp);
+	    } else if (argname (argp, "-b", "-refbase")) {
+		argp = (argv[++i]);
+		refbase = atoi (argp);
+	    } else if (argname (argp, "-t", "-tock")) {
+		argp = (argv[++i]);
+		tock = atoi (argp);
+	    } else if (argname (argp, "-l", "-lockpages")) {
+		lockpages++;
+	    } else if (argname (argp, "-d", "-debug")) {
+		debug++;
+	    } else
+		fprintf (stderr, "vmcached: unknown argument `%s'\n", argp);
+	}
+
+	/* Construct the initstr for VMcache. */
+	op = initstr;
+	sprintf (op, "cachesize=%s,defpri=%d,refbase=%d,tock=%d",
+	    cachesize, defpri, refbase, tock);
+	if (lockpages) {
+	    op = initstr + strlen(initstr);
+	    strcat (op, ",lockpages");
+	}
+	if (debug) {
+	    op = initstr + strlen(initstr);
+	    strcat (op, ",debug");
+	}
+
+	if (debug)
+	    fprintf (stderr, "vmcached: init vmcache `%s'\n", initstr);
+
+	/* Initialize the VM cache. */
+	if (!(vm = vm_initcache (NULL, initstr))) {
+	    fprintf (stderr, "vmcached: failed to open socket `%s'\n", osfn);
+	    exit (1);
+	}
+
+	/* Open the server port for incoming connections.
+	 */
+	sprintf (osfn, "inet:%d::nonblock", socket);
+	acmode = NEW_FILE;
+	if (debug)
+	    fprintf (stderr, "vmcached: open server socket `%s'\n", osfn);
+
+	ZOPNND (osfn, &acmode, &server);
+	if (server == XERR) {
+	    fprintf (stderr, "vmcached: failed to open socket `%s'\n", osfn);
+	    vm_closecache (vm);
+	    exit (2);
+	}
+
+	if (debug)
+	    fprintf (stderr, "vmcached: enter main server loop:\n");
+
+	/* Loop indefinitely waiting for new connections or client
+	 * requests.
+	 */
+	for (running=1;  running;  ) {
+	    FD_ZERO (&readfds);
+	    FD_SET (server, &readfds);
+	    for (i=0;  i < maxclients;  i++)
+		if (client[i].fd)
+		    FD_SET (client[i].fd, &readfds);
+	    if (select (MAX_CLIENTS, &readfds, NULL, NULL, NULL) <= 0)
+		break;
+
+	    /* Check for a new client connection. */
+	    if (FD_ISSET (server, &readfds)) {
+		char buf[SZ_CMDBUF];
+		FILE *fdopen();
+		int fd, n;
+
+		if (debug)
+		    fprintf (stderr, "vmcached: open new client connection: ");
+
+		/* Accept the connection. */
+		sprintf (osfn, "sock:%d", server);
+		acmode = NEW_FILE;
+		ZOPNND (osfn, &acmode, &fd);
+		if (fd == XERR)
+		    exit (1);
+
+		for (i=0;  i < MAX_CLIENTS;  i++)
+		    if (!client[i].fd)
+			break;
+		if (i >= MAX_CLIENTS) {
+		    fprintf (stderr, "vmcached: too many clients\n");
+		    ZCLSND (&fd, &status);
+		    continue;
+		}
+
+		/* The client name is passed as data in an open. */
+		if ((n = read (fd, buf, SZ_CMDBUF)) > 0) {
+		    strncpy (client[i].name, buf, SZ_NAME);
+		    client[i].name[n < SZ_NAME ? n : SZ_NAME] = '\0';
+		}
+
+		if (debug)
+		    fprintf (stderr, "fd=%d (%s)\n", fd, client[i].name);
+
+		client[i].fd = fd;
+		client[i].out = fdopen (fd, "w");
+		nclients++;
+		if (i >= maxclients)
+		    maxclients = i + 1;
+
+		/* Send an acknowledge back to the client. */
+		c_argc = 1;  c_argv[0] = client[i].name;
+		putstati (client[i].out, c_argc, c_argv, 0);
+	    }
+
+	    /* Check for command input from clients.  Any command data
+	     * must be sent as a complete command block.  The block must
+	     * be syntatically complete, by may contain multiple 
+	     * concatenated commands.  If a command references any data
+	     * not passed as part of the command, the data can be read
+	     * from the client input stream during execution of the command.
+	     */
+	    for (i=0;  i < MAX_CLIENTS;  i++) {
+		Client *cx = &client[i];
+		if (!cx->fd)
+		    continue;
+
+		if (FD_ISSET (cx->fd, &readfds)) {
+		    int status, buflen;
+		    char buf[SZ_CMDBUF];
+		    char *ip, *itop;
+
+		    if (debug) fprintf (stderr,
+			"vmcached: client input on fd=%d: ", cx->fd);
+
+		    if ((buflen = read (cx->fd, buf, SZ_CMDBUF)) <= 0) {
+			if (debug)
+			    fputs ("[EOF (disconnected)]\n", stderr);
+			goto disconnect;
+		    }
+		    if (debug) {
+			buf[buflen] = '\0';
+			fputs (buf, stderr);
+		    }
+
+		    ip = buf;
+		    itop = buf + buflen;
+
+		    while (getcmd (&ip, itop, &c_argc, c_argv) > 0)
+			if (execute (cx, c_argc, c_argv) > 0) {
+disconnect:		    fclose (cx->out);
+			    ZCLSND (&cx->fd, &status);
+			    cx->fd = 0;
+			    cx->out = NULL;
+			    nclients--;
+			    if (maxclients == i+1)
+				maxclients--;
+			    break;
+			}
+
+		    if (cx->out)
+			fflush (cx->out);
+		}
+	    }
+	}
+
+	if (debug)
+	    fprintf (stderr, "vmcached: shutdown\n");
+
+	/* Close all client connections. */
+	for (i=0;  i < maxclients;  i++) {
+	    Client *cx = &client[i];
+	    if (cx->fd) {
+		fclose (cx->out);
+		close (cx->fd);
+		cx->fd = 0;
+	    }
+	}
+
+	ZCLSND (&server, &status);
+	vm_closecache (vm);
+	exit (0);
+}
+
+
+/* EXECUTE -- Execute a vmcached directive.
+ *
+ * Directives are simple newline or semicolon delimited commands, with the
+ * arguments delimited by whitespace or quotes, e.g., :
+ *
+ *	access /d1/iraf/h1904b.fits rw
+ *
+ * Multiple commands can be concatenated (with command delimiters) and sent
+ * as a batch if desired.  They will be executed in sequence.  Most commands
+ * result in a response to the client.  These have the form
+ *
+ *	<status> '=' <command> <args>
+ *
+ * for example,
+ *
+ *	1 = access /d1/iraf/h1904b.fits rw
+ *
+ * This form makes the status value easy to parse for simple commands.
+ * The command is echoed so that the status value can be matched to the
+ * command it is for, e.g., if multiple commands were issued.
+ */
+execute (cx, argc, argv)
+Client *cx;
+int argc;
+char *argv[];
+{
+	char *cmd = argv[0];
+	int execstat = 0;
+	int i, status = 0;
+
+	if (!cmd)
+	    return (-1);
+
+	if (debug) {
+	    fprintf (stderr, "vmcached: execute \"%s (", cmd);
+	    for (i=1;  i < argc;  i++) {
+		if (i > 1)
+		    fprintf (stderr, ", ");
+		fprintf (stderr, "%s", argv[i]);
+	    }
+	    fprintf (stderr, ")\"\n");
+	}
+
+	if (strcmp (cmd, "bye") == 0) {
+	    /* Usage: bye
+	     * Close a client connection.
+	     */
+	    execstat = 1;
+
+	} else if (strcmp (cmd, "quit") == 0) {
+	    /* Usage: quit
+	     * Shutdown vmcached and exit.
+	     */
+	    running = 0;
+
+	} else if (strcmp (cmd, "access") == 0) {
+	    /* Usage: access <fname> [<mode>]
+	     *
+	     * Determine whether the named file should be accessed via the
+	     * VMcache (via virtual memory / normal i/o) or via direct i/o,
+	     * bypassing VM.  In the simplest scenario we just check whether
+	     * the named file is already in the cache, perhaps loaded via
+	     * the cache directive by a control process.  More complex
+	     * strategies are possible, e.g., every access could be set up
+	     * to automatically cache the referenced file; caching could be
+	     * decided on a per-process basic depending upon access history,
+	     * etc.  A client about to access a file should issue an access
+	     * directive to the cache to determine whether or not to use VM
+	     * (e.g., normal file i/o) to access the file.
+	     */
+	    char *fname = argv[1];
+	    char *mode = (argc > 2) ? argv[2] : "r";
+
+	    if (!fname)
+		status = -1;
+	    else
+		status = vm_access (vm, fname, mode, 0);
+	    putstati (cx->out, argc, argv, status);
+
+	} else if (strcmp (cmd, "cache") == 0) {
+	    /* Usage: cache <fname>
+	     * 
+	     * Cache the named file.  The file is asynchronously loaded 
+	     * into the VM cache.
+	     */
+	    char *fname = argv[1];
+	    
+	    if (!fname)
+		status = -1;
+	    else
+		status = vm_cachefile (vm, fname, 0);
+	    putstati (cx->out, argc, argv, status);
+
+	} else if (strcmp (cmd, "uncache") == 0) {
+	    /* Usage: uncache <fname>
+	     *
+	     * If the named file is present in the cache the space it is
+	     * marked as ready for reuse.  Any VM space used by the file is
+	     * not immediately reused.  The actual disk file is not affected.
+	     */
+	    char *fname = argv[1];
+	    
+	    if (!fname)
+		status = -1;
+	    else
+		status = vm_uncachefile (vm, fname, 0);
+	    putstati (cx->out, argc, argv, status);
+
+	} else if (strcmp (cmd, "delete") == 0) {
+	    /* Usage: delete <fname>
+	     *
+	     * If the named file is present in the cache it is removed from
+	     * the cache, freeing the space to be used for other files.  The
+	     * actual disk file is not affected.
+	     */
+	    char *fname = argv[1];
+	    
+	    if (!fname)
+		status = -1;
+	    else {
+		status = vm_uncachefile (vm, fname,
+		    VM_DESTROYREGION|VM_CANCELREFCNT);
+	    }
+	    putstati (cx->out, argc, argv, status);
+
+	} else if (strcmp (cmd, "refresh") == 0) {
+	    /* Usage: refresh <fname>
+	     *
+	     * If the named file is present in the cache it is moved to the
+	     * head of the cache (most recently referenced), and any missing
+	     * file pages are asynchronously loaded from disk.
+	     */
+	    char *fname = argv[1];
+	    
+	    if (!fname)
+		status = -1;
+	    else
+		status = vm_refreshfile (vm, fname, 0);
+	    putstati (cx->out, argc, argv, status);
+
+	} else if (strcmp (cmd, "reserve") == 0) {
+	    /* Usage: reserve <nbytes>
+	     *
+	     * The indicated amount of space is made available in the cache.
+	     * The space goes on the VM free list, for use to buffer data
+	     * without paging out other data.
+	     */
+	    long nbytes = (argv[1]) ? atol(argv[1]) : 0;
+
+	    if (!nbytes)
+		status = -1;
+	    else
+		status = vm_reservespace (vm, nbytes);
+	    putstati (cx->out, argc, argv, status);
+
+	} else if (strcmp (cmd, "status") == 0) {
+	    /* Usage: status
+	     *
+	     * The status directive is used to query the status and contents
+	     * of the VM cache.  A description of all parameters and cached
+	     * files is returned in text form.
+	     */
+	    char statbuf[SZ_STATBUF];
+
+	    status = vm_status (vm, statbuf, SZ_STATBUF, 0);
+	    putstats (cx->out, argc, argv, status);
+	    fputs (statbuf, cx->out);
+
+	} else if (strcmp (cmd, "subscribe") == 0) {
+	    /* Usage: subscribe */
+	    fprintf (cx->out, "%s %d\n", cmd, status);
+
+	} else if (strcmp (cmd, "unsubscribe") == 0) {
+	    /* Usage: unsubscribe */
+	    fprintf (cx->out, "%s %d\n", cmd, status);
+
+	} else {
+	    execstat = status = -1;
+	    putstati (cx->out, argc, argv, status);
+	}
+
+	return (execstat);
+}
+
+
+/* PUTSTATI -- Return an integer valued command status to the client.
+ */
+putstati (fp, argc, argv, status)
+FILE *fp;
+int argc;
+char **argv;
+int status;
+{
+	register int i;
+
+	fprintf (fp, "%d = %s", status, argv[0]);
+	for (i=1;  i < argc && argv[i];  i++)
+	    fprintf (fp, " %s", argv[i]);
+	fprintf (fp, "\n");
+	fflush (fp);
+
+	if (debug)
+	    fprintf (stderr, "vmcached: %s -> %d\n", argv[0], status);
+}
+
+
+/* PUTSTATS -- Return a string valued command status to the client.
+ */
+putstats (fp, argc, argv, status)
+FILE *fp;
+int argc;
+char **argv;
+char *status;
+{
+	register int i;
+
+	fprintf (fp, "%s = %s", status, argv[0]);
+	for (i=0;  i < argc && argv[i];  i++)
+	    fprintf (fp, " %s", argv[i]);
+	fprintf (fp, "\n");
+	fflush (fp);
+}
+
+
+/* ARGNAME -- Test whether a string is one of the named arguments.
+ */
+argname (arg, name1, name2)
+char *arg;
+char *name1, *name2;
+{
+	int status = 0;
+
+	if (name1)
+	    status |= (strcmp (arg, name1) == 0);
+	if (name2)
+	    status |= (strcmp (arg, name2) == 0);
+
+	return (status);
+}
+
+
+/* GETCMD -- Read a command from the input command block and parse it into
+ * the command name and arguments.  The input pointer is left positioned
+ * to the text following the command.  The command name is returned as
+ * argv[0];
+ */
+getcmd (ipp, itop, argc, argv)
+char **ipp;
+char *itop;
+int *argc;
+char *argv[];
+{
+	register char *ip = *ipp;
+	register char *argp;
+	int i, nargs = 0;
+
+	for (i=0;  i < MAX_ARGS;  i++)
+	    argv[i] = NULL;
+
+	while (ip < itop && (*ip == ' ' || *ip == '\t'))
+	    ip++;
+
+	/* Get command name and any arguments. */
+	while (ip < itop && *ip != '\n' && *ip != ';') {
+	    /* Get next argument. */
+	    argp = ip;
+
+	    /* Quoted strings may include whitespace.  The quote characters
+	     * are omitted from the argument.
+	     */
+	    if (*ip == '\'') {
+		for (argp = ++ip;  ip < itop && *ip != '\'';  )
+		    ip++;
+	    } else if (*ip == '"') {
+		for (argp = ++ip;  ip < itop && *ip != '"';  )
+		    ip++;
+	    } else {
+		while (ip < itop && !isspace(*ip)) {
+		    if (*ip == '\\' && ip+1 < itop)
+			ip++;
+		    ip++;
+		}
+	    }
+
+	    *ip++ = '\0';
+	    if (argp[0])
+		argv[nargs++] = argp;
+
+	    /* Skip forward to next argument. */
+	    while (ip < itop && (*ip == ' ' || *ip == '\t'))
+		ip++;
+	}
+
+	/* Skip forward to next command line. */
+	while (ip < itop && (isspace(*ip) || *ip == ';'))
+	    ip++;
+
+	*argc = nargs;
+	*ipp = ip;
+
+	return (nargs);
+}
diff --git a/unix/boot/wtar/README b/unix/boot/wtar/README
new file mode 100644
index 00000000..2baafbd4
--- /dev/null
+++ b/unix/boot/wtar/README
@@ -0,0 +1,21 @@
+WTAR -- Write a tar format file or tape.  This is a portable, non-UNIX, non-
+	proprietary program for writing tar format files on a variety of
+	systems.  The TAR format is an excellent choice for transporting
+	files between different machines because of its simplicity, efficiency,
+	and machine independence.
+
+
+wtar [-tvdo] [-f tarfile] [files]
+
+	-t	print names of files as they are written
+	-v	verbose output
+	-d	debug mode
+	-o	omit binary files
+	-f fn	write to file FN (stdout, mt[ab..], binary file)
+	[files]	files or directories to be written to tar file
+
+
+Output may be to a disk file, a magtape device, or to the standard output
+(on some systems).  Text files may be padded with extra blanks at the end on
+some systems, due to lack of knowledge of the precise file length when the
+file header is written.
diff --git a/unix/boot/wtar/mkpkg.sh b/unix/boot/wtar/mkpkg.sh
new file mode 100644
index 00000000..1bf0e0f6
--- /dev/null
+++ b/unix/boot/wtar/mkpkg.sh
@@ -0,0 +1,6 @@
+# Bootstrap WTAR.
+
+$CC -c $HSI_CF	wtar.c
+$CC $HSI_LF	wtar.o $HSI_LIBS -o wtar.e
+mv		wtar.e ../../hlib
+rm -f		wtar.o
diff --git a/unix/boot/wtar/wtar.c b/unix/boot/wtar/wtar.c
new file mode 100644
index 00000000..2b9c03a1
--- /dev/null
+++ b/unix/boot/wtar/wtar.c
@@ -0,0 +1,717 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#include <stdio.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <string.h>
+#include <stdlib.h>
+
+#define	NOKNET
+#define	import_spp
+#define	import_finfo
+#define	import_knames
+#include <iraf.h>
+
+#include "../bootProto.h"
+
+
+/*
+ * WTAR -- Write a UNIX tar format file (on disk, tape, or to stdout)
+ *
+ * Switches:
+ *		f	write to named file, otherwise write to stdout
+ *		t	print name of each file written
+ *		v	verbose; print full description of each file
+ *		d	print debug messages
+ *		o	omit binary files (e.g. when foreign host has
+ *			  incompatible binary file format)
+ */
+
+#define TBLOCK		512
+#define NBLOCK		20
+#define NAMSIZ		100
+#define	MAXERR		20
+#define	MAXTRYS		100
+#define	SZ_TAPEBUFFER	(TBLOCK * NBLOCK)
+#define	RWXR_XR_X	0755
+
+#define	LF_LINK		1
+#define	LF_SYMLINK	2
+#define	LF_DIR		5
+
+/* File header structure.  One of these precedes each file on the tape.
+ * Each file occupies an integral number of TBLOCK size logical blocks
+ * on the tape.  The number of logical blocks per physical block is variable,
+ * with at most NBLOCK logical blocks per physical tape block.  Two zero
+ * blocks mark the end of the tar file.
+ */
+union hblock {
+	char dummy[TBLOCK];
+	struct header {
+		char name[NAMSIZ];	/* NULL delimited		*/
+		char mode[8];		/* octal, ascii			*/
+		char uid[8];
+		char gid[8];
+		char size[12];
+		char mtime[12];
+		char chksum[8];
+		char linkflag;
+		char linkname[NAMSIZ];
+	} dbuf;
+};
+
+/* Decoded file header.
+ */
+struct fheader {
+	char	name[NAMSIZ];
+	int	mode;
+	int	uid;
+	int	gid;
+	int	isdir;
+	long	size;
+	long	mtime;
+	long	chksum;
+	int	linkflag;
+	char	linkname[NAMSIZ];
+};
+
+/* Map TAR file mode bits into characters for printed output.
+ */
+struct _modebits {
+    int	  code;
+    char  ch;
+} modebits[] = {
+    { 040000,	'd' },
+    { 0400,	'r' },
+    { 0200,	'w' },
+    { 0100,	'x' },
+    { 040,	'r' },
+    { 020,	'w' },
+    { 010,	'x' },
+    { 04,	'r' },
+    { 02,	'w' },
+    { 01,	'x' },
+    { 0,	0   }
+};
+
+int	debug=NO;		/* Print debugging messages		*/
+int	omitbinary;		/* omit binary files 			*/
+int	printfnames;		/* Print file names			*/
+int	verbose;		/* Print everything			*/
+
+struct	fheader *curfil;
+int	nerrs;
+char	*first_file;
+char	tapeblock[SZ_TAPEBUFFER];
+char	*nextblock = NULL;
+int	nblocks;
+int	in;
+int	out = EOF;
+
+
+extern  int ZZSTRT (void);
+extern  int ZZSTOP (void);
+extern  int ZFINFO (PKCHAR *fname, XLONG *finfo_struct, XINT *status);
+
+extern  int tape_open (char *fname, int mode);
+extern  int tape_close (int fd);
+extern  int tape_write (int fd, char *buf, int nbytes);
+
+
+static void  putfiles (char *dir, int   out, char *path);
+static void  tarfileout (char *fname, int out, int ftype, char *path);
+static int   putheader (register struct fheader *fh, int out);
+static int   cchksum (register char *p, register int nbytes);
+static void  printheader (FILE *fp, register struct fheader *fh, int verbose);
+static void  copyfile (char *fname, struct fheader *fh, int ftype, int out);
+static int   putblock (int out, char *buf);
+static void  endtar (int out);
+static int   u_fmode (int iraf_fmode, int ftype);
+static char *dname (char *dir);
+
+
+
+
+/* MAIN -- "wtar [-tvdo] [-f tarfile] [files]".  If no files are listed the
+ * current directory tree is used as input.  If no output file is specified
+ * output is to the standard output.
+ */
+int main (int argc, char *argv[])
+{
+	static	char	*def_flist[2] = { ".", NULL };
+	char	*argp, **flist;
+	int	argno, ftype, i;
+
+	ZZSTRT();
+
+	flist       = def_flist;
+	omitbinary  = NO;
+	printfnames = debug;
+	verbose     = debug;
+
+	if (debug) {
+	    printf ("wtar called with %d arguments:", argc);
+	    for (argno=1;  (argp = argv[argno]) != NULL;  argno++)
+		printf (" %s", argp);
+	    printf ("\n");
+	}
+
+	/* Process the argument list.
+	 */
+	for (argno=1;  (argp = argv[argno]) != NULL;  argno++) {
+	    if (*argp != '-') {
+		flist = &argv[argno];
+		break;
+
+	    } else {
+		for (argp++;  *argp;  argp++) {
+		    switch (*argp) {
+		    case 'd':
+			debug++;
+			printfnames++;
+			verbose++;
+			break;
+		    case 't':
+			printfnames++;
+			break;
+		    case 'v':
+			printfnames++;
+			verbose++;
+			break;
+		    case 'o':
+			omitbinary++;
+			break;
+
+		    case 'f':
+			if (argv[argno+1]) {
+			    argno++;
+			    if (debug)
+				printf ("open output file `%s'\n", argv[argno]);
+			    out = tape_open (argv[argno], 1);
+			    if (out == ERR) {
+				fflush (stdout);
+				fprintf (stderr,
+				    "cannot open `%s'\n", argv[argno]);
+				ZZSTOP();
+				exit (OSOK+1);
+			    }
+			}
+			break;
+
+		    default:
+			fflush (stdout);
+			fprintf (stderr,
+			    "Warning: unknown switch -%c\n", *argp);
+			fflush (stderr);
+		    }
+		}
+	    }
+	}
+
+	/* Write to the standard output if no output file specified.
+	 * The filename "stdin" is reserved.
+	 */
+	if (out == ERR) {
+	    if (debug)
+		printf ("output defaults to stdout\n");
+	    out = tape_open ("stdout", 1);
+	}
+
+	nextblock = tapeblock;
+	nblocks = 0;
+
+	/* Put each directory and file listed on the command line to 
+	 * the tarfile.
+	 */
+	for (i=0;  (argp = flist[i]) != NULL;  i++)
+	    if ((ftype = os_filetype (argp)) == DIRECTORY_FILE)
+		putfiles (argp, out, "");
+	    else
+		tarfileout (argp, out, ftype, "");
+
+	/* Close the tarfile.
+	 */
+	endtar (out);
+	tape_close (out);
+
+	ZZSTOP();
+	exit (OSOK);
+
+	return (0);
+}
+
+
+/* PUTFILES -- Put the named directory tree to the output tarfile.  We chdir
+ * to each subdirectory to minimize path searches and speed up execution.
+ */
+static void
+putfiles (
+    char *dir,			/* directory name		*/
+    int	  out,			/* output file			*/
+    char *path 			/* pathname of curr. directory	*/
+)
+{
+	char	newpath[SZ_PATHNAME+1];
+	char	oldpath[SZ_PATHNAME+1];
+	char	fname[SZ_PATHNAME+1];
+	int	ftype, dp;
+
+	if (debug)
+	    printf ("putfiles (%s, %d, %s)\n", dir, out, path);
+
+	/* Put the directory file itself to the output as a file.
+	 */
+	tarfileout (dir, out, DIRECTORY_FILE, path);
+
+	if ((dp = os_diropen (dir)) == ERR) {
+	    fflush (stdout);
+	    fprintf (stderr, "cannot open subdirectory `%s%s'\n", path, dir);
+	    fflush (stderr);
+	    return;
+	}
+
+	os_fpathname (".", oldpath, SZ_PATHNAME);
+	sprintf (newpath, "%s%s", dname(path), dir);
+	strcpy (newpath, dname(newpath));
+
+	if (debug)
+	    printf ("change directory to %s\n", newpath);
+	if (os_chdir (dir) == ERR) {
+	    os_dirclose (dp);
+	    fflush (stdout);
+	    fprintf (stderr, "cannot change directory to `%s'\n", newpath);
+	    fflush (stderr);
+	    return;
+	}
+
+	/* Put each file in the directory to the output file.  Recursively
+	 * read any directories encountered.
+	 */
+	while (os_gfdir (dp, fname, SZ_PATHNAME) > 0)
+	    if (os_symlink (fname, 0, 0))
+		tarfileout (fname, out, LF_SYMLINK, newpath);
+	    else if ((ftype = os_filetype (fname)) == DIRECTORY_FILE)
+		putfiles (fname, out, newpath);
+	    else
+		tarfileout (fname, out, ftype, newpath);
+
+	if (debug)
+	    printf ("return from subdirectory %s\n", newpath);
+	if (os_chdir (oldpath) == ERR) {
+	    fflush (stdout);
+	    fprintf (stderr, "cannot return from subdirectory `%s'\n", newpath);
+	    fflush (stderr);
+	}
+
+	os_dirclose (dp);
+}
+
+
+/* TARFILEOUT -- Write the named file to the output in tar format.
+ */
+static void
+tarfileout (
+    char *fname,			/* file to be output	*/
+    int	  out,				/* output stream	*/
+    int	  ftype,			/* file type		*/
+    char *path				/* current path		*/
+)
+{
+	struct	_finfo fi;
+	struct	fheader fh;
+	int	status;
+
+	if (debug)
+	    printf ("put file `%s', type %d\n", fname, ftype);
+
+	if (ftype == BINARY_FILE && omitbinary) {
+	    if (printfnames) {
+		fflush (stdout);
+		fprintf (stderr, "omit binary file `%s'\n", fname);
+		fflush (stderr);
+	    }
+	    return;
+	}
+
+	/* Get info on file to make file header.
+	 */
+	ZFINFO ((PKCHAR *)vfn2osfn(fname,0), (XLONG *) &fi, (XINT *) &status);
+	if (status == XERR) {
+	    fflush (stdout);
+	    fprintf (stderr, "Warning: can't get info on file `%s'\n", fname);
+	    fflush (stderr);
+	    return;
+	}
+
+	/* Format and output the file header.
+	 */
+	memset (&fh, 0, sizeof(fh));
+	strcpy (fh.name, path);
+	strcat (fh.name, fname);
+	strcpy (fh.linkname, "");
+	fh.linkflag = 0;
+
+	if (ftype == DIRECTORY_FILE) {
+	    strcpy (fh.name, dname(fh.name));
+	    fh.size  = 0;
+	    fh.isdir = 1;
+	    fh.linkflag = LF_DIR;
+	} else {
+	    fh.size  = fi.fi_size;
+	    fh.isdir = 0;
+	}
+
+	os_getowner (fname, &fh.uid, &fh.gid);
+	fh.mode  = u_fmode  (fi.fi_perm, fi.fi_type);
+	fh.mtime = os_utime (fi.fi_mtime);
+
+	if (ftype == LF_SYMLINK) {
+	    struct  stat fi;
+	    lstat (fname, &fi);
+
+	    /* Set attributes of symbolic link, not file pointed to. */
+	    fh.uid   = fi.st_uid;
+	    fh.gid   = fi.st_gid;
+	    fh.mode  = fi.st_mode;
+	    fh.mtime = fi.st_mtime;
+	    fh.size  = 0;
+
+	    fh.linkflag = LF_SYMLINK;
+	    os_symlink (fname, fh.linkname, NAMSIZ);
+	}
+
+	if (putheader (&fh, out) == EOF)  {
+	    fflush (stdout);
+	    fprintf (stderr, 
+		"Warning: could not write file header for `%s'\n", fname);
+	    fflush (stderr);
+	    return;
+	}
+
+	/* Copy the file data.
+	 */
+	if (fh.size > 0 && !fh.isdir && !fh.linkflag)
+	    copyfile (fname, &fh, ftype, out);
+
+	if (printfnames) {
+	    printheader (stdout, &fh, verbose);
+	    fflush (stdout);
+	}
+}
+
+
+/* PUTHEADER -- Encode and write the file header to the output tarfile.
+ */
+static int
+putheader (
+    register struct fheader *fh,	/* (input) file header		*/
+    int	 out 				/* output file descriptor	*/
+)
+{
+	register char	*ip;
+	register int	n;
+	union	hblock	hb;
+	char	chksum[10];
+
+
+	/* Clear the header block. */
+	for (n=0;  n < TBLOCK;  n++)
+	    hb.dummy[n] = '\0';
+
+	/* Encode the file header.
+	 */
+	strcpy  (hb.dbuf.name,  fh->name);
+	sprintf (hb.dbuf.mode,  "%6o ",   fh->mode);
+	sprintf (hb.dbuf.uid,   "%6o ",   fh->uid);
+	sprintf (hb.dbuf.gid,   "%6o ",   fh->gid);
+	sprintf (hb.dbuf.size,  "%11lo ", fh->size);
+	sprintf (hb.dbuf.mtime, "%11lo ", fh->mtime);
+
+	switch (fh->linkflag) {
+	case LF_SYMLINK:
+	    hb.dbuf.linkflag = '2';
+	    break;
+	case LF_DIR:
+	    hb.dbuf.linkflag = '5';
+	    break;
+	default:
+	    hb.dbuf.linkflag = '0';
+	    break;
+	}
+	strcpy (hb.dbuf.linkname, fh->linkname);
+
+	/* Encode the checksum value for the file header and then
+	 * write the field.  Calculate the checksum with the checksum
+	 * field blanked out. Compute the actual checksum as the sum of 
+	 * all bytes in the header block.  A sum of zero indicates the 
+	 * end of the tar file.
+	 */
+	for (n=0;  n < 8;  n++)
+	    hb.dbuf.chksum[n] = ' ';
+
+	sprintf (chksum, "%6o", cchksum (hb.dummy, TBLOCK));
+	for (n=0, ip=chksum;  n < 8;  n++)
+	    hb.dbuf.chksum[n] = *ip++;
+
+	if (debug) {
+	    printf ("File header:\n");
+	    printf ("      name = %s\n", hb.dbuf.name);
+	    printf ("      mode = %s\n", hb.dbuf.mode);
+	    printf ("       uid = %s\n", hb.dbuf.uid);
+	    printf ("       gid = %s\n", hb.dbuf.gid);
+	    printf ("      size = %-12.12s\n", hb.dbuf.size);
+	    printf ("     mtime = %-12.12s\n", hb.dbuf.mtime);
+	    printf ("    chksum = %s\n", hb.dbuf.chksum);
+	    printf ("  linkflag = %c\n", hb.dbuf.linkflag);
+	    printf ("  linkname = %s\n", hb.dbuf.linkname);
+	    fflush (stdout);
+	}
+
+	/* Write the header to the tarfile.
+	 */
+	return (putblock (out, hb.dummy));
+}
+
+
+/* CCHKSUM -- Compute the checksum of a byte array.
+ */
+static int
+cchksum (
+    register char	*p,
+    register int	nbytes
+)
+{
+	register int	sum;
+
+	for (sum=0;  --nbytes >= 0;  )
+	    sum += *p++;
+
+	return (sum);
+}
+
+
+/* PRINTHEADER -- Print the file header in either short or long (verbose)
+ * format, e.g.:
+ *		drwxr-xr-x  9 tody         1024 Nov  3 17:53 .
+ */
+static void
+printheader (
+    FILE  *fp,				/* output file			*/
+    register struct fheader *fh,	/* file header struct		*/
+    int	verbose 			/* long format output		*/
+)
+{
+	register struct	_modebits *mp;
+	char	*tp, *ctime();
+
+	if (!verbose) {
+	    fprintf (fp, "%s\n", fh->name);
+	    return;
+	}
+
+	for (mp=modebits;  mp->code;  mp++)
+	    fprintf (fp, "%c", mp->code & fh->mode ? mp->ch : '-');
+
+	tp = ctime (&fh->mtime);
+	fprintf (fp, "%3d %4d %2d %8ld %-12.12s %-4.4s %s",
+	    fh->linkflag,
+	    fh->uid,
+	    fh->gid,
+	    fh->size,
+	    tp + 4, tp + 20,
+	    fh->name);
+
+	if (fh->linkflag && *fh->linkname)
+	    fprintf (fp, " -> %s\n", fh->linkname);
+	else
+	    fprintf (fp, "\n");
+}
+
+
+/* COPYFILE -- Copy bytes from the input file to the output file.  Each file
+ * consists of a integral number of TBLOCK size blocks on the output file.
+ */
+static void
+copyfile (
+    char  *fname,		/* file being read from		*/
+    struct fheader *fh,		/* file header structure	*/
+    int	   ftype,		/* file type, text or binary	*/
+    int	   out 			/* output file			*/
+)
+{
+	register char	*bp;
+	register int	i;
+	int	nbytes, nleft, blocks, fd, count, total, ch;
+	char	buf[TBLOCK*2];
+
+	bp = buf;
+	total = nbytes = 0;
+	blocks = (fh->size + TBLOCK - 1 ) / TBLOCK;
+
+	if ((fd = os_open (fname, 0, ftype)) == ERR) {
+	    fflush (stdout);
+	    fprintf (stderr, "Warning: cannot open file `%s'\n", fname);
+	    fflush (stderr);
+	    goto pad_;
+	}
+
+	while (blocks > 0) {
+	    if ((count = os_read (fd, bp, TBLOCK)) == ERR || count > TBLOCK) {
+		fflush (stdout);
+		fprintf (stderr, "Warning: file read error on `%s'\n", fname);
+		fflush (stderr);
+		if (nerrs++ > MAXERR) {
+		    fprintf (stderr, "Too many errors\n");
+		    exit (OSOK+1);
+		}
+	    } else {
+		/* Buffer input to TBLOCK blocks.
+		 */
+		if (count == 0)		/* EOF */
+		    break;
+		else if ((nbytes += count) < TBLOCK)
+		    bp += count;
+		else {	
+		    putblock (out, buf);
+		    blocks--;
+
+		    /* Copy overflow back to beginning... */
+		    if (nbytes > TBLOCK) {
+			nleft = nbytes - TBLOCK;
+			os_amovb (&buf[TBLOCK], buf, nbytes - TBLOCK);
+		    } else
+			nleft = 0;
+
+		    bp = (char *) ((long)buf + nleft);
+		    total += nbytes;
+		    nbytes = nleft;
+		}
+	    }
+	}
+
+	os_close (fd);
+
+	/* Fill current block and subsequent full blocks until the number of
+	 * bytes specified in the file header have been output.  All files
+	 * occupy an integral number of 512 byte blocks on tape.  For text
+	 * files, pad with spaces, otherwise pad with nulls.  Also, for text
+	 * files, add newlines to avoid excessively long lines.
+	 */
+pad_:
+	ch = (ftype == TEXT_FILE) ? ' ' : '\0';
+	while (blocks > 0) {
+	    for (i=nbytes;  i < TBLOCK;  i++)
+		if (ftype == TEXT_FILE && i % 64 == 0)
+		    buf[i] = '\n';
+		else
+		    buf[i] = ch;
+
+	    if (ftype == TEXT_FILE)
+		buf[TBLOCK-1] = '\n';
+
+	    putblock (out, buf);
+	    blocks--;
+	    nbytes = 0;
+	}
+}
+
+
+/* PUTBLOCK -- Write a block to tape (buffered).
+ */
+static int
+putblock (int out, char *buf)
+{
+	int	nbytes = 0;
+
+	if (buf) {
+	    os_amovb (buf, nextblock, TBLOCK);
+	    nextblock += TBLOCK;
+	    if (++nblocks == NBLOCK)
+		nbytes = SZ_TAPEBUFFER;
+	} else if (nblocks > 0)
+	    nbytes = SZ_TAPEBUFFER;
+
+	if (nbytes > 0) {
+	    if (tape_write (out, tapeblock, nbytes) < nbytes) {
+		fflush (stdout);
+		fprintf (stderr, "Warning: write error on tarfile\n");
+		fflush (stderr);
+	    }
+
+	    nextblock = tapeblock;
+	    nblocks = 0;
+	}
+
+	return (TBLOCK);
+}
+
+
+/* ENDTAR -- Write the end of the tar file, i.e., two zero blocks.
+ */
+static void
+endtar (int out)
+{
+	register int  i;
+	union    hblock hb;
+
+	if (debug)
+	    printf ("write end of tar file\n");
+
+	for (i=0;  i < TBLOCK;  i++)
+	    hb.dummy[i] = '\0';
+
+	putblock (out, hb.dummy);	/* write 2 null blocks */
+	putblock (out, hb.dummy);
+	putblock (out, 0);		/* flush tape buffer */
+}
+
+
+/* U_FMODE -- Convert the IRAF file mode bits to the corresponding UNIX bits
+ * for the tar file header.
+ */
+static int
+u_fmode (int iraf_fmode, int ftype)
+{
+	register int	in = iraf_fmode;
+	register int	m = 0;
+	int	exec;
+
+	exec = (ftype == FI_DIRECTORY || ftype == FI_EXECUTABLE);
+
+	if (in & 001)	m |= 0400;	/* Owner READ  */
+	if (in & 002)  	m |= 0200;	/*       WRITE */
+	if (exec)	m |= 0100;	/*       EXECUTE */
+
+	if (in & 004)	m |= 040;	/* Group READ  */
+	if (in & 010)	m |= 020;	/*       WRITE */
+	if (exec)	m |= 010;	/*       EXECUTE */
+
+	if (in & 020)	m |= 004;	/* World READ  */
+	if (in & 040)	m |= 002;	/*       WRITE */
+	if (exec)	m |= 001;	/*       EXECUTE */
+
+	return (m);
+}
+
+
+/* DNAME -- Normalize a directory pathname.   For unix, this means convert
+ * an // sequences into a single /, and make sure the directory pathname ends
+ * in a single /.
+ */
+static char *
+dname (char *dir)
+{
+	register char	*ip, *op;
+	static	char path[SZ_PATHNAME+1];
+
+	for (ip=dir, op=path;  *ip;  *op++ = *ip++)
+	    while (*ip == '/' && *(ip+1) == '/')
+		ip++;
+
+	if (op > path && *(op-1) != '/')
+	    *op++ = '/';
+	*op = EOS;
+
+	return (path);
+}
diff --git a/unix/boot/wtar/wtar.hlp b/unix/boot/wtar/wtar.hlp
new file mode 100644
index 00000000..fdbc3aea
--- /dev/null
+++ b/unix/boot/wtar/wtar.hlp
@@ -0,0 +1,89 @@
+.help wtar Oct92 softools
+.ih
+NAME
+wtar -- write TAR format archive file
+.ih
+USAGE
+wtar [-flags] [-f archive] [files]
+.ih
+ARGUMENTS
+.ls 12 -d
+Print debug messages.
+.le
+.ls 12 -o
+Omit binary files.
+.le
+.ls 12 -t
+Print the name of each file as it is written or omitted.
+.le
+.ls 12 -v
+Verbose mode; print more information about each file.
+.le
+.ls 12 -f archive
+The tar format file to be written, i.e., "stdout", a host magtape device
+name (e.g., "/dev/nrmt8" or "MSA0"), or the IRAF virtual filename of a disk
+file.  The default is the standard output.
+.le
+.ls 12 files
+The names of the files or root directories of directory trees to be written
+to the archive file.  If no files are specified "." (the directory tree
+rooted at the current directory) is assumed.
+.le
+.ih
+DESCRIPTION
+The named files and directories are written to the indicated
+UNIX "tar" format output file.  Any directories in the file list are
+recursively descended.  The named directories should be subdirectories of
+the current directory when \fIwtar\fR is called.  Binary files may be
+omitted if desired, e.g., when transporting software to a different host, or
+when making a backup of a large system which would otherwise exceed the
+capacity of a single reel of tape.  All file, directory, and magtape names
+conform to the IRAF standard.
+
+The output file is normally either a disk file (e.g., if the transport
+medium is an electronic network), or a magtape file.  If the output file is
+a magtape multiple files, i.e., wtar archives, may be written on the tape.
+The blocking factor is fixed at 10240 bytes per record.
+
+The TAR format file written by \fIwtar\fR conforms to the UNIX standard except
+that [1] no link information is preserved, [2] the user and group numbers
+may not be preserved (they are preserved in the UNIX version of \fIwtar\fR),
+and [3] some versions of \fIwtar\fR (e.g., VMS) pad text files at the end
+with extra blank lines.
+
+All \fIwtar\fR filename arguments are IRAF virtual filenames (or host
+filenames).  Magtape devices should be specified by their host (not IRAF)
+device name, e.g., "/dev/nrmt8" or "MSA0".
+.ih
+EXAMPLES
+1. Make a source-only archive of the IRAF system on the UNIX device
+/dev/nrmt8.
+
+.nf
+	cl> cd iraf
+	cl> wtar -of /dev/nrmt8
+.fi
+
+2. Archive the "uparm" directory to the VMS logical device MSA0:.
+
+	cl> wtar -f msa0 uparm
+
+3. Make a disk archive of the LIB and PKG directory trees in your home
+directory.
+
+	cl> wtar -f home$archive.tar lib pkg 
+
+4. Examine the resultant file to make sure everything worked correctly.
+
+	cl> rtar -tvf home$archive.tar
+
+
+5. Make a disk archive, using a host filename for the output file.
+
+	cl> wtar -f /tmp2/arc lib pkg sys
+
+IRAF magtape commands such as \fIrewind\fR may be used with \fIwtar\fR,
+but switching between IRAF and host device names can be confusing.
+.ih
+SEE ALSO
+rtar, rmbin
diff --git a/unix/boot/xyacc/Makefile b/unix/boot/xyacc/Makefile
new file mode 100644
index 00000000..1afcdfdd
--- /dev/null
+++ b/unix/boot/xyacc/Makefile
@@ -0,0 +1,21 @@
+HLIB	= ../../hlib/
+IRAFLIB	= ../../../lib/
+VGRIND	= csh /usr/ucb/vgrind -W
+
+head:	xyacc 
+xyacc:	y1.o y2.o y3.o y4.o
+	cc -o xyacc.e y?.o 
+
+y1.o y2.o y3.o y4.o: dextern files
+
+install:
+	mv -f xyacc.e $(HLIB)
+	cp    yaccpar.x $(IRAFLIB)
+
+clean :
+	rm -f *.o 
+
+vgrind:
+	cp /dev/null index
+	$(VGRIND) -h 'Yacc' dextern files y1.c y2.c y3.c y4.c
+	$(VGRIND) -h 'Yacc' -x index
diff --git a/unix/boot/xyacc/README b/unix/boot/xyacc/README
new file mode 100644
index 00000000..2da6b992
--- /dev/null
+++ b/unix/boot/xyacc/README
@@ -0,0 +1,117 @@
+.help xyacc
+.nf
+This directory contains the source for the Yacc compiler compiler as modified
+to produce SPP language parsers.  This version of XYACC is based on code
+obtained from the OpenSolaris project and distributed under the Common
+Development and Distribution License (CDDL), considered to be a 'free'
+license.  All parsers in the system will be regenerated using this new
+version of XYACC, all vestiges of the original XYACC code have been
+removed.
+
+Notes regarding the changes required for SPP from the original README
+file are included below.
+
+Mike Fitzpatrick 
+1/25/2011
+
+
+------------------------------------------------------------------------------
+
+    For the most part, the operation of SPP/Yacc is as described in the 
+Yacc reference manual, with the important differences noted below.  A 
+complete working example of a desk calculator program may be found in 
+the subdirectory debug, file dc.y.
+
+Notes on SPP Yacc
+
+    (1)	The Yacc input syntax is unmodified, except that the comment convention
+	is now as in SPP, rather than C (i.e., use #, rather than /*..*/).
+	All defines, actions, etc. are of course given in the SPP language.
+
+    (2)	The Yacc output file is "ytab.x", rather than "y.tab.c".  The token
+	defs file "y.tab.h" now contains SPP defines, rather than C #defines.
+	The states file "y.output" is completely unmodified.
+
+    (3)	The global declarations section %{ .. %} had to be changed somewhat
+	because SPP does not have global variables.  The section is now
+	divided into two subsections.  The first is for global defines,
+	includes, etc. which go into the header area of the ytab.x file.
+	Then follows a %L, telling Yacc that the local declarations for
+	the parser procedure follow.  This second section should contain
+	variable and function declarations required for the user supplied
+	actions (code fragments to be executed when a rule of the grammar
+	is recognized) in the yyparse procedure.
+
+    (4)	The global declarations section MUST contain the following two
+	defines:
+
+		YYMAXDEPTH	Depth of the parser stacks; determines
+				the maximum complexity of a language
+				construct which can be parsed.  A typical
+				value is 150.
+
+		YYOPLEN		The length, in struct units, of a token
+				operand value structure.  You define the
+				operand structure to be whatever you wish;
+				all the parser needs to know is how big an
+				element is.  The lexical analyzer and the
+				actions, both of which are supplied by the
+				user, use the operand structure for
+				communications.  Operand structures are
+				always referred to by a Mem pointer.
+
+    (5)	The calling sequence for the parser is as follows
+
+		status = yyparse (fd, debug, yylex)
+
+	where
+		status is OK, EOF, or ERR (syntax error)
+		fd is the text stream to be parsed
+		debug is a boolean, true to print debugging info
+		yylex is the user supplied lexical analysis procedure.
+
+	The calling sequence for the lexical analysis procedure is as
+	follows (the name "yylex" may be anything):
+
+		token = yylex (fd, yylval)
+
+	where
+		Token is the integer code for the token.  The tokens are
+		    named in the Yacc grammar, and are defined either by
+		    the user or by Yacc in the header area of ytab.x.
+		    If Yacc is permitted to assign codes to tokens, the
+		    token defininitions file ytab.h is written out.
+		fd is the file to be read
+		yylval is a POINTER to the token value structure to be
+		    returned by yylex.
+
+    (6)	The SPP version of Yacc, unlike the C version, does not use any
+	external or global variables for communication between routines,
+	and hence it is possible for several distinct parsers to coexist
+	in the same image.  If this is done, the user supplied yylex
+	procedures should be named something else, and the name of the
+	parser procedure (yyparse) should be changed.  This can be done
+	by putting a "define yyparse" in the global definitions area.
+
+    (7)	Token values (i.e., $$, $1, $2, yyval, yylval, etc.) are always
+	pointers to structures in the SPP version, as opposed to structures
+	in the C version.  Thus actions like
+
+		{ $$ = $1; }
+
+	which are common in the C version, are programmed like this in SPP:
+
+		{ YYMOVE ($1, $$) }
+	
+	where YYMOVE is a Yacc supplied macro which copies an operand
+	structure.
+
+    (8)	The source for the language independent part of the parser is given
+	in "lib$yaccpar.x".
+
+Doug Tody, 21 Feb 84.
+20Jan85:
+	y.tab.x -> ytab.x (etc), added EOF token
+20Apr85:
+	lib$yaccpar.x, deleted entry points for examining parser stack and
+	other context state variables.
diff --git a/unix/boot/xyacc/debug/dc.y b/unix/boot/xyacc/debug/dc.y
new file mode 100644
index 00000000..0d6fe655
--- /dev/null
+++ b/unix/boot/xyacc/debug/dc.y
@@ -0,0 +1,306 @@
+# SPP/Yacc specification for a simple desk calculator.  Input consists
+# of simple arithmetic expressions; output is the value of the expression.
+# Operands are restricted to integer and real numeric constants.
+
+%{
+include	<ctype.h>
+include	<lexnum.h>
+
+define	YYMAXDEPTH	150		# length of parser stack
+
+task	dc = t_dc
+
+# Operand Structure (parser stack)
+define	YYOPLEN		2		# size of operand structure
+define	OPTYPE		Memi[$1]	# operand datatype
+define	OPVALI		Memi[$1+1]	# integer value of operand
+define	OPVALR		Memr[$1+1]	# real value of operand
+
+%}
+
+%token	CONST LETTER YYEOF
+
+%left	'+' '-'
+%left	'*' '/'
+%left	UMINUS
+
+%%
+
+prog	:	# Empty
+	|	prog stmt eost {
+			return (OK)
+		    }
+	|	YYEOF {
+			return (EOF)
+		    }
+	|	prog error '\n' {
+			yyerrok
+		    }
+	;
+
+stmt	:	expr {
+			# Print the value of an expression.
+			if (OPTYPE($1) == TY_INT) {
+			    call printf ("%d\n")
+				call pargi (OPVALI($1))
+			} else {
+			    call printf ("%g\n")
+				call pargr (OPVALR($1))
+			}
+		    }
+	|	LETTER '=' expr {
+			# Set the value of a register (from a-z).
+			call putreg (OPVALI($1), $3)
+		    }
+	;
+
+expr	:	'(' expr ')' {
+			YYMOVE ($2, $$)
+		    }
+	|	expr '+' opnl expr {
+			call binop ($1, $4, $$, '+')
+		    }
+	|	expr '-' opnl expr {
+			call binop ($1, $4, $$, '-')
+		    }
+	|	expr '*' opnl expr {
+			call binop ($1, $4, $$, '*')
+		    }
+	|	expr '/' opnl expr {
+			call binop ($1, $4, $$, '/')
+		    }
+	|	'-' expr %prec UMINUS {
+			call unop ($2, $$, '-')
+		    }
+	|	LETTER {
+			call getreg (OPVALI($1), $$)
+		    }
+	|	CONST
+	;
+
+eost	:	';'
+	|	'\n'
+	;
+
+opnl	:	# Empty
+	|	opnl '\n'
+	;
+
+%%
+
+
+# DC -- Main routine for the desk calculator.
+
+procedure t_dc()
+
+bool	debug
+int	status
+bool	clgetb()
+int	yyparse()
+extern	yylex()
+
+begin
+	debug = clgetb ("debug")
+
+	repeat {
+	    status = yyparse (STDIN, debug, yylex)
+	    if (status == ERR)
+		call eprintf ("syntax error")
+	} until (status == EOF)
+end
+
+
+# BINOP -- Perform an arithmetic binary operation on two operands (passed
+# by pointer), returning the result in a third.
+
+procedure binop (a, b, c, operation)
+
+pointer	a, b, c			# c = a op b
+int	operation		# i.e., '+', '-', etc.
+int	i, j, k
+real	x, y, z
+
+begin
+	if (OPTYPE(a) == TY_INT && OPTYPE(b) == TY_INT) {
+	    # Both operands are of type int, so return an integer result.
+
+	    i = OPVALI(a)
+	    j = OPVALI(b)
+
+	    switch (operation) {
+	    case '+':
+		k = i + j
+	    case '-':
+		k = i - j
+	    case '*':
+		k = i * j
+	    case '/':
+		k = i / j
+	    default:
+		call error (1, "unknown binary operator")
+	    }
+	    OPVALI(c) = k
+	    OPTYPE(c) = TY_INT
+
+	} else {
+	    # At least one of the two operands is a real.  Perform the
+	    # calculation in type real, producing a real result.
+
+	    if (OPTYPE(a) == TY_INT)
+		x = OPVALI(a)
+	    else
+		x = OPVALR(a)
+	    if (OPTYPE(b) == TY_INT)
+		y = OPVALI(b)
+	    else
+		y = OPVALR(b)
+
+	    switch (operation) {
+	    case '+':
+		z = x + y
+	    case '-':
+		z = x - y
+	    case '*':
+		z = x * y
+	    case '/':
+		z = x / y
+	    default:
+		call error (1, "unknown binary operator")
+	    }
+
+	    OPVALR(c) = z
+	    OPTYPE(c) = TY_REAL
+	}
+end
+
+
+# UNOP -- Perform a unary operation.  Since there is only one operand, the
+# datatype does not change.
+
+procedure unop (a, b, operation)
+
+pointer	a, b
+int	operation
+
+begin
+	OPTYPE(b) = OPTYPE(a)
+
+	switch (operation) {
+	case '-':
+	    switch (OPTYPE(a)) {
+	    case TY_INT:
+		OPVALI(b) = -OPVALI(a)
+	    case TY_REAL:
+		OPVALR(b) = -OPVALR(a)
+	    }
+	default:
+	    call error (2, "unknown unary operator")
+	}
+end
+
+
+# GETREG, PUTREG -- Fetch or store the contents of a register variable.
+# Registers are referred to by letter, A-Z or a-z.
+
+define	MAXREG		('z'-'a'+1)
+
+
+procedure getreg (regchar, op)
+
+int	regchar
+pointer	op
+
+bool	store
+int	regbuf[MAXREG*YYOPLEN]
+int	reg, offset
+
+begin
+	store = false
+	goto 10
+
+entry	putreg (regchar, op)
+	store = true
+
+	# Compute offset into storage.  Structures are stored in buffer
+	# by a binary copy, knowing only the length of the structure.
+10	if (IS_UPPER(regchar))
+	    reg = regchar - 'A' + 1
+	else
+	    reg = regchar - 'a' + 1
+	reg = max(1, min(MAXREG, reg))
+	offset = (reg-1) * YYOPLEN + 1
+
+	# Copy the operand structure either in or out.
+	if (store)
+	    call amovi (Memi[op], regbuf[offset], YYOPLEN)
+	else
+	    call amovi (regbuf[offset], Memi[op], YYOPLEN)
+end
+
+
+# YYLEX -- Lexical input routine.  Return next token from the input
+# stream.  Recognized tokens are CONST (numeric constants), LETTER,
+# and the operator characters.
+
+int procedure yylex (fd, yylval)
+
+int	fd
+pointer	yylval
+char	ch, lbuf[SZ_LINE]
+int	ip, nchars, token, junk
+double	dval
+int	lexnum(), getline(), gctod()
+data	ip /0/
+
+begin
+	# Fetch a nonempty input line, or advance to start of next token
+	# if within a line.  Newline is a token.
+	repeat {
+	    if (ip <= 0 || lbuf[ip] == EOS) {
+		if (getline (fd, lbuf) == EOF) {
+		    ip = 0
+		    return (YYEOF)
+		} else
+		    ip = 1
+	    }
+	    while (IS_WHITE (lbuf[ip]))
+		ip = ip + 1
+	} until (lbuf[ip] != EOS)
+
+	# Determine type of token.  If numeric constant, convert to binary
+	# and return value in op structure (yylval).  If letter (register
+	# variable) return value and advance input one char.  If any other
+	# character, return char itself as the token, and advance input one
+	# character.
+
+	if (IS_DIGIT (lbuf[ip]))
+	    token = lexnum (lbuf, ip, nchars)
+	else
+	    token = LEX_NONNUM
+
+	switch (token) {
+	case LEX_OCTAL, LEX_DECIMAL, LEX_HEX:
+	    junk = gctod (lbuf, ip, dval)
+	    OPTYPE(yylval) = TY_INT
+	    OPVALI(yylval) = int (dval)
+	    return (CONST)
+
+	case LEX_REAL:
+	    junk = gctod (lbuf, ip, dval)
+	    OPTYPE(yylval) = TY_REAL
+	    OPVALR(yylval) = dval
+	    return (CONST)
+
+	default:
+	    ch = lbuf[ip]
+	    ip = ip + 1
+	    if (IS_ALPHA (ch)) {
+		OPTYPE(yylval) = LETTER
+		OPVALI(yylval) = ch
+		return (LETTER)
+	    } else {
+		OPTYPE(yylval) = ch
+		return (OPTYPE(yylval))
+	    }
+	}
+end
diff --git a/unix/boot/xyacc/debug/y.output b/unix/boot/xyacc/debug/y.output
new file mode 100644
index 00000000..5640244f
--- /dev/null
+++ b/unix/boot/xyacc/debug/y.output
@@ -0,0 +1,331 @@
+
+state 0
+	$accept : _prog $end 
+	prog : _    (1)
+
+	YYEOF  shift 2
+	.  reduce 1
+
+	prog  goto 1
+
+state 1
+	$accept :  prog_$end 
+	prog :  prog_stmt eost 
+	prog :  prog_error \n 
+
+	$end  accept
+	error  shift 4
+	CONST  shift 9
+	LETTER  shift 6
+	-  shift 8
+	(  shift 7
+	.  error
+
+	stmt  goto 3
+	expr  goto 5
+
+state 2
+	prog :  YYEOF_    (3)
+
+	.  reduce 3
+
+
+state 3
+	prog :  prog stmt_eost 
+
+	\n  shift 12
+	;  shift 11
+	.  error
+
+	eost  goto 10
+
+state 4
+	prog :  prog error_\n 
+
+	\n  shift 13
+	.  error
+
+
+state 5
+	stmt :  expr_    (5)
+	expr :  expr_+ opnl expr 
+	expr :  expr_- opnl expr 
+	expr :  expr_* opnl expr 
+	expr :  expr_/ opnl expr 
+
+	+  shift 14
+	-  shift 15
+	*  shift 16
+	/  shift 17
+	.  reduce 5
+
+
+state 6
+	stmt :  LETTER_= expr 
+	expr :  LETTER_    (13)
+
+	=  shift 18
+	.  reduce 13
+
+
+state 7
+	expr :  (_expr ) 
+
+	CONST  shift 9
+	LETTER  shift 20
+	-  shift 8
+	(  shift 7
+	.  error
+
+	expr  goto 19
+
+state 8
+	expr :  -_expr 
+
+	CONST  shift 9
+	LETTER  shift 20
+	-  shift 8
+	(  shift 7
+	.  error
+
+	expr  goto 21
+
+state 9
+	expr :  CONST_    (14)
+
+	.  reduce 14
+
+
+state 10
+	prog :  prog stmt eost_    (2)
+
+	.  reduce 2
+
+
+state 11
+	eost :  ;_    (15)
+
+	.  reduce 15
+
+
+state 12
+	eost :  \n_    (16)
+
+	.  reduce 16
+
+
+state 13
+	prog :  prog error \n_    (4)
+
+	.  reduce 4
+
+
+state 14
+	expr :  expr +_opnl expr 
+	opnl : _    (17)
+
+	.  reduce 17
+
+	opnl  goto 22
+
+state 15
+	expr :  expr -_opnl expr 
+	opnl : _    (17)
+
+	.  reduce 17
+
+	opnl  goto 23
+
+state 16
+	expr :  expr *_opnl expr 
+	opnl : _    (17)
+
+	.  reduce 17
+
+	opnl  goto 24
+
+state 17
+	expr :  expr /_opnl expr 
+	opnl : _    (17)
+
+	.  reduce 17
+
+	opnl  goto 25
+
+state 18
+	stmt :  LETTER =_expr 
+
+	CONST  shift 9
+	LETTER  shift 20
+	-  shift 8
+	(  shift 7
+	.  error
+
+	expr  goto 26
+
+state 19
+	expr :  ( expr_) 
+	expr :  expr_+ opnl expr 
+	expr :  expr_- opnl expr 
+	expr :  expr_* opnl expr 
+	expr :  expr_/ opnl expr 
+
+	+  shift 14
+	-  shift 15
+	*  shift 16
+	/  shift 17
+	)  shift 27
+	.  error
+
+
+state 20
+	expr :  LETTER_    (13)
+
+	.  reduce 13
+
+
+state 21
+	expr :  expr_+ opnl expr 
+	expr :  expr_- opnl expr 
+	expr :  expr_* opnl expr 
+	expr :  expr_/ opnl expr 
+	expr :  - expr_    (12)
+
+	.  reduce 12
+
+
+state 22
+	expr :  expr + opnl_expr 
+	opnl :  opnl_\n 
+
+	CONST  shift 9
+	LETTER  shift 20
+	-  shift 8
+	\n  shift 29
+	(  shift 7
+	.  error
+
+	expr  goto 28
+
+state 23
+	expr :  expr - opnl_expr 
+	opnl :  opnl_\n 
+
+	CONST  shift 9
+	LETTER  shift 20
+	-  shift 8
+	\n  shift 29
+	(  shift 7
+	.  error
+
+	expr  goto 30
+
+state 24
+	expr :  expr * opnl_expr 
+	opnl :  opnl_\n 
+
+	CONST  shift 9
+	LETTER  shift 20
+	-  shift 8
+	\n  shift 29
+	(  shift 7
+	.  error
+
+	expr  goto 31
+
+state 25
+	expr :  expr / opnl_expr 
+	opnl :  opnl_\n 
+
+	CONST  shift 9
+	LETTER  shift 20
+	-  shift 8
+	\n  shift 29
+	(  shift 7
+	.  error
+
+	expr  goto 32
+
+state 26
+	stmt :  LETTER = expr_    (6)
+	expr :  expr_+ opnl expr 
+	expr :  expr_- opnl expr 
+	expr :  expr_* opnl expr 
+	expr :  expr_/ opnl expr 
+
+	+  shift 14
+	-  shift 15
+	*  shift 16
+	/  shift 17
+	.  reduce 6
+
+
+state 27
+	expr :  ( expr )_    (7)
+
+	.  reduce 7
+
+
+state 28
+	expr :  expr_+ opnl expr 
+	expr :  expr + opnl expr_    (8)
+	expr :  expr_- opnl expr 
+	expr :  expr_* opnl expr 
+	expr :  expr_/ opnl expr 
+
+	*  shift 16
+	/  shift 17
+	.  reduce 8
+
+
+state 29
+	opnl :  opnl \n_    (18)
+
+	.  reduce 18
+
+
+state 30
+	expr :  expr_+ opnl expr 
+	expr :  expr_- opnl expr 
+	expr :  expr - opnl expr_    (9)
+	expr :  expr_* opnl expr 
+	expr :  expr_/ opnl expr 
+
+	*  shift 16
+	/  shift 17
+	.  reduce 9
+
+
+state 31
+	expr :  expr_+ opnl expr 
+	expr :  expr_- opnl expr 
+	expr :  expr_* opnl expr 
+	expr :  expr * opnl expr_    (10)
+	expr :  expr_/ opnl expr 
+
+	.  reduce 10
+
+
+state 32
+	expr :  expr_+ opnl expr 
+	expr :  expr_- opnl expr 
+	expr :  expr_* opnl expr 
+	expr :  expr_/ opnl expr 
+	expr :  expr / opnl expr_    (11)
+
+	.  reduce 11
+
+
+15/127 terminals, 5/300 nonterminals
+19/600 grammar rules, 33/750 states
+0 shift/reduce, 0 reduce/reduce conflicts reported
+13/350 working sets used
+memory: states,etc. 226/12000, parser 14/12000
+11/600 distinct lookahead sets
+5 extra closures
+59 shift entries, 1 exceptions
+15 goto entries
+0 entries saved by goto default
+Optimizer space used: input 145/12000, output 249/12000
+249 table entries, 204 zero
+maximum spread: 259, maximum offset: 259
diff --git a/unix/boot/xyacc/debug/ytab.x b/unix/boot/xyacc/debug/ytab.x
new file mode 100644
index 00000000..5a453b52
--- /dev/null
+++ b/unix/boot/xyacc/debug/ytab.x
@@ -0,0 +1,645 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+include	<lexnum.h>
+
+define	YYMAXDEPTH	150		# length of parser stack
+
+task	dc = t_dc
+
+# Operand Structure (parser stack)
+define	YYOPLEN		2		# size of operand structure
+define	OPTYPE		Memi[$1]	# operand datatype
+define	OPVALI		Memi[$1+1]	# integer value of operand
+define	OPVALR		Memr[$1+1]	# real value of operand
+
+define	CONST		257
+define	LETTER		258
+define	YYEOF		259
+define	UMINUS		260
+define	yyclearin	yychar = -1
+define	yyerrok		yyerrflag = 0
+define	YYMOVE		call amovi (Memi[$1], Memi[$2], YYOPLEN)
+define	YYERRCODE	256
+
+# line 89 "dc.y"
+
+
+
+# DC -- Main routine for the desk calculator.
+
+procedure t_dc()
+
+bool	debug
+int	status
+bool	clgetb()
+int	yyparse()
+extern	yylex()
+
+begin
+	debug = clgetb ("debug")
+
+	repeat {
+	    status = yyparse (STDIN, debug, yylex)
+	    if (status == ERR)
+		call eprintf ("syntax error")
+	} until (status == EOF)
+end
+
+
+# BINOP -- Perform an arithmetic binary operation on two operands (passed
+# by pointer), returning the result in a third.
+
+procedure binop (a, b, c, opchar)
+
+pointer	a, b, c		# c = a op b
+char	opchar		# i.e., '+', '-', etc.
+int	i, j, k
+real	x, y, z
+
+begin
+	if (OPTYPE(a) == TY_INT && OPTYPE(b) == TY_INT) {
+	    # Both operands are of type int, so return an integer result.
+
+	    i = OPVALI(a)
+	    j = OPVALI(b)
+
+	    switch (opchar) {
+	    case '+':
+		k = i + j
+	    case '-':
+		k = i - j
+	    case '*':
+		k = i * j
+	    case '/':
+		k = i / j
+	    default:
+		call error (1, "unknown binary operator")
+	    }
+	    OPVALI(c) = k
+	    OPTYPE(c) = TY_INT
+
+	} else {
+	    # At least one of the two operands is a real.  Perform the
+	    # calculation in type real, producing a real result.
+
+	    if (OPTYPE(a) == TY_INT)
+		x = OPVALI(a)
+	    else
+		x = OPVALR(a)
+	    if (OPTYPE(b) == TY_INT)
+		y = OPVALI(b)
+	    else
+		y = OPVALR(b)
+
+	    switch (opchar) {
+	    case '+':
+		z = x + y
+	    case '-':
+		z = x - y
+	    case '*':
+		z = x * y
+	    case '/':
+		z = x / y
+	    default:
+		call error (1, "unknown binary operator")
+	    }
+
+	    OPVALR(c) = z
+	    OPTYPE(c) = TY_REAL
+	}
+end
+
+
+# UNOP -- Perform a unary operation.  Since there is only one operand, the
+# datatype does not change.
+
+procedure unop (a, b, opchar)
+
+pointer	a, b
+char	opchar
+
+begin
+	OPTYPE(b) = OPTYPE(a)
+
+	switch (opchar) {
+	case '-':
+	    switch (OPTYPE(a)) {
+	    case TY_INT:
+		OPVALI(b) = -OPVALI(a)
+	    case TY_REAL:
+		OPVALR(b) = -OPVALR(a)
+	    }
+	default:
+	    call error (2, "unknown unary operator")
+	}
+end
+
+
+# GETREG, PUTREG -- Fetch or store the contents of a register variable.
+# Registers are referred to by letter, A-Z or a-z.
+
+define	MAXREG		('z'-'a'+1)
+
+
+procedure getreg (regchar, op)
+
+char	regchar
+pointer	op
+
+bool	store
+int	regbuf[MAXREG*YYOPLEN]
+int	reg, offset
+
+begin
+	store = false
+	goto 10
+
+entry	putreg (regchar, op)
+	store = true
+
+	# Compute offset into storage.  Structures are stored in buffer
+	# by a binary copy, knowing only the length of the structure.
+10	if (IS_UPPER(regchar))
+	    reg = regchar - 'A' + 1
+	else
+	    reg = regchar - 'a' + 1
+	reg = max(1, min(MAXREG, reg))
+	offset = (reg-1) * YYOPLEN + 1
+
+	# Copy the operand structure either in or out.
+	if (store)
+	    call amovi (Memi[op], regbuf[offset], YYOPLEN)
+	else
+	    call amovi (regbuf[offset], Memi[op], YYOPLEN)
+end
+
+
+# YYLEX -- Lexical input routine.  Return next token from the input
+# stream.  Recognized tokens are CONST (numeric constants), LETTER,
+# and the operator characters.
+
+int procedure yylex (fd, yylval)
+
+int	fd
+pointer	yylval
+char	ch, lbuf[SZ_LINE]
+int	ip, nchars, token, junk
+double	dval
+int	lexnum(), getline(), gctod()
+data	ip /0/
+
+begin
+	# Fetch a nonempty input line, or advance to start of next token
+	# if within a line.  Newline is a token.
+	repeat {
+	    if (ip <= 0 || lbuf[ip] == EOS) {
+		if (getline (fd, lbuf) == EOF) {
+		    ip = 0
+		    return (YYEOF)
+		} else
+		    ip = 1
+	    }
+	    while (IS_WHITE (lbuf[ip]))
+		ip = ip + 1
+	} until (lbuf[ip] != EOS)
+
+	# Determine type of token.  If numeric constant, convert to binary
+	# and return value in op structure (yylval).  If letter (register
+	# variable) return value and advance input one char.  If any other
+	# character, return char itself as the token, and advance input one
+	# character.
+
+	if (IS_DIGIT (lbuf[ip]))
+	    token = lexnum (lbuf, ip, nchars)
+	else
+	    token = LEX_NONNUM
+
+	switch (token) {
+	case LEX_OCTAL, LEX_DECIMAL, LEX_HEX:
+	    junk = gctod (lbuf, ip, dval)
+	    OPTYPE(yylval) = TY_INT
+	    OPVALI(yylval) = int (dval)
+	    return (CONST)
+
+	case LEX_REAL:
+	    junk = gctod (lbuf, ip, dval)
+	    OPTYPE(yylval) = TY_REAL
+	    OPVALR(yylval) = dval
+	    return (CONST)
+
+	default:
+	    ch = lbuf[ip]
+	    ip = ip + 1
+	    if (IS_ALPHA (ch)) {
+		OPTYPE(yylval) = LETTER
+		OPVALI(yylval) = ch
+		return (LETTER)
+	    } else {
+		OPTYPE(yylval) = ch
+		return (OPTYPE(yylval))
+	    }
+	}
+end
+define	YYNPROD		19
+define	YYLAST		249
+
+# Parser for yacc output, translated to the IRAF SPP language.  The contents
+# of this file form the bulk of the source of the parser produced by Yacc.
+# Yacc recognizes several macros in the yaccpar input source and replaces
+# them as follows:
+#	A	user suppled "global" definitions and declarations
+# 	B	parser tables
+# 	C	user supplied actions (reductions)
+# The remainder of the yaccpar code is not changed.
+
+define	yystack_	10		# statement labels for gotos
+define	yynewstate_	20
+define	yydefault_	30
+define	yyerrlab_	40
+define	yyabort_	50
+
+define	YYFLAG		(-1000)		# defs used in user actions
+define	YYERROR		goto yyerrlab_
+define	YYACCEPT	return (OK)
+define	YYABORT		return (ERR)
+
+
+# YYPARSE -- Parse the input stream, returning OK if the source is
+# syntactically acceptable (i.e., if compilation is successful),
+# otherwise ERR.  The parameters YYMAXDEPTH and YYOPLEN must be
+# supplied by the caller in the %{ ... %} section of the Yacc source.
+# The token value stack is a dynamically allocated array of operand
+# structures, with the length and makeup of the operand structure being
+# application dependent.
+
+int procedure yyparse (fd, yydebug, yylex)
+
+int	fd			# stream to be parsed
+bool	yydebug			# print debugging information?
+int	yylex()			# user-supplied lexical input function
+extern	yylex()
+
+short	yys[YYMAXDEPTH]		# parser stack -- stacks tokens
+pointer	yyv			# pointer to token value stack
+pointer	yyval			# value returned by action
+pointer	yylval			# value of token
+int	yyps			# token stack pointer
+pointer	yypv			# value stack pointer
+int	yychar			# current input token number
+int	yyerrflag		# error recovery flag
+int	yynerrs			# number of errors
+
+short	yyj, yym		# internal variables
+pointer	sp, yypvt
+short	yystate, yyn
+int	yyxi
+
+int	toksp			# declarations for status entry points
+int	uups, uuchar
+pointer	valsp, uuop, uupv, uuval, uulval
+int	yygtok(), yygval(), yystat()
+errchk	salloc, yylex
+
+short	yyexca[6]
+data	(yyexca(i),i=  1,  6)	/  -1,   1,   0,  -1,  -2,   0/
+short	yyact[249]
+data	(yyact(i),i=  1,  8)	/  29,   7,   2,   7,  18,  12,   8,  16/
+data	(yyact(i),i=  9, 16)	/   8,  27,  16,  14,  17,  15,   5,  17/
+data	(yyact(i),i= 17, 24)	/  16,  14,  13,  15,  10,  17,  19,  21/
+data	(yyact(i),i= 25, 32)	/   3,  22,   1,   0,   0,   0,   7,   0/
+data	(yyact(i),i= 33, 40)	/   0,  26,   0,   8,   0,  28,  30,  31/
+data	(yyact(i),i= 41, 48)	/  32,  23,  24,  25,   0,   0,   0,   0/
+data	(yyact(i),i= 49, 56)	/   0,   0,   0,   0,   0,   0,  11,   0/
+data	(yyact(i),i= 57, 64)	/   0,   0,   0,   0,   0,   0,   0,   0/
+data	(yyact(i),i= 65, 72)	/   0,   0,   0,   0,   0,   0,   0,   0/
+data	(yyact(i),i= 73, 80)	/   0,   0,   0,   0,   0,   0,   0,   0/
+data	(yyact(i),i= 81, 88)	/   0,   0,   0,   0,   0,   0,   0,   0/
+data	(yyact(i),i= 89, 96)	/   0,   0,   0,   0,   0,   0,   0,   0/
+data	(yyact(i),i= 97,104)	/   0,   0,   0,   0,   0,   0,   0,   0/
+data	(yyact(i),i=105,112)	/   0,   0,   0,   0,   0,   0,   0,   0/
+data	(yyact(i),i=113,120)	/   0,   0,   0,   0,   0,   0,   0,   0/
+data	(yyact(i),i=121,128)	/   0,   0,   0,   0,   0,   0,   0,   0/
+data	(yyact(i),i=129,136)	/   0,   0,   0,   0,   0,   0,   0,   0/
+data	(yyact(i),i=137,144)	/   0,   0,   0,   0,   0,   0,   0,   0/
+data	(yyact(i),i=145,152)	/   0,   0,   0,   0,   0,   0,   0,   0/
+data	(yyact(i),i=153,160)	/   0,   0,   0,   0,   0,   0,   0,   0/
+data	(yyact(i),i=161,168)	/   0,   0,   0,   0,   0,   0,   0,   0/
+data	(yyact(i),i=169,176)	/   0,   0,   0,   0,   0,   0,   0,   0/
+data	(yyact(i),i=177,184)	/   0,   0,   0,   0,   0,   0,   0,   0/
+data	(yyact(i),i=185,192)	/   0,   0,   0,   0,   0,   0,   0,   0/
+data	(yyact(i),i=193,200)	/   0,   0,   0,   0,   0,   0,   0,   0/
+data	(yyact(i),i=201,208)	/   0,   0,   0,   0,   0,   0,   0,   0/
+data	(yyact(i),i=209,216)	/   0,   0,   0,   0,   0,   0,   0,   0/
+data	(yyact(i),i=217,224)	/   0,   4,   9,   6,   9,  20,   0,   0/
+data	(yyact(i),i=225,232)	/   0,   0,   0,   0,   0,   0,   0,   0/
+data	(yyact(i),i=233,240)	/   0,   0,   0,   0,   0,   0,   0,   0/
+data	(yyact(i),i=241,248)	/   0,   0,   0,   0,   0,   0,   0,   9/
+data	(yyact(i),i=249,249)	/  20/
+short	yypact[33]
+data	(yypact(i),i=  1,  8)	/-257, -39,-1000,  -5,   8, -26, -57, -37/
+data	(yypact(i),i=  9, 16)	/ -37,-1000,-1000,-1000,-1000,-1000,-1000,-1000/
+data	(yypact(i),i= 17, 24)	/-1000,-1000, -37, -32,-1000,-1000, -10, -10/
+data	(yypact(i),i= 25, 32)	/ -10, -10, -26,-1000, -35,-1000, -35,-1000/
+data	(yypact(i),i= 33, 33)	/-1000/
+short	yypgo[6]
+data	(yypgo(i),i=  1,  6)	/   0,  26,  24,  20,  14,  25/
+short	yyr1[19]
+data	(yyr1(i),i=  1,  8)	/   0,   1,   1,   1,   1,   2,   2,   4/
+data	(yyr1(i),i=  9, 16)	/   4,   4,   4,   4,   4,   4,   4,   3/
+data	(yyr1(i),i= 17, 19)	/   3,   5,   5/
+short	yyr2[19]
+data	(yyr2(i),i=  1,  8)	/   0,   0,   3,   1,   3,   1,   3,   3/
+data	(yyr2(i),i=  9, 16)	/   4,   4,   4,   4,   2,   1,   1,   1/
+data	(yyr2(i),i= 17, 19)	/   1,   0,   2/
+short	yychk[33]
+data	(yychk(i),i=  1,  8)	/-1000,  -1, 259,  -2, 256,  -4, 258,  40/
+data	(yychk(i),i=  9, 16)	/  45, 257,  -3,  59,  10,  10,  43,  45/
+data	(yychk(i),i= 17, 24)	/  42,  47,  61,  -4, 258,  -4,  -5,  -5/
+data	(yychk(i),i= 25, 32)	/  -5,  -5,  -4,  41,  -4,  10,  -4,  -4/
+data	(yychk(i),i= 33, 33)	/  -4/
+short	yydef[33]
+data	(yydef(i),i=  1,  8)	/   1,  -2,   3,   0,   0,   5,  13,   0/
+data	(yydef(i),i=  9, 16)	/   0,  14,   2,  15,  16,   4,  17,  17/
+data	(yydef(i),i= 17, 24)	/  17,  17,   0,   0,  13,  12,   0,   0/
+data	(yydef(i),i= 25, 32)	/   0,   0,   6,   7,   8,  18,   9,  10/
+data	(yydef(i),i= 33, 33)	/  11/
+
+begin
+	call smark (sp)
+	call salloc (yyv, (YYMAXDEPTH+2) * YYOPLEN, TY_STRUCT)
+
+	# Initialization.  The first element of the dynamically allocated
+	# token value stack (yyv) is used for yyval, the second for yylval,
+	# and the actual stack starts with the third element.
+
+	yystate = 0
+	yychar = -1
+	yynerrs = 0
+	yyerrflag = 0
+	yyps = 0
+	yyval = yyv
+	yylval = yyv + YYOPLEN
+	yypv = yylval
+
+yystack_
+	# SHIFT -- Put a state and value onto the stack.  The token and
+	# value stacks are logically the same stack, implemented as two
+	# separate arrays.
+
+	if (yydebug) {
+	    call printf ("state %d, char 0%o\n")
+		call pargs (yystate)
+		call pargi (yychar)
+	}
+	yyps = yyps + 1
+	yypv = yypv + YYOPLEN
+	if (yyps > YYMAXDEPTH) {
+	    call sfree (sp)
+	    call eprintf ("yacc stack overflow\n")
+	    return (ERR)
+	}
+	yys[yyps] = yystate
+	YYMOVE (yyval, yypv)
+
+yynewstate_
+	# Process the new state.
+	yyn = yypact[yystate+1]
+
+	if (yyn <= YYFLAG)
+	    goto yydefault_			# simple state
+
+	# The variable "yychar" is the lookahead token.
+	if (yychar < 0) {
+	    yychar = yylex (fd, yylval)
+	    if (yychar < 0)
+		yychar = 0
+	}
+	yyn = yyn + yychar
+	if (yyn < 0 || yyn >= YYLAST)
+	    goto yydefault_
+
+	yyn = yyact[yyn+1]
+	if (yychk[yyn+1] == yychar) {		# valid shift
+	    yychar = -1
+	    YYMOVE (yylval, yyval)
+	    yystate = yyn
+	    if (yyerrflag > 0)
+		yyerrflag = yyerrflag - 1
+	    goto yystack_
+	}
+
+yydefault_
+	# Default state action.
+
+	yyn = yydef[yystate+1]
+	if (yyn == -2) {
+	    if (yychar < 0) {
+		yychar = yylex (fd, yylval)
+		if (yychar < 0)
+		    yychar = 0
+	    }
+
+	    # Look through exception table.
+	    yyxi = 1
+	    while ((yyexca[yyxi] != (-1)) || (yyexca[yyxi+1] != yystate))
+		yyxi = yyxi + 2
+	    for (yyxi=yyxi+2;  yyexca[yyxi] >= 0;  yyxi=yyxi+2) {
+		if (yyexca[yyxi] == yychar)
+		    break
+	    }
+
+	    yyn = yyexca[yyxi+1]
+	    if (yyn < 0) {
+		call sfree (sp)
+		return (OK)			# ACCEPT -- all done
+	    }
+	}
+
+
+	# SYNTAX ERROR -- resume parsing if possible.
+
+	if (yyn == 0) {
+	    switch (yyerrflag) {
+	    case 0, 1, 2:
+		if (yyerrflag == 0) {		# brand new error
+		    call eprintf ("syntax error\n")
+yyerrlab_
+		    yynerrs = yynerrs + 1
+		    # fall through...
+		}
+
+	    # case 1:
+	    # case 2: incompletely recovered error ... try again
+		yyerrflag = 3
+
+		# Find a state where "error" is a legal shift action.
+		while (yyps >= 1) {
+		    yyn = yypact[yys[yyps]+1] + YYERRCODE
+		    if ((yyn >= 0) && (yyn < YYLAST) &&
+			(yychk[yyact[yyn+1]+1] == YYERRCODE)) {
+			    # Simulate a shift of "error".
+			    yystate = yyact[yyn+1]
+			    goto yystack_
+		    }
+		    yyn = yypact[yys[yyps]+1]
+
+		    # The current yyps has no shift on "error", pop stack.
+		    if (yydebug) {
+			call printf ("error recovery pops state %d, ")
+			    call pargs (yys[yyps])
+			call printf ("uncovers %d\n")
+			    call pargs (yys[yyps-1])
+		    }
+		    yyps = yyps - 1
+		    yypv = yypv - YYOPLEN
+		}
+
+		# ABORT -- There is no state on the stack with an error shift.
+yyabort_
+		call sfree (sp)
+		return (ERR)
+
+
+	    case 3: # No shift yet; clobber input char.
+
+		if (yydebug) {
+		    call printf ("error recovery discards char %d\n")
+			call pargi (yychar)
+		}
+
+		if (yychar == 0)
+		    goto yyabort_		# don't discard EOF, quit
+		yychar = -1
+		goto yynewstate_		# try again in the same state
+	    }
+	}
+
+
+	# REDUCE -- Reduction by production yyn.
+
+	if (yydebug) {
+	    call printf ("reduce %d\n")
+		call pargs (yyn)
+	}
+	yyps  = yyps - yyr2[yyn+1]
+	yypvt = yypv
+	yypv  = yypv - yyr2[yyn+1] * YYOPLEN
+	YYMOVE (yypv + YYOPLEN, yyval)
+	yym   = yyn
+
+	# Consult goto table to find next state.
+	yyn = yyr1[yyn+1]
+	yyj = yypgo[yyn+1] + yys[yyps] + 1
+	if (yyj >= YYLAST)
+	    yystate = yyact[yypgo[yyn+1]+1]
+	else {
+	    yystate = yyact[yyj+1]
+	    if (yychk[yystate+1] != -yyn)
+		yystate = yyact[yypgo[yyn+1]+1]
+	}
+
+	# Perform action associated with the grammar rule, if any.
+	switch (yym) {
+	    
+case 2:
+# line 30 "dc.y"
+{
+			return (OK)
+		    }
+case 3:
+# line 33 "dc.y"
+{
+			return (EOF)
+		    }
+case 4:
+# line 36 "dc.y"
+{
+			yyerrok
+		    }
+case 5:
+# line 41 "dc.y"
+{
+			# Print the value of an expression.
+			if (OPTYPE(yypvt) == TY_INT) {
+			    call printf ("%d\n")
+				call pargi (OPVALI(yypvt))
+			} else {
+			    call printf ("%g\n")
+				call pargr (OPVALR(yypvt))
+			}
+		    }
+case 6:
+# line 51 "dc.y"
+{
+			# Set the value of a register (from a-z).
+			call putreg (char(OPVALI(yypvt-2*YYOPLEN)), yypvt)
+		    }
+case 7:
+# line 57 "dc.y"
+{
+			YYMOVE (yypvt-YYOPLEN, yyval)
+		    }
+case 8:
+# line 60 "dc.y"
+{
+			call binop (yypvt-3*YYOPLEN, yypvt, yyval, '+')
+		    }
+case 9:
+# line 63 "dc.y"
+{
+			call binop (yypvt-3*YYOPLEN, yypvt, yyval, '-')
+		    }
+case 10:
+# line 66 "dc.y"
+{
+			call binop (yypvt-3*YYOPLEN, yypvt, yyval, '*')
+		    }
+case 11:
+# line 69 "dc.y"
+{
+			call binop (yypvt-3*YYOPLEN, yypvt, yyval, '/')
+		    }
+case 12:
+# line 72 "dc.y"
+{
+			call unop (yypvt, yyval, '-')
+		    }
+case 13:
+# line 75 "dc.y"
+{
+			call getreg (char(OPVALI(yypvt)), yyval)
+		    }	}
+
+	goto yystack_				# stack new state and value
+
+
+# The following entry points are provided so that lexical routines
+# and actions may get information of the parser status, i.e., how
+# deep is the stack, what tokens are currently stacked, and so on.
+# Conceivably there could be reentrancy problems here...
+
+	# YYGTOK -- Read an element from the token stack.
+entry	yygtok (toksp)
+	return (yys[toksp])
+
+	# YYGVAL -- Read an element from the value stack.
+entry	yygval (valsp, uuop)
+	YYMOVE (valsp, uuop)
+	return (OPTYPE(uuop))
+
+	# YYSTAT -- Return parser state variables.  The code for the token
+	# currently on top of the stack is returned as the function value.
+
+entry	yystat (uups, uupv, uuchar, uuval, uulval)
+	uups = yyps
+	uupv = yypv
+	uuchar = yychar
+	YYMOVE (yyval, uuval)
+	YYMOVE (yylval, uulval)
+
+	if (yyps <= 0)
+	    return (0)
+	else
+	    return (yys[yyps])
+end
diff --git a/unix/boot/xyacc/dextern.h b/unix/boot/xyacc/dextern.h
new file mode 100644
index 00000000..e735003d
--- /dev/null
+++ b/unix/boot/xyacc/dextern.h
@@ -0,0 +1,382 @@
+/*
+ * CDDL HEADER START
+ *
+ * The contents of this file are subject to the terms of the
+ * Common Development and Distribution License (the "License").
+ * You may not use this file except in compliance with the License.
+ *
+ * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE
+ * or http://www.opensolaris.org/os/licensing.
+ * See the License for the specific language governing permissions
+ * and limitations under the License.
+ *
+ * When distributing Covered Code, include this CDDL HEADER in each
+ * file and include the License file at usr/src/OPENSOLARIS.LICENSE.
+ * If applicable, add the following below this CDDL HEADER, with the
+ * fields enclosed by brackets "[]" replaced with your own identifying
+ * information: Portions Copyright [yyyy] [name of copyright owner]
+ *
+ * CDDL HEADER END
+ */
+/*
+ * Copyright 2008 Sun Microsystems, Inc.  All rights reserved.
+ * Use is subject to license terms.
+ */
+
+/* Copyright (c) 1988 AT&T */
+/* All Rights Reserved */
+
+#ifndef _DEXTERN_H
+#define	_DEXTERN_H
+
+//#pragma ident	"%Z%%M%	%I%	%E% SMI"
+
+#include <stdio.h>
+#include <inttypes.h>
+#include <ctype.h>
+#include <memory.h>
+#include <string.h>
+#ifdef LINUX
+#include <malloc.h>
+#include <values.h>
+#else
+#include <malloc/malloc.h>
+#endif
+#include <unistd.h>
+#include <stdlib.h>
+
+
+#ifdef	__cplusplus
+extern "C" {
+#endif
+
+	/*  MANIFEST CONSTANT DEFINITIONS */
+#if u3b || u3b15 || u3b2 || vax || uts || sparc
+#define	WORD32
+#endif
+#ifdef LINUX
+#include <libintl.h>
+#endif
+
+	/* base of nonterminal internal numbers */
+
+#define	NTBASE 		010000
+
+	/* internal codes for error and accept actions */
+
+#define	ERRCODE  	8190
+#define	ACCEPTCODE 	8191
+
+	/* sizes and limits */
+
+#define	ACTSIZE 	12000
+#define	MEMSIZE 	12000
+#define	NSTATES 	750
+#define	PSTSIZE 	1024
+#define	NTERMS  	127
+#define	NPROD   	600
+#define	NNONTERM 	300
+#define	TEMPSIZE 	1200
+#define	CNAMSZ 		5000
+#define	LSETSIZE 	600
+#define	WSETSIZE 	350
+
+#define	NAMESIZE 	50
+#define	NTYPES 		63
+
+#define	NMBCHARSZ 	100
+#define	LKFACTOR 	16
+
+#define	WORD32
+#ifdef WORD32
+
+	/* bit packing macros (may be machine dependent) */
+#define	BIT(a, i) 	((a)[(i)>>5] & (1<<((i)&037)))
+#define	SETBIT(a, i) 	((a)[(i)>>5] |= (1<<((i)&037)))
+
+	/* number of words needed to hold n+1 bits */
+#define	NWORDS(n) 	(((n)+32)/32)
+
+#else
+
+	/* bit packing macros (may be machine dependent) */
+#define	BIT(a, i) 	((a)[(i)>>4] & (1<<((i)&017)))
+#define	SETBIT(a, i) 	((a)[(i)>>4] |= (1<<((i)&017)))
+
+	/* number of words needed to hold n+1 bits */
+#define	NWORDS(n) 	(((n)+16)/16)
+#endif
+
+	/*
+	 * relationships which must hold:
+	 * TBITSET ints must hold NTERMS+1 bits...
+	 * WSETSIZE >= NNONTERM
+	 * LSETSIZE >= NNONTERM
+	 * TEMPSIZE >= NTERMS + NNONTERMs + 1
+	 * TEMPSIZE >= NSTATES
+	 */
+
+	/* associativities */
+
+#define	NOASC 0  /* no assoc. */
+#define	LASC 1  /* left assoc. */
+#define	RASC 2  /* right assoc. */
+#define	BASC 3  /* binary assoc. */
+
+	/* flags for state generation */
+
+#define	DONE 0
+#define	MUSTDO 1
+#define	MUSTLOOKAHEAD 2
+
+	/* flags for a rule having an action, and being reduced */
+
+#define	ACTFLAG 04
+#define	REDFLAG 010
+
+	/* output parser flags */
+#define	YYFLAG1 (-1000)
+
+	/* macros for getting associativity and precedence levels */
+
+#define	ASSOC(i) ((i)&07)
+#define	PLEVEL(i) (((i)>>4)&077)
+#define	TYPE(i)  ((i>>10)&077)
+
+	/* macros for setting associativity and precedence levels */
+
+#define	SETASC(i, j) i |= j
+#define	SETPLEV(i, j) i |= (j<<4)
+#define	SETTYPE(i, j) i |= (j<<10)
+
+	/* looping macros */
+
+#define	TLOOP(i) for (i = 1; i <= ntokens; ++i)
+#define	NTLOOP(i) for (i = 0; i <= nnonter; ++i)
+#define	PLOOP(s, i) for (i = s; i < nprod; ++i)
+#define	SLOOP(i) for (i = 0; i < nstate; ++i)
+#define	WSBUMP(x) ++x
+#define	WSLOOP(s, j) for (j = s; j < &wsets[cwp]; ++j)
+#define	ITMLOOP(i, p, q) q = pstate[i+1]; for (p = pstate[i]; p < q; ++p)
+#define	SETLOOP(i) for (i = 0; i < tbitset; ++i)
+
+	/* I/O descriptors */
+
+extern FILE *finput;		/* input file */
+extern FILE *faction;		/* file for saving actions */
+extern FILE *fdefine;		/* file for #defines */
+extern FILE *ftable;		/* y.tab.c file */
+extern FILE *ftemp;		/* tempfile to pass 2 */
+extern FILE *fdebug;		/* tempfile for two debugging info arrays */
+extern FILE *foutput;		/* y.output file */
+extern FILE *fsppout;		/* ytab.x file */
+
+	/* structure declarations */
+
+typedef struct looksets {
+	int *lset;
+} LOOKSETS;
+
+typedef struct item {
+	int *pitem;
+	LOOKSETS *look;
+} ITEM;
+
+typedef struct toksymb {
+	char *name;
+	int value;
+} TOKSYMB;
+
+typedef struct mbclit {
+	char character;
+	int tvalue; /* token issued for the character */
+} MBCLIT;
+
+typedef struct ntsymb {
+	char *name;
+	int tvalue;
+} NTSYMB;
+
+typedef struct wset {
+	int *pitem;
+	int flag;
+	LOOKSETS ws;
+} WSET;
+
+	/* token information */
+
+extern int ntokens;	/* number of tokens */
+extern TOKSYMB *tokset;
+extern int ntoksz;
+
+	/*
+	 * multibyte (c > 255) character literals are
+	 * handled as though they were tokens except
+	 * that it generates a separate mapping table.
+	 */
+extern int nmbchars;	/* number of mb literals */
+extern MBCLIT *mbchars;
+extern int nmbcharsz;
+
+	/* nonterminal information */
+
+extern int nnonter;	/* the number of nonterminals */
+extern NTSYMB *nontrst;
+extern int nnontersz;
+
+	/* grammar rule information */
+
+extern int nprod;	/* number of productions */
+extern int **prdptr;	/* pointers to descriptions of productions */
+extern int *levprd;	/* contains production levels to break conflicts */
+extern char *had_act; /* set if reduction has associated action code */
+
+	/* state information */
+
+extern int nstate;		/* number of states */
+extern ITEM **pstate;	/* pointers to the descriptions of the states */
+extern int *tystate;	/* contains type information about the states */
+extern int *defact;	/* the default action of the state */
+
+extern int size;
+
+	/* lookahead set information */
+
+extern int TBITSET;
+extern LOOKSETS *lkst;
+extern int nolook;  /* flag to turn off lookahead computations */
+
+	/* working set information */
+
+extern WSET *wsets;
+
+	/* storage for productions */
+
+extern int *mem0;
+extern int *mem;
+extern int *tracemem;
+extern int new_memsize;
+
+	/* storage for action table */
+
+extern int *amem;
+extern int *memp;		/* next free action table position */
+extern int *indgo;		/* index to the stored goto table */
+extern int new_actsize;
+
+	/* temporary vector, indexable by states, terms, or ntokens */
+
+extern int *temp1;
+extern int lineno; /* current line number */
+
+	/* statistics collection variables */
+
+extern int zzgoent;
+extern int zzgobest;
+extern int zzacent;
+extern int zzexcp;
+extern int zzrrconf;
+extern int zzsrconf;
+
+	/* define external functions */
+
+extern void setup(int, char *[]);
+extern void closure(int);
+extern void output(void);
+extern void aryfil(int *, int, int);
+extern void error(char *, ...);
+extern void warning(int, char *, ...);
+extern void putitem(int *, LOOKSETS *);
+extern void go2out(void);
+extern void hideprod(void);
+extern void callopt(void);
+extern void warray(char *, int *, int);
+extern char *symnam(int);
+extern char *writem(int *);
+extern void exp_mem(int);
+extern void exp_act(int **);
+extern int apack(int *, int);
+extern int state(int);
+extern void fprintf3(FILE *, const char *, const char *, const char *, ...);
+extern void error3(const char *, const char *, const char *, ...);
+
+extern char *wscpy(char *, const char *);
+extern size_t wslen(const char *);
+extern int wscmp(const char *, const char *);
+
+
+	/* yaccpar location */
+
+extern char *parser;
+
+	/* default settings for a number of macros */
+
+	/* name of yacc tempfiles */
+
+#ifndef TEMPNAME
+#define	TEMPNAME 	"yacc.tmp"
+#endif
+
+#ifndef ACTNAME
+#define	ACTNAME 	"yacc.acts"
+#endif
+
+#ifndef DEBUGNAME
+#define	DEBUGNAME 	"yacc.debug"
+#endif
+
+#ifndef OFILE 				/* output file name                   */
+#define	OFILE 		"ytab.x"
+#endif
+
+#ifndef TABFILE 			/* parser tables file name            */
+#define	TABFILE 	"yacc.tab"
+#endif
+
+#ifndef UDFILE 				/* user global declarations file name */
+#define	UDFILE 		"yacc.udecl"
+#endif
+
+#ifndef FILEU 				/* user output file name              */
+#define	FILEU 		"y.output"
+#endif
+
+#ifndef FILED 				/* output file for # defines          */
+#define	FILED 		"ytab.h"
+#endif
+
+	/* command to clobber tempfiles after use */
+
+#ifndef ZAPFILE
+#define	ZAPFILE(x) (void)unlink(x)
+#endif
+
+#ifndef PARSER
+#define	PARSER "/iraf/iraf/lib/yaccpar.x"
+#endif
+
+
+
+/*
+ * Lint is unable to properly handle formats with wide strings
+ * (e.g. %ws) and misdiagnoses them as being malformed.
+ * This macro is used to work around that, by substituting
+ * a pointer to a null string when compiled by lint. This
+ * trick works because lint is not able to evaluate the
+ * variable.
+ *
+ * When lint is able to handle %ws, it would be appropriate
+ * to come back through and remove the use of this macro.
+ */
+#if defined(__lint)
+static const char *lint_ws_fmt = "";
+#define	WSFMT(_fmt) lint_ws_fmt
+#else
+#define	WSFMT(_fmt) _fmt
+#endif
+
+#ifdef	__cplusplus
+}
+#endif
+
+#endif /* _DEXTERN_H */
diff --git a/unix/boot/xyacc/mkpkg.sh b/unix/boot/xyacc/mkpkg.sh
new file mode 100644
index 00000000..205d8f5d
--- /dev/null
+++ b/unix/boot/xyacc/mkpkg.sh
@@ -0,0 +1,7 @@
+# XYACC -- Yacc parser generator for SPP.
+
+$CC -c $HSI_CF	y[1-4].c
+$CC $HSI_LF	y[1-4].o -o xyacc.e
+mv -f		xyacc.e ../../hlib
+cp 		yaccpar.x ../../../lib
+rm -f		*.o
diff --git a/unix/boot/xyacc/y1.c b/unix/boot/xyacc/y1.c
new file mode 100644
index 00000000..58f2f945
--- /dev/null
+++ b/unix/boot/xyacc/y1.c
@@ -0,0 +1,1307 @@
+/*
+ * CDDL HEADER START
+ *
+ * The contents of this file are subject to the terms of the
+ * Common Development and Distribution License (the "License").
+ * You may not use this file except in compliance with the License.
+ *
+ * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE
+ * or http://www.opensolaris.org/os/licensing.
+ * See the License for the specific language governing permissions
+ * and limitations under the License.
+ *
+ * When distributing Covered Code, include this CDDL HEADER in each
+ * file and include the License file at usr/src/OPENSOLARIS.LICENSE.
+ * If applicable, add the following below this CDDL HEADER, with the
+ * fields enclosed by brackets "[]" replaced with your own identifying
+ * information: Portions Copyright [yyyy] [name of copyright owner]
+ *
+ * CDDL HEADER END
+ */
+/*
+ * Copyright 2008 Sun Microsystems, Inc.  All rights reserved.
+ * Use is subject to license terms.
+ */
+
+/* Copyright (c) 1988 AT&T */
+/* All Rights Reserved */
+
+//#pragma ident	"%Z%%M%	%I%	%E% SMI"
+
+#include "dextern.h"
+#include <sys/param.h>
+#include <sys/errno.h>
+#include <unistd.h>
+#include <locale.h>
+#include <stdarg.h>		/* For error() */
+
+static void mktbls (void);
+static void others (void);
+static void summary (void);
+static char *chcopy (char *, char *);
+static int setunion (int *, int *);
+static void prlook (LOOKSETS *);
+static void cpres (void);
+static void cpfir (void);
+static void cempty (void);
+static void stagen (void);
+static LOOKSETS *flset (LOOKSETS *);
+static void exp_lkst (void);
+static void exp_wsets (void);
+static void exp_states (void);
+static void exp_psmem (void);
+
+	/* lookahead computations */
+
+int TBITSET;
+static int tbitset;		/* size of lookahead sets */
+LOOKSETS *lkst;
+static int lsetsize;
+
+static int nlset = 0;		/* next lookahead set index */
+int nolook = 0;			/* flag to suppress lookahead computations */
+static LOOKSETS clset;		/* temporary storage for lookahead computations */
+
+static ITEM *psmem, *zzmemsz;
+static int new_pstsize = PSTSIZE;
+
+	/* I/O descriptors */
+
+extern FILE *finput;		/* input file                   */
+extern FILE *faction;		/* file for saving actions      */
+extern FILE *fdefine;		/* file for #defines            */
+extern FILE *fudecl;		/* file for user declarations   */
+extern FILE *ftable;		/* parser tables file           */
+extern FILE *fsppout;		/* SPP output file              */
+extern FILE *ftemp;		/* tempfile to pass 2           */
+extern FILE *foutput;		/* y.output file                */
+
+	/* working set computations */
+
+WSET *wsets;
+int cwp;
+static int wsetsz = 0;		/* number of WSET items in wsets block */
+
+	/* state information */
+
+int nstate = 0;			/* number of states */
+static int nstatesz = NSTATES;	/* number of state space allocated      */
+ITEM **pstate;			/* ptr to descriptions of the states    */
+int *tystate;			/* contains type info about the states  */
+int *indgo;			/* index to the stored goto table       */
+static int *tmp_lset;
+static int *tstates;		/* states generated by terminal gotos   */
+static int *ntstates;		/* states generated by non-term gotos   */
+static int *mstates;		/* chain of overflows of term/nonterm   */
+				/* generation lists                     */
+
+	/* storage for the actions in the parser */
+
+int *amem, *memp;		/* next free action table position */
+int new_actsize = ACTSIZE;
+
+	/* other storage areas */
+
+int *temp1;			/* temp storate, indexed by terms+ntokens or states */
+int lineno = 0;			/* current input line number */
+int size;
+static int fatfl = 1;		/* if on, error is fatal */
+static int nerrors = 0;		/* number of errors */
+
+	/* storage for information about the nonterminals */
+
+static int ***pres;		/* vector of pointers to productions    */
+				/* yielding each nonterminal            */
+static LOOKSETS **pfirst;	/* vector of pointers to first sets for */
+				/* each nonterminal                     */
+static int *pempty;		/* vector of nonterminals nontrivially  */
+				/* deriving e                           */
+extern int nprodsz;
+
+int
+main (int argc, char *argv[])
+{
+    (void) setlocale (LC_ALL, "");
+#if !defined(TEXT_DOMAIN)	/* Should be defined by cc -D */
+#define	TEXT_DOMAIN "SYS_TEST"	/* Use this only if it weren't */
+#endif
+    /*
+       (void) textdomain (TEXT_DOMAIN);
+     */
+
+    setup (argc, argv);		/* initialize and read productions */
+    TBITSET = NWORDS (ntoksz * LKFACTOR);
+    tbitset = NWORDS (ntokens * LKFACTOR);
+    mktbls ();
+    cpres ();			/* make table of which productions yield a */
+    /* given nonterminal */
+    cempty ();			/* make a table of which nonterminals can match */
+    /* the empty string */
+    cpfir ();			/* make a table of firsts of nonterminals */
+    stagen ();			/* generate the states  */
+    output ();			/* write the states and the tables */
+    go2out ();
+    hideprod ();
+    summary ();
+    callopt ();
+    others ();
+    return (0);
+}
+
+
+static void
+mktbls ()
+{
+    int i;
+
+    size = ntoksz + nnontersz + 1;
+    if (size < nstatesz)
+	size = nstatesz;
+    if (size < new_memsize)
+	size = new_memsize;
+
+    amem = (int *) malloc (sizeof (int) * new_actsize);
+    psmem = (ITEM *) malloc (sizeof (ITEM) * new_pstsize);
+    if ((psmem == NULL) || (amem == NULL))
+/*
+ * TRANSLATION_NOTE  -- This is a message from yacc.
+ *	This message is passed to error() function.
+ *	This error happens when yacc could not allocate
+ *	initial memory to be used for internal tables.
+ *
+ *	You may just translate this as:
+ *	'Could not allocate internally used memory.'
+ */
+	error ("couldn't allocate initial table");
+    zzmemsz = psmem;
+    memp = amem;
+
+    /*
+     * For lkst
+     */
+#define	INIT_LSIZE	nnontersz*LKFACTOR
+    tmp_lset = (int *)
+	calloc ((size_t) (TBITSET * (INIT_LSIZE + 1)), sizeof (int));
+    if (tmp_lset == NULL)
+/*
+ * TRANSLATION_NOTE  -- This is a message from yacc.
+ *	This message is passed to error() function.
+ *	Yacc could not allocate memory for table named lookset.
+ *	Do not translate 'lookset'.
+ *
+ *	You may just translate this as:
+ *	'Could not allocate internally used memory.'
+ */
+	error ("could not allocate lookset array");
+    lkst = (LOOKSETS *) malloc (sizeof (LOOKSETS) * (INIT_LSIZE + 1));
+    for (i = 0; i <= INIT_LSIZE; ++i)
+	lkst[i].lset = tmp_lset + TBITSET * i;
+    tmp_lset = NULL;
+
+    /*
+     * For wsets
+     */
+    tmp_lset = (int *)
+	calloc ((size_t) (TBITSET * (nnontersz + 1)), sizeof (int));
+    if (tmp_lset == NULL)
+	error ("could not allocate lookset array");
+    wsets = (WSET *) malloc (sizeof (WSET) * (nnontersz + 1));
+    for (i = 0; i <= nnontersz; ++i)
+	wsets[i].ws.lset = tmp_lset + TBITSET * i;
+    tmp_lset = NULL;
+
+    clset.lset = (int *) malloc (sizeof (int) * TBITSET);
+    tstates = (int *) malloc (sizeof (int) * (ntoksz + 1));
+    ntstates = (int *) malloc (sizeof (int) * (nnontersz + 1));
+    temp1 = (int *) malloc (sizeof (int) * size);
+    pres = (int ***) malloc (sizeof (int **) * (nnontersz + 2));
+    pfirst = (LOOKSETS **) malloc (sizeof (LOOKSETS *) * (nnontersz + 2));
+    pempty = (int *) malloc (sizeof (int) * (nnontersz + 1));
+
+    pstate = (ITEM **) malloc (sizeof (ITEM *) * (nstatesz + 2));
+    tystate = (int *) malloc (sizeof (int) * nstatesz);
+    indgo = (int *) malloc (sizeof (int) * nstatesz);
+    mstates = (int *) malloc (sizeof (int) * nstatesz);
+    defact = (int *) malloc (sizeof (int) * nstatesz);
+
+    if ((lkst == NULL) || (wsets == NULL) || (tstates == NULL) ||
+	(ntstates == NULL) || (temp1 == NULL) || (pres == NULL) ||
+	(pfirst == NULL) || (pempty == NULL) || (pstate == NULL) ||
+	(tystate == NULL) || (indgo == NULL) || (mstates == NULL) ||
+	(defact == NULL) || (clset.lset == NULL))
+/*
+ * TRANSLATION_NOTE  -- This is a message from yacc.
+ *	This message is passed to error() function.
+ *	Do not translate mktbls(). It is a function name.
+ *
+ *	You may just translate this as:
+ *	'Could not allocate internally used memory.'
+ */
+	error ("cannot allocate tables in mktbls()");
+
+    aryfil (ntstates, nnontersz + 1, 0);
+    aryfil (tstates, ntoksz + 1, 0);
+    wsetsz = nnontersz + 1;
+    lsetsize = INIT_LSIZE + 1;
+}
+
+/* put out other arrays, copy the parsers */
+static void
+others ()
+{
+    extern int gen_lines;
+    int c, i, j;
+    int tmpline;
+
+    finput = fopen (parser, "r");
+    if (finput == NULL)
+/*
+ * TRANSLATION_NOTE  -- This is a message from yacc.
+ *	This message is passed to error() function.
+ *	This error message is issued when yacc can not find
+ *	the parser to be copied.
+ */
+	error ("cannot find parser %s", parser);
+
+    warray ("yyr1", levprd, nprod);
+
+    aryfil (temp1, nprod, 0);
+    /* had_act[i] is either 1 or 0 */
+/* original
+	PLOOP(1, i)
+		temp1[i] = ((prdptr[i+1] - prdptr[i]-2) << 1) | had_act[i];
+*/
+    PLOOP (1, i) temp1[i] = prdptr[i + 1] - prdptr[i] - 2;
+
+    warray ("yyr2", temp1, nprod);
+
+    aryfil (temp1, nstate, -1000);
+    TLOOP (i) for (j = tstates[i]; j != 0; j = mstates[j])
+	temp1[j] = tokset[i].value;
+    NTLOOP (i) for (j = ntstates[i]; j != 0; j = mstates[j])
+	temp1[j] = -i;
+    warray ("yychk", temp1, nstate);
+    warray ("yydef", defact, nstate);
+
+    fclose (ftable);
+    fclose (fudecl);
+
+    if ((fdebug = fopen (DEBUGNAME, "r")) == NULL)
+	error ("cannot open yacc.debug");
+    while ((c = getc (fdebug)) != EOF)
+	(void) putc (c, fsppout);
+    (void) fclose (fdebug);
+    ZAPFILE (DEBUGNAME);
+
+    if (gen_lines)
+	(void) fprintf (fsppout, "# line\t1 \"%s\"\n", parser);
+    tmpline = 1;
+    /* copy parser text */
+    while ((c = getc (finput)) != EOF) {
+	if (c == '\n')
+	    tmpline++;
+	if (c == '$') {
+	    if ((c = getc (finput)) == 'A') {
+		/* Replace $A macro by the user declarations.
+		 */
+		fudecl = fopen (UDFILE, "r");
+		if (fudecl == NULL)
+		    error ("cannot reopen user declarations tempfile");
+		while ((c = getc (fudecl)) != EOF)
+		    putc (c, fsppout);
+		fclose (fudecl);
+		ZAPFILE (UDFILE);
+		/* Skip remainder of line following macro.
+		 */
+		while ((c = getc (finput)) != '\n' && c != EOF);
+
+	    } else if (c == 'B') {
+		/* Replace $B macro by the parser tables.
+		 */
+		ftable = fopen (TABFILE, "r");
+		if (ftable == NULL)
+		    error ("cannot reopen parser tables tempfile");
+		while ((c = getc (ftable)) != EOF)
+		    putc (c, fsppout);
+		fclose (ftable);
+		ZAPFILE (TABFILE);
+		/* Skip remainder of line following macro.
+		 */
+		while ((c = getc (finput)) != '\n' && c != EOF);
+
+	    } else if (c == 'C') {
+		/* Replace $C macro by user-supplied actions.
+		 */
+		faction = fopen (ACTNAME, "r");
+		if (faction == NULL)
+		    error ("cannot reopen action tempfile");
+		while ((c = getc (faction)) != EOF)
+		    putc (c, fsppout);
+		fclose (faction);
+		ZAPFILE (ACTNAME);
+		/* Skip remainder of line following macro.
+		 */
+		while ((c = getc (finput)) != '\n' && c != EOF);
+
+	    } else {
+		putc ('$', fsppout);
+		putc (c, fsppout);
+	    }
+
+	} else
+	    putc (c, fsppout);
+    }
+
+    fclose (fsppout);
+}
+
+
+/* copies string q into p, returning next free char ptr */
+static char *
+chcopy (p, q)
+     char *p, *q;
+{
+    while ((*p = *q++))
+	++p;
+    return (p);
+}
+
+#define	ISIZE 400
+/* creates output string for item pointed to by pp */
+char *
+writem (pp)
+     int *pp;
+{
+    int i, *p;
+    static int isize = ISIZE;
+    static char *sarr = NULL;
+    char *q;
+
+    if (sarr == NULL) {
+	sarr = (char *) malloc (sizeof (char) * isize);
+	if (sarr == NULL)
+/*
+ * TRANSLATION_NOTE  -- This is a message from yacc.
+ *	This message is passed to error() function.
+ *	This error is issued when yacc could not allocate
+ *	memory for internally used array.
+ *
+ *	You may just translate this as:
+ *	'Could not allocate internally used memory.'
+ */
+	    error ("could not allocate output string array");
+	for (i = 0; i < isize; ++i)
+	    sarr[i] = ' ';
+    }
+    for (p = pp; *p > 0; ++p)	/* NULL */
+	;
+    p = prdptr[-*p];
+    q = chcopy (sarr, nontrst[*p - NTBASE].name);
+    q = chcopy (q, " : ");
+
+    for (;;) {
+	*q++ = ++p == pp ? '_' : ' ';
+	*q = 0;
+	if ((i = *p) <= 0)
+	    break;
+	q = chcopy (q, symnam (i));
+	while (q > &sarr[isize - 30]) {
+	    static char *sarrbase;
+
+	    sarrbase = sarr;
+	    isize += ISIZE;
+	    sarr = (char *)
+		realloc ((char *) sarr, sizeof (*sarr) * isize);
+	    if (sarr == NULL)
+/*
+ * TRANSLATION_NOTE  -- This is a message from yacc.
+ *	This message is passed to error() function.
+ *	This error is issued when yacc could not allocate
+ *	memory for internally used array.
+ *
+ *	You may just translate this as:
+ *	'Could not allocate internally used memory.'
+ */
+		error ("cannot expand sarr arrays");
+	    q = q - sarrbase + sarr;
+	}
+    }
+
+    /* an item calling for a reduction */
+    if ((i = *pp) < 0) {
+	q = chcopy (q, "    (");
+	(void) sprintf (q, "%d)", -i);
+    }
+    return (sarr);
+}
+
+/* return a pointer to the name of symbol i */
+char *
+symnam (int i)
+{
+    char *cp;
+
+    cp = (i >= NTBASE) ? nontrst[i - NTBASE].name : tokset[i].name;
+    if (*cp == ' ')
+	++cp;
+    return (cp);
+}
+
+static int zzcwp = 0;
+static int zzclose = 0;
+int zzgoent = 0;
+int zzgobest = 0;
+int zzacent = 0;
+int zzexcp = 0;
+int zzsrconf = 0;
+int zzrrconf = 0;
+
+/* output the summary on the tty */
+static void
+summary ()
+{
+    if (foutput != NULL) {
+	(void) fprintf (foutput,
+			"\n%d/%d terminals, %d/%d nonterminals\n",
+			ntokens, ntoksz, nnonter, nnontersz);
+	(void) fprintf (foutput,
+			"%d/%d grammar rules, %d/%d states\n",
+			nprod, nprodsz, nstate, nstatesz);
+	(void) fprintf (foutput,
+			"%d shift/reduce, %d reduce/reduce conflicts reported\n",
+			zzsrconf, zzrrconf);
+	(void) fprintf (foutput, "%d/%d working sets used\n", zzcwp, wsetsz);
+	(void) fprintf (foutput,
+			"memory: states,etc. %" PRIdPTR
+			"/%d, parser %" PRIdPTR "/%d\n",
+			mem - tracemem, new_memsize,
+			memp - amem, new_actsize);
+	(void) fprintf (foutput,
+			"%d/%d distinct lookahead sets\n", nlset, lsetsize);
+	(void) fprintf (foutput, "%d extra closures\n", zzclose - 2 * nstate);
+	(void) fprintf (foutput,
+			"%d shift entries, %d exceptions\n", zzacent, zzexcp);
+	(void) fprintf (foutput, "%d goto entries\n", zzgoent);
+	(void) fprintf (foutput,
+			"%d entries saved by goto default\n", zzgobest);
+    }
+    if (zzsrconf != 0 || zzrrconf != 0) {
+/*
+ * TRANSLATION_NOTE  -- This is a message from yacc.
+ *	You may just leave this message un-translated.
+ *	This message only makes sense to those who knows
+ *	how yacc works, and the person should know what
+ *	this message means in English.
+ */
+	(void) fprintf (stderr, "\nconflicts: ");
+	if (zzsrconf)
+	    (void) fprintf (stderr, "%d shift/reduce", zzsrconf);
+	if (zzsrconf && zzrrconf)
+	    (void) fprintf (stderr, ", ");
+	if (zzrrconf)
+	    (void) fprintf (stderr, "%d reduce/reduce", zzrrconf);
+	(void) fprintf (stderr, "\n");
+    }
+
+    if (ftemp != NULL)
+	(void) fclose (ftemp);
+    if (fdefine != NULL)
+	(void) fclose (fdefine);
+}
+
+/* write out error comment */
+/*PRINTFLIKE1*/
+void
+error (char *s, ...)
+{
+    extern char *infile;
+    va_list ap;
+
+    va_start (ap, s);
+
+    ++nerrors;
+    if (!lineno)
+/*
+ * TRANSLATION_NOTE  -- This is a message from yacc.
+ *	This message is a prefix to the error messages
+ *	passed to error() function.
+ */
+	(void) fprintf (stderr, "command line: fatal: ");
+    else {
+	(void) fprintf (stderr, "\"%s\", ", infile);
+/*
+ * TRANSLATION_NOTE  -- This is a message from yacc.
+ *	This message is a prefix to the error messages
+ *	passed to error() function.
+ */
+	(void) fprintf (stderr, "line %d: fatal: ", lineno);
+    }
+    (void) vfprintf (stderr, s, ap);
+    (void) fprintf (stderr, "\n");
+    va_end (ap);
+    if (!fatfl)
+	return;
+    summary ();
+    exit (1);
+}
+
+/*
+ * Print out a warning message.
+ */
+/*PRINTFLIKE2*/
+void
+warning (int flag, char *s, ...)
+{
+    extern char *infile;
+    va_list ap;
+    va_start (ap, s);
+
+    (void) fprintf (stderr, "\"%s\", ", infile);
+    /*
+     * If flag, print lineno as well.
+     */
+    if (flag == 0)
+/*
+ * TRANSLATION_NOTE  -- This is a message from yacc.
+ *	This message is a prefix to the warning messages
+ *	passed to warning() function.
+ */
+	(void) fprintf (stderr, "warning: ");
+    else
+/*
+ * TRANSLATION_NOTE  -- This is a message from yacc.
+ *	This message is a prefix to the warning messages
+ *	passed to warning() function.
+ */
+	(void) fprintf (stderr, "line %d: warning: ", lineno);
+    (void) vfprintf (stderr, s, ap);
+    (void) fprintf (stderr, "\n");
+    va_end (ap);
+}
+
+/* set elements 0 through n-1 to c */
+void
+aryfil (v, n, c)
+     int *v, n, c;
+{
+    int i;
+    for (i = 0; i < n; ++i)
+	v[i] = c;
+}
+
+/* set a to the union of a and b */
+/* return 1 if b is not a subset of a, 0 otherwise */
+static int
+setunion (a, b)
+     int *a, *b;
+{
+    int i, x, sub;
+
+    sub = 0;
+    SETLOOP (i) {
+	*a = (x = *a) | *b++;
+	if (*a++ != x)
+	    sub = 1;
+    }
+    return (sub);
+}
+
+static void
+prlook (p)
+     LOOKSETS *p;
+{
+    int j, *pp;
+    pp = p->lset;
+    if (pp == 0)
+	(void) fprintf (foutput, "\tNULL");
+    else {
+	(void) fprintf (foutput, " { ");
+	TLOOP (j) {
+	    if (BIT (pp, j))
+		(void) fprintf (foutput, WSFMT ("%s "), symnam (j));
+	}
+	(void) fprintf (foutput, "}");
+    }
+}
+
+/*
+ * compute an array with the beginnings of  productions yielding
+ * given nonterminals
+ * The array pres points to these lists
+ * the array pyield has the lists: the total size is only NPROD+1
+ */
+static void
+cpres ()
+{
+    int **ptrpy;
+    int **pyield;
+    int c, j, i;
+
+    /*
+     * 2/29/88 -
+     * nprodsz is the size of the tables describing the productions.
+     * Normally this will be NPROD unless the production tables have
+     * been expanded, in which case the tables will be NPROD * N(where
+     * N is the number of times the tables had to be expanded.)
+     */
+    if ((pyield = (int **) malloc (sizeof (int *) * nprodsz)) == NULL)
+/*
+ * TRANSLATION_NOTE  -- This is a message from yacc.
+ *	This message is passed to error() function.
+ *	This error is issued when yacc could not allocate
+ *	memory for internally used array.
+ *
+ *	pyield is name of an array. You should not try to translate
+ *	this word.
+ *
+ *	You may just translate this as:
+ *	'Could not allocate internally used memory.'
+ */
+	error ("cannot allocate space for pyield array");
+
+    ptrpy = pyield;
+
+    NTLOOP (i) {
+	c = i + NTBASE;
+	pres[i] = ptrpy;
+	fatfl = 0;		/* make undefined  symbols  nonfatal */
+	PLOOP (0, j) {
+	    if (*prdptr[j] == c)	/* linear search for all c's */
+		*ptrpy++ = prdptr[j] + 1;
+	}
+	if (pres[i] == ptrpy) {	/* c not found */
+/*
+ * TRANSLATION_NOTE  -- This is a message from yacc.
+ *	This message is passed to error() function.
+ *	Ask somebody who knows yacc how to translate nonterminal or
+ *	look at translated yacc document.
+ */
+	    error ("undefined nonterminal: %s", nontrst[i].name);
+	}
+    }
+    pres[i] = ptrpy;
+    fatfl = 1;
+    if (nerrors) {
+	summary ();
+	exit (1);
+    }
+    if (ptrpy != &pyield[nprod])
+/*
+ * TRANSLATION_NOTE  -- This is a message from yacc.
+ *	This message is passed to error() function.
+ *	This is an internal error message.
+ *	Very little use to user. You may leave it
+ *	un-translated.
+ *
+ *	pyied is name of an array. Do not translate it.
+ */
+	error ("internal Yacc error: pyield %d", ptrpy - &pyield[nprod]);
+}
+
+static int indebug = 0;
+/* compute an array with the first of nonterminals */
+static void
+cpfir ()
+{
+    int *p, **s, i, **t, ch, changes;
+
+    zzcwp = nnonter;
+    NTLOOP (i) {
+	aryfil (wsets[i].ws.lset, tbitset, 0);
+	t = pres[i + 1];
+	/* initially fill the sets */
+	for (s = pres[i]; s < t; ++s) {
+	    /* check if ch is non-terminal */
+	    for (p = *s; (ch = *p) > 0; ++p) {
+		if (ch < NTBASE) {	/* should be token */
+		    SETBIT (wsets[i].ws.lset, ch);
+		    break;
+		} else if (!pempty[ch - NTBASE])
+		    break;
+	    }
+	}
+    }
+
+    /* now, reflect transitivity */
+
+    changes = 1;
+    while (changes) {
+	changes = 0;
+	NTLOOP (i) {
+	    t = pres[i + 1];
+	    for (s = pres[i]; s < t; ++s) {
+		for (p = *s; (ch = (*p - NTBASE)) >= 0; ++p) {
+		    changes |= setunion (wsets[i].ws.lset, wsets[ch].ws.lset);
+		    if (!pempty[ch])
+			break;
+		}
+	    }
+	}
+    }
+
+    NTLOOP (i) pfirst[i] = flset (&wsets[i].ws);
+    if (!indebug)
+	return;
+    if ((foutput != NULL)) {
+	NTLOOP (i) {
+	    (void) fprintf (foutput, WSFMT ("\n%s: "), nontrst[i].name);
+	    prlook (pfirst[i]);
+	    (void) fprintf (foutput, " %d\n", pempty[i]);
+	}
+    }
+}
+
+/* sorts last state,and sees if it equals earlier ones. returns state number */
+int
+state (int c)
+{
+    int size1, size2;
+    int i;
+    ITEM *p1, *p2, *k, *l, *q1, *q2;
+    p1 = pstate[nstate];
+    p2 = pstate[nstate + 1];
+    if (p1 == p2)
+	return (0);		/* null state */
+    /* sort the items */
+    for (k = p2 - 1; k > p1; k--) {	/* make k the biggest */
+	for (l = k - 1; l >= p1; --l)
+	    if (l->pitem > k->pitem) {
+		int *s;
+		LOOKSETS *ss;
+		s = k->pitem;
+		k->pitem = l->pitem;
+		l->pitem = s;
+		ss = k->look;
+		k->look = l->look;
+		l->look = ss;
+	    }
+    }
+    size1 = p2 - p1;		/* size of state */
+
+    for (i = (c >= NTBASE) ? ntstates[c - NTBASE] : tstates[c];
+	 i != 0; i = mstates[i]) {
+	/* get ith state */
+	q1 = pstate[i];
+	q2 = pstate[i + 1];
+	size2 = q2 - q1;
+	if (size1 != size2)
+	    continue;
+	k = p1;
+	for (l = q1; l < q2; l++) {
+	    if (l->pitem != k->pitem)
+		break;
+	    ++k;
+	}
+	if (l != q2)
+	    continue;
+	/* found it */
+	pstate[nstate + 1] = pstate[nstate];	/* delete last state */
+	/* fix up lookaheads */
+	if (nolook)
+	    return (i);
+	for (l = q1, k = p1; l < q2; ++l, ++k) {
+	    int s;
+	    SETLOOP (s) clset.lset[s] = l->look->lset[s];
+	    if (setunion (clset.lset, k->look->lset)) {
+		tystate[i] = MUSTDO;
+		/* register the new set */
+		l->look = flset (&clset);
+	    }
+	}
+	return (i);
+    }
+    /* state is new */
+    if (nolook)
+/*
+ * TRANSLATION_NOTE  -- This is a message from yacc.
+ *	This message is passed to error() function.
+ *	You may leave this untranslated. Leave
+ *	state/nolook un-translated.
+ */
+	error ("yacc state/nolook error");
+    pstate[nstate + 2] = p2;
+    if (nstate + 1 >= nstatesz)
+	exp_states ();
+    if (c >= NTBASE) {
+	mstates[nstate] = ntstates[c - NTBASE];
+	ntstates[c - NTBASE] = nstate;
+    } else {
+	mstates[nstate] = tstates[c];
+	tstates[c] = nstate;
+    }
+    tystate[nstate] = MUSTDO;
+    return (nstate++);
+}
+
+static int pidebug = 0;
+
+void
+putitem (ptr, lptr)
+     int *ptr;
+     LOOKSETS *lptr;
+{
+    register ITEM *j;
+
+    if (pidebug && (foutput != NULL))
+	(void) fprintf (foutput,
+			WSFMT ("putitem(%s), state %d\n"), writem (ptr),
+			nstate);
+    j = pstate[nstate + 1];
+    j->pitem = ptr;
+    if (!nolook)
+	j->look = flset (lptr);
+    pstate[nstate + 1] = ++j;
+    if (j > zzmemsz) {
+	zzmemsz = j;
+	if (zzmemsz >= &psmem[new_pstsize])
+	    exp_psmem ();
+	/* error("out of state space"); */
+    }
+}
+
+/*
+ * mark nonterminals which derive the empty string
+ * also, look for nonterminals which don't derive any token strings
+ */
+static void
+cempty ()
+{
+#define	EMPTY 1
+#define	WHOKNOWS 0
+#define	OK 1
+    int i, *p;
+
+    /*
+     * first, use the array pempty to detect productions
+     * that can never be reduced
+     */
+
+    /* set pempty to WHONOWS */
+    aryfil (pempty, nnonter + 1, WHOKNOWS);
+
+    /*
+     * now, look at productions, marking nonterminals which
+     * derive something
+     */
+  more:
+    PLOOP (0, i) {
+	if (pempty[*prdptr[i] - NTBASE])
+	    continue;
+	for (p = prdptr[i] + 1; *p >= 0; ++p)
+	    if (*p >= NTBASE && pempty[*p - NTBASE] == WHOKNOWS)
+		break;
+	if (*p < 0) {		/* production can be derived */
+	    pempty[*prdptr[i] - NTBASE] = OK;
+	    goto more;
+	}
+    }
+
+    /* now, look at the nonterminals, to see if they are all OK */
+
+    NTLOOP (i) {
+	/*
+	 * the added production rises or falls as the
+	 * start symbol ...
+	 */
+	if (i == 0)
+	    continue;
+	if (pempty[i] != OK) {
+	    fatfl = 0;
+/*
+ * TRANSLATION_NOTE  -- This is a message from yacc.
+ *	This message is passed to error() function.
+ *	Ask somebody who knows yacc how to translate nonterminal or
+ *	look at translated yacc document. Check how 'derive' is
+ *	translated in these documents also.
+ */
+	    error ("nonterminal %s never derives any token string",
+		   nontrst[i].name);
+	}
+    }
+
+    if (nerrors) {
+	summary ();
+	exit (1);
+    }
+
+    /*
+     * now, compute the pempty array, to see which nonterminals
+     * derive the empty string
+     */
+
+    /* set pempty to WHOKNOWS */
+
+    aryfil (pempty, nnonter + 1, WHOKNOWS);
+
+    /* loop as long as we keep finding empty nonterminals */
+
+  again:
+    PLOOP (1, i) {
+	/* not known to be empty */
+	if (pempty[*prdptr[i] - NTBASE] == WHOKNOWS) {
+	    for (p = prdptr[i] + 1;
+		 *p >= NTBASE && pempty[*p - NTBASE] == EMPTY; ++p);
+	    /* we have a nontrivially empty nonterminal */
+	    if (*p < 0) {
+		pempty[*prdptr[i] - NTBASE] = EMPTY;
+		goto again;	/* got one ... try for another */
+	    }
+	}
+    }
+}
+
+/* generate the states */
+static int gsdebug = 0;
+static void
+stagen ()
+{
+    int i, j;
+    int c;
+    register WSET *p, *q;
+
+    /* initialize */
+
+    nstate = 0;
+
+    pstate[0] = pstate[1] = psmem;
+    aryfil (clset.lset, tbitset, 0);
+    putitem (prdptr[0] + 1, &clset);
+    tystate[0] = MUSTDO;
+    nstate = 1;
+    pstate[2] = pstate[1];
+
+    aryfil (amem, new_actsize, 0);
+
+    /* now, the main state generation loop */
+
+  more:
+    SLOOP (i) {
+	if (tystate[i] != MUSTDO)
+	    continue;
+	tystate[i] = DONE;
+	aryfil (temp1, nnonter + 1, 0);
+	/* take state i, close it, and do gotos */
+	closure (i);
+	WSLOOP (wsets, p) {	/* generate goto's */
+	    if (p->flag)
+		continue;
+	    p->flag = 1;
+	    c = *(p->pitem);
+	    if (c <= 1) {
+		if (pstate[i + 1] - pstate[i] <= p - wsets)
+		    tystate[i] = MUSTLOOKAHEAD;
+		continue;
+	    }
+	    /* do a goto on c */
+	    WSLOOP (p, q) {
+		/* this item contributes to the goto */
+		if (c == *(q->pitem)) {
+		    putitem (q->pitem + 1, &q->ws);
+		    q->flag = 1;
+		}
+	    }
+	    if (c < NTBASE)
+		(void) state (c);	/* register new state */
+	    else
+		temp1[c - NTBASE] = state (c);
+	}
+	if (gsdebug && (foutput != NULL)) {
+	    (void) fprintf (foutput, "%d: ", i);
+	    NTLOOP (j) {
+		if (temp1[j])
+		    (void) fprintf (foutput,
+				    WSFMT ("%s %d, "), nontrst[j].name,
+				    temp1[j]);
+	    }
+	    (void) fprintf (foutput, "\n");
+	}
+	indgo[i] = apack (&temp1[1], nnonter - 1) - 1;
+	goto more;		/* we have done one goto; do some more */
+    }
+    /* no more to do... stop */
+}
+
+/* generate the closure of state i */
+static int cldebug = 0;		/* debugging flag for closure */
+
+void
+closure (int i)
+{
+    int c, ch, work, k;
+    register WSET *u, *v;
+    int *pi;
+    int **s, **t;
+    ITEM *q;
+    register ITEM *p;
+    int idx1 = 0;
+
+    ++zzclose;
+
+    /* first, copy kernel of state i to wsets */
+    cwp = 0;
+    ITMLOOP (i, p, q) {
+	wsets[cwp].pitem = p->pitem;
+	wsets[cwp].flag = 1;	/* this item must get closed */
+	SETLOOP (k) wsets[cwp].ws.lset[k] = p->look->lset[k];
+	WSBUMP (cwp);
+    }
+
+    /* now, go through the loop, closing each item */
+
+    work = 1;
+    while (work) {
+	work = 0;
+	/*
+	 * WSLOOP(wsets, u) {
+	 */
+	for (idx1 = 0; idx1 < cwp; idx1++) {
+	    u = &wsets[idx1];
+	    if (u->flag == 0)
+		continue;
+	    c = *(u->pitem);	/* dot is before c */
+	    if (c < NTBASE) {
+		u->flag = 0;
+		/*
+		 * only interesting case is where . is
+		 * before nonterminal
+		 */
+		continue;
+	    }
+
+	    /* compute the lookahead */
+	    aryfil (clset.lset, tbitset, 0);
+
+	    /* find items involving c */
+
+	    WSLOOP (u, v) {
+		if (v->flag == 1 && *(pi = v->pitem) == c) {
+		    v->flag = 0;
+		    if (nolook)
+			continue;
+		    while ((ch = *++pi) > 0) {
+			/* terminal symbol */
+			if (ch < NTBASE) {
+			    SETBIT (clset.lset, ch);
+			    break;
+			}
+			/* nonterminal symbol */
+			(void) setunion (clset.lset,
+					 pfirst[ch - NTBASE]->lset);
+			if (!pempty[ch - NTBASE])
+			    break;
+		    }
+		    if (ch <= 0)
+			(void) setunion (clset.lset, v->ws.lset);
+		}
+	    }
+
+	    /*  now loop over productions derived from c */
+
+	    c -= NTBASE;	/* c is now nonterminal number */
+
+	    t = pres[c + 1];
+	    for (s = pres[c]; s < t; ++s) {
+		/* put these items into the closure */
+		WSLOOP (wsets, v) {	/* is the item there */
+		    /* yes, it is there */
+		    if (v->pitem == *s) {
+			if (nolook)
+			    goto nexts;
+			if (setunion (v->ws.lset, clset.lset))
+			    v->flag = work = 1;
+			goto nexts;
+		    }
+		}
+
+		/*  not there; make a new entry */
+		if (cwp + 1 >= wsetsz)
+		    exp_wsets ();
+
+		wsets[cwp].pitem = *s;
+		wsets[cwp].flag = 1;
+		if (!nolook) {
+		    work = 1;
+		    SETLOOP (k) wsets[cwp].ws.lset[k] = clset.lset[k];
+		}
+		WSBUMP (cwp);
+	      nexts:;
+	    }
+	}
+    }
+
+    /* have computed closure; flags are reset; return */
+
+    if (&wsets[cwp] > &wsets[zzcwp])
+	zzcwp = cwp;
+    if (cldebug && (foutput != NULL)) {
+	(void) fprintf (foutput, "\nState %d, nolook = %d\n", i, nolook);
+	WSLOOP (wsets, u) {
+	    if (u->flag)
+		(void) fprintf (foutput, "flag set!\n");
+	    u->flag = 0;
+	    (void) fprintf (foutput, WSFMT ("\t%s"), writem (u->pitem));
+	    prlook (&u->ws);
+	    (void) fprintf (foutput, "\n");
+	}
+    }
+}
+
+static LOOKSETS *
+flset (p)
+     LOOKSETS *p;
+{
+    /* decide if the lookahead set pointed to by p is known */
+    /* return pointer to a perminent location for the set */
+
+    int j, *w;
+    int *u, *v;
+    register LOOKSETS *q;
+
+    for (q = &lkst[nlset]; q-- > lkst;) {
+	u = p->lset;
+	v = q->lset;
+	w = &v[tbitset];
+	while (v < w)
+	    if (*u++ != *v++)
+		goto more;
+	/* we have matched */
+	return (q);
+      more:;
+    }
+    /* add a new one */
+    q = &lkst[nlset++];
+    if (nlset >= lsetsize) {
+	exp_lkst ();
+	q = &lkst[nlset++];
+    }
+    SETLOOP (j) q->lset[j] = p->lset[j];
+    return (q);
+}
+
+static void
+exp_lkst ()
+{
+    int i, j;
+    static LOOKSETS *lookbase;
+
+    lookbase = lkst;
+    lsetsize += LSETSIZE;
+    tmp_lset = (int *)
+	calloc ((size_t) (TBITSET * (lsetsize - LSETSIZE)), sizeof (int));
+    if (tmp_lset == NULL)
+/*
+ * TRANSLATION_NOTE  -- This is a message from yacc.
+ *	This message is passed to error() function.
+ *	Memory allocation error. Do not translate lookset.
+ *
+ *	You may just translate this as:
+ *	'Could not allocate internally used memory.'
+ */
+	error ("could not expand lookset array");
+    lkst = (LOOKSETS *) realloc ((char *) lkst, sizeof (LOOKSETS) * lsetsize);
+    for (i = lsetsize - LSETSIZE, j = 0; i < lsetsize; ++i, ++j)
+	lkst[i].lset = tmp_lset + TBITSET * j;
+    tmp_lset = NULL;
+    if (lkst == NULL)
+/*
+ * TRANSLATION_NOTE  -- This is a message from yacc.
+ *	This message is passed to error() function.
+ *	Memory allocation error. Do not translate lookset.
+ *
+ *	You may just translate this as:
+ *	'Could not allocate internally used memory.'
+ */
+	error ("could not expand lookahead sets");
+    for (i = 0; i <= nnonter; ++i)
+	pfirst[i] = pfirst[i] - lookbase + lkst;
+    for (i = 0; i <= nstate + 1; ++i) {
+	if (psmem[i].look)
+	    psmem[i].look = psmem[i].look - lookbase + lkst;
+	if (pstate[i]->look)
+	    pstate[i]->look = pstate[i]->look - lookbase + lkst;
+    }
+}
+
+static void
+exp_wsets ()
+{
+    int i, j;
+
+    wsetsz += WSETSIZE;
+    tmp_lset = (int *)
+	calloc ((size_t) (TBITSET * (wsetsz - WSETSIZE)), sizeof (int));
+    if (tmp_lset == NULL)
+/*
+ * TRANSLATION_NOTE  -- This is a message from yacc.
+ *	This message is passed to error() function.
+ *	Memory allocation error. Do not translate lookset.
+ *
+ *	You may just translate this as:
+ *	'Could not allocate internally used memory.'
+ */
+	error ("could not expand lookset array");
+    wsets = (WSET *) realloc ((char *) wsets, sizeof (WSET) * wsetsz);
+    for (i = wsetsz - WSETSIZE, j = 0; i < wsetsz; ++i, ++j)
+	wsets[i].ws.lset = tmp_lset + TBITSET * j;
+    tmp_lset = NULL;
+    if (wsets == NULL)
+/*
+ * TRANSLATION_NOTE  -- This is a message from yacc.
+ *	This message is passed to error() function.
+ *	Memory allocation error. You may just transltate
+ *	this as 'Could not allocate internally used memory.'
+ *
+ *	You may just translate this as:
+ *	'Could not allocate internally used memory.'
+ */
+	error ("could not expand working sets");
+}
+
+static void
+exp_states ()
+{
+    nstatesz += NSTATES;
+
+    pstate = (ITEM **)
+	realloc ((char *) pstate, sizeof (ITEM *) * (nstatesz + 2));
+    mstates = (int *) realloc ((char *) mstates, sizeof (int) * nstatesz);
+    defact = (int *) realloc ((char *) defact, sizeof (int) * nstatesz);
+    tystate = (int *) realloc ((char *) tystate, sizeof (int) * nstatesz);
+    indgo = (int *) realloc ((char *) indgo, sizeof (int) * nstatesz);
+
+    if ((*pstate == NULL) || (tystate == NULL) || (defact == NULL) ||
+	(indgo == NULL) || (mstates == NULL))
+/*
+ * TRANSLATION_NOTE  -- This is a message from yacc.
+ *	This message is passed to error() function.
+ *	Memory allocation error.
+ *
+ *	You may just translate this as:
+ *	'Could not allocate internally used memory.'
+ */
+	error ("cannot expand table of states");
+}
+
+static void
+exp_psmem ()
+{
+    int i;
+
+    new_pstsize += PSTSIZE;
+    psmem = (ITEM *) realloc ((char *) psmem, sizeof (ITEM) * new_pstsize);
+    if (psmem == NULL)
+/*
+ * TRANSLATION_NOTE  -- This is a message from yacc.
+ *	This message is passed to error() function.
+ *	Memory allocation error.
+ *
+ *	You may just translate this as:
+ *	'Could not allocate internally used memory.'
+ */
+	error ("cannot expand pstate memory");
+
+    zzmemsz = zzmemsz - pstate[0] + psmem;
+    for (i = 1; i <= nstate + 1; ++i)
+	pstate[i] = pstate[i] - pstate[0] + psmem;
+    pstate[0] = psmem;
+}
diff --git a/unix/boot/xyacc/y2.c b/unix/boot/xyacc/y2.c
new file mode 100644
index 00000000..072b6c8c
--- /dev/null
+++ b/unix/boot/xyacc/y2.c
@@ -0,0 +1,1952 @@
+/*
+ * CDDL HEADER START
+ *
+ * The contents of this file are subject to the terms of the
+ * Common Development and Distribution License (the "License").
+ * You may not use this file except in compliance with the License.
+ *
+ * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE
+ * or http://www.opensolaris.org/os/licensing.
+ * See the License for the specific language governing permissions
+ * and limitations under the License.
+ *
+ * When distributing Covered Code, include this CDDL HEADER in each
+ * file and include the License file at usr/src/OPENSOLARIS.LICENSE.
+ * If applicable, add the following below this CDDL HEADER, with the
+ * fields enclosed by brackets "[]" replaced with your own identifying
+ * information: Portions Copyright [yyyy] [name of copyright owner]
+ *
+ * CDDL HEADER END
+ */
+/*
+ * Copyright 2008 Sun Microsystems, Inc.  All rights reserved.
+ * Use is subject to license terms.
+ */
+
+/* Copyright (c) 1988 AT&T */
+/* All Rights Reserved */
+
+//#pragma ident	"%Z%%M%	%I%	%E% SMI"
+
+#include "dextern.h"
+#include <stdio.h>
+
+
+#define	IDENTIFIER 257
+
+#define	MARK 258
+#define	TERM 259
+#define	LEFT 260
+#define	RIGHT 261
+#define	BINARY 262
+#define	PREC 263
+#define	LCURLY 264
+#define	C_IDENTIFIER 265	/* name followed by colon */
+#define	NUMBER 266
+#define	START 267
+#define	TYPEDEF 268
+#define	TYPENAME 269
+#define	UNION 270
+#define	ENDFILE 0
+#define	LHS_TEXT_LEN		80	/* length of lhstext */
+#define	RHS_TEXT_LEN		640	/* length of rhstext */
+	/* communication variables between various I/O routines */
+
+#define	v_FLAG	0x01
+#define	d_FLAG	0x02
+#define	DEFAULT_PREFIX	"y"
+
+char *infile;			/* input file name              */
+static int numbval;		/* value of an input number     */
+static int toksize = NAMESIZE;
+static char *tokname;		/* input token name             */
+char *parser = PARSER;		/* location of common parser    */
+
+static void finact (void);
+static char *cstash (char *);
+static void defout (void);
+static void cpyunion (void);
+static void cpycode (void);
+static void cpyact (int);
+static void lhsfill (char *);
+static void rhsfill (char *);
+static void lrprnt (void);
+#ifdef XYACC_DEBUG
+static void beg_debug (void);
+static void end_toks (void);
+static void end_debug (void);
+#endif
+static void exp_tokname (void);
+static void exp_prod (void);
+static void exp_ntok (void);
+static void exp_nonterm (void);
+static int defin (int, char *);
+static int gettok (void);
+static int chfind (int, char *);
+static int skipcom (void);
+static int findchtok (int);
+#ifdef PREFIX_DEFINE
+static void put_prefix_define (char *);
+#endif
+
+
+/* storage of names */
+
+/*
+ * initial block to place token and
+ * nonterminal names are stored
+ * points to initial block - more space
+ * is allocated as needed.
+ */
+static char cnamesblk0[CNAMSZ];
+static char *cnames = cnamesblk0;
+
+/* place where next name is to be put in */
+static char *cnamp = cnamesblk0;
+
+/* number of defined symbols output */
+static int ndefout = 3;
+
+	/* storage of types */
+static int defunion = 0;	/* union of types defined? */
+static int ntypes = 0;		/* number of types defined */
+static char *typeset[NTYPES];	/* pointers to type tags */
+
+	/* symbol tables for tokens and nonterminals */
+
+int ntokens = 0;
+int ntoksz = NTERMS;
+TOKSYMB *tokset;
+int *toklev;
+
+int nnonter = -1;
+NTSYMB *nontrst;
+int nnontersz = NNONTERM;
+
+static int start;		/* start symbol */
+
+	/* assigned token type values */
+static int extval = 0;
+
+	/* input and output file descriptors */
+
+FILE *finput;			/* yacc input file */
+FILE *faction;			/* file for saving actions */
+FILE *fdefine;			/* file for # defines */
+FILE *ftable;			/* y.tab.x file */
+FILE *ftemp;			/* tempfile to pass 2 */
+FILE *fudecl;			/* file for user declarations   */
+FILE *fsppout;			/* SPP y.tab.x output file      */
+FILE *fdebug;			/* where the strings for debugging are stored */
+FILE *foutput;			/* y.output file */
+
+	/* output string */
+
+static char *lhstext;
+static char *rhstext;
+
+	/* storage for grammar rules */
+
+int *mem0;			/* production storage */
+int *mem;
+int *tracemem;
+extern int *optimmem;
+int new_memsize = MEMSIZE;
+int nprod = 1;			/* number of productions */
+int nprodsz = NPROD;
+
+int **prdptr;
+int *levprd;
+char *had_act;
+
+/* flag for generating the # line's default is yes */
+int gen_lines = 1;
+int act_lines = 0;
+
+/* flag for whether to include runtime debugging */
+static int gen_testing = 0;
+
+/* flag for version stamping--default turned off */
+static char *v_stmp = "n";
+
+int nmbchars = 0;		/* number of mb literals in mbchars */
+MBCLIT *mbchars = (MBCLIT *) 0;	/* array of mb literals */
+int nmbcharsz = 0;		/* allocated space for mbchars */
+
+void
+setup (argc, argv)
+     int argc;
+     char *argv[];
+{
+    int ii, i, j, lev, t, ty;
+    /* ty is the sequencial number of token name in tokset */
+    int c;
+    int *p;
+    char *cp;
+    char actname[8];
+    unsigned int options = 0;
+    char *file_prefix = DEFAULT_PREFIX;
+    char *sym_prefix = "";
+#define	F_NAME_LENGTH	128
+    char fname[F_NAME_LENGTH + 1];
+
+    foutput = NULL;
+    fdefine = NULL;
+    i = 1;
+
+    tokname = (char *) malloc (sizeof (char) * toksize);
+    tokset = (TOKSYMB *) malloc (sizeof (TOKSYMB) * ntoksz);
+    toklev = (int *) malloc (sizeof (int) * ntoksz);
+    nontrst = (NTSYMB *) malloc (sizeof (NTSYMB) * nnontersz);
+    mem0 = (int *) malloc (sizeof (int) * new_memsize);
+    prdptr = (int **) malloc (sizeof (int *) * (nprodsz + 2));
+    levprd = (int *) malloc (sizeof (int) * (nprodsz + 2));
+    had_act = (char *) calloc ((nprodsz + 2), sizeof (char));
+    lhstext = (char *) calloc (1, sizeof (char) * LHS_TEXT_LEN);
+    rhstext = (char *) calloc (1, sizeof (char) * RHS_TEXT_LEN);
+    aryfil (toklev, ntoksz, 0);
+    aryfil (levprd, nprodsz, 0);
+    for (ii = 0; ii < ntoksz; ++ii)
+	tokset[ii].value = 0;
+    for (ii = 0; ii < nnontersz; ++ii)
+	nontrst[ii].tvalue = 0;
+    aryfil (mem0, new_memsize, 0);
+    mem = mem0;
+    tracemem = mem0;
+
+    while ((c = getopt (argc, argv, "vVdltp:Q:Y:P:b:")) != EOF)
+	switch (c) {
+	case 'v':
+	    options |= v_FLAG;
+	    break;
+	case 'V':
+	    (void) fprintf (stderr, "yacc: NOAO/IRAF v1.0\n");
+	    break;
+	case 'Q':
+	    v_stmp = optarg;
+	    if (*v_stmp != 'y' && *v_stmp != 'n')
+/*
+ * TRANSLATION_NOTE  -- This is a message from yacc.
+ *	This message is passed to error() function.
+ *	Do not translate -Q and [y/n].
+ */
+		error ("yacc: -Q should be followed by [y/n]");
+	    break;
+	case 'd':
+	    options |= d_FLAG;
+	    break;
+	case 'l':
+	    gen_lines = 0;	/* don't gen #lines */
+	    break;
+	case 't':
+	    gen_testing = 1;	/* set YYDEBUG on */
+	    break;
+	case 'Y':
+	    cp = (char *) malloc (strlen (optarg) + sizeof ("/yaccpar") + 1);
+	    cp = strcpy (cp, optarg);
+	    parser = strcat (cp, "/yaccpar");
+	    break;
+	case 'P':
+	    parser = optarg;
+	    break;
+	case 'p':
+	    if (strcmp (optarg, "yy") != 0)
+		sym_prefix = optarg;
+	    else
+		sym_prefix = "";
+	    break;
+	case 'b':
+	    file_prefix = optarg;
+	    break;
+	case '?':
+	default:
+/*
+ * TRANSLATION_NOTE  -- This is a message from yacc.
+ *	This message is passed to error() function.
+ *	This is a usage message. The translate should be
+ *	consistent with man page translation.
+ */
+	    (void) fprintf (stderr,
+			    "Usage: yacc [-vVdltY] [-Q(y/n)] [-b file_prefix] [-p sym_prefix]"
+			    " [-P parser] file\n");
+	    exit (1);
+	}
+    /*
+     * Open y.output if -v is specified
+     */
+    if (options & v_FLAG) {
+	(void) strncpy (fname,
+			file_prefix, F_NAME_LENGTH - strlen (".output"));
+	(void) strcat (fname, ".output");
+	foutput = fopen (fname, "w");
+	if (foutput == NULL)
+	    error ("cannot open y.output");
+    }
+
+    /*
+     * Open y.tab.h if -d is specified
+     */
+    if (options & d_FLAG) {
+	(void) strncpy (fname,
+			file_prefix, F_NAME_LENGTH - strlen (".tab.h"));
+	(void) strcat (fname, ".tab.h");
+	fdefine = fopen (fname, "w");
+	if (fdefine == NULL)
+	    error ("cannot open y.tab.h");
+    }
+
+    fdebug = fopen (DEBUGNAME, "w");
+    if (fdebug == NULL)
+/*
+ * TRANSLATION_NOTE  -- This is a message from yacc.
+ *	This message is passed to error() function.
+ *	Do not translate yacc.debug.
+ */
+	error ("cannot open yacc.debug");
+    /*
+     * Open ytab.x
+     (void) strncpy(fname, file_prefix, F_NAME_LENGTH-strlen(".tab.x"));
+     (void) strcat(fname, ".tab.x");
+     ftable = fopen(fname, "w");
+     if (ftable == NULL)
+     error("cannot open %s", fname);
+     */
+
+
+    fsppout = fopen (OFILE, "w");
+    if (fsppout == NULL)
+	error ("cannot create output file");
+    ftable = fopen (TABFILE, "w");
+    if (ftable == NULL)
+	error ("cannot create table file");
+    fudecl = fopen (UDFILE, "w");
+    if (fudecl == NULL)
+	error ("cannot create user declarations file");
+
+
+    ftemp = fopen (TEMPNAME, "w");
+    faction = fopen (ACTNAME, "w");
+    if (ftemp == NULL || faction == NULL)
+/*
+ * TRANSLATION_NOTE  -- This is a message from yacc.
+ *	This message is passed to error() function.
+ *	The message means: "Could not open a temporary file."
+ */
+	error ("cannot open temp file");
+
+    if ((finput = fopen (infile = argv[optind], "r")) == NULL)
+/*
+ * TRANSLATION_NOTE  -- This is a message from yacc.
+ *	This message is passed to error() function.
+ */
+	error ("cannot open input file");
+
+    lineno = 1;
+    cnamp = cnames;
+    (void) defin (0, "$end");
+    extval = 0400;
+    (void) defin (0, "error");
+    (void) defin (1, "$accept");
+    mem = mem0;
+    lev = 0;
+    ty = 0;
+    i = 0;
+#ifdef XYACC_DEBUG
+    beg_debug();  /* initialize fdebug file */
+#endif
+
+    /*
+     * sorry -- no yacc parser here.....
+     *      we must bootstrap somehow...
+     */
+
+    t = gettok ();
+    if (*v_stmp == 'y')
+	(void) fprintf (ftable, "#ident\t\"yacc: NOAO/IRAF v1.0\"\n");
+    for (; t != MARK && t != ENDFILE;) {
+	int tok_in_line;
+	switch (t) {
+
+	case ';':
+	    t = gettok ();
+	    break;
+
+	case START:
+	    if ((t = gettok ()) != IDENTIFIER) {
+		error ("bad %%start construction");
+	    }
+	    start = chfind (1, tokname);
+	    t = gettok ();
+	    continue;
+
+	case TYPEDEF:
+	    tok_in_line = 0;
+	    if ((t = gettok ()) != TYPENAME)
+/*
+ * TRANSLATION_NOTE  -- This is a message from yacc.
+ *	This message is passed to error() function.
+ *	Do not translate %%type.
+ */
+		error ("bad syntax in %%type");
+	    ty = numbval;
+	    for (;;) {
+		t = gettok ();
+		switch (t) {
+
+		case IDENTIFIER:
+		    /*
+		     * The following lines are idented to left.
+		     */
+		    tok_in_line = 1;
+		    if ((t = chfind (1, tokname)) < NTBASE) {
+			j = TYPE (toklev[t]);
+			if (j != 0 && j != ty) {
+/*
+ * TRANSLATION_NOTE  -- This is a message from yacc.
+ *	This message is passed to error() function.
+ */
+			    error
+				("type redeclaration of token %s",
+				 tokset[t].name);
+			} else
+			    SETTYPE (toklev[t], ty);
+		    } else {
+			j = nontrst[t - NTBASE].tvalue;
+			if (j != 0 && j != ty) {
+/*
+ * TRANSLATION_NOTE  -- This is a message from yacc.
+ *	This message is passed to error() function.
+ *	Check how nonterminal is translated in translated
+ *	yacc man page or yacc user's document.
+ */
+			    error
+				("type redeclaration of nonterminal %s",
+				 nontrst[t - NTBASE].name);
+			} else
+			    nontrst[t - NTBASE].tvalue = ty;
+		    }
+		    /* FALLTHRU */
+		    /*
+		     * End Indentation
+		     */
+		case ',':
+		    continue;
+
+		case ';':
+		    t = gettok ();
+		    break;
+		default:
+		    break;
+		}
+		if (!tok_in_line)
+/*
+ * TRANSLATION_NOTE  -- This is a message from yacc.
+ *	This message is passed to error() function.
+ */
+		    error ("missing tokens or illegal tokens");
+		break;
+	    }
+	    continue;
+
+	case UNION:
+	    /* copy the union declaration to the output */
+	    cpyunion ();
+	    defunion = 1;
+	    t = gettok ();
+	    continue;
+
+	case LEFT:
+	case BINARY:
+	case RIGHT:
+	    i++;
+	    /* FALLTHRU */
+	case TERM:
+	    tok_in_line = 0;
+
+	    /* nonzero means new prec. and assoc. */
+	    lev = (t - TERM) | 04;
+	    ty = 0;
+
+	    /* get identifiers so defined */
+
+	    t = gettok ();
+	    if (t == TYPENAME) {	/* there is a type defined */
+		ty = numbval;
+		t = gettok ();
+	    }
+
+	    for (;;) {
+		switch (t) {
+
+		case ',':
+		    t = gettok ();
+		    continue;
+
+		case ';':
+		    break;
+
+		case IDENTIFIER:
+		    tok_in_line = 1;
+		    j = chfind (0, tokname);
+		    if (j > NTBASE) {
+/*
+ * TRANSLATION_NOTE  -- This is a message from yacc.
+ *	This message is passed to error() function.
+ */
+			error ("%s is not a token.", tokname);
+		    }
+		    if (lev & ~04) {
+			if (ASSOC (toklev[j]) & ~04)
+/*
+ * TRANSLATION_NOTE  -- This is a message from yacc.
+ *	This message is passed to error() function.
+ */
+			    error
+				("redeclaration of precedence of %s",
+				 tokname);
+			SETASC (toklev[j], lev);
+			SETPLEV (toklev[j], i);
+		    } else {
+			if (ASSOC (toklev[j]))
+			    (void) warning (1,
+					    "redeclaration of precedence of %s.",
+					    tokname);
+			SETASC (toklev[j], lev);
+		    }
+		    if (ty) {
+			if (TYPE (toklev[j]))
+			    error (
+/*
+ * TRANSLATION_NOTE  -- This is a message from yacc.
+ *	This message is passed to error() function.
+ */
+				      "redeclaration of type of %s", tokname);
+			SETTYPE (toklev[j], ty);
+		    }
+		    if ((t = gettok ()) == NUMBER) {
+			tokset[j].value = numbval;
+			if (j < ndefout && j > 2) {
+/*
+ * TRANSLATION_NOTE  -- This is a message from yacc.
+ *	This message is passed to error() function.
+ */
+			    error
+				("type number of %s should be defined earlier",
+				 tokset[j].name);
+			}
+			if (numbval >= -YYFLAG1) {
+/*
+ * TRANSLATION_NOTE  -- This is a message from yacc.
+ *	This message is passed to error() function.
+ */
+			    error
+				("token numbers must be less than %d",
+				 -YYFLAG1);
+			}
+			t = gettok ();
+		    }
+		    continue;
+
+		}
+		if (!tok_in_line)
+/*
+ * TRANSLATION_NOTE  -- This is a message from yacc.
+ *	This message is passed to error() function.
+ */
+		    error ("missing tokens or illegal tokens");
+		break;
+	    }
+	    continue;
+
+	case LCURLY:
+	    defout ();
+	    cpycode ();
+	    t = gettok ();
+	    continue;
+
+	default:
+	    error ("syntax error");
+
+	}
+
+    }
+
+    if (t == ENDFILE) {
+/*
+ * TRANSLATION_NOTE  -- This is a message from yacc.
+ *	This message is passed to error() function.
+ *	Do not translate %%%%.
+ */
+	error ("unexpected EOF before %%%%");
+    }
+
+    /* t is MARK */
+
+    defout ();
+#ifdef XYACC_DEBUG
+    end_toks();   /* all tokens dumped - get ready for reductions */
+#endif
+
+    fprintf (fsppout, "define\tyyclearin\tyychar = -1\n");
+    fprintf (fsppout, "define\tyyerrok\t\tyyerrflag = 0\n");
+    fprintf (fsppout,
+	     "define\tYYMOVE\t\tcall amovi (Memi[$1], Memi[$2], YYOPLEN)\n");
+
+    prdptr[0] = mem;
+    /* added production */
+    *mem++ = NTBASE;
+
+    /* if start is 0, we will overwrite with the lhs of the first rule */
+    *mem++ = start;
+    *mem++ = 1;
+    *mem++ = 0;
+    prdptr[1] = mem;
+
+    while ((t = gettok ()) == LCURLY)
+	cpycode ();
+
+    if (t != C_IDENTIFIER)
+	error ("bad syntax on first rule");
+
+    if (!start)
+	prdptr[0][1] = chfind (1, tokname);
+
+    /* read rules */
+
+    while (t != MARK && t != ENDFILE) {
+
+	/* process a rule */
+
+	if (t == '|') {
+	    rhsfill ((char *) 0);	/* restart fill of rhs */
+	    *mem = *prdptr[nprod - 1];
+	    if (++mem >= &tracemem[new_memsize])
+		exp_mem (1);
+	} else if (t == C_IDENTIFIER) {
+	    *mem = chfind (1, tokname);
+	    if (*mem < NTBASE)
+/*
+ * TRANSLATION_NOTE  -- This is a message from yacc.
+ *	This message is passed to error() function.
+ *	Check how nonterminal is translated.
+ */
+		error ("illegal nonterminal in grammar rule");
+	    if (++mem >= &tracemem[new_memsize])
+		exp_mem (1);
+	    lhsfill (tokname);	/* new rule: restart strings */
+	} else
+/*
+ * TRANSLATION_NOTE  -- This is a message from yacc.
+ *	This message is passed to error() function.
+ */
+	    error ("illegal rule: missing semicolon or | ?");
+
+	/* read rule body */
+
+
+	t = gettok ();
+      more_rule:
+	while (t == IDENTIFIER) {
+	    *mem = chfind (1, tokname);
+	    if (*mem < NTBASE)
+		levprd[nprod] = toklev[*mem] & ~04;
+	    if (++mem >= &tracemem[new_memsize])
+		exp_mem (1);
+	    rhsfill (tokname);	/* add to rhs string */
+	    t = gettok ();
+	}
+
+	if (t == PREC) {
+	    if (gettok () != IDENTIFIER)
+/*
+ * TRANSLATION_NOTE  -- This is a message from yacc.
+ *	This message is passed to error() function.
+ *	Do not translate %%prec.
+ */
+		error ("illegal %%prec syntax");
+	    j = chfind (2, tokname);
+	    if (j >= NTBASE)
+/*
+ * TRANSLATION_NOTE  -- This is a message from yacc.
+ *	This message is passed to error() function.
+ *	Do not translate %%prec.
+ */
+		error ("nonterminal %s illegal after %%prec",
+		       nontrst[j - NTBASE].name);
+	    levprd[nprod] = toklev[j] & ~04;
+	    t = gettok ();
+	}
+
+	if (t == '=') {
+	    had_act[nprod] = 1;
+	    levprd[nprod] |= ACTFLAG;
+	    (void) fprintf (faction, "\ncase %d:", nprod);
+	    cpyact (mem - prdptr[nprod] - 1);
+	    /* !SPP         (void) fprintf(faction, " break;"); */
+
+	    if ((t = gettok ()) == IDENTIFIER) {
+		/* action within rule... */
+
+#ifdef XYACC_DEBUG
+		lrprnt();             /* dump lhs, rhs */
+#endif
+		(void) sprintf (actname, "$$%d", nprod);
+		/*
+		 * make it nonterminal
+		 */
+		j = chfind (1, actname);
+
+		/*
+		 * the current rule will become rule
+		 * number nprod+1 move the contents down,
+		 * and make room for the null
+		 */
+
+		if (mem + 2 >= &tracemem[new_memsize])
+		    exp_mem (1);
+		for (p = mem; p >= prdptr[nprod]; --p)
+		    p[2] = *p;
+		mem += 2;
+
+		/* enter null production for action */
+
+		p = prdptr[nprod];
+
+		*p++ = j;
+		*p++ = -nprod;
+
+		/* update the production information */
+
+		levprd[nprod + 1] = levprd[nprod] & ~ACTFLAG;
+		levprd[nprod] = ACTFLAG;
+
+		if (++nprod >= nprodsz)
+		    exp_prod ();
+		prdptr[nprod] = p;
+
+		/*
+		 * make the action appear in
+		 * the original rule
+		 */
+		*mem++ = j;
+		if (mem >= &tracemem[new_memsize])
+		    exp_mem (1);
+		/* get some more of the rule */
+		goto more_rule;
+	    }
+	}
+	while (t == ';')
+	    t = gettok ();
+	*mem++ = -nprod;
+	if (mem >= &tracemem[new_memsize])
+	    exp_mem (1);
+
+	/* check that default action is reasonable */
+
+	if (ntypes && !(levprd[nprod] & ACTFLAG) &&
+	    nontrst[*prdptr[nprod] - NTBASE].tvalue) {
+	    /* no explicit action, LHS has value */
+	    int tempty;
+	    tempty = prdptr[nprod][1];
+	    if (tempty < 0)
+/*
+ * TRANSLATION_NOTE  -- This is a message from yacc.
+ *	This message is passed to error() function.
+ *	LHS means Left Hand Side. It does not need to be translated.
+ */
+		error ("must return a value, since LHS has a type");
+	    else if (tempty >= NTBASE)
+		tempty = nontrst[tempty - NTBASE].tvalue;
+	    else
+		tempty = TYPE (toklev[tempty]);
+	    if (tempty != nontrst[*prdptr[nprod] - NTBASE].tvalue) {
+/*
+ * TRANSLATION_NOTE  -- This is a message from yacc.
+ *	This message is passed to error() function.
+ *	Check how action is transltated in yacc man page or documents.
+ */
+		error ("default action causes potential type clash");
+	    }
+	}
+
+	if (++nprod >= nprodsz)
+	    exp_prod ();
+	prdptr[nprod] = mem;
+	levprd[nprod] = 0;
+    }
+    /* end of all rules */
+
+#ifdef XYACC_DEBUG
+    end_debug();          /* finish fdebug file's input */
+#endif
+    finact ();
+    if (t == MARK) {
+	/*
+	   if (gen_lines)
+	   (void) fprintf(fsppout, "\n# a line %d \"%s\"\n",
+	   lineno, infile);
+	 */
+	while ((c = getc (finput)) != EOF)
+	    (void) putc (c, fsppout);
+    }
+    (void) fclose (finput);
+}
+
+static void
+finact ()
+{
+    /* finish action routine */
+    (void) fclose (faction);
+    (void) fprintf (fsppout, "define\tYYERRCODE\t%d\n", tokset[2].value);
+}
+
+static char *
+cstash (s)
+     register char *s;
+{
+    char *temp;
+    static int used = 0;
+    static int used_save = 0;
+    static int exp_cname = CNAMSZ;
+    int len = strlen (s);
+
+    /*
+     * 2/29/88 -
+     * Don't need to expand the table, just allocate new space.
+     */
+    used_save = used;
+    while (len >= (exp_cname - used_save)) {
+	exp_cname += CNAMSZ;
+	if (!used)
+	    free ((char *) cnames);
+	if ((cnames = (char *) malloc (sizeof (char) * exp_cname)) == NULL)
+/*
+ * TRANSLATION_NOTE  -- This is a message from yacc.
+ *	This message is passed to error() function.
+ *
+ *	You may just translate this as:
+ *	'Could not allocate internally used memory.'
+ */
+	    error ("cannot expand string dump");
+	cnamp = cnames;
+	used = 0;
+    }
+
+    temp = cnamp;
+    do {
+	*cnamp++ = *s;
+    }
+    while (*s++);
+    used += cnamp - temp;
+    return (temp);
+}
+
+static int
+defin (int t, char *s)
+{
+    /* define s to be a terminal if t=0 or a nonterminal if t=1 */
+
+    int val;
+
+    val = 0;
+    if (t) {
+	if (++nnonter >= nnontersz)
+	    exp_nonterm ();
+	nontrst[nnonter].name = cstash (s);
+	return (NTBASE + nnonter);
+    }
+    /* must be a token */
+    if (++ntokens >= ntoksz)
+	exp_ntok ();
+    tokset[ntokens].name = cstash (s);
+
+    /* establish value for token */
+
+    if (s[0] == ' ' && s[2] == 0) {	/* single character literal */
+	val = findchtok (s[1]);
+    } else if (s[0] == ' ' && s[1] == '\\') {	/* escape sequence */
+	if (s[3] == 0) {	/* single character escape sequence */
+	    switch (s[2]) {
+		/* character which is escaped */
+	    case 'a':
+		(void) warning (1,
+/*
+ * TRANSLATION_NOTE  -- This is a message from yacc.
+ *	This message is passed to warning() function.
+ *	Do not trasnlate ANSI C, \\a.
+ */
+				"\\a is ANSI C \"alert\" character");
+#if __STDC__ - 1 == 0
+		val = '\a';
+		break;
+#else
+		val = '\007';
+		break;
+#endif
+	    case 'v':
+		val = '\v';
+		break;
+	    case 'n':
+		val = '\n';
+		break;
+	    case 'r':
+		val = '\r';
+		break;
+	    case 'b':
+		val = '\b';
+		break;
+	    case 't':
+		val = '\t';
+		break;
+	    case 'f':
+		val = '\f';
+		break;
+	    case '\'':
+		val = '\'';
+		break;
+	    case '"':
+		val = '"';
+		break;
+	    case '?':
+		val = '?';
+		break;
+	    case '\\':
+		val = '\\';
+		break;
+/*
+ * TRANSLATION_NOTE  -- This is a message from yacc.
+ *	This message is passed to error() function.
+ */
+	    default:
+		error ("invalid escape");
+	    }
+	} else if (s[2] <= '7' && s[2] >= '0') {	/* \nnn sequence */
+	    int i = 3;
+	    val = s[2] - '0';
+	    while (isdigit (s[i]) && i <= 4) {
+		if (s[i] >= '0' && s[i] <= '7')
+		    val = val * 8 + s[i] - '0';
+		else
+/*
+ * TRANSLATION_NOTE  -- This is a message from yacc.
+ *	This message is passed to error() function.
+ */
+		    error ("illegal octal number");
+		i++;
+	    }
+	    if (s[i] != 0)
+/*
+ * TRANSLATION_NOTE  -- This is a message from yacc.
+ *	This message is passed to error() function.
+ *	Do not translate \\nnn.
+ */
+		error ("illegal \\nnn construction");
+	    if (val > 255)
+/*
+ * TRANSLATION_NOTE  -- This is a message from yacc.
+ *	This message is passed to error() function.
+ *	Do not translate
+ *		\\nnn, \\xnnnnnnnn.
+ */
+		error
+		    ("\\nnn exceed \\377; use \\xnnnnnnnn for char value of multibyte char");
+	    if (val == 0 && i >= 4)
+/*
+ * TRANSLATION_NOTE  -- This is a message from yacc.
+ *	This message is passed to error() function.
+ *	Do not translate \\000.
+ */
+		error ("'\\000' is illegal");
+	} else if (s[2] == 'x') {	/* hexadecimal \xnnn sequence */
+	    int i = 3;
+	    val = 0;
+/*
+ * TRANSLATION_NOTE  -- This is a message from yacc.
+ *	This message is passed to warning() function.
+ *	Do not translate \\x, ANSI C.
+ */
+	    (void) warning (1, "\\x is ANSI C hex escape");
+	    if (isxdigit (s[i]))
+		while (isxdigit (s[i])) {
+		    int tmpval;
+		    if (isdigit (s[i]))
+			tmpval = s[i] - '0';
+		    else if (s[i] >= 'a')
+			tmpval = s[i] - 'a' + 10;
+		    else
+			tmpval = s[i] - 'A' + 10;
+		    val = 16 * val + tmpval;
+		    i++;
+	    } else
+		error ("illegal hexadecimal number");
+	    if (s[i] != 0)
+/*
+ * TRANSLATION_NOTE  -- This is a message from yacc.
+ *	This message is passed to error() function.
+ *	Do not translate \\xnn.
+ */
+		error ("illegal \\xnn construction");
+#define	LWCHAR_MAX	0x7fffffff
+	    if ((unsigned) val > LWCHAR_MAX)
+/*
+ * TRANSLATION_NOTE  -- This is a message from yacc.
+ *	This message is passed to error() function.
+ *	Do not translate \\xnnnnnnnn and %#x.
+ */
+		error (" \\xnnnnnnnn exceed %#x", LWCHAR_MAX);
+	    if (val == 0)
+/*
+ * TRANSLATION_NOTE  -- This is a message from yacc.
+ *	This message is passed to error() function.
+ *	Do not translate \\x00.
+ */
+		error ("'\\x00' is illegal");
+	    val = findchtok (val);
+	} else
+	    error ("invalid escape");
+    } else {
+	val = extval++;
+    }
+    tokset[ntokens].value = val;
+    toklev[ntokens] = 0;
+    return (ntokens);
+}
+
+static void
+defout ()
+{
+    /* write out the defines (at the end of the declaration section) */
+
+    register int i, c;
+    register char *cp;
+
+    for (i = ndefout; i <= ntokens; ++i) {
+
+	cp = tokset[i].name;
+	if (*cp == ' ') {	/* literals */
+	    (void) fprintf (fdebug, WSFMT ("\t\"%s\",\t%d,\n"),
+			    tokset[i].name + 1, tokset[i].value);
+	    continue;		/* was cp++ */
+	}
+
+	for (; (c = *cp) != 0; ++cp) {
+	    if (islower (c) || isupper (c) || isdigit (c) || c == '_')
+		/* EMPTY */ ;
+	    else
+		goto nodef;
+	}
+
+	(void) fprintf (fdebug,
+			WSFMT ("\t\"%s\",\t%d,\n"), tokset[i].name,
+			tokset[i].value);
+	(void) fprintf (fsppout, WSFMT ("define\t%s\t\t%d\n"),
+			tokset[i].name, tokset[i].value);
+	if (fdefine != NULL)
+	    (void) fprintf (fdefine,
+			    WSFMT ("define\t%s\t\t%d\n"), tokset[i].name,
+			    tokset[i].value);
+
+      nodef:;
+    }
+    ndefout = ntokens + 1;
+}
+
+static int
+gettok ()
+{
+    int i, base;
+    static int peekline;	/* number of '\n' seen in lookahead */
+    int c, match, reserve;
+  begin:
+    reserve = 0;
+    lineno += peekline;
+    peekline = 0;
+    c = getc (finput);
+    /*
+     * while (c == ' ' || c == '\n' || c == '\t' || c == '\f') {
+     */
+    while (isspace (c)) {
+	if (c == '\n')
+	    ++lineno;
+	c = getc (finput);
+    }
+    if (c == '#') {		/* skip comment */
+	lineno += skipcom ();
+	goto begin;
+    }
+
+    switch (c) {
+
+    case EOF:
+	return (ENDFILE);
+    case '{':
+	(void) ungetc (c, finput);
+	return ('=');		/* action ... */
+    case '<':			/* get, and look up, a type name (union member name) */
+	i = 0;
+	while ((c = getc (finput)) != '>' && c != EOF && c != '\n') {
+	    tokname[i] = c;
+	    if (++i >= toksize)
+		exp_tokname ();
+	}
+	if (c != '>')
+	    error ("unterminated < ... > clause");
+	tokname[i] = 0;
+	if (i == 0)
+	    error ("missing type name in < ... > clause");
+	for (i = 1; i <= ntypes; ++i) {
+	    if (!strcmp (typeset[i], tokname)) {
+		numbval = i;
+		return (TYPENAME);
+	    }
+	}
+	typeset[numbval = ++ntypes] = cstash (tokname);
+	return (TYPENAME);
+
+    case '"':
+    case '\'':
+	match = c;
+	tokname[0] = ' ';
+	i = 1;
+	for (;;) {
+	    c = getc (finput);
+	    if (c == '\n' || c == EOF)
+		error ("illegal or missing ' or \"");
+	    if (c == '\\') {
+		c = getc (finput);
+		tokname[i] = '\\';
+		if (++i >= toksize)
+		    exp_tokname ();
+	    } else if (c == match)
+		break;
+	    tokname[i] = c;
+	    if (++i >= toksize)
+		exp_tokname ();
+	}
+	break;
+
+    case '%':
+    case '\\':
+
+	switch (c = getc (finput)) {
+
+	case '0':
+	    return (TERM);
+	case '<':
+	    return (LEFT);
+	case '2':
+	    return (BINARY);
+	case '>':
+	    return (RIGHT);
+	case '%':
+	case '\\':
+	    return (MARK);
+	case '=':
+	    return (PREC);
+	case '{':
+	    return (LCURLY);
+	default:
+	    reserve = 1;
+	}
+
+    default:
+
+	if (isdigit (c)) {	/* number */
+	    numbval = c - '0';
+	    base = (c == '0') ? 8 : 10;
+	    for (c = getc (finput); isdigit (c); c = getc (finput)) {
+		numbval = numbval * base + c - '0';
+	    }
+	    (void) ungetc (c, finput);
+	    return (NUMBER);
+	} else if (islower (c) || isupper (c) ||
+		   c == '_' || c == '.' || c == '$') {
+	    i = 0;
+	    while (islower (c) || isupper (c) ||
+		   isdigit (c) || c == '_' || c == '.' || c == '$') {
+		tokname[i] = c;
+		if (reserve && isupper (c))
+		    tokname[i] = tolower (c);
+		if (++i >= toksize)
+		    exp_tokname ();
+		c = getc (finput);
+	    }
+	} else
+	    return (c);
+
+	(void) ungetc (c, finput);
+    }
+
+    tokname[i] = 0;
+
+    if (reserve) {		/* find a reserved word */
+	if (!strcmp (tokname, "term"))
+	    return (TERM);
+	if (!strcmp (tokname, "token"))
+	    return (TERM);
+	if (!strcmp (tokname, "left"))
+	    return (LEFT);
+	if (!strcmp (tokname, "nonassoc"))
+	    return (BINARY);
+	if (!strcmp (tokname, "binary"))
+	    return (BINARY);
+	if (!strcmp (tokname, "right"))
+	    return (RIGHT);
+	if (!strcmp (tokname, "prec"))
+	    return (PREC);
+	if (!strcmp (tokname, "start"))
+	    return (START);
+	if (!strcmp (tokname, "type"))
+	    return (TYPEDEF);
+	if (!strcmp (tokname, "union"))
+	    return (UNION);
+	error ("invalid escape, or illegal reserved word: %s", tokname);
+    }
+
+    /* look ahead to distinguish IDENTIFIER from C_IDENTIFIER */
+
+    c = getc (finput);
+    /*
+     * while (c == ' ' || c == '\t' || c == '\n' || c == '\f' || c == '/')
+     * {
+     */
+    while (isspace (c) || c == '/') {
+	if (c == '\n') {
+	    ++peekline;
+	} else if (c == '#') {	/* look for comments */
+	    peekline += skipcom ();
+	}
+	c = getc (finput);
+    }
+    if (c == ':')
+	return (C_IDENTIFIER);
+    (void) ungetc (c, finput);
+    return (IDENTIFIER);
+}
+
+static int
+fdtype (int t)
+{
+    /* determine the type of a symbol */
+    int v;
+    if (t >= NTBASE)
+	v = nontrst[t - NTBASE].tvalue;
+    else
+	v = TYPE (toklev[t]);
+    if (v <= 0)
+	error ("must specify type for %s",
+	       (t >= NTBASE) ? nontrst[t - NTBASE].name : tokset[t].name);
+    return (v);
+}
+
+static int
+chfind (int t, char *s)
+{
+    int i;
+
+    if (s[0] == ' ')
+	t = 0;
+    TLOOP (i) {
+	if (!strcmp (s, tokset[i].name)) {
+	    return (i);
+	}
+    }
+    NTLOOP (i) {
+	if (!strcmp (s, nontrst[i].name)) {
+	    return (i + NTBASE);
+	}
+    }
+    /* cannot find name */
+    if (t > 1)
+	error ("%s should have been defined earlier", s);
+    return (defin (t, s));
+}
+
+static void
+cpyunion ()
+{
+    /*
+     * copy the union declaration to the output,
+     * and the define file if present
+     */
+    int level, c;
+    if (gen_lines)
+	(void) fprintf (fsppout, "\n# line %d \"%s\"\n", lineno, infile);
+    (void) fprintf (fsppout, "typedef union\n");
+    if (fdefine)
+	(void) fprintf (fdefine, "\ntypedef union\n");
+    (void) fprintf (fsppout, "#ifdef __cplusplus\n\tYYSTYPE\n#endif\n");
+    if (fdefine)
+	(void) fprintf (fdefine, "#ifdef __cplusplus\n\tYYSTYPE\n#endif\n");
+
+    level = 0;
+    for (;;) {
+	if ((c = getc (finput)) == EOF)
+/*
+ * TRANSLATION_NOTE  -- This is a message from yacc.
+ *	This message is passed to error() function.
+ *	EOF - End Of File.
+ *	Do not translate %%union.
+ */
+	    error ("EOF encountered while processing %%union");
+	(void) putc (c, fsppout);
+	if (fdefine)
+	    (void) putc (c, fdefine);
+
+	switch (c) {
+
+	case '\n':
+	    ++lineno;
+	    break;
+
+	case '{':
+	    ++level;
+	    break;
+
+	case '}':
+	    --level;
+	    if (level == 0) {	/* we are finished copying */
+		(void) fprintf (fsppout, " YYSTYPE;\n");
+		if (fdefine)
+		    (void) fprintf (fdefine,
+				    " YYSTYPE;\nextern YYSTYPE yylval;\n");
+		return;
+	    }
+	}
+    }
+}
+
+static void
+cpycode ()
+{
+    /* copies code between \{ and \} */
+    int c;
+    FILE *out;
+
+
+    c = getc (finput);
+    if (c == '\n') {
+	c = getc (finput);
+	lineno++;
+    }
+
+    /* The %{ .. %} section is divided up into a global and a local region.
+     * The global region is first, so set the out file to fsppout (write
+     * directly into SPP output file).  The start of the local declarations
+     * for the parser is marked by %L.  When this is seen, direct output
+     * into the temp file fudecl, which is later inserted into the
+     * declarations section of yyparse.
+     */
+    out = fsppout;
+
+    if (gen_lines)
+	(void) fprintf (out, "\n# line %d \"%s\"\n", lineno, infile);
+    for (; c >= 0; c = getc (finput)) {
+	if (c == '\\') {
+	    if ((c = getc (finput)) == '}')
+		return;
+	    else
+		putc ('\\', out);
+	}
+	if (c == '%') {
+	    if ((c = getc (finput)) == '}') {
+		return;
+	    } else if (c == 'L') {
+		out = fudecl;
+		continue;
+	    } else
+		putc ('%', out);
+	}
+	putc (c, out);
+	if (c == '\n')
+	    ++lineno;
+    }
+
+    error ("eof before %%}");
+}
+
+static int
+skipcom ()
+{
+    register int ch;
+
+    /* skip over SPP comments */
+    while ((ch = getc (finput)) != '\n')
+	if (ch == EOF)
+	    error ("EOF inside comment");
+
+    return (1);
+}
+
+
+static void
+cpyact (int offset)
+{
+    /* copy C action to the next ; or closing } */
+    int brac, c, match, j, s, tok, argument;
+    char id_name[NAMESIZE + 1];
+    int id_idx = 0;
+
+    if (gen_lines) {
+	(void) fprintf (faction, "\n# line %d \"%s\"\n", lineno, infile);
+	act_lines++;
+    }
+    brac = 0;
+    id_name[0] = 0;
+  loop:
+    c = getc (finput);
+  swt:
+    switch (c) {
+    case ';':
+	if (brac == 0) {
+	    (void) putc (c, faction);
+	    return;
+	}
+	goto lcopy;
+    case '{':
+	brac++;
+	goto lcopy;
+    case '$':
+	s = 1;
+	tok = -1;
+	argument = 1;
+	while ((c = getc (finput)) == ' ' || c == '\t')
+	    /* NULL */ ;
+	if (c == '<') {		/* type description */
+	    (void) ungetc (c, finput);
+	    if (gettok () != TYPENAME)
+/*
+ * TRANSLATION_NOTE  -- This is a message from yacc.
+ *	This message is passed to error() function.
+ *	Do not translate $<ident>
+ */
+		error ("bad syntax on $<ident> clause");
+	    tok = numbval;
+	    c = getc (finput);
+	}
+	if (c == '$') {
+	    (void) fprintf (faction, "yyval");
+	    if (ntypes) {	/* put out the proper tag... */
+		if (tok < 0)
+		    tok = fdtype (*prdptr[nprod]);
+		(void) fprintf (faction, WSFMT (".%s"), typeset[tok]);
+	    }
+	    goto loop;
+	}
+	if (c == '-') {
+	    s = -s;
+	    c = getc (finput);
+	}
+	if (isdigit (c)) {
+	    j = 0;
+	    while (isdigit (c)) {
+		j = j * 10 + c - '0';
+		c = getc (finput);
+	    }
+	    j = j * s - offset;
+	    if (j > 0) {
+/*
+ * TRANSLATION_NOTE  -- This is a message from yacc.
+ *	This message is passed to error() function.
+ *	Do not translate $%d.
+ */
+		error ("Illegal use of $%d", j + offset);
+	    }
+
+	    switch (-j) {
+	    case 0:
+		fprintf (faction, "yypvt");
+		break;
+	    case 1:
+		fprintf (faction, "yypvt-YYOPLEN");
+		break;
+	    default:
+		fprintf (faction, "yypvt-%d*YYOPLEN", -j);
+	    }
+
+
+	    if (ntypes) {	/* put out the proper tag */
+		if (j + offset <= 0 && tok < 0)
+/*
+ * TRANSLATION_NOTE  -- This is a message from yacc.
+ *	This message is passed to error() function.
+ *	Do not translate $%d.
+ */
+		    error ("must specify type of $%d", j + offset);
+		if (tok < 0)
+		    tok = fdtype (prdptr[nprod][j + offset]);
+		(void) fprintf (faction, WSFMT (".%s"), typeset[tok]);
+	    }
+	    goto swt;
+	}
+	(void) putc ('$', faction);
+	if (s < 0)
+	    (void) putc ('-', faction);
+	goto swt;
+    case '}':
+	if (--brac)
+	    goto lcopy;
+	(void) putc (c, faction);
+	return;
+    case '/':			/* look for comments */
+	(void) putc (c, faction);
+	c = getc (finput);
+	if (c != '*')
+	    goto swt;
+	/* it really is a comment */
+	(void) putc (c, faction);
+	c = getc (finput);
+	while (c != EOF) {
+	    while (c == '*') {
+		(void) putc (c, faction);
+		if ((c = getc (finput)) == '/')
+		    goto lcopy;
+	    }
+	    (void) putc (c, faction);
+	    if (c == '\n')
+		++lineno;
+	    c = getc (finput);
+	}
+	error ("EOF inside comment");
+	/* FALLTHRU */
+    case '\'':			/* character constant */
+    case '"':			/* character string */
+	match = c;
+	(void) putc (c, faction);
+	while ((c = getc (finput)) != EOF) {
+	    if (c == '\\') {
+		(void) putc (c, faction);
+		c = getc (finput);
+		if (c == '\n')
+		    ++lineno;
+	    } else if (c == match)
+		goto lcopy;
+	    else if (c == '\n')
+/*
+ * TRANSLATION_NOTE  -- This is a message from yacc.
+ *	This message is passed to error() function.
+ *	This error message is issued when
+ *	quoted string has multiple lines.
+ */
+		error ("newline in string or char. const.");
+	    (void) putc (c, faction);
+	}
+	error ("EOF in string or character constant");
+	/* FALLTHRU */
+    case EOF:
+/*
+ * TRANSLATION_NOTE  -- This is a message from yacc.
+ *	This message is passed to error() function.
+ *	Check how 'action' is translated in yacc mapage/document.
+ */
+	error ("action does not terminate");
+	/* FALLTHRU */
+    case '\n':
+	++lineno;
+	goto lcopy;
+    }
+  lcopy:
+    (void) putc (c, faction);
+    /*
+     * Save the possible identifier name.
+     * Used to print out a warning message.
+     */
+    if (id_idx >= NAMESIZE) {
+	/*
+	 * Error. Silently ignore.
+	 */
+	/* EMPTY */ ;
+    }
+    /*
+     * If c has a possibility to be a
+     * part of identifier, save it.
+     */
+    else if (isalnum (c) || c == '_') {
+	id_name[id_idx++] = c;
+	id_name[id_idx] = 0;
+    } else {
+	id_idx = 0;
+	id_name[id_idx] = 0;
+    }
+    goto loop;
+}
+
+static void
+lhsfill (s)			/* new rule, dump old (if exists), restart strings */
+     char *s;
+{
+    static int lhs_len = LHS_TEXT_LEN;
+    int s_lhs = strlen (s);
+    if (s_lhs >= lhs_len) {
+	lhs_len = s_lhs + 2;
+	lhstext = (char *)
+	    realloc ((char *) lhstext, sizeof (char) * lhs_len);
+	if (lhstext == NULL)
+/*
+ * TRANSLATION_NOTE  -- This is a message from yacc.
+ *	This message is passed to error() function.
+ *	LHS -- Left Hand Side.
+ */
+	    error ("couldn't expanded LHS length");
+    }
+    rhsfill ((char *) 0);
+    (void) strcpy (lhstext, s);	/* don't worry about too long of a name */
+}
+
+static void
+rhsfill (s)
+     char *s;			/* either name or 0 */
+{
+    static char *loc;		/* next free location in rhstext */
+    static int rhs_len = RHS_TEXT_LEN;
+    static int used = 0;
+    int s_rhs = (s == NULL ? 0 : strlen (s));
+    register char *p;
+
+    if (!s) {			/* print out and erase old text */
+	if (*lhstext)		/* there was an old rule - dump it */
+	    lrprnt ();
+	(loc = rhstext)[0] = 0;
+	return;
+    }
+    /* add to stuff in rhstext */
+    p = s;
+
+    used = loc - rhstext;
+    if ((s_rhs + 3) >= (rhs_len - used)) {
+	static char *textbase;
+	textbase = rhstext;
+	rhs_len += s_rhs + RHS_TEXT_LEN;
+	rhstext = (char *)
+	    realloc ((char *) rhstext, sizeof (char) * rhs_len);
+	if (rhstext == NULL)
+/*
+ * TRANSLATION_NOTE  -- This is a message from yacc.
+ *	This message is passed to error() function.
+ *	RHS -- Right Hand Side.
+ */
+	    error ("couldn't expanded RHS length");
+	loc = loc - textbase + rhstext;
+    }
+
+    *loc++ = ' ';
+    if (*s == ' ') {		/* special quoted symbol */
+	*loc++ = '\'';		/* add first quote */
+	p++;
+    }
+    while ((*loc = *p++)) {
+	if (loc++ > &rhstext[RHS_TEXT_LEN] - 3)
+	    break;
+    }
+
+    if (*s == ' ')
+	*loc++ = '\'';
+    *loc = 0;			/* terminate the string */
+}
+
+static void
+lrprnt ()
+{				/* print out the left and right hand sides */
+    char *rhs;
+    char *m_rhs = NULL;
+
+    if (!*rhstext)		/* empty rhs - print usual comment */
+	rhs = " /* empty */";
+    else {
+	int idx1;		/* tmp idx used to find if there are d_quotes */
+	int idx2;		/* tmp idx used to generate escaped string */
+	char *p;
+	/*
+	 * Check if there are any double quote in RHS.
+	 */
+	for (idx1 = 0; rhstext[idx1] != 0; idx1++) {
+	    if (rhstext[idx1] == '"') {
+		/*
+		 * A double quote is found.
+		 */
+		idx2 = strlen (rhstext) * 2;
+		p = m_rhs = (char *)
+		    malloc ((idx2 + 1) * sizeof (char));
+		if (m_rhs == NULL)
+/*
+ * TRANSLATION_NOTE  -- This is a message from yacc.
+ *	This message is passed to error() function.
+ *	RHS - Right Hand Side.
+ *
+ *	You may just translate this as:
+ *	'Could not allocate internally used memory.'
+ */
+		    error ("Couldn't allocate memory for RHS.");
+		/*
+		 * Copy string
+		 */
+		for (idx2 = 0; rhstext[idx2] != 0; idx2++) {
+		    /*
+		     * Check if this quote is escaped or not
+		     */
+		    if (rhstext[idx2] == '"') {
+			int tmp_l = idx2 - 1;
+			int cnt = 0;
+			while (tmp_l >= 0 && rhstext[tmp_l] == '\\') {
+			    cnt++;
+			    tmp_l--;
+			}
+			/*
+			 * If quote is not escaped,
+			 * then escape it.
+			 */
+			if (cnt % 2 == 0)
+			    *p++ = '\\';
+		    }
+		    *p++ = rhstext[idx2];
+		}
+		*p = 0;
+		/*
+		 * Break from the loop
+		 */
+		break;
+	    }
+	}
+	if (m_rhs == NULL)
+	    rhs = rhstext;
+	else
+	    rhs = m_rhs;
+    }
+    (void) fprintf (fdebug, WSFMT ("\t\"%s :%s\",\n"), lhstext, rhs);
+    if (m_rhs)
+	free (m_rhs);
+}
+
+
+#ifdef XYACC_DEBUG 
+
+static void
+beg_debug ()
+{				/* dump initial sequence for fdebug file */
+    (void) fprintf (fdebug, "typedef struct\n");
+    (void) fprintf (fdebug, "#ifdef __cplusplus\n\tyytoktype\n");
+    (void) fprintf (fdebug, "#endif\n{\n");
+    (void) fprintf (fdebug, "#ifdef __cplusplus\nconst\n#endif\n");
+    (void) fprintf (fdebug, "char *t_name; int t_val; } yytoktype;\n");
+    (void) fprintf (fdebug,
+		    "#ifndef YYDEBUG\n#\tdefine YYDEBUG\t%d", gen_testing);
+    (void) fprintf (fdebug, "\t/*%sallow debugging */\n#endif\n\n",
+		    gen_testing ? " " : " don't ");
+    (void) fprintf (fdebug, "#if YYDEBUG\n\nyytoktype yytoks[] =\n{\n");
+}
+
+
+static void
+end_toks ()
+{				/* finish yytoks array, get ready for yyred's strings */
+    (void) fprintf (fdebug, "\t\"-unknown-\",\t-1\t/* ends search */\n");
+    (void) fprintf (fdebug, "};\n\n");
+    (void) fprintf (fdebug, "#ifdef __cplusplus\nconst\n#endif\n");
+    (void) fprintf (fdebug, "char * yyreds[] =\n{\n");
+    (void) fprintf (fdebug, "\t\"-no such reduction-\",\n");
+}
+
+
+static void
+end_debug ()
+{				/* finish yyred array, close file */
+    lrprnt ();			/* dump last lhs, rhs */
+    (void) fprintf (fdebug, "};\n#endif /* YYDEBUG */\n");
+    (void) fclose (fdebug);
+}
+
+#endif
+
+
+/*
+ * 2/29/88 -
+ * The normal length for token sizes is NAMESIZE - If a token is
+ * seen that has a longer length, expand "tokname" by NAMESIZE.
+ */
+static void
+exp_tokname ()
+{
+    toksize += NAMESIZE;
+    tokname = (char *) realloc ((char *) tokname, sizeof (char) * toksize);
+}
+
+
+/*
+ * 2/29/88 -
+ *
+ */
+static void
+exp_prod ()
+{
+    int i;
+    nprodsz += NPROD;
+
+    prdptr =
+	(int **) realloc ((char *) prdptr, sizeof (int *) * (nprodsz + 2));
+    levprd = (int *) realloc ((char *) levprd, sizeof (int) * (nprodsz + 2));
+    had_act = (char *)
+	realloc ((char *) had_act, sizeof (char) * (nprodsz + 2));
+    for (i = nprodsz - NPROD; i < nprodsz + 2; ++i)
+	had_act[i] = 0;
+
+    if ((*prdptr == NULL) || (levprd == NULL) || (had_act == NULL))
+/*
+ * TRANSLATION_NOTE  -- This is a message from yacc.
+ *	This message is passed to error() function.
+ *
+ *	You may just translate this as:
+ *	'Could not allocate internally used memory.'
+ */
+	error ("couldn't expand productions");
+}
+
+/*
+ * 2/29/88 -
+ * Expand the number of terminals.  Initially there are NTERMS;
+ * each time space runs out, the size is increased by NTERMS.
+ * The total size, however, cannot exceed MAXTERMS because of
+ * the way LOOKSETS(struct looksets) is set up.
+ * Tables affected:
+ *	tokset, toklev : increased to ntoksz
+ *
+ *	tables with initial dimensions of TEMPSIZE must be changed if
+ *	(ntoksz + NNONTERM) >= TEMPSIZE : temp1[]
+ */
+static void
+exp_ntok ()
+{
+    ntoksz += NTERMS;
+
+    tokset = (TOKSYMB *) realloc ((char *) tokset, sizeof (TOKSYMB) * ntoksz);
+    toklev = (int *) realloc ((char *) toklev, sizeof (int) * ntoksz);
+
+    if ((tokset == NULL) || (toklev == NULL))
+/*
+ * TRANSLATION_NOTE  -- This is a message from yacc.
+ *	This message is passed to error() function.
+ *	Do not translate NTERMS.
+ *
+ *	You may just translate this as:
+ *	'Could not allocate internally used memory.'
+ */
+	error ("couldn't expand NTERMS");
+}
+
+
+static void
+exp_nonterm ()
+{
+    nnontersz += NNONTERM;
+
+    nontrst = (NTSYMB *)
+	realloc ((char *) nontrst, sizeof (TOKSYMB) * nnontersz);
+    if (nontrst == NULL)
+/*
+ * TRANSLATION_NOTE  -- This is a message from yacc.
+ *	This message is passed to error() function.
+ *	Do not translate NTERMS.
+ *
+ *	You may just translate this as:
+ *	'Could not allocate internally used memory.'
+ */
+	error ("couldn't expand NNONTERM");
+}
+
+void
+exp_mem (flag)
+     int flag;
+{
+    int i;
+    static int *membase;
+    new_memsize += MEMSIZE;
+
+    membase = tracemem;
+    tracemem = (int *)
+	realloc ((char *) tracemem, sizeof (int) * new_memsize);
+    if (tracemem == NULL)
+/*
+ * TRANSLATION_NOTE  -- This is a message from yacc.
+ *	This message is passed to error() function.
+ *
+ *	You may just translate this as:
+ *	'Could not allocate internally used memory.'
+ */
+	error ("couldn't expand mem table");
+    if (flag) {
+	for (i = 0; i <= nprod; ++i)
+	    prdptr[i] = prdptr[i] - membase + tracemem;
+	mem = mem - membase + tracemem;
+    } else {
+	size += MEMSIZE;
+	temp1 = (int *) realloc ((char *) temp1, sizeof (int) * size);
+	optimmem = optimmem - membase + tracemem;
+    }
+}
+
+static int
+findchtok (chlit)
+     int chlit;
+/*
+ * findchtok(chlit) returns the token number for a character literal
+ * chlit that is "bigger" than 255 -- the max char value that the
+ * original yacc was build for.  This yacc treate them as though
+ * an ordinary token.
+ */
+{
+    int i;
+
+    if (chlit < 0xff)
+	return (chlit);		/* single-byte char */
+    for (i = 0; i < nmbchars; ++i) {
+	if (mbchars->character == chlit)
+	    return (mbchars->tvalue);
+    }
+
+    /* Not found.  Register it! */
+    if (++nmbchars > nmbcharsz) {	/* Make sure there's enough space */
+	nmbcharsz += NMBCHARSZ;
+	mbchars = (MBCLIT *)
+	    realloc ((char *) mbchars, sizeof (MBCLIT) * nmbcharsz);
+	if (mbchars == NULL)
+	    error ("too many character literals");
+    }
+    mbchars[nmbchars - 1].character = chlit;
+    return (mbchars[nmbchars - 1].tvalue = extval++);
+    /* Return the newly assigned token. */
+}
+
+/*
+ * When -p is specified, symbol prefix for
+ *	yy{parse, lex, error}(),
+ *	yy{lval, val, char, debug, errflag, nerrs}
+ * are defined to the specified name.
+ */
+#ifdef PREFIX_DEFINE
+
+static void
+put_prefix_define (char *pre)
+{
+    char *syms[] = {
+	/* Functions */
+	"parse",
+	"lex",
+	"error",
+	/* Variables */
+	"lval",
+	"val",
+	"char",
+	"debug",
+	"errflag",
+	"nerrs",
+	NULL
+    };
+    int i;
+
+    for (i = 0; syms[i]; i++)
+	(void) fprintf (fsppout, "define\tyy%s\t%s%s\n",
+			syms[i], pre, syms[i]);
+}
+
+#endif
+
+
diff --git a/unix/boot/xyacc/y3.c b/unix/boot/xyacc/y3.c
new file mode 100644
index 00000000..1b6ac149
--- /dev/null
+++ b/unix/boot/xyacc/y3.c
@@ -0,0 +1,606 @@
+/*
+ * CDDL HEADER START
+ *
+ * The contents of this file are subject to the terms of the
+ * Common Development and Distribution License (the "License").
+ * You may not use this file except in compliance with the License.
+ *
+ * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE
+ * or http://www.opensolaris.org/os/licensing.
+ * See the License for the specific language governing permissions
+ * and limitations under the License.
+ *
+ * When distributing Covered Code, include this CDDL HEADER in each
+ * file and include the License file at usr/src/OPENSOLARIS.LICENSE.
+ * If applicable, add the following below this CDDL HEADER, with the
+ * fields enclosed by brackets "[]" replaced with your own identifying
+ * information: Portions Copyright [yyyy] [name of copyright owner]
+ *
+ * CDDL HEADER END
+ */
+/*
+ * Copyright 2008 Sun Microsystems, Inc.  All rights reserved.
+ * Use is subject to license terms.
+ */
+
+/* Copyright (c) 1988 AT&T */
+/* All Rights Reserved */
+
+//#pragma ident	"%Z%%M%	%I%	%E% SMI"
+
+#include "dextern.h"
+
+static void go2gen (int);
+static void precftn (int, int, int);
+static void wract (int);
+static void wrstate (int);
+static void wdef (char *, int);
+static void wrmbchars (void);
+	/* important local variables */
+static int lastred;		/* number of the last reduction of a state */
+int *defact;
+extern int *toklev;
+extern int cwp;
+
+int exca[NSTATES * 2];		/* buffer states for printing with warray  */
+int nexca;
+
+
+	/* I/O descriptors */
+
+extern FILE *finput;		/* input file                   */
+extern FILE *faction;		/* file for saving actions      */
+extern FILE *fdefine;		/* file for #defines            */
+extern FILE *fudecl;		/* file for user declarations   */
+extern FILE *ftable;		/* parser tables file           */
+extern FILE *fsppout;		/* SPP output file              */
+extern FILE *ftemp;		/* tempfile to pass 2           */
+extern FILE *foutput;		/* y.output file                */
+
+
+
+
+/* print the output for the states */
+void
+output ()
+{
+    int i, k, c;
+    register WSET *u, *v;
+
+    /*
+       (void) fprintf(fsppout, "static YYCONST yytabelem yyexca[] ={\n");
+     */
+
+    SLOOP (i) {			/* output the stuff for state i */
+	nolook = !(tystate[i] == MUSTLOOKAHEAD);
+	closure (i);
+	/* output actions */
+	nolook = 1;
+	aryfil (temp1, ntoksz + nnontersz + 1, 0);
+	WSLOOP (wsets, u) {
+	    c = *(u->pitem);
+	    if (c > 1 && c < NTBASE && temp1[c] == 0) {
+		WSLOOP (u, v) {
+		    if (c == *(v->pitem))
+			putitem (v->pitem + 1, (LOOKSETS *) 0);
+		}
+		temp1[c] = state (c);
+	    } else if (c > NTBASE && temp1[(c -= NTBASE) + ntokens] == 0) {
+		temp1[c + ntokens] = amem[indgo[i] + c];
+	    }
+	}
+	if (i == 1)
+	    temp1[1] = ACCEPTCODE;
+	/* now, we have the shifts; look at the reductions */
+	lastred = 0;
+	WSLOOP (wsets, u) {
+	    c = *(u->pitem);
+	    if (c <= 0) {	/* reduction */
+		lastred = -c;
+		TLOOP (k) {
+		    if (BIT (u->ws.lset, k)) {
+			if (temp1[k] == 0)
+			    temp1[k] = c;
+			else if (temp1[k] < 0) {
+			    /*
+			     * reduce/reduce
+			     * conflict
+			     */
+			    /* BEGIN CSTYLED */
+			    if (foutput != NULL)
+				(void) fprintf (foutput,
+						WSFMT
+						("\n%d: reduce/reduce conflict"
+						 " (red'ns %d and %d ) on %s"),
+						i, -temp1[k], lastred,
+						symnam (k));
+			    if (-temp1[k] > lastred)
+				temp1[k] = -lastred;
+			    ++zzrrconf;
+			    /* END CSTYLED */
+			} else
+			    /*
+			     * potentia
+			     * shift/reduce
+			     * conflict.
+			     */
+			    precftn (lastred, k, i);
+		    }
+		}
+	    }
+	}
+	wract (i);
+    }
+
+    /*
+       (void) fprintf(fsppout, "\t};\n");
+     */
+    warray ("yyexca", exca, nexca);
+    wdef ("YYNPROD", nprod);
+    if (nmbchars > 0) {
+	wrmbchars ();
+    }
+}
+
+static int pkdebug = 0;
+int
+apack (p, n)
+     int *p;
+     int n;
+{
+    /* pack state i from temp1 into amem */
+    int off;
+    int *pp, *qq;
+    int *q, *rr;
+    int diff;
+
+    /*
+     * we don't need to worry about checking because we
+     * we will only look up entries known to be there...
+     */
+
+    /* eliminate leading and trailing 0's */
+
+    q = p + n;
+    for (pp = p, off = 0; *pp == 0 && pp <= q; ++pp, --off)
+	/* NULL */ ;
+    if (pp > q)
+	return (0);		/* no actions */
+    p = pp;
+
+    /* now, find a place for the elements from p to q, inclusive */
+    /* for( rr=amem; rr<=r; ++rr,++off ){ *//* try rr */
+    rr = amem;
+    for (;; ++rr, ++off) {
+	while (rr >= &amem[new_actsize - 1])
+	    exp_act (&rr);
+	qq = rr;
+	for (pp = p; pp <= q; ++pp, ++qq) {
+	    if (*pp) {
+		diff = qq - rr;
+		while (qq >= &amem[new_actsize - 1]) {
+		    exp_act (&rr);
+		    qq = diff + rr;
+		}
+		if (*pp != *qq && *qq != 0)
+		    goto nextk;
+	    }
+	}
+
+	/* we have found an acceptable k */
+
+	if (pkdebug && foutput != NULL)
+	    (void) fprintf (foutput,
+			    "off = %d, k = %" PRIdPTR "\n", off, rr - amem);
+
+	qq = rr;
+	for (pp = p; pp <= q; ++pp, ++qq) {
+	    if (*pp) {
+		diff = qq - rr;
+		while (qq >= &amem[new_actsize - 1]) {
+		    exp_act (&rr);
+		    qq = diff + rr;
+		}
+		if (qq > memp)
+		    memp = qq;
+		*qq = *pp;
+	    }
+	}
+	if (pkdebug && foutput != NULL) {
+	    for (pp = amem; pp <= memp; pp += 10) {
+		(void) fprintf (foutput, "\t");
+		for (qq = pp; qq <= pp + 9; ++qq)
+		    (void) fprintf (foutput, "%d ", *qq);
+		(void) fprintf (foutput, "\n");
+	    }
+	}
+	return (off);
+      nextk:;
+    }
+    /* error("no space in action table" ); */
+    /* NOTREACHED */
+}
+
+void
+go2out ()
+{
+    /* output the gotos for the nontermninals */
+    int i, j, k, best, count, cbest, times;
+
+    (void) fprintf (ftemp, "$\n");	/* mark begining of gotos */
+
+    for (i = 1; i <= nnonter; ++i) {
+	go2gen (i);
+	/* find the best one to make default */
+	best = -1;
+	times = 0;
+	for (j = 0; j < nstate; ++j) {	/* is j the most frequent */
+	    if (tystate[j] == 0)
+		continue;
+	    if (tystate[j] == best)
+		continue;
+	    /* is tystate[j] the most frequent */
+	    count = 0;
+	    cbest = tystate[j];
+	    for (k = j; k < nstate; ++k)
+		if (tystate[k] == cbest)
+		    ++count;
+	    if (count > times) {
+		best = cbest;
+		times = count;
+	    }
+	}
+
+	/* best is now the default entry */
+	zzgobest += (times - 1);
+	for (j = 0; j < nstate; ++j) {
+	    if (tystate[j] != 0 && tystate[j] != best) {
+		(void) fprintf (ftemp, "%d,%d,", j, tystate[j]);
+		zzgoent += 1;
+	    }
+	}
+
+	/* now, the default */
+
+	zzgoent += 1;
+	(void) fprintf (ftemp, "%d\n", best);
+
+    }
+}
+
+static int g2debug = 0;
+static void
+go2gen (int c)
+{
+    /* output the gotos for nonterminal c */
+    int i, work, cc;
+    ITEM *p, *q;
+
+    /* first, find nonterminals with gotos on c */
+    aryfil (temp1, nnonter + 1, 0);
+    temp1[c] = 1;
+
+    work = 1;
+    while (work) {
+	work = 0;
+	PLOOP (0, i) {
+	    if ((cc = prdptr[i][1] - NTBASE) >= 0) {
+		/* cc is a nonterminal */
+		if (temp1[cc] != 0) {
+		    /*
+		     * cc has a goto on c
+		     * thus, the left side of
+		     * production i does too.
+		     */
+		    cc = *prdptr[i] - NTBASE;
+		    if (temp1[cc] == 0) {
+			work = 1;
+			temp1[cc] = 1;
+		    }
+		}
+	    }
+	}
+    }
+
+    /* now, we have temp1[c] = 1 if a goto on c in closure of cc */
+
+    if (g2debug && foutput != NULL) {
+	(void) fprintf (foutput, WSFMT ("%s: gotos on "), nontrst[c].name);
+	NTLOOP (i) if (temp1[i])
+	    (void) fprintf (foutput, WSFMT ("%s "), nontrst[i].name);
+	(void) fprintf (foutput, "\n");
+    }
+
+    /* now, go through and put gotos into tystate */
+    aryfil (tystate, nstate, 0);
+    SLOOP (i) {
+	ITMLOOP (i, p, q) {
+	    if ((cc = *p->pitem) >= NTBASE) {
+		if (temp1[cc -= NTBASE]) {
+		    /* goto on c is possible */
+		    tystate[i] = amem[indgo[i] + c];
+		    break;
+		}
+	    }
+	}
+    }
+}
+
+/* decide a shift/reduce conflict by precedence.  */
+static void
+precftn (int r, int t, int s)
+{
+
+    /*
+     * r is a rule number, t a token number
+     * the conflict is in state s
+     * temp1[t] is changed to reflect the action
+     */
+
+    int lp, lt, action;
+
+    lp = levprd[r];
+    lt = toklev[t];
+    if (PLEVEL (lt) == 0 || PLEVEL (lp) == 0) {
+	/* conflict */
+	if (foutput != NULL)
+	    (void) fprintf (foutput,
+			    WSFMT ("\n%d: shift/reduce conflict"
+				   " (shift %d, red'n %d) on %s"),
+			    s, temp1[t], r, symnam (t));
+	++zzsrconf;
+	return;
+    }
+    if (PLEVEL (lt) == PLEVEL (lp))
+	action = ASSOC (lt) & ~04;
+    else if (PLEVEL (lt) > PLEVEL (lp))
+	action = RASC;		/* shift */
+    else
+	action = LASC;		/* reduce */
+
+    switch (action) {
+    case BASC:			/* error action */
+	temp1[t] = ERRCODE;
+	return;
+    case LASC:			/* reduce */
+	temp1[t] = -r;
+	return;
+    }
+}
+
+
+/* WRACT -- Output the state I.  Modified to save state array in exca
+ * for later printing by warray.
+ */
+static void
+wract (int i)
+{
+    /* output state i */
+    /* temp1 has the actions, lastred the default */
+    int p, p0, p1;
+    int ntimes, tred, count, j;
+    int flag;
+
+    /* find the best choice for lastred */
+
+    lastred = 0;
+    ntimes = 0;
+    TLOOP (j) {
+	if (temp1[j] >= 0)
+	    continue;
+	if (temp1[j] + lastred == 0)
+	    continue;
+	/* count the number of appearances of temp1[j] */
+	count = 0;
+	tred = -temp1[j];
+	levprd[tred] |= REDFLAG;
+	TLOOP (p) {
+	    if (temp1[p] + tred == 0)
+		++count;
+	}
+	if (count > ntimes) {
+	    lastred = tred;
+	    ntimes = count;
+	}
+    }
+
+    /*
+     * for error recovery, arrange that, if there is a shift on the
+     * error recovery token, `error', that the default be the error action
+     if (temp1[2] > 0)
+     */
+    if (temp1[1] > 0)
+	lastred = 0;
+
+    /* clear out entries in temp1 which equal lastred */
+    TLOOP (p) {
+	if (temp1[p] + lastred == 0)
+	    temp1[p] = 0;
+    }
+
+    wrstate (i);
+    defact[i] = lastred;
+
+    flag = 0;
+    TLOOP (p0) {
+	if ((p1 = temp1[p0]) != 0) {
+	    if (p1 < 0) {
+		p1 = -p1;
+		goto exc;
+	    } else if (p1 == ACCEPTCODE) {
+		p1 = -1;
+		goto exc;
+	    } else if (p1 == ERRCODE) {
+		p1 = 0;
+		goto exc;
+	      exc:
+		if (flag++ == 0) {
+		    exca[nexca++] = -1;
+		    exca[nexca++] = i;
+		}
+		exca[nexca++] = tokset[p0].value;
+		exca[nexca++] = p1;
+		++zzexcp;
+		if (nexca >= NSTATES * 2) {
+		    error ("state table overflow");
+		}
+	    } else {
+		(void) fprintf (ftemp, "%d,%d,", tokset[p0].value, p1);
+		++zzacent;
+	    }
+	}
+    }
+    if (flag) {
+	defact[i] = -2;
+	exca[nexca++] = -2;
+	exca[nexca++] = lastred;
+    }
+    (void) fprintf (ftemp, "\n");
+}
+
+static void
+wrstate (int i)
+{
+    /* writes state i */
+    int j0, j1;
+    register ITEM *pp, *qq;
+    register WSET *u;
+
+    if (foutput == NULL)
+	return;
+    (void) fprintf (foutput, "\nstate %d\n", i);
+    ITMLOOP (i, pp, qq) {
+	(void) fprintf (foutput, WSFMT ("\t%s\n"), writem (pp->pitem));
+    }
+    if (tystate[i] == MUSTLOOKAHEAD) {
+	/* print out empty productions in closure */
+	WSLOOP (wsets + (pstate[i + 1] - pstate[i]), u) {
+	    if (*(u->pitem) < 0)
+		(void) fprintf (foutput, WSFMT ("\t%s\n"), writem (u->pitem));
+	}
+    }
+
+    /* check for state equal to another */
+    TLOOP (j0) if ((j1 = temp1[j0]) != 0) {
+	(void) fprintf (foutput, WSFMT ("\n\t%s  "), symnam (j0));
+	if (j1 > 0) {		/* shift, error, or accept */
+	    if (j1 == ACCEPTCODE)
+		(void) fprintf (foutput, "accept");
+	    else if (j1 == ERRCODE)
+		(void) fprintf (foutput, "error");
+	    else
+		(void) fprintf (foutput, "shift %d", j1);
+	} else
+	    (void) fprintf (foutput, "reduce %d", -j1);
+    }
+
+    /* output the final production */
+    if (lastred)
+	(void) fprintf (foutput, "\n\t.  reduce %d\n\n", lastred);
+    else
+	(void) fprintf (foutput, "\n\t.  error\n\n");
+
+    /* now, output nonterminal actions */
+    j1 = ntokens;
+    for (j0 = 1; j0 <= nnonter; ++j0) {
+	if (temp1[++j1])
+	    (void) fprintf (foutput,
+			    WSFMT ("\t%s  goto %d\n"),
+			    symnam (j0 + NTBASE), temp1[j1]);
+    }
+}
+
+static void
+wdef (char *s, int n)
+{
+    /* output a definition of s to the value n */
+    (void) fprintf (fsppout, WSFMT ("define\t%s\t\t%d\n"), s, n);
+}
+
+# define NDP_PERLINE    8
+
+void
+warray (s, v, n)
+     char *s;
+     int *v, n;
+{
+    register int i, j;
+
+    fprintf (ftable, "short\t%s[%d]\n", s, n);
+
+    for (j = 0; j < n; j += NDP_PERLINE) {
+	fprintf (ftable, "data\t(%s(i),i=%3d,%3d)\t/",
+		 s, j + 1, (j + NDP_PERLINE < n) ? j + NDP_PERLINE : n);
+
+	for (i = j; i < j + NDP_PERLINE && i < n; i++) {
+	    if ((i == j + NDP_PERLINE - 1) || i >= n - 1)
+		fprintf (ftable, "%4d/\n", v[i]);
+	    else
+		fprintf (ftable, "%4d,", v[i]);
+	}
+    }
+}
+
+void
+hideprod ()
+{
+    /*
+     * in order to free up the mem and amem arrays for the optimizer,
+     * and still be able to output yyr1, etc., after the sizes of
+     * the action array is known, we hide the nonterminals
+     * derived by productions in levprd.
+     */
+
+    int i, j;
+
+    j = 0;
+    levprd[0] = 0;
+    PLOOP (1, i) {
+	if (!(levprd[i] & REDFLAG)) {
+	    ++j;
+	    if (foutput != NULL) {
+		(void) fprintf (foutput,
+				WSFMT ("Rule not reduced:   %s\n"),
+				writem (prdptr[i]));
+	    }
+	}
+	levprd[i] = *prdptr[i] - NTBASE;
+    }
+    if (j)
+/*
+ * TRANSLATION_NOTE  -- This is a message from yacc.
+ *	Check how 'reduced' is translated in yacc man page/document.
+ */
+	(void) fprintf (stderr, "%d rules never reduced\n", j);
+}
+
+
+static int
+cmpmbchars (p, q)
+     MBCLIT *p, *q;
+{
+    /* Compare two MBLITs. */
+    return ((p->character) - (q->character));
+}
+
+static void
+wrmbchars ()
+{
+    int i;
+
+    return wdef ("YYNMBCHARS", nmbchars);
+    qsort (mbchars, nmbchars, sizeof (*mbchars),
+	   (int (*)(const void *, const void *)) cmpmbchars);
+    (void) fprintf (ftable,
+		    "static struct{\n\tchar character;"
+		    "\n\tint tvalue;\n}yymbchars[YYNMBCHARS]={\n");
+    for (i = 0; i < nmbchars; ++i) {
+	(void) fprintf (ftable, "\t{%#x,%d}",
+			(int) mbchars[i].character, mbchars[i].tvalue);
+	if (i < nmbchars - 1) {
+	    /* Not the last. */
+	    (void) fprintf (ftable, ",\n");
+	}
+    }
+    (void) fprintf (ftable, "\n};\n");
+}
diff --git a/unix/boot/xyacc/y4.c b/unix/boot/xyacc/y4.c
new file mode 100644
index 00000000..2badc0e5
--- /dev/null
+++ b/unix/boot/xyacc/y4.c
@@ -0,0 +1,528 @@
+/*
+ * CDDL HEADER START
+ *
+ * The contents of this file are subject to the terms of the
+ * Common Development and Distribution License (the "License").
+ * You may not use this file except in compliance with the License.
+ *
+ * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE
+ * or http://www.opensolaris.org/os/licensing.
+ * See the License for the specific language governing permissions
+ * and limitations under the License.
+ *
+ * When distributing Covered Code, include this CDDL HEADER in each
+ * file and include the License file at usr/src/OPENSOLARIS.LICENSE.
+ * If applicable, add the following below this CDDL HEADER, with the
+ * fields enclosed by brackets "[]" replaced with your own identifying
+ * information: Portions Copyright [yyyy] [name of copyright owner]
+ *
+ * CDDL HEADER END
+ */
+/*
+ * Copyright 2008 Sun Microsystems, Inc.  All rights reserved.
+ * Use is subject to license terms.
+ */
+
+/* Copyright (c) 1988 AT&T */
+/* All Rights Reserved */
+
+//#pragma ident	"%Z%%M%	%I%	%E% SMI"
+
+#include "dextern.h"
+#include <wctype.h>
+#define	NOMORE -1000
+
+static void gin (int);
+static void stin (int);
+static void osummary (void);
+static void aoutput (void);
+static void arout (char *, int *, int);
+static int nxti (void);
+static int gtnm (void);
+
+static int *ggreed;
+static int *pgo;
+static int *yypgo;
+
+static int maxspr = 0;		/* maximum spread of any entry */
+static int maxoff = 0;		/* maximum offset into an array */
+int *optimmem;
+static int *maxa;
+
+static int nxdb = 0;
+static int adb = 0;
+
+	/* I/O descriptors */
+
+extern FILE *finput;		/* input file                   */
+extern FILE *faction;		/* file for saving actions      */
+extern FILE *fdefine;		/* file for #defines            */
+extern FILE *fudecl;		/* file for user declarations   */
+extern FILE *ftable;		/* parser tables file           */
+extern FILE *fsppout;		/* SPP output file              */
+extern FILE *ftemp;		/* tempfile to pass 2           */
+extern FILE *foutput;		/* y.output file                */
+
+
+void
+callopt ()
+{
+    int i, *p, j, k, *q;
+
+    ggreed = (int *) malloc (sizeof (int) * size);
+    pgo = (int *) malloc (sizeof (int) * size);
+    yypgo = &nontrst[0].tvalue;
+
+    /* read the arrays from tempfile and set parameters */
+
+    if ((finput = fopen (TEMPNAME, "r")) == NULL)
+/*
+ * TRANSLATION_NOTE  -- This is a message from yacc.
+ *	This message is passed to error() function.
+ *	tempfile can be translated as temporary file.
+ */
+	error ("optimizer cannot open tempfile");
+
+    optimmem = tracemem;
+    pgo[0] = 0;
+    temp1[0] = 0;
+    nstate = 0;
+    nnonter = 0;
+    for (;;) {
+	switch (gtnm ()) {
+
+	case '\n':
+	    temp1[++nstate] = (--optimmem) - tracemem;
+	    /* FALLTHRU */
+
+	case ',':
+	    continue;
+
+	case '$':
+	    break;
+
+	default:
+	    error ("bad tempfile");
+	}
+	break;
+    }
+
+    temp1[nstate] = yypgo[0] = (--optimmem) - tracemem;
+
+    for (;;) {
+	switch (gtnm ()) {
+
+	case '\n':
+	    yypgo[++nnonter] = optimmem - tracemem;
+	    /* FALLTHRU */
+	case ',':
+	    continue;
+
+	case EOF:
+	    break;
+
+	default:
+/*
+ * TRANSLATION_NOTE  -- This is a message from yacc.
+ *	This message is passed to error() function.
+ *	tempfile can be translated as 'temporary file'.
+ */
+	    error ("bad tempfile");
+	}
+	break;
+    }
+
+    yypgo[nnonter--] = (--optimmem) - tracemem;
+
+    for (i = 0; i < nstate; ++i) {
+	k = 32000;
+	j = 0;
+	q = tracemem + temp1[i + 1];
+	for (p = tracemem + temp1[i]; p < q; p += 2) {
+	    if (*p > j)
+		j = *p;
+	    if (*p < k)
+		k = *p;
+	}
+	if (k <= j) {
+	    /*
+	     * nontrivial situation
+	     * temporarily, kill this for compatibility
+	     */
+	    /* j -= k;  j is now the range */
+	    if (k > maxoff)
+		maxoff = k;
+	}
+	tystate[i] = (temp1[i + 1] - temp1[i]) + 2 * j;
+	if (j > maxspr)
+	    maxspr = j;
+    }
+
+    /* initialize ggreed table */
+    for (i = 1; i <= nnonter; ++i) {
+	ggreed[i] = 1;
+	j = 0;
+	/* minimum entry index is always 0 */
+	q = tracemem + yypgo[i + 1] - 1;
+	for (p = tracemem + yypgo[i]; p < q; p += 2) {
+	    ggreed[i] += 2;
+	    if (*p > j)
+		j = *p;
+	}
+	ggreed[i] = ggreed[i] + 2 * j;
+	if (j > maxoff)
+	    maxoff = j;
+    }
+
+    /* now, prepare to put the shift actions into the amem array */
+    for (i = 0; i < new_actsize; ++i)
+	amem[i] = 0;
+    maxa = amem;
+
+    for (i = 0; i < nstate; ++i) {
+	if (tystate[i] == 0 && adb > 1)
+	    (void) fprintf (ftable, "State %d: null\n", i);
+	indgo[i] = YYFLAG1;
+    }
+
+    while ((i = nxti ()) != NOMORE) {
+	if (i >= 0)
+	    stin (i);
+	else
+	    gin (-i);
+    }
+
+    if (adb > 2) {		/* print a array */
+	for (p = amem; p <= maxa; p += 10) {
+	    (void) fprintf (ftable, "%4" PRIdPTR "  ", p - amem);
+	    for (i = 0; i < 10; ++i)
+		(void) fprintf (ftable, "%4d  ", p[i]);
+	    (void) fprintf (ftable, "\n");
+	}
+    }
+
+
+    /* write out the output appropriate to the language */
+    aoutput ();
+    osummary ();
+    ZAPFILE (TEMPNAME);
+}
+
+static void
+gin (int i)
+{
+    int *r, *s, *q1, *q2;
+    int *p;
+
+    /* enter gotos on nonterminal i into array amem */
+    ggreed[i] = 0;
+
+    q2 = tracemem + yypgo[i + 1] - 1;
+    q1 = tracemem + yypgo[i];
+
+    /* now, find a place for it */
+
+    /* for( p=amem; p < &amem[new_actsize]; ++p ){ */
+    p = amem;
+    for (;;) {
+	while (p >= &amem[new_actsize])
+	    exp_act (&p);
+	if (*p)
+	    goto nextgp;
+	for (r = q1; r < q2; r += 2) {
+	    s = p + *r + 1;
+	    /*
+	     * Check if action table needs to
+	     * be expanded or not. If so,
+	     * expand it.
+	     */
+	    while (s >= &amem[new_actsize]) {
+		exp_act (&p);
+		s = p + *r + 1;
+	    }
+	    if (*s)
+		goto nextgp;
+	    if (s > maxa) {
+		while ((maxa = s) >= &amem[new_actsize])
+		    /* error( "amem array overflow" ); */
+		    exp_act (&p);
+	    }
+	}
+	/* we have found a spot */
+	*p = *q2;
+	if (p > maxa) {
+	    while ((maxa = p) >= &amem[new_actsize])
+		/* error("amem array overflow"); */
+		exp_act (&p);
+	}
+	for (r = q1; r < q2; r += 2) {
+	    s = p + *r + 1;
+	    /*
+	     * Check if action table needs to
+	     * be expanded or not. If so,
+	     * expand it.
+	     */
+	    while (s >= &amem[new_actsize]) {
+		exp_act (&p);
+		s = p + *r + 1;
+	    }
+	    *s = r[1];
+	}
+
+	pgo[i] = p - amem;
+	if (adb > 1)
+	    (void) fprintf (ftable,
+			    "Nonterminal %d, entry at %d\n", i, pgo[i]);
+	goto nextgi;
+
+      nextgp:
+	++p;
+    }
+    /* error( "cannot place goto %d\n", i ); */
+  nextgi:;
+}
+
+static void
+stin (int i)
+{
+    int *r, n, nn, flag, j, *q1, *q2;
+    int *s;
+
+    tystate[i] = 0;
+
+    /* Enter state i into the amem array */
+
+    q2 = tracemem + temp1[i + 1];
+    q1 = tracemem + temp1[i];
+    /* Find an acceptable place */
+
+    nn = -maxoff;
+  more:
+    for (n = nn; n < new_actsize; ++n) {
+	flag = 0;
+	for (r = q1; r < q2; r += 2) {
+	    s = *r + n + amem;
+	    if (s < amem)
+		goto nextn;
+	    /*
+	     * Check if action table needs to
+	     * be expanded or not. If so,
+	     * expand it.
+	     */
+	    while (s >= &amem[new_actsize]) {
+		exp_act ((int **) NULL);
+		s = *r + n + amem;
+	    }
+	    if (*s == 0)
+		++flag;
+	    else if (*s != r[1])
+		goto nextn;
+	}
+
+	/*
+	 * check that the position equals another
+	 * only if the states are identical
+	 */
+	for (j = 0; j < nstate; ++j) {
+	    if (indgo[j] == n) {
+		if (flag)
+		    /*
+		     * we have some disagreement.
+		     */
+		    goto nextn;
+		if (temp1[j + 1] + temp1[i] == temp1[j] + temp1[i + 1]) {
+		    /* states are equal */
+		    indgo[i] = n;
+		    if (adb > 1)
+			(void) fprintf (ftable,
+					"State %d: entry at"
+					" %d equals state %d\n", i, n, j);
+		    return;
+		}
+		goto nextn;	/* we have some disagreement */
+	    }
+	}
+
+	for (r = q1; r < q2; r += 2) {
+	    while ((s = *r + n + amem) >= &amem[new_actsize]) {
+		/*
+		 * error( "out of space");
+		 */
+		exp_act ((int **) NULL);
+	    }
+	    if (s > maxa)
+		maxa = s;
+	    if (*s != 0 && *s != r[1])
+/*
+ * TRANSLATION_NOTE  -- This is a message from yacc.
+ *	This message is passed to error() function.
+ *	Leave this untrasnlated. Yacc internal error.
+ */
+		error ("clobber of amem array, pos'n %d, by %d",
+		       s - amem, r[1]);
+	    *s = r[1];
+	}
+	indgo[i] = n;
+	if (adb > 1)
+	    (void) fprintf (ftable, "State %d: entry at %d\n", i, indgo[i]);
+	return;
+      nextn:;
+    }
+
+    /* error( "Error; failure to place state %d\n", i ); */
+    exp_act ((int **) NULL);
+    nn = new_actsize - ACTSIZE;
+    goto more;
+    /* NOTREACHED */
+}
+
+static int
+nxti ()
+{
+    /* finds the next i */
+    int i, max, maxi;
+    max = 0;
+    maxi = 0;
+
+    for (i = 1; i <= nnonter; ++i)
+	if (ggreed[i] >= max) {
+	    max = ggreed[i];
+	    maxi = -i;
+	}
+
+    for (i = 0; i < nstate; ++i)
+	if (tystate[i] >= max) {
+	    max = tystate[i];
+	    maxi = i;
+	}
+    if (nxdb)
+	(void) fprintf (ftable, "nxti = %d, max = %d\n", maxi, max);
+    if (max == 0)
+	return (NOMORE);
+    else
+	return (maxi);
+}
+
+static void
+osummary ()
+{
+    /* write summary */
+    int i, *p;
+
+    if (foutput == NULL)
+	return;
+    i = 0;
+    for (p = maxa; p >= amem; --p) {
+	if (*p == 0)
+	    ++i;
+    }
+
+    (void) fprintf (foutput,
+		    "Optimizer space used: input %" PRIdPTR
+		    "/%d, output %" PRIdPTR "/%d\n",
+		    optimmem - tracemem + 1, new_memsize, maxa - amem + 1,
+		    new_actsize);
+    (void) fprintf (foutput, "%" PRIdPTR " table entries, %d zero\n",
+		    (maxa - amem) + 1, i);
+    (void) fprintf (foutput, "maximum spread: %d, maximum offset: %d\n",
+		    maxspr, maxoff);
+
+}
+
+
+/* AOUTPUT -- This version is for SPP.
+ */
+static void
+aoutput ()
+{
+    /* write out the optimized parser */
+
+    fprintf (fsppout, "define\tYYLAST\t\t%d\n", (int) (maxa - amem + 1));
+
+    arout ("yyact", amem, (maxa - amem) + 1);
+    arout ("yypact", indgo, nstate);
+    arout ("yypgo", pgo, nnonter + 1);
+}
+
+
+/* AROUT -- Output SPP declarations and initializations for a Yacc table.
+ */
+# define NDP_PERLINE    8
+
+static void
+arout (s, v, n)
+     char *s;
+     int *v, n;
+{
+    register int i, j;
+
+    fprintf (ftable, "short\t%s[%d]\n", s, n);
+
+    for (j = 0; j < n; j += NDP_PERLINE) {
+	fprintf (ftable, "data\t(%s(i),i=%3d,%3d)\t/",
+		 s, j + 1, (j + NDP_PERLINE < n) ? j + NDP_PERLINE : n);
+
+	for (i = j; i < j + NDP_PERLINE && i < n; i++) {
+	    if ((i == j + NDP_PERLINE - 1) || i >= n - 1)
+		fprintf (ftable, "%4d/\n", v[i]);
+	    else
+		fprintf (ftable, "%4d,", v[i]);
+	}
+    }
+}
+
+static int
+gtnm ()
+{
+    int s, val, c;
+
+    /* read and convert an integer from the standard input */
+    /* return the terminating character */
+    /* blanks, tabs, and newlines are ignored */
+
+    s = 1;
+    val = 0;
+
+    while ((c = getc (finput)) != EOF) {
+	if (iswdigit (c))
+	    val = val * 10 + c - '0';
+	else if (c == '-')
+	    s = -1;
+	else
+	    break;
+    }
+    *optimmem++ = s * val;
+    if (optimmem >= &tracemem[new_memsize])
+	exp_mem (0);
+    return (c);
+}
+
+void
+exp_act (ptr)
+     int **ptr;
+{
+    static int *actbase;
+    int i;
+    new_actsize += ACTSIZE;
+
+    actbase = amem;
+    amem = (int *) realloc ((char *) amem, sizeof (int) * new_actsize);
+    if (amem == NULL)
+/*
+ * TRANSLATION_NOTE  -- This is a message from yacc.
+ *	This message is passed to error() function.
+ *
+ *	You may just translate this as:
+ *	'Could not allocate internally used memory.'
+ */
+	error ("couldn't expand action table");
+
+    for (i = new_actsize - ACTSIZE; i < new_actsize; ++i)
+	amem[i] = 0;
+    if (ptr != NULL)
+	*ptr = *ptr - actbase + amem;
+    if (memp >= amem)
+	memp = memp - actbase + amem;
+    if (maxa >= amem)
+	maxa = maxa - actbase + amem;
+}
diff --git a/unix/boot/xyacc/yaccpar.x b/unix/boot/xyacc/yaccpar.x
new file mode 100644
index 00000000..71a323b4
--- /dev/null
+++ b/unix/boot/xyacc/yaccpar.x
@@ -0,0 +1,238 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# Parser for yacc output, translated to the IRAF SPP language.  The contents
+# of this file form the bulk of the source of the parser produced by Yacc.
+# Yacc recognizes several macros in the yaccpar input source and replaces
+# them as follows:
+#	A	user suppled "global" definitions and declarations
+# 	B	parser tables
+# 	C	user supplied actions (reductions)
+# The remainder of the yaccpar code is not changed.
+
+define	yystack_	10		# statement labels for gotos
+define	yynewstate_	20
+define	yydefault_	30
+define	yyerrlab_	40
+define	yyabort_	50
+
+define	YYFLAG		(-1000)		# defs used in user actions
+define	YYERROR		goto yyerrlab_
+define	YYACCEPT	return (OK)
+define	YYABORT		return (ERR)
+
+
+# YYPARSE -- Parse the input stream, returning OK if the source is
+# syntactically acceptable (i.e., if compilation is successful),
+# otherwise ERR.  The parameters YYMAXDEPTH and YYOPLEN must be
+# supplied by the caller in the %{ ... %} section of the Yacc source.
+# The token value stack is a dynamically allocated array of operand
+# structures, with the length and makeup of the operand structure being
+# application dependent.
+
+int procedure yyparse (fd, yydebug, yylex)
+
+int	fd			# stream to be parsed
+bool	yydebug			# print debugging information?
+int	yylex()			# user-supplied lexical input function
+extern	yylex()
+
+short	yys[YYMAXDEPTH]		# parser stack -- stacks tokens
+pointer	yyv			# pointer to token value stack
+pointer	yyval			# value returned by action
+pointer	yylval			# value of token
+int	yyps			# token stack pointer
+pointer	yypv			# value stack pointer
+int	yychar			# current input token number
+int	yyerrflag		# error recovery flag
+int	yynerrs			# number of errors
+
+short	yyj, yym		# internal variables
+pointer	yysp, yypvt
+short	yystate, yyn
+int	yyxi, i
+errchk	salloc, yylex
+
+$A	# User declarations go here.
+$B	# YACC parser tables defining the finite automaton go here.
+
+begin
+	call smark (yysp)
+	call salloc (yyv, (YYMAXDEPTH+2) * YYOPLEN, TY_STRUCT)
+
+	# Initialization.  The first element of the dynamically allocated
+	# token value stack (yyv) is used for yyval, the second for yylval,
+	# and the actual stack starts with the third element.
+
+	yystate = 0
+	yychar = -1
+	yynerrs = 0
+	yyerrflag = 0
+	yyps = 0
+	yyval = yyv
+	yylval = yyv + YYOPLEN
+	yypv = yylval
+
+yystack_
+	# SHIFT -- Put a state and value onto the stack.  The token and
+	# value stacks are logically the same stack, implemented as two
+	# separate arrays.
+
+	if (yydebug) {
+	    call printf ("state %d, char 0%o\n")
+		call pargs (yystate)
+		call pargi (yychar)
+	}
+	yyps = yyps + 1
+	yypv = yypv + YYOPLEN
+	if (yyps > YYMAXDEPTH) {
+	    call sfree (yysp)
+	    call eprintf ("yacc stack overflow\n")
+	    return (ERR)
+	}
+	yys[yyps] = yystate
+	YYMOVE (yyval, yypv)
+
+yynewstate_
+	# Process the new state.
+	yyn = yypact[yystate+1]
+
+	if (yyn <= YYFLAG)
+	    goto yydefault_			# simple state
+
+	# The variable "yychar" is the lookahead token.
+	if (yychar < 0) {
+	    yychar = yylex (fd, yylval)
+	    if (yychar < 0)
+		yychar = 0
+	}
+	yyn = yyn + yychar
+	if (yyn < 0 || yyn >= YYLAST)
+	    goto yydefault_
+
+	yyn = yyact[yyn+1]
+	if (yychk[yyn+1] == yychar) {		# valid shift
+	    yychar = -1
+	    YYMOVE (yylval, yyval)
+	    yystate = yyn
+	    if (yyerrflag > 0)
+		yyerrflag = yyerrflag - 1
+	    goto yystack_
+	}
+
+yydefault_
+	# Default state action.
+
+	yyn = yydef[yystate+1]
+	if (yyn == -2) {
+	    if (yychar < 0) {
+		yychar = yylex (fd, yylval)
+		if (yychar < 0)
+		    yychar = 0
+	    }
+
+	    # Look through exception table.
+	    yyxi = 1
+	    while ((yyexca[yyxi] != (-1)) || (yyexca[yyxi+1] != yystate))
+		yyxi = yyxi + 2
+	    for (yyxi=yyxi+2;  yyexca[yyxi] >= 0;  yyxi=yyxi+2) {
+		if (yyexca[yyxi] == yychar)
+		    break
+	    }
+
+	    yyn = yyexca[yyxi+1]
+	    if (yyn < 0) {
+		call sfree (yysp)
+		return (OK)			# ACCEPT -- all done
+	    }
+	}
+
+
+	# SYNTAX ERROR -- resume parsing if possible.
+
+	if (yyn == 0) {
+	    switch (yyerrflag) {
+	    case 0, 1, 2:
+		if (yyerrflag == 0) {		# brand new error
+		    call eprintf ("syntax error\n")
+yyerrlab_
+		    yynerrs = yynerrs + 1
+		    # fall through...
+		}
+
+	    # case 1:
+	    # case 2: incompletely recovered error ... try again
+		yyerrflag = 3
+
+		# Find a state where "error" is a legal shift action.
+		while (yyps >= 1) {
+		    yyn = yypact[yys[yyps]+1] + YYERRCODE
+		    if ((yyn >= 0) && (yyn < YYLAST) &&
+			(yychk[yyact[yyn+1]+1] == YYERRCODE)) {
+			    # Simulate a shift of "error".
+			    yystate = yyact[yyn+1]
+			    goto yystack_
+		    }
+		    yyn = yypact[yys[yyps]+1]
+
+		    # The current yyps has no shift on "error", pop stack.
+		    if (yydebug) {
+			call printf ("error recovery pops state %d, ")
+			    call pargs (yys[yyps])
+			call printf ("uncovers %d\n")
+			    call pargs (yys[yyps-1])
+		    }
+		    yyps = yyps - 1
+		    yypv = yypv - YYOPLEN
+		}
+
+		# ABORT -- There is no state on the stack with an error shift.
+yyabort_
+		call sfree (yysp)
+		return (ERR)
+
+
+	    case 3: # No shift yet; clobber input char.
+
+		if (yydebug) {
+		    call printf ("error recovery discards char %d\n")
+			call pargi (yychar)
+		}
+
+		if (yychar == 0)
+		    goto yyabort_		# don't discard EOF, quit
+		yychar = -1
+		goto yynewstate_		# try again in the same state
+	    }
+	}
+
+
+	# REDUCE -- Reduction by production yyn.
+
+	if (yydebug) {
+	    call printf ("reduce %d\n")
+		call pargs (yyn)
+	}
+	yyps  = yyps - yyr2[yyn+1]
+	yypvt = yypv
+	yypv  = yypv - yyr2[yyn+1] * YYOPLEN
+	YYMOVE (yypv + YYOPLEN, yyval)
+	yym   = yyn
+
+	# Consult goto table to find next state.
+	yyn = yyr1[yyn+1]
+	yyj = yypgo[yyn+1] + yys[yyps] + 1
+	if (yyj >= YYLAST)
+	    yystate = yyact[yypgo[yyn+1]+1]
+	else {
+	    yystate = yyact[yyj+1]
+	    if (yychk[yystate+1] != -yyn)
+		yystate = yyact[yypgo[yyn+1]+1]
+	}
+
+	# Perform action associated with the grammar rule, if any.
+	switch (yym) {
+	    $C	# YACC replaces this line by the user supplied actions.
+	}
+
+	goto yystack_				# stack new state and value
+end